diff --git a/src/CRTM_Tangent_Linear_Module.f90 b/src/CRTM_Tangent_Linear_Module.f90 index dc9bddad..9940f995 100644 --- a/src/CRTM_Tangent_Linear_Module.f90 +++ b/src/CRTM_Tangent_Linear_Module.f90 @@ -657,9 +657,9 @@ FUNCTION profile_solution (m, Opt, AncillaryInput) RESULT( Error_Status ) CALL Display_Message( ROUTINE_NAME, Message, Error_Status ) RETURN END IF - - Atm_TL%Height = Atm%Height - + + Atm_TL%Height = Atm%Height + ! ...Check the total number of Atm layers IF ( Atm%n_Layers > MAX_N_LAYERS .OR. Atm_TL%n_Layers > MAX_N_LAYERS) THEN Error_Status = FAILURE @@ -859,6 +859,40 @@ FUNCTION profile_solution (m, Opt, AncillaryInput) RESULT( Error_Status ) Predictor_TL(nt) , & ! Output PVar(nt) ) ! Internal variable input + ! Process aircraft pressure altitude + IF ( Opt%Aircraft_Pressure > ZERO ) THEN + RTV(nt)%aircraft%rt = .TRUE. + RTV(nt)%aircraft%idx = CRTM_Get_PressureLevelIdx(Atm, Opt%Aircraft_Pressure) + ! ...Issue warning if profile level is TOO different from flight level + IF ( ABS(Atm%Level_Pressure(RTV(nt)%aircraft%idx)-Opt%Aircraft_Pressure) > AIRCRAFT_PRESSURE_THRESHOLD ) THEN + WRITE( Message,'("Difference between aircraft pressure level (",es22.15,& + &"hPa) and closest input profile level (",es22.15,& + &"hPa) is larger than recommended (",f4.1,"hPa) for profile #",i0)') & + Opt%Aircraft_Pressure, Atm%Level_Pressure(RTV(nt)%aircraft%idx), & + AIRCRAFT_PRESSURE_THRESHOLD, m + CALL Display_Message( ROUTINE_NAME, Message, WARNING ) + END IF + ELSE + RTV(nt)%aircraft%rt = .FALSE. + END IF + + ! Process observing downward radiance, Obs_4_downward_P = ZERO means at surface + ! Obs_4_downward_P > ZERO, sensor at the pressure + IF ( Opt%Obs_4_downward_P > ZERO ) THEN + RTV(nt)%Obs_4_downward%rt = .TRUE. + RTV(nt)%Obs_4_downward%idx = CRTM_Get_PressureLevelIdx(Atm, Opt%Obs_4_downward_P) + ! ...Issue warning if profile level is TOO different from flight level + IF ( ABS(Atm%Level_Pressure(RTV(nt)%Obs_4_downward%idx)-Opt%Obs_4_downward_P) > AIRCRAFT_PRESSURE_THRESHOLD ) THEN + WRITE( Message,'("Difference between Obs pressure level (",es22.15,& + &"hPa) and closest input profile level (",es22.15,& + &"hPa) is larger than recommended (",f4.1,"hPa) for profile #",i0)') & + Opt%Obs_4_downward_P, Atm%Level_Pressure(RTV%Obs_4_downward%idx), & + AIRCRAFT_PRESSURE_THRESHOLD, m + CALL Display_Message( ROUTINE_NAME, Message, WARNING ) + END IF + ELSE + RTV(nt)%Obs_4_downward%rt = .FALSE. + END IF ! Compute predictors for AtmAbsorption calcs ! ...Allocate the predictor structure @@ -1339,7 +1373,7 @@ FUNCTION profile_solution (m, Opt, AncillaryInput) RESULT( Error_Status ) SensorIndex , & ! Input ChannelIndex , & ! Input RTSolution(ln,m)) ! Input/Output - + CALL CRTM_Compute_Reflectivity_TL(Atm , & ! Input AtmOptics(nt) , & ! Input AtmOptics_TL(nt) , & ! Input diff --git a/src/RTSolution/ADA/ADA_Module.f90 b/src/RTSolution/ADA/ADA_Module.f90 index 42553096..1e354d94 100644 --- a/src/RTSolution/ADA/ADA_Module.f90 +++ b/src/RTSolution/ADA/ADA_Module.f90 @@ -12,6 +12,8 @@ ! 08-Jun-2004 ! Updated by: Quanhua Liu, NOAA/STAR: quanhua.liu@noaa.gov ! 18-Dec-2021 +! Updated by: Cheng Dang, UCAR, dangch@ucar.edu, Aug-2024 + MODULE ADA_Module ! ------------------ @@ -134,11 +136,15 @@ SUBROUTINE CRTM_ADA(n_Layers, & ! Input number of atmospheric layers CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CRTM_ADA' CHARACTER(256) :: Message + ! Total optical depth from the layer to TOA + ! ... Zero at TOA total_opt(0) = ZERO + ! ... Below TOA DO k = 1, n_Layers total_opt(k) = total_opt(k-1) + T_OD(k) END DO + ! Variable initialization nZ = RTV%n_Angles * RTV%n_Stokes RTV%s_Layer_Trans = ZERO RTV%s_Layer_Refl = ZERO @@ -149,229 +155,258 @@ SUBROUTINE CRTM_ADA(n_Layers, & ! Input number of atmospheric layers refl_down = ZERO temporal_matrix = ZERO + ! Boundary conditions for the bottom layer + ! ... Surface reflectivity RTV%s_Level_Refl_UP(1:nZ,1:nZ,n_Layers)=reflectivity(1:nZ,1:nZ) - + ! ... Upwelling/surface-leaving radiance + ! ... (a) Radiance emitted by the surface IF( RTV%mth_Azi == 0 ) THEN RTV%s_Level_Rad_UP(1:nZ,n_Layers ) = emissivity(1:nZ)*RTV%Planck_Surface END IF - + ! ... (b) Direct solar radiance reflected by the surface IF( RTV%Solar_Flag_true ) THEN RTV%s_Level_Rad_UP(1:nZ,n_Layers ) = RTV%s_Level_Rad_UP(1:nZ,n_Layers )+direct_reflectivity(1:nZ)* & RTV%COS_SUN*RTV%Solar_irradiance/PI*exp(-total_opt(n_Layers)/RTV%COS_SUN) END IF + ! 1. CRTM DEFAULT OUTPUT: Top-of-Atmosphere leaving radiance ! UPWARD ADDING LOOP STARTS FROM BOTTOM LAYER TO ATMOSPHERIC TOP LAYER. DO 10 k = n_Layers, 1, -1 - ! Compute tranmission and reflection matrices for a layer - IF(w(k) > SCATTERING_ALBEDO_THRESHOLD .and. maxval(abs(RTV%Pff(1:nZ,1:nZ,k))) > ZERO) THEN - ! ----------------------------------------------------------- ! - ! CALL multiple-stream algorithm for computing layer ! - ! transmission, reflection, and source functions. ! - ! ----------------------------------------------------------- ! - - CALL CRTM_AMOM_layer( & - RTV%n_Streams, & - nZ,k,w(k), & - T_OD(k), & - total_opt(k-1), & - RTV%COS_AngleS(1:nZ), & ! Input - RTV%COS_WeightS(1:nZ), & - RTV%Pff(:,:,k), & - RTV%Pbb(:,:,k), & ! Input - RTV%Planck_Atmosphere(k), & ! Input - RTV, Error_Status ) ! Internal variable - - IF( Error_Status /= SUCCESS ) THEN - WRITE( Message,'("Error in CALL CRTM_AMOM_layer ")' ) - CALL Display_Message( ROUTINE_NAME, & - TRIM(Message), & - Error_Status ) - RETURN - END IF - ! ----------------------------------------------------------- ! - ! Adding method to add the layer to the present level ! - ! to compute upward radiances and reflection matrix ! - ! at new level. ! - ! ----------------------------------------------------------- ! - - temporal_matrix = -matmul(RTV%s_Level_Refl_UP(1:nZ,1:nZ,k), & - RTV%s_Layer_Refl(1:nZ,1:nZ,k)) - - DO i = 1, nZ - temporal_matrix(i,i) = ONE + temporal_matrix(i,i) - END DO - - RTV%Inv_Gamma(1:nZ,1:nZ,k) = matinv(temporal_matrix, Error_Status) - IF( Error_Status /= SUCCESS ) THEN - WRITE( Message,'("Error in matrix inversion matinv(temporal_matrix, Error_Status) ")' ) - CALL Display_Message( ROUTINE_NAME, & - TRIM(Message), & - Error_Status ) - RETURN - END IF - - RTV%Inv_GammaT(1:nZ,1:nZ,k) = & - matmul(RTV%s_Layer_Trans(1:nZ,1:nZ,k), RTV%Inv_Gamma(1:nZ,1:nZ,k)) - refl_down(1:nZ,k) = matmul(RTV%s_Level_Refl_UP(1:nZ,1:nZ,k), & - RTV%s_Layer_Source_DOWN(1:nZ,k)) - - RTV%s_Level_Rad_UP(1:nZ,k-1 )=RTV%s_Layer_Source_UP(1:nZ,k)+ & - matmul(RTV%Inv_GammaT(1:nZ,1:nZ,k),refl_down(1:nZ,k) & - +RTV%s_Level_Rad_UP(1:nZ,k )) - - RTV%Refl_Trans(1:nZ,1:nZ,k) = matmul(RTV%s_Level_Refl_UP(1:nZ,1:nZ,k), & - RTV%s_Layer_Trans(1:nZ,1:nZ,k)) - RTV%s_Level_Refl_UP(1:nZ,1:nZ,k-1)=RTV%s_Layer_Refl(1:nZ,1:nZ,k) + & - matmul(RTV%Inv_GammaT(1:nZ,1:nZ,k),RTV%Refl_Trans(1:nZ,1:nZ,k)) - ELSE - DO i = 1, nZ - RTV%s_Layer_Trans(i,i,k) = exp(-T_OD(k)/RTV%COS_AngleS(i)) - END DO - DO i = 1, nZ, RTV%n_Stokes - RTV%s_Layer_Source_UP(i,k) = RTV%Planck_Atmosphere(k) * (ONE - RTV%s_Layer_Trans(i,i,k) ) - RTV%s_Layer_Source_DOWN(i,k) = RTV%s_Layer_Source_UP(i,k) - END DO - - ! Adding method - DO i = 1, nZ - RTV%s_Level_Rad_UP(i,k-1 )=RTV%s_Layer_Source_UP(i,k)+ & - RTV%s_Layer_Trans(i,i,k)*(sum(RTV%s_Level_Refl_UP(i,1:nZ,k)*RTV%s_Layer_Source_DOWN(1:nZ,k)) & - +RTV%s_Level_Rad_UP(i,k )) - ENDDO - DO i = 1, nZ - DO j = 1, nZ - RTV%s_Level_Refl_UP(i,j,k-1)=RTV%s_Layer_Trans(i,i,k)*RTV%s_Level_Refl_UP(i,j,k)*RTV%s_Layer_Trans(j,j,k) - ENDDO - ENDDO - ENDIF - - 10 CONTINUE - ! Adding reflected cosmic background radiation - IF( RTV%mth_Azi == 0 ) THEN - DO i = 1, nZ, RTV%n_Stokes - RTV%s_Level_Rad_UP(i,0)=RTV%s_Level_Rad_UP(i,0)+sum(RTV%s_Level_Refl_UP(i,1:nZ,0))*cosmic_background - ENDDO - END IF - - - !! print *,' Aircraft or downward ',RTV%aircraft%rt, RTV%obs_4_downward%rt - !! write(6,'(ES15.6)') RTV%s_Level_Rad_UP(1,0) - IF(RTV%aircraft%rt.or.RTV%obs_4_downward%rt) THEN - ! - ! Added, May 20, 2024 - ! except at TOA, RTV%s_Level_Rad_UP is "intermediate" value, the following part for final vertical profiles of radiance - ! Downward, finalize s_Level_Rad_UPT and s_Level_Rad_DOWNT - RTV%s_Level_Rad_UPT(:,0) = RTV%s_Level_Rad_UP(:,0) - IF( RTV%mth_Azi == 0 ) THEN - DO i = 1, nZ, RTV%n_Stokes - RTV%s_Level_Rad_DOWN(i,0)=cosmic_background - RTV%s_Level_Rad_DOWNT(i,0)=cosmic_background - ENDDO - END IF - RTV%s_Level_Refl_DOWN(1:nZ,1:nZ,0) = ZERO - - DO 20 k = 1, n_Layers - ! Compute tranmission and reflection matrices for a layer IF(w(k) > SCATTERING_ALBEDO_THRESHOLD .and. maxval(abs(RTV%Pff(1:nZ,1:nZ,k))) > ZERO) THEN + ! ... Case 1, with solar scattering + ! ----------------------------------------------------------- ! + ! CALL multiple-stream algorithm for computing layer ! + ! transmission, reflection, and source functions. ! + ! ----------------------------------------------------------- ! + CALL CRTM_AMOM_layer( & + RTV%n_Streams, & + nZ,k,w(k), & + T_OD(k), & + total_opt(k-1), & + RTV%COS_AngleS(1:nZ), & ! Input + RTV%COS_WeightS(1:nZ), & + RTV%Pff(:,:,k), & + RTV%Pbb(:,:,k), & ! Input + RTV%Planck_Atmosphere(k), & ! Input + RTV, Error_Status ) ! Internal variable + + IF( Error_Status /= SUCCESS ) THEN + WRITE( Message,'("Error in CALL CRTM_AMOM_layer ")' ) + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + Error_Status ) + RETURN + END IF ! ----------------------------------------------------------- ! ! Adding method to add the layer to the present level ! ! to compute upward radiances and reflection matrix ! ! at new level. ! ! ----------------------------------------------------------- ! - - temporal_matrix = -matmul(RTV%s_Level_Refl_DOWN(1:nZ,1:nZ,k-1), & - RTV%s_Layer_Refl(1:nZ,1:nZ,k) ) + ! Reference Liu and Lu, 2016, book chapter, + ! "Community Radiative Transfer Model for Air Quality Studies" + ! Equation 16(a-b) + ! - R_k * r_k + temporal_matrix = -matmul(RTV%s_Level_Refl_UP(1:nZ,1:nZ,k), & + RTV%s_Layer_Refl(1:nZ,1:nZ,k)) + ! E - R_k * r_k DO i = 1, nZ temporal_matrix(i,i) = ONE + temporal_matrix(i,i) END DO - - RTV%Inv_Gamma2(1:nZ,1:nZ,k) = matinv(temporal_matrix, Error_Status) + ! matinv(E - R_k * r_k) + RTV%Inv_Gamma(1:nZ,1:nZ,k) = matinv(temporal_matrix, Error_Status) IF( Error_Status /= SUCCESS ) THEN - WRITE( Message,'("Error in matrix inversion matinv in Inv_Gamma2 ")' ) + WRITE( Message,'("Error in matrix inversion matinv(temporal_matrix, Error_Status) ")' ) CALL Display_Message( ROUTINE_NAME, & TRIM(Message), & Error_Status ) RETURN END IF - RTV%Inv_Gamma2T(1:nZ,1:nZ,k) = & - matmul(RTV%s_Layer_Trans(1:nZ,1:nZ,k), RTV%Inv_Gamma2(1:nZ,1:nZ,k)) - - refl_down(1:nZ,k) = matmul(RTV%s_Level_Refl_DOWN(1:nZ,1:nZ,k-1), & - RTV%s_Layer_Source_UP(1:nZ,k)) - - RTV%s_Level_Rad_DOWN(1:nZ,k)=RTV%s_Layer_Source_DOWN(1:nZ,k)+ & - matmul(RTV%Inv_Gamma2T(1:nZ,1:nZ,k),refl_down(1:nZ,k) & - +RTV%s_Level_Rad_DOWN(1:nZ,k-1)) - - RTV%Refl_Trans_DOWN(1:nZ,1:nZ,k) = & - matmul(RTV%s_Level_Refl_DOWN(1:nZ,1:nZ,k-1), & - RTV%s_Layer_Trans(1:nZ,1:nZ,k)) - RTV%s_Level_Refl_DOWN(1:nZ,1:nZ,k)=RTV%s_Layer_Refl(1:nZ,1:nZ,k) + & - matmul(RTV%Inv_Gamma2T(1:nZ,1:nZ,k),RTV%Refl_Trans_DOWN(1:nZ,1:nZ,k)) + ! t_k * matinv(E - R_k * r_k) + RTV%Inv_GammaT(1:nZ,1:nZ,k) = & + matmul(RTV%s_Layer_Trans(1:nZ,1:nZ,k), RTV%Inv_Gamma(1:nZ,1:nZ,k)) + ! R_k * Sd_k + refl_down(1:nZ,k) = matmul(RTV%s_Level_Refl_UP(1:nZ,1:nZ,k), & + RTV%s_Layer_Source_DOWN(1:nZ,k)) + ! 16b: I_k-1 = Su_k + [t_k * matinv(E - R_k * r_k)] * (R_k * Sd_k + I_k) + RTV%s_Level_Rad_UP(1:nZ,k-1 )=RTV%s_Layer_Source_UP(1:nZ,k)+ & + matmul(RTV%Inv_GammaT(1:nZ,1:nZ,k),refl_down(1:nZ,k) & + +RTV%s_Level_Rad_UP(1:nZ,k )) + ! R_k * t_k + RTV%Refl_Trans(1:nZ,1:nZ,k) = matmul(RTV%s_Level_Refl_UP(1:nZ,1:nZ,k), & + RTV%s_Layer_Trans(1:nZ,1:nZ,k)) + ! 16a: r_k-1 = r_k + [t_k * matinv(E - R_k * r_k) * (R_k * t_k)] + RTV%s_Level_Refl_UP(1:nZ,1:nZ,k-1)=RTV%s_Layer_Refl(1:nZ,1:nZ,k) + & + matmul(RTV%Inv_GammaT(1:nZ,1:nZ,k),RTV%Refl_Trans(1:nZ,1:nZ,k)) ELSE - ! Adding method for absorption layer, no solar diffuse radiation for no scattering layer + ! ... case 2, absorption/emission only DO i = 1, nZ - RTV%s_Level_Rad_DOWN(i,k)=RTV%s_Layer_Source_DOWN(i,k)+ & - RTV%s_Layer_Trans(i,i,k)*(sum(RTV%s_Level_Refl_DOWN(i,1:nZ,k-1)*RTV%s_Layer_Source_UP(1:nZ,k)) & - +RTV%s_Level_Rad_DOWN(i,k-1)) - ENDDO + RTV%s_Layer_Trans(i,i,k) = exp(-T_OD(k)/RTV%COS_AngleS(i)) + END DO + DO i = 1, nZ, RTV%n_Stokes + RTV%s_Layer_Source_UP(i,k) = RTV%Planck_Atmosphere(k) * (ONE - RTV%s_Layer_Trans(i,i,k) ) + RTV%s_Layer_Source_DOWN(i,k) = RTV%s_Layer_Source_UP(i,k) + END DO + ! Adding method + DO i = 1, nZ + RTV%s_Level_Rad_UP(i,k-1 )=RTV%s_Layer_Source_UP(i,k)+ & + RTV%s_Layer_Trans(i,i,k)*(sum(RTV%s_Level_Refl_UP(i,1:nZ,k)*RTV%s_Layer_Source_DOWN(1:nZ,k)) & + +RTV%s_Level_Rad_UP(i,k )) + END DO DO i = 1, nZ DO j = 1, nZ - RTV%s_Level_Refl_DOWN(i,j,k)=RTV%s_Layer_Trans(i,i,k)*RTV%s_Level_Refl_DOWN(i,j,k-1)*RTV%s_Layer_Trans(j,j,k) - ENDDO - ENDDO + RTV%s_Level_Refl_UP(i,j,k-1)=RTV%s_Layer_Trans(i,i,k)*RTV%s_Level_Refl_UP(i,j,k)*RTV%s_Layer_Trans(j,j,k) + END DO + END DO + ENDIF + 10 CONTINUE - temporal_vector = matmul(RTV%s_Level_Refl_DOWN(1:nZ,1:nZ,k-1),RTV%s_Level_Rad_UP(1:nZ,k) ) - RTV%s_Level_Rad_UPT(1:nZ,k)= temporal_vector + RTV%s_Level_Rad_UP(1:nZ,k) + ! Adding reflected cosmic background radiation + IF( RTV%mth_Azi == 0 ) THEN + DO i = 1, nZ, RTV%n_Stokes + RTV%s_Level_Rad_UP(i,0)=RTV%s_Level_Rad_UP(i,0)+sum(RTV%s_Level_Refl_UP(i,1:nZ,0))*cosmic_background + ENDDO + END IF - temporal_vector = matmul(RTV%s_Level_Refl_UP(1:nZ,1:nZ,k), & - RTV%s_Level_Rad_DOWN(1:nZ,k)) - RTV%s_Level_Rad_UPT(1:nZ,k) = temporal_vector + RTV%s_Level_Rad_UP(1:nZ,k) - ENDIF - ! - ! finalize upward and downward radiance s_Level_Rad_UPT, s_Level_Rad_DOWNT + ! 2. USER-DEFINED + ! Upwelling radiance at aircraft-level, flag RTV%aircraft%rt + ! OR downwelling radiance at user-defined level, flag RTV%obs_4_downward%rt + IF(RTV%aircraft%rt.or.RTV%obs_4_downward%rt) THEN + ! --- note by Mark ---- + ! Added, May 20, 2024 + ! Except at TOA, RTV%s_Level_Rad_UP is "intermediate" value, the following part for final vertical profiles of radiance + ! Downward, finalize s_Level_Rad_UPT and s_Level_Rad_DOWNT + ! -------------------- + + ! Boundary conditions for the top layer + ! ... Upwelling radiance at TOA + RTV%s_Level_Rad_UPT(:,0) = RTV%s_Level_Rad_UP(:,0) + ! ... Downwelling radiance at TOA + IF( RTV%mth_Azi == 0 ) THEN + DO i = 1, nZ, RTV%n_Stokes + RTV%s_Level_Rad_DOWN(i,0)=cosmic_background + RTV%s_Level_Rad_DOWNT(i,0)=cosmic_background + ENDDO + END IF + ! ... Downward reflectivity from the space + RTV%s_Level_Refl_DOWN(1:nZ,1:nZ,0) = ZERO - IF (maxval(abs(RTV%s_Level_Refl_DOWN(1:nZ,1:nZ,k))) > ZERO) THEN - temporal_matrix = -matmul(RTV%s_Level_Refl_DOWN(1:nZ,1:nZ,k), & - RTV%s_Level_Refl_UP(1:nZ,1:nZ,k)) - DO i = 1, nZ - temporal_matrix(i,i) = ONE + temporal_matrix(i,i) - END DO + ! DOWNWARD ADDING LOOP STARTS FROM ATMOSPHER TOP TO BOTTOM LAYER + DO 20 k = 1, n_Layers + + ! ... Case 1, with solar scattering + ! Compute tranmission and reflection matrices for a layer + IF(w(k) > SCATTERING_ALBEDO_THRESHOLD .and. maxval(abs(RTV%Pff(1:nZ,1:nZ,k))) > ZERO) THEN + ! ----------------------------------------------------------- ! + ! Adding method to add the layer to the present level ! + ! to compute upward radiances and reflection matrix ! + ! at new level. ! + ! ----------------------------------------------------------- ! + + ! - R_k-1 * r_k + temporal_matrix = -matmul(RTV%s_Level_Refl_DOWN(1:nZ,1:nZ,k-1), & + RTV%s_Layer_Refl(1:nZ,1:nZ,k) ) + ! E - R_k-1 * r_k + DO i = 1, nZ + temporal_matrix(i,i) = ONE + temporal_matrix(i,i) + END DO + ! matinv(E - R_k-1 * r_k) + RTV%Inv_Gamma2(1:nZ,1:nZ,k) = matinv(temporal_matrix, Error_Status) + IF( Error_Status /= SUCCESS ) THEN + WRITE( Message,'("Error in matrix inversion matinv in Inv_Gamma2 ")' ) + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + Error_Status ) + RETURN + END IF + + ! t(k) * matinv(E - R_k-1 * r_k) + RTV%Inv_Gamma2T(1:nZ,1:nZ,k) = matmul(RTV%s_Layer_Trans(1:nZ,1:nZ,k), & + RTV%Inv_Gamma2(1:nZ,1:nZ,k)) + ! R_k-1 * Sd_k + refl_down(1:nZ,k) = matmul(RTV%s_Level_Refl_DOWN(1:nZ,1:nZ,k-1), & + RTV%s_Layer_Source_UP(1:nZ,k)) + ! Radiance: I_k = Su_k + [t(k) * matinv(E - R_k-1 * r_k)] * [R_k-1 * Sd_k + I_k-1] + RTV%s_Level_Rad_DOWN(1:nZ,k) = RTV%s_Layer_Source_DOWN(1:nZ,k) & + + matmul(RTV%Inv_Gamma2T(1:nZ,1:nZ,k), & + refl_down(1:nZ,k) + RTV%s_Level_Rad_DOWN(1:nZ,k-1)) + ! R_k-1 * t_k + RTV%Refl_Trans_DOWN(1:nZ,1:nZ,k) = & + matmul(RTV%s_Level_Refl_DOWN(1:nZ,1:nZ,k-1), & + RTV%s_Layer_Trans(1:nZ,1:nZ,k)) + ! R_k = r_k + [t(k) * matinv(E - R_k-1 * r_k)] * [R_k-1 * t_k] + RTV%s_Level_Refl_DOWN(1:nZ,1:nZ,k)= RTV%s_Layer_Refl(1:nZ,1:nZ,k) & + + matmul(RTV%Inv_Gamma2T(1:nZ,1:nZ,k),& + RTV%Refl_Trans_DOWN(1:nZ,1:nZ,k)) + + ELSE + + ! Adding method for absorption layer, no solar diffuse radiation for no scattering layer + DO i = 1, nZ + RTV%s_Level_Rad_DOWN(i,k)=RTV%s_Layer_Source_DOWN(i,k)+ & + RTV%s_Layer_Trans(i,i,k)*(sum(RTV%s_Level_Refl_DOWN(i,1:nZ,k-1)*RTV%s_Layer_Source_UP(1:nZ,k)) & + +RTV%s_Level_Rad_DOWN(i,k-1)) + END DO + + DO i = 1, nZ + DO j = 1, nZ + RTV%s_Level_Refl_DOWN(i,j,k)=RTV%s_Layer_Trans(i,i,k)*RTV%s_Level_Refl_DOWN(i,j,k-1)*RTV%s_Layer_Trans(j,j,k) + END DO + END DO + + + temporal_vector = matmul(RTV%s_Level_Refl_DOWN(1:nZ,1:nZ,k-1),RTV%s_Level_Rad_UP(1:nZ,k) ) + RTV%s_Level_Rad_UPT(1:nZ,k)= temporal_vector + RTV%s_Level_Rad_UP(1:nZ,k) + + temporal_vector = matmul(RTV%s_Level_Refl_UP(1:nZ,1:nZ,k), & + RTV%s_Level_Rad_DOWN(1:nZ,k)) + RTV%s_Level_Rad_UPT(1:nZ,k) = temporal_vector + RTV%s_Level_Rad_UP(1:nZ,k) - RTV%Inv_Gamma3(1:nZ,1:nZ,k) = matinv(temporal_matrix, Error_Status) - IF( Error_Status /= SUCCESS ) THEN - WRITE( Message,'("Error in matrix inversion matinv in Inv_Gamma3 ")' ) - CALL Display_Message( ROUTINE_NAME, & - TRIM(Message), & - Error_Status ) - RETURN END IF - RTV%s_Level_Rad_DOWNT(1:nZ,k)= matmul( RTV%Inv_Gamma3(1:nZ,1:nZ,k), & - matmul(RTV%s_Level_Refl_DOWN(1:nZ,1:nZ,k),RTV%s_Level_Rad_UP(1:nZ,k) ) & - + RTV%s_Level_Rad_DOWN(1:nZ,k) ) - temporal_vector = matmul(RTV%Inv_Gamma3(1:nZ,1:nZ,k),RTV%s_Level_Rad_DOWN(1:nZ,k)) - RTV%s_Level_Rad_UPT(1:nZ,k)= matmul(RTV%s_Level_Refl_UP(1:nZ,1:nZ,k),temporal_vector) & - + matmul(RTV%Inv_Gamma3(1:nZ,1:nZ,k),RTV%s_Level_Rad_UP(1:nZ,k)) - ELSE - RTV%s_Level_Rad_DOWNT(1:nZ,k)= RTV%s_Level_Rad_DOWN(1:nZ,k) - RTV%s_Level_Rad_UPT(1:nZ,k) = & - matmul(RTV%s_Level_Refl_UP(1:nZ,1:nZ,k),RTV%s_Level_Rad_DOWN(1:nZ,k)) & - + RTV%s_Level_Rad_UP(1:nZ,k) - END IF + ! + ! finalize upward and downward radiance s_Level_Rad_UPT, s_Level_Rad_DOWNT + IF (maxval(abs(RTV%s_Level_Refl_DOWN(1:nZ,1:nZ,k))) > ZERO) THEN + temporal_matrix = -matmul(RTV%s_Level_Refl_DOWN(1:nZ,1:nZ,k), & + RTV%s_Level_Refl_UP(1:nZ,1:nZ,k)) + DO i = 1, nZ + temporal_matrix(i,i) = ONE + temporal_matrix(i,i) + END DO + + RTV%Inv_Gamma3(1:nZ,1:nZ,k) = matinv(temporal_matrix, Error_Status) + IF( Error_Status /= SUCCESS ) THEN + WRITE( Message,'("Error in matrix inversion matinv in Inv_Gamma3 ")' ) + CALL Display_Message( ROUTINE_NAME, & + TRIM(Message), & + Error_Status ) + RETURN + END IF + + RTV%s_Level_Rad_DOWNT(1:nZ,k)= matmul( RTV%Inv_Gamma3(1:nZ,1:nZ,k), & + matmul(RTV%s_Level_Refl_DOWN(1:nZ,1:nZ,k), RTV%s_Level_Rad_UP(1:nZ,k)) & + + RTV%s_Level_Rad_DOWN(1:nZ,k) ) + + temporal_vector = matmul(RTV%Inv_Gamma3(1:nZ,1:nZ,k),RTV%s_Level_Rad_DOWN(1:nZ,k)) + RTV%s_Level_Rad_UPT(1:nZ,k)= matmul(RTV%s_Level_Refl_UP(1:nZ,1:nZ,k),temporal_vector) & + + matmul(RTV%Inv_Gamma3(1:nZ,1:nZ,k),RTV%s_Level_Rad_UP(1:nZ,k)) + ELSE + RTV%s_Level_Rad_DOWNT(1:nZ,k)= RTV%s_Level_Rad_DOWN(1:nZ,k) + RTV%s_Level_Rad_UPT(1:nZ,k) = & + matmul(RTV%s_Level_Refl_UP(1:nZ,1:nZ,k),RTV%s_Level_Rad_DOWN(1:nZ,k)) & + + RTV%s_Level_Rad_UP(1:nZ,k) + END IF - 20 CONTINUE - RTV%s_Level_Rad_DOWN = RTV%s_Level_Rad_DOWNT - RTV%s_Level_Rad_UP = RTV%s_Level_Rad_UPT + 20 CONTINUE + RTV%s_Level_Rad_DOWN = RTV%s_Level_Rad_DOWNT + RTV%s_Level_Rad_UP = RTV%s_Level_Rad_UPT END IF !IF(RTV%aircraft%rt.or.RTV%obs_4_downward%rt) @@ -1248,188 +1283,380 @@ SUBROUTINE CRTM_ADA_TL(n_Layers, & ! Input number of atmospheric layers direct_reflectivity_TL, & ! Input TL direct reflectivity Pff_TL, & ! Input TL forward phase matrix Pbb_TL, & ! Input TL backward phase matrix - s_rad_up_TL) ! Output TL upward radiance -! ------------------------------------------------------------------------- ! -! FUNCTION: ! -! This subroutine calculates IR/MW tangent-linear radiance at the top of ! -! the atmosphere including atmospheric scattering. The structure RTV ! -! carried in forward part results. ! -! The CRTM_ADA_TL algorithm computes layer tangent-linear reflectance and ! -! transmittance as well as source function by the subroutine ! -! CRTM_Doubling_layer as source function by the subroutine ! -! CRTM_Doubling_layer, then uses ! -! an adding method to integrate the layer and surface components. ! -! ! -! Quanhua Liu Quanhua.Liu@noaa.gov ! -! ------------------------------------------------------------------------- ! - IMPLICIT NONE - INTEGER, INTENT(IN) :: n_Layers - TYPE(RTV_type), INTENT(IN) :: RTV - REAL (fp), INTENT(IN), DIMENSION( : ) :: w,T_OD - REAL (fp), INTENT(IN), DIMENSION( : ) :: emissivity,direct_reflectivity - REAL (fp), INTENT(IN) :: cosmic_background + s_rad_TL) ! Output TL radiance + ! ------------------------------------------------------------------------- ! + ! FUNCTION: ! + ! This subroutine calculates IR/MW tangent-linear radiance at the top of ! + ! the atmosphere including atmospheric scattering. The structure RTV ! + ! carried in forward part results. ! + ! The CRTM_ADA_TL algorithm computes layer tangent-linear reflectance and ! + ! transmittance as well as source function by the subroutine ! + ! CRTM_Doubling_layer as source function by the subroutine ! + ! CRTM_Doubling_layer, then uses ! + ! an adding method to integrate the layer and surface components. ! + ! ! + ! Quanhua Liu Quanhua.Liu@noaa.gov ! + ! ------------------------------------------------------------------------- ! + IMPLICIT NONE + INTEGER, INTENT(IN) :: n_Layers + TYPE(RTV_type), INTENT(IN) :: RTV + REAL (fp), INTENT(IN), DIMENSION( : ) :: w,T_OD + REAL (fp), INTENT(IN), DIMENSION( : ) :: emissivity,direct_reflectivity + REAL (fp), INTENT(IN) :: cosmic_background - REAL (fp),INTENT(IN),DIMENSION( :,:,: ) :: Pff_TL, Pbb_TL - REAL (fp),INTENT(IN),DIMENSION( : ) :: w_TL,T_OD_TL - REAL (fp),INTENT(IN),DIMENSION( 0: ) :: Planck_Atmosphere_TL - REAL (fp),INTENT(IN) :: Planck_Surface_TL - REAL (fp),INTENT(IN),DIMENSION( : ) :: emissivity_TL - REAL (fp),INTENT(IN),DIMENSION( :,: ) :: reflectivity_TL - REAL (fp),INTENT(INOUT),DIMENSION( : ) :: s_rad_up_TL - REAL (fp),INTENT(INOUT),DIMENSION( : ) :: direct_reflectivity_TL - ! -------------- internal variables --------------------------------- ! - ! Abbreviations: ! - ! s: scattering, rad: radiance, trans: transmission, ! - ! refl: reflection, up: upward, down: downward ! - ! --------------------------------------------------------------------! - REAL (fp), DIMENSION(RTV%n_Angles*RTV%n_Stokes,RTV%n_Angles*RTV%n_Stokes) :: temporal_matrix_TL + REAL (fp),INTENT(IN),DIMENSION( :,:,: ) :: Pff_TL, Pbb_TL + REAL (fp),INTENT(IN),DIMENSION( : ) :: w_TL,T_OD_TL + REAL (fp),INTENT(IN),DIMENSION( 0: ) :: Planck_Atmosphere_TL + REAL (fp),INTENT(IN) :: Planck_Surface_TL + REAL (fp),INTENT(IN),DIMENSION( : ) :: emissivity_TL + REAL (fp),INTENT(IN),DIMENSION( :,: ) :: reflectivity_TL + REAL (fp),INTENT(INOUT),DIMENSION( : ) :: s_rad_TL + REAL (fp),INTENT(INOUT),DIMENSION( : ) :: direct_reflectivity_TL + ! -------------- internal variables --------------------------------- ! + ! Abbreviations: ! + ! s: scattering, rad: radiance, trans: transmission, ! + ! refl: reflection, up: upward, down: downward ! + ! --------------------------------------------------------------------! + REAL (fp), DIMENSION(RTV%n_Angles*RTV%n_Stokes,RTV%n_Angles*RTV%n_Stokes) :: temporal_matrix_TL - REAL (fp), DIMENSION( RTV%n_Angles*RTV%n_Stokes, n_Layers) :: refl_down - REAL (fp), DIMENSION( RTV%n_Angles*RTV%n_Stokes ) :: s_source_up_TL,s_source_down_TL,refl_down_TL + REAL (fp), DIMENSION( RTV%n_Angles*RTV%n_Stokes, n_Layers) :: refl_down + REAL (fp), DIMENSION( RTV%n_Angles*RTV%n_Stokes ) :: s_source_up_TL,s_source_down_TL,refl_down_TL - REAL (fp), DIMENSION( RTV%n_Angles*RTV%n_Stokes, RTV%n_Angles*RTV%n_Stokes ) :: s_trans_TL,s_refl_TL,Refl_Trans_TL - REAL (fp), DIMENSION( RTV%n_Angles*RTV%n_Stokes, RTV%n_Angles*RTV%n_Stokes ) :: s_refl_up_TL,Inv_Gamma_TL,Inv_GammaT_TL - REAL (fp), DIMENSION(0:n_Layers) :: total_opt, total_opt_TL - INTEGER :: i, j, k, nZ -! - nZ = RTV%n_Angles*RTV%n_Stokes - total_opt(0) = ZERO - total_opt_TL(0) = ZERO - DO k = 1, n_Layers - total_opt(k) = total_opt(k-1) + T_OD(k) - total_opt_TL(k) = total_opt_TL(k-1) + T_OD_TL(k) - END DO + REAL (fp), DIMENSION( RTV%n_Angles*RTV%n_Stokes, RTV%n_Angles*RTV%n_Stokes ) :: s_trans_TL,s_refl_TL,Refl_Trans_TL - Refl_Trans_TL = ZERO - s_rad_up_TL = ZERO + REAL (fp), DIMENSION( RTV%n_Angles*RTV%n_Stokes, RTV%n_Angles*RTV%n_Stokes ) :: s_refl_up_TL,Inv_Gamma_TL,Inv_GammaT_TL - s_refl_up_TL = reflectivity_TL(1:nZ,1:nZ) - IF( RTV%mth_Azi == 0 ) THEN - s_rad_up_TL = emissivity_TL(1:nZ)* RTV%Planck_Surface + emissivity(1:nZ) * Planck_Surface_TL - END IF + REAL (fp), DIMENSION( RTV%n_Angles*RTV%n_Stokes, RTV%n_Angles*RTV%n_Stokes ) :: s_refl_down_TL,Inv_Gamma2_TL,Inv_Gamma2T_TL - IF( RTV%Solar_Flag_true ) THEN - s_rad_up_TL = s_rad_up_TL+direct_reflectivity_TL(1:nZ)*RTV%COS_SUN*RTV%Solar_irradiance/PI & - * exp(-total_opt(n_Layers)/RTV%COS_SUN) & - - direct_reflectivity(1:nZ) * RTV%Solar_irradiance/PI & - * total_opt_TL(n_Layers) * exp(-total_opt(n_Layers)/RTV%COS_SUN) - END IF + REAL (fp), DIMENSION( RTV%n_Angles*RTV%n_Stokes ) :: s_rad_up_TL, s_rad_down_TL + REAL (fp), DIMENSION( RTV%n_Angles*RTV%n_Stokes, n_Layers ) :: s_rad_upt_TL, s_rad_downt_TL + REAL (fp), DIMENSION( RTV%n_Angles*RTV%n_Stokes, RTV%n_Angles*RTV%n_Stokes, n_Layers ) :: s_refl_upt_TL, s_refl_downt_TL + REAL (fp), DIMENSION( RTV%n_Angles*RTV%n_Stokes, RTV%n_Angles*RTV%n_Stokes ) :: Inv_Gamma3_TL + REAL (fp), DIMENSION(RTV%n_Angles*RTV%n_Stokes) :: temporal_vector, temporal_vector_TL - DO 10 k = n_Layers, 1, -1 - s_source_up_TL = ZERO - s_source_down_TL = ZERO - s_trans_TL = ZERO - s_refl_TL = ZERO - Inv_GammaT_TL = ZERO - Inv_Gamma_TL = ZERO - refl_down_TL = ZERO -! -! Compute tranmission and reflection matrices for a layer - IF(w(k) > SCATTERING_ALBEDO_THRESHOLD .and. maxval(abs(RTV%Pff(1:nZ,1:nZ,k))) > ZERO) THEN + + REAL (fp), DIMENSION(0:n_Layers) :: total_opt, total_opt_TL + INTEGER :: i, j, k, nZ + + nZ = RTV%n_Angles*RTV%n_Stokes + total_opt(0) = ZERO + total_opt_TL(0) = ZERO + DO k = 1, n_Layers + total_opt(k) = total_opt(k-1) + T_OD(k) + total_opt_TL(k) = total_opt_TL(k-1) + T_OD_TL(k) + END DO + + Refl_Trans_TL = ZERO + s_rad_up_TL = ZERO + + s_refl_up_TL = reflectivity_TL(1:nZ,1:nZ) + IF( RTV%mth_Azi == 0 ) THEN + s_rad_up_TL = emissivity_TL(1:nZ)* RTV%Planck_Surface + emissivity(1:nZ) * Planck_Surface_TL + END IF + + IF( RTV%Solar_Flag_true ) THEN + s_rad_up_TL = s_rad_up_TL+direct_reflectivity_TL(1:nZ)*RTV%COS_SUN*RTV%Solar_irradiance/PI & + * exp(-total_opt(n_Layers)/RTV%COS_SUN) & + - direct_reflectivity(1:nZ) * RTV%Solar_irradiance/PI & + * total_opt_TL(n_Layers) * exp(-total_opt(n_Layers)/RTV%COS_SUN) + END IF + + DO 10 k = n_Layers, 1, -1 + s_source_up_TL = ZERO + s_source_down_TL = ZERO + s_trans_TL = ZERO + s_refl_TL = ZERO + Inv_GammaT_TL = ZERO + Inv_Gamma_TL = ZERO + refl_down_TL = ZERO + + ! Compute tranmission and reflection matrices for a layer + IF(w(k) > SCATTERING_ALBEDO_THRESHOLD .and. maxval(abs(RTV%Pff(1:nZ,1:nZ,k))) > ZERO) THEN ! ----------------------------------------------------------- ! ! CALL Doubling algorithm to computing forward and tagent ! ! layer transmission, reflection, and source functions. ! ! ----------------------------------------------------------- ! - call CRTM_AMOM_layer_TL(RTV%n_Streams,nZ,k,w(k),T_OD(k),total_opt(k-1), & !Input - RTV%COS_AngleS(1:nZ),RTV%COS_WeightS(1:nZ) , & !Input - RTV%Pff(:,:,k), RTV%Pbb(:,:,k),RTV%Planck_Atmosphere(k) , & !Input - w_TL(k),T_OD_TL(k),total_opt_TL(k-1),Pff_TL(:,:,k) , & !Input - Pbb_TL(:,:,k),Planck_Atmosphere_TL(k),RTV , & !Input - s_trans_TL,s_refl_TL,s_source_up_TL,s_source_down_TL) !Output -! -! Adding method - temporal_matrix_TL = -matmul(s_refl_up_TL,RTV%s_Layer_Refl(1:nZ,1:nZ,k)) & - - matmul(RTV%s_Level_Refl_UP(1:nZ,1:nZ,k),s_refl_TL) + CALL CRTM_AMOM_layer_TL(RTV%n_Streams,nZ,k,w(k),T_OD(k),total_opt(k-1), & !Input + RTV%COS_AngleS(1:nZ),RTV%COS_WeightS(1:nZ) , & !Input + RTV%Pff(:,:,k), RTV%Pbb(:,:,k),RTV%Planck_Atmosphere(k) , & !Input + w_TL(k),T_OD_TL(k),total_opt_TL(k-1),Pff_TL(:,:,k) , & !Input + Pbb_TL(:,:,k),Planck_Atmosphere_TL(k),RTV , & !Input + s_trans_TL,s_refl_TL,s_source_up_TL,s_source_down_TL) !Output - temporal_matrix_TL = matmul(RTV%Inv_Gamma(1:nZ,1:nZ,k),temporal_matrix_TL) - Inv_Gamma_TL = -matmul(temporal_matrix_TL,RTV%Inv_Gamma(1:nZ,1:nZ,k)) + ! Adding method + temporal_matrix_TL = -matmul(s_refl_up_TL,RTV%s_Layer_Refl(1:nZ,1:nZ,k)) & + - matmul(RTV%s_Level_Refl_UP(1:nZ,1:nZ,k),s_refl_TL) - Inv_GammaT_TL = matmul(s_trans_TL, RTV%Inv_Gamma(1:nZ,1:nZ,k)) & - + matmul(RTV%s_Layer_Trans(1:nZ,1:nZ,k), Inv_Gamma_TL) + temporal_matrix_TL = matmul(RTV%Inv_Gamma(1:nZ,1:nZ,k),temporal_matrix_TL) + Inv_Gamma_TL = -matmul(temporal_matrix_TL,RTV%Inv_Gamma(1:nZ,1:nZ,k)) - refl_down(1:nZ,k) = matmul(RTV%s_Level_Refl_UP(1:nZ,1:nZ,k), & - RTV%s_Layer_Source_DOWN(1:nZ,k)) - refl_down_TL(:) = matmul(s_refl_up_TL,RTV%s_Layer_Source_DOWN(1:nZ,k)) & - + matmul(RTV%s_Level_Refl_UP(1:nZ,1:nZ,k),s_source_down_TL(:)) - s_rad_up_TL(1:nZ)=s_source_up_TL(1:nZ)+ & - matmul(Inv_GammaT_TL,refl_down(:,k)+RTV%s_Level_Rad_UP(1:nZ,k)) & - +matmul(RTV%Inv_GammaT(1:nZ,1:nZ,k),refl_down_TL(1:nZ)+s_rad_up_TL(1:nZ)) + Inv_GammaT_TL = matmul(s_trans_TL, RTV%Inv_Gamma(1:nZ,1:nZ,k)) & + + matmul(RTV%s_Layer_Trans(1:nZ,1:nZ,k), Inv_Gamma_TL) - Refl_Trans_TL = matmul(s_refl_up_TL,RTV%s_Layer_Trans(1:nZ,1:nZ,k)) & - + matmul(RTV%s_Level_Refl_UP(1:nZ,1:nZ,k),s_trans_TL) + refl_down(1:nZ,k) = matmul(RTV%s_Level_Refl_UP(1:nZ,1:nZ,k), & + RTV%s_Layer_Source_DOWN(1:nZ,k)) + refl_down_TL(:) = matmul(s_refl_up_TL,RTV%s_Layer_Source_DOWN(1:nZ,k)) & + + matmul(RTV%s_Level_Refl_UP(1:nZ,1:nZ,k),s_source_down_TL(:)) + s_rad_up_TL(1:nZ)=s_source_up_TL(1:nZ)+ & + matmul(Inv_GammaT_TL,refl_down(:,k)+RTV%s_Level_Rad_UP(1:nZ,k)) & + +matmul(RTV%Inv_GammaT(1:nZ,1:nZ,k),refl_down_TL(1:nZ)+s_rad_up_TL(1:nZ)) - s_refl_up_TL=s_refl_TL+matmul(Inv_GammaT_TL,RTV%Refl_Trans(1:nZ,1:nZ,k)) & - +matmul(RTV%Inv_GammaT(1:nZ,1:nZ,k),Refl_Trans_TL) + Refl_Trans_TL = matmul(s_refl_up_TL,RTV%s_Layer_Trans(1:nZ,1:nZ,k)) & + + matmul(RTV%s_Level_Refl_UP(1:nZ,1:nZ,k),s_trans_TL) - Refl_Trans_TL = ZERO + s_refl_up_TL=s_refl_TL+matmul(Inv_GammaT_TL,RTV%Refl_Trans(1:nZ,1:nZ,k)) & + +matmul(RTV%Inv_GammaT(1:nZ,1:nZ,k),Refl_Trans_TL) - ELSE + Refl_Trans_TL = ZERO + + ELSE + + DO i = 1, nZ + s_trans_TL(i,i) = -T_OD_TL(k)/RTV%COS_AngleS(i) * RTV%s_Layer_Trans(i,i,k) + END DO + DO i = 1, nZ, RTV%n_Stokes + s_source_up_TL(i) = Planck_Atmosphere_TL(k) * (ONE - RTV%s_Layer_Trans(i,i,k) ) & + - RTV%Planck_Atmosphere(k) * s_trans_TL(i,i) + s_source_down_TL(i) = s_source_up_TL(i) + END DO + + ! Adding method + DO i = 1, nZ + s_rad_up_TL(i)=s_source_up_TL(i) & + +s_trans_TL(i,i)*(sum(RTV%s_Level_Refl_UP(i,1:nZ,k) & + *RTV%s_Layer_Source_DOWN(1:nZ,k))+RTV%s_Level_Rad_UP(i,k)) & + +RTV%s_Layer_Trans(i,i,k) & + *(sum(s_refl_up_TL(i,1:nZ)*RTV%s_Layer_Source_DOWN(1:nZ,k) & + +RTV%s_Level_Refl_UP(i,1:nZ,k)*s_source_down_TL(1:nZ))+s_rad_up_TL(i)) + END DO - DO i = 1, nZ - s_trans_TL(i,i) = -T_OD_TL(k)/RTV%COS_AngleS(i) * RTV%s_Layer_Trans(i,i,k) + DO i = 1, nZ + DO j = 1, nZ + s_refl_up_TL(i,j)=s_trans_TL(i,i)*RTV%s_Level_Refl_UP(i,j,k) & + *RTV%s_Layer_Trans(j,j,k) & + +RTV%s_Layer_Trans(i,i,k)*s_refl_up_TL(i,j)*RTV%s_Layer_Trans(j,j,k) & + +RTV%s_Layer_Trans(i,i,k)*RTV%s_Level_Refl_UP(i,j,k)*s_trans_TL(j,j) END DO - DO i = 1, nZ, RTV%n_Stokes - s_source_up_TL(i) = Planck_Atmosphere_TL(k) * (ONE - RTV%s_Layer_Trans(i,i,k) ) & - - RTV%Planck_Atmosphere(k) * s_trans_TL(i,i) - s_source_down_TL(i) = s_source_up_TL(i) - ENDDO + END DO -! Adding method - DO i = 1, nZ - s_rad_up_TL(i)=s_source_up_TL(i) & - +s_trans_TL(i,i)*(sum(RTV%s_Level_Refl_UP(i,1:nZ,k) & - *RTV%s_Layer_Source_DOWN(1:nZ,k))+RTV%s_Level_Rad_UP(i,k)) & - +RTV%s_Layer_Trans(i,i,k) & - *(sum(s_refl_up_TL(i,1:nZ)*RTV%s_Layer_Source_DOWN(1:nZ,k) & - +RTV%s_Level_Refl_UP(i,1:nZ,k)*s_source_down_TL(1:nZ))+s_rad_up_TL(i)) + END IF - ENDDO + ! Save results to temporal variable matrix + s_rad_upt_TL(:,k) = s_rad_up_TL + s_refl_upt_TL(:,:,k) = s_refl_up_TL - DO i = 1, nZ - DO j = 1, nZ - s_refl_up_TL(i,j)=s_trans_TL(i,i)*RTV%s_Level_Refl_UP(i,j,k) & - *RTV%s_Layer_Trans(j,j,k) & - +RTV%s_Layer_Trans(i,i,k)*s_refl_up_TL(i,j)*RTV%s_Layer_Trans(j,j,k) & - +RTV%s_Layer_Trans(i,i,k)*RTV%s_Level_Refl_UP(i,j,k)*s_trans_TL(j,j) - ENDDO - ENDDO + 10 CONTINUE - ENDIF - 10 CONTINUE -! -! Adding reflected cosmic background radiation + ! Adding reflected cosmic background radiation (to the top layer only) IF( RTV%mth_Azi == 0 ) THEN - DO i = 1, nZ, RTV%n_Stokes - s_rad_up_TL(i)=s_rad_up_TL(i)+sum(s_refl_up_TL(i,1:nZ))*cosmic_background - ENDDO + DO i = 1, nZ, RTV%n_Stokes + s_rad_upt_TL(i,1)=s_rad_upt_TL(i,1)+sum(s_refl_upt_TL(i,1:nZ,1))*cosmic_background + END DO END IF - RETURN - END SUBROUTINE CRTM_ADA_TL + ! 2. USER-DEFINED + ! Upwelling radiance at aircraft-level, flag RTV%aircraft%rt + ! Downwelling radiance at user-defined level, flag RTV%obs_4_downward%rt + IF ( RTV%aircraft%rt .OR. RTV%obs_4_downward%rt ) THEN + + ! Boundary conditions for the top layer + ! ... Upwelling radiance at TOA == s_rad_up_TL computed in the previous step + s_rad_up_TL = s_rad_up_TL + ! ... Downwelling radiance at TOA + IF( RTV%mth_Azi == 0 ) THEN + DO i = 1, nZ, RTV%n_Stokes + s_rad_down_TL(i) = ZERO + END DO + END IF + ! ... Downward reflectivity from the space + s_refl_down_TL(1:nZ,1:nZ) = ZERO + + ! DOWNWARD ADDING LOOP STARTS FROM ATMOSPHER TOP TO BOTTOM LAYER + DO 20 k = 1, n_Layers + ! initialize layer-specific variables + s_source_up_TL = ZERO + s_source_down_TL = ZERO + s_trans_TL = ZERO + s_refl_TL = ZERO + Inv_Gamma2T_TL = ZERO + Inv_Gamma2_TL = ZERO + Inv_Gamma3_TL = ZERO + refl_down_TL = ZERO + + IF( w(k) > SCATTERING_ALBEDO_THRESHOLD .AND. maxval(abs(RTV%Pff(1:nZ,1:nZ,k))) > ZERO ) THEN + ! ----------------------------------------------------------- ! + ! CALL Doubling algorithm to computing forward and tagent ! + ! layer transmission, reflection, and source functions. ! + ! ----------------------------------------------------------- ! + ! Note that unlike CRTM_AMOM_layer, part of the CRTM_AMOM_layer_TL outputs are + ! for a single layer only, so need to call this function again for downward ADA + ! CD: something can be optimized later? + CALL CRTM_AMOM_layer_TL(RTV%n_Streams,nZ,k,w(k),T_OD(k),total_opt(k-1), & !Input + RTV%COS_AngleS(1:nZ),RTV%COS_WeightS(1:nZ) , & !Input + RTV%Pff(:,:,k), RTV%Pbb(:,:,k),RTV%Planck_Atmosphere(k) , & !Input + w_TL(k),T_OD_TL(k),total_opt_TL(k-1),Pff_TL(:,:,k) , & !Input + Pbb_TL(:,:,k),Planck_Atmosphere_TL(k),RTV , & !Input + s_trans_TL,s_refl_TL,s_source_up_TL,s_source_down_TL) !Output + + ! - R_k-1 * r_k + temporal_matrix_TL = -matmul(s_refl_down_TL, & + RTV%s_Layer_Refl(1:nZ,1:nZ,k)) & + -matmul(RTV%s_Level_Refl_DOWN(1:nZ,1:nZ,k-1), & + s_refl_TL) + + ! RTV%Inv_Gamma was computed in CRTM_Compute_RTSolution, which is always called + ! before calling CRTM_Compute_RTSolution_TL in CRTM_Tangent_Linear_Module.f90 + temporal_matrix_TL = matmul(RTV%Inv_Gamma2(1:nZ,1:nZ,k),temporal_matrix_TL) + Inv_Gamma2_TL = -matmul(temporal_matrix_TL,RTV%Inv_Gamma2(1:nZ,1:nZ,k)) + + ! t(k) * matinv(E - R_k-1 * r_k) + Inv_Gamma2T_TL = matmul(s_trans_TL, RTV%Inv_Gamma2(1:nZ,1:nZ,k)) & + + matmul(RTV%s_Layer_Trans(1:nZ,1:nZ,k), Inv_Gamma2_TL) + + ! R_k-1 * Sd_k + refl_down(1:nZ,k) = matmul(RTV%s_Level_Refl_DOWN(1:nZ,1:nZ,k-1), & + RTV%s_Layer_Source_UP(1:nZ,k)) + refl_down_TL(:) = matmul(s_refl_down_TL, RTV%s_Layer_Source_UP(1:nZ,k)) & + + matmul(RTV%s_Level_Refl_DOWN(1:nZ,1:nZ,k-1), s_source_up_TL) + + ! I_k = Su_k + [t(k) * matinv(E - R_k-1 * r_k)] * [R_k-1 * Sd_k + I_k-1] + s_rad_down_TL(1:nZ) = s_source_down_TL(1:nZ) & + + matmul(Inv_Gamma2T_TL,refl_down(:,k)+RTV%s_Level_Rad_DOWN(1:nZ,k-1)) & + + matmul(RTV%Inv_Gamma2T(1:nZ,1:nZ,k),refl_down_TL(:)+s_rad_down_TL(1:nZ)) + + ! R_k-1 * t_k + Refl_Trans_TL = matmul(s_refl_down_TL,RTV%s_Layer_Trans(1:nZ,1:nZ,k)) & + + matmul(RTV%s_Level_Refl_DOWN(1:nZ,1:nZ,k-1),s_trans_TL) + + ! R_k = r_k + [t(k) * matinv(E - R_k-1 * r_k)] * [R_k-1 * t_k] + s_refl_down_TL = s_refl_TL & + + matmul(Inv_Gamma2T_TL, RTV%Refl_Trans_DOWN(1:nZ,1:nZ,k)) & + + matmul(RTV%Inv_Gamma2T(1:nZ,1:nZ,k), Refl_Trans_TL) + ! + Refl_Trans_TL = ZERO + + ELSE + + ! Case 2, absorption/emission only + DO i = 1, nZ + s_trans_TL(i,i) = -T_OD_TL(k)/RTV%COS_AngleS(i) * RTV%s_Layer_Trans(i,i,k) + ENDDO + + DO i = 1, nZ, RTV%n_Stokes + s_source_up_TL(i) = Planck_Atmosphere_TL(k) * (ONE - RTV%s_Layer_Trans(i,i,k) ) & + - RTV%Planck_Atmosphere(k) * s_trans_TL(i,i) + s_source_down_TL(i) = s_source_up_TL(i) + END DO + + ! Adding method + DO i = 1, nZ + s_rad_down_TL(i)=s_source_down_TL(i) & + +s_trans_TL(i,i)*(sum(RTV%s_Level_Refl_DOWN(i,1:nZ,k-1) & + *RTV%s_Layer_Source_UP(1:nZ,k))+RTV%s_Level_Rad_DOWN(i,k-1)) & + +RTV%s_Layer_Trans(i,i,k) & + *(sum(s_refl_down_TL(i,1:nZ)*RTV%s_Layer_Source_UP(1:nZ,k) & + +RTV%s_Level_Refl_DOWN(i,1:nZ,k-1)*s_source_up_TL(1:nZ))+s_rad_down_TL(i)) + END DO + + DO i = 1, nZ + DO j = 1, nZ + s_refl_down_TL(i,j)=s_trans_TL(i,i)*RTV%s_Level_Refl_DOWN(i,j,k-1) & + *RTV%s_Layer_Trans(j,j,k) & + +RTV%s_Layer_Trans(i,i,k)*s_refl_down_TL(i,j)*RTV%s_Layer_Trans(j,j,k) & + +RTV%s_Layer_Trans(i,i,k)*RTV%s_Level_Refl_DOWN(i,j,k-1)*s_trans_TL(j,j) + END DO + END DO + + + END IF! EndIF for adding method + + ! Save results to temporal variable matrix + s_rad_downt_TL(:,k) = s_rad_down_TL + s_refl_downt_TL(:,:,k) = s_refl_down_TL + + ! Finalize upward and downward radiance s_Level_Rad_UPT, s_Level_Rad_DOWNT + IF ( maxval(abs(RTV%s_Level_Refl_DOWN(1:nZ,1:nZ,k))) > ZERO ) THEN + + ! Inv_Gamma3 + temporal_matrix_TL = -matmul(s_refl_downt_TL(1:nZ,1:nZ,k), & + RTV%s_Level_Refl_UP(1:nZ,1:nZ,k)) & + -matmul(RTV%s_Level_Refl_DOWN(1:nZ,1:nZ,k), & + s_refl_upt_TL(1:nZ,1:nZ,k)) + temporal_matrix_TL = matmul(RTV%Inv_Gamma3(1:nZ,1:nZ,k),temporal_matrix_TL) + Inv_Gamma3_TL = -matmul(temporal_matrix_TL,RTV%Inv_Gamma3(1:nZ,1:nZ,k)) + + ! s_rad_downt_TL + ! RTV%s_Level_Rad_DOWNT(1:nZ,k)= matmul( RTV%Inv_Gamma3(1:nZ,1:nZ,k), & + ! matmul(RTV%s_Level_Refl_DOWN(1:nZ,1:nZ,k),RTV%s_Level_Rad_UP(1:nZ,k) ) & + ! + RTV%s_Level_Rad_DOWN(1:nZ,k) ) + temporal_vector = matmul(RTV%s_Level_Refl_DOWN(1:nZ,1:nZ,k),RTV%s_Level_Rad_UP(1:nZ,k)) & + + RTV%s_Level_Rad_DOWN(1:nZ,k) + temporal_vector_TL = matmul(s_refl_downt_TL(1:nZ,1:nZ,k),RTV%s_Level_Rad_UP(1:nZ,k)) & + + matmul(RTV%s_Level_Refl_DOWN(1:nZ,1:nZ,k),s_rad_upt_TL(1:nZ,k)) & + + s_rad_downt_TL(1:nZ,k) + s_rad_downt_TL(1:nZ,k) = matmul( Inv_Gamma3_TL, temporal_vector) & + + matmul( RTV%Inv_Gamma3(1:nZ,1:nZ,k),temporal_vector_TL ) + + + ! s_rad_upt_TL + ! temporal_vector = matmul(RTV%Inv_Gamma3(1:nZ,1:nZ,k),RTV%s_Level_Rad_DOWN(1:nZ,k)) + ! RTV%s_Level_Rad_UPT(1:nZ,k)= matmul(RTV%s_Level_Refl_UP(1:nZ,1:nZ,k),temporal_vector) & + ! + matmul(RTV%Inv_Gamma3(1:nZ,1:nZ,k),RTV%s_Level_Rad_UP(1:nZ,k)) + temporal_vector = matmul(RTV%Inv_Gamma3(1:nZ,1:nZ,k),RTV%s_Level_Rad_DOWN(1:nZ,k)) + temporal_vector_TL = matmul(RTV%Inv_Gamma3(1:nZ,1:nZ,k),s_rad_downt_TL(1:nZ,k)) & + + matmul(Inv_Gamma3_TL, RTV%s_Level_Rad_DOWN(1:nZ,k)) + s_rad_upt_TL(1:nZ,k) = matmul(RTV%s_Level_Refl_UP(1:nZ,1:nZ,k),temporal_vector_TL) & + + matmul(s_refl_upt_TL(1:nZ,1:nZ,k),temporal_vector) & + + matmul(Inv_Gamma3_TL, RTV%s_Level_Rad_UP(1:nZ,k)) & + + matmul(RTV%Inv_Gamma3(1:nZ,1:nZ,k), s_rad_upt_TL(1:nZ,k)) + ELSE + s_rad_upt_TL(1:nZ,k) = s_rad_upt_TL(1:nZ,k) & + + matmul(RTV%s_Level_Refl_UP(1:nZ,1:nZ,k), s_rad_downt_TL(1:nZ,k)) & + + matmul(s_refl_upt_TL(1:nZ,1:nZ,k), RTV%s_Level_Rad_DOWN(1:nZ,k)) + + END IF + + 20 CONTINUE + + END IF ! RTV%aircraft%rt .OR. RTV%obs_4_downward%rt + + ! Assign radiance TL + IF ( RTV%aircraft%rt ) THEN + s_rad_TL = s_rad_upt_TL(:, RTV%aircraft%idx) + ELSE IF ( RTV%obs_4_downward%rt ) THEN + s_rad_TL = s_rad_downt_TL(:, RTV%obs_4_downward%idx) + ELSE + ! Default, TOA upward radiance + s_rad_TL = s_rad_upt_TL(:,1) + END IF + + RETURN + + END SUBROUTINE CRTM_ADA_TL ! ! - SUBROUTINE CRTM_AMOM_layer_TL( n_streams, & ! Input, number of streams - nZ, & ! Input, number of angles - KL, & ! Input, KL-th layer - single_albedo, & ! Input, single scattering albedo - optical_depth, & ! Input, layer optical depth - total_opt, & ! Input, accumulated optical depth from the top to current layer top - COS_Angle, & ! Input, COSINE of ANGLES - COS_Weight, & ! Input, GAUSSIAN Weights - ff, & ! Input, Phase matrix (forward part) - bb, & ! Input, Phase matrix (backward part) - Planck_Func, & ! Input, Planck for layer temperature - single_albedo_TL, & ! Input, tangent-linear single albedo - optical_depth_TL, & ! Input, TL layer optical depth - total_opt_TL, & ! Input, accumulated TL optical depth from the top to current layer top - ff_TL, & ! Input, TL forward Phase matrix - bb_TL, & ! Input, TL backward Phase matrix - Planck_Func_TL, & ! Input, TL Planck for layer temperature - RTV, & ! Input, structure containing forward results - trans_TL, & ! Output, layer tangent-linear trans - refl_TL, & ! Output, layer tangent-linear refl - source_up_TL, & ! Output, layer tangent-linear source_up - source_down_TL) ! Output, layer tangent-linear source_down + SUBROUTINE CRTM_AMOM_layer_TL( n_streams, & ! Input, number of streams + nZ, & ! Input, number of angles + KL, & ! Input, KL-th layer + single_albedo, & ! Input, single scattering albedo + optical_depth, & ! Input, layer optical depth + total_opt, & ! Input, accumulated optical depth from the top to current layer top + COS_Angle, & ! Input, COSINE of ANGLES + COS_Weight, & ! Input, GAUSSIAN Weights + ff, & ! Input, Phase matrix (forward part) + bb, & ! Input, Phase matrix (backward part) + Planck_Func, & ! Input, Planck for layer temperature + single_albedo_TL, & ! Input, tangent-linear single albedo + optical_depth_TL, & ! Input, TL layer optical depth + total_opt_TL, & ! Input, accumulated TL optical depth from the top to current layer top + ff_TL, & ! Input, TL forward Phase matrix + bb_TL, & ! Input, TL backward Phase matrix + Planck_Func_TL, & ! Input, TL Planck for layer temperature + RTV, & ! Input, structure containing forward results + trans_TL, & ! Output, layer tangent-linear trans + refl_TL, & ! Output, layer tangent-linear refl + source_up_TL, & ! Output, layer tangent-linear source_up + source_down_TL) ! Output, layer tangent-linear source_down ! --------------------------------------------------------------------------------------- ! FUNCTION diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index d63d9c2e..eb2b2251 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -196,32 +196,30 @@ list( APPEND AOD_Sensor_Ids # Create list of sensor ids for testing list( APPEND Zeeman_Sensor_Ids - ssmis_f20 - ssmis_f19 - ssmis_f18 - ssmis_f17 - ssmis_f16 + ssmis_f20 + ssmis_f19 + ssmis_f18 + ssmis_f17 + ssmis_f16 ) list( APPEND ChannelSubset_Sensor_Ids - iasi_metop-b + iasi_metop-b ) list( APPEND Aircraft_Sensor_Ids - cris-fsr_n21 - crisB1_npp + cris-fsr_n21 + crisB1_npp + v.abi_gr + abi_g18 ) list( APPEND Downwelling_Radiance_Sensor_Ids - atms_n21 cris-fsr_n21 - v.abi_g18 - atms_npp - cris399_npp + crisB1_npp v.abi_gr abi_g18 - modis_aqua ) @@ -229,39 +227,41 @@ list( APPEND OMPoverChannels_Sensor_Ids atms_n21 ) -list (APPEND common_tests - Simple - AOD - Zeeman - ChannelSubset - ClearSky - Aircraft - Downwelling_Radiance - ScatteringSwitch - User_Emissivity - SOI - SSU - VerticalCoordinates +list( APPEND common_tests + Simple + AOD + Zeeman + ChannelSubset + ClearSky + Aircraft + Downwelling_Radiance + ScatteringSwitch + User_Emissivity + SOI + SSU + VerticalCoordinates ) -list (APPEND omp_tests - OMPoverChannels +list( APPEND omp_tests + OMPoverChannels ) -list (APPEND regression_types - forward - k_matrix +list( APPEND regression_types + forward + k_matrix ) -list (APPEND TLAD_types - adjoint - tangent_linear +list( APPEND TLAD_types + adjoint + tangent_linear ) -list (APPEND TLAD_tests - Simple - ClearSky +list( APPEND TLAD_tests + Simple + ClearSky + Aircraft + Downwelling_Radiance ) @@ -454,7 +454,16 @@ endforeach() #--------------------------------------------------------------------------------- #TLAD Regression tests foreach(regtype IN LISTS TLAD_types) + string(COMPARE EQUAL ${regtype} "adjoint" isregtype) foreach(testtype IN LISTS TLAD_tests) + string(COMPARE EQUAL ${testtype} "Aircraft" istesttype) + if (isregtype AND istesttype) + continue() #skip Aircraft type for adjoint + endif() + string(COMPARE EQUAL ${testtype} "Downwelling_Radiance" istesttype) + if (isregtype AND istesttype) + continue() #skip Downwelling_Radiance type for adjoint + endif() add_executable(test_${regtype}_test_${testtype} mains/regression/${regtype}/test_${testtype}/test_${testtype}.f90) target_link_libraries(test_${regtype}_test_${testtype} PRIVATE crtm) diff --git a/test/mains/regression/tangent_linear/test_Aircraft/Load_Atm_Data.inc b/test/mains/regression/tangent_linear/test_Aircraft/Load_Atm_Data.inc new file mode 100644 index 00000000..d8357b8a --- /dev/null +++ b/test/mains/regression/tangent_linear/test_Aircraft/Load_Atm_Data.inc @@ -0,0 +1,489 @@ + ! + ! Include file containing an internal subprogam to load some test profile data + ! + SUBROUTINE Load_Atm_Data() + ! Local variables + INTEGER :: nc + INTEGER :: k1, k2 + + + ! 4a.1 Profile #1 + ! --------------- + ! ...Profile and absorber definitions + atm(1)%Climatology = US_STANDARD_ATMOSPHERE + atm(1)%Absorber_Id(1:2) = (/ H2O_ID , O3_ID /) + atm(1)%Absorber_Units(1:2) = (/ MASS_MIXING_RATIO_UNITS, VOLUME_MIXING_RATIO_UNITS /) + ! ...Profile data + atm(1)%Level_Pressure = & + (/0.714_fp, 0.975_fp, 1.297_fp, 1.687_fp, 2.153_fp, 2.701_fp, 3.340_fp, 4.077_fp, & + 4.920_fp, 5.878_fp, 6.957_fp, 8.165_fp, 9.512_fp, 11.004_fp, 12.649_fp, 14.456_fp, & + 16.432_fp, 18.585_fp, 20.922_fp, 23.453_fp, 26.183_fp, 29.121_fp, 32.274_fp, 35.650_fp, & + 39.257_fp, 43.100_fp, 47.188_fp, 51.528_fp, 56.126_fp, 60.990_fp, 66.125_fp, 71.540_fp, & + 77.240_fp, 83.231_fp, 89.520_fp, 96.114_fp, 103.017_fp, 110.237_fp, 117.777_fp, 125.646_fp, & + 133.846_fp, 142.385_fp, 151.266_fp, 160.496_fp, 170.078_fp, 180.018_fp, 190.320_fp, 200.989_fp, & + 212.028_fp, 223.441_fp, 235.234_fp, 247.409_fp, 259.969_fp, 272.919_fp, 286.262_fp, 300.000_fp, & + 314.137_fp, 328.675_fp, 343.618_fp, 358.967_fp, 374.724_fp, 390.893_fp, 407.474_fp, 424.470_fp, & + 441.882_fp, 459.712_fp, 477.961_fp, 496.630_fp, 515.720_fp, 535.232_fp, 555.167_fp, 575.525_fp, & + 596.306_fp, 617.511_fp, 639.140_fp, 661.192_fp, 683.667_fp, 706.565_fp, 729.886_fp, 753.627_fp, & + 777.790_fp, 802.371_fp, 827.371_fp, 852.788_fp, 878.620_fp, 904.866_fp, 931.524_fp, 958.591_fp, & + 986.067_fp,1013.948_fp,1042.232_fp,1070.917_fp,1100.000_fp/) + + atm(1)%Pressure = & + (/0.838_fp, 1.129_fp, 1.484_fp, 1.910_fp, 2.416_fp, 3.009_fp, 3.696_fp, 4.485_fp, & + 5.385_fp, 6.402_fp, 7.545_fp, 8.822_fp, 10.240_fp, 11.807_fp, 13.532_fp, 15.423_fp, & + 17.486_fp, 19.730_fp, 22.163_fp, 24.793_fp, 27.626_fp, 30.671_fp, 33.934_fp, 37.425_fp, & + 41.148_fp, 45.113_fp, 49.326_fp, 53.794_fp, 58.524_fp, 63.523_fp, 68.797_fp, 74.353_fp, & + 80.198_fp, 86.338_fp, 92.778_fp, 99.526_fp, 106.586_fp, 113.965_fp, 121.669_fp, 129.703_fp, & + 138.072_fp, 146.781_fp, 155.836_fp, 165.241_fp, 175.001_fp, 185.121_fp, 195.606_fp, 206.459_fp, & + 217.685_fp, 229.287_fp, 241.270_fp, 253.637_fp, 266.392_fp, 279.537_fp, 293.077_fp, 307.014_fp, & + 321.351_fp, 336.091_fp, 351.236_fp, 366.789_fp, 382.751_fp, 399.126_fp, 415.914_fp, 433.118_fp, & + 450.738_fp, 468.777_fp, 487.236_fp, 506.115_fp, 525.416_fp, 545.139_fp, 565.285_fp, 585.854_fp, & + 606.847_fp, 628.263_fp, 650.104_fp, 672.367_fp, 695.054_fp, 718.163_fp, 741.693_fp, 765.645_fp, & + 790.017_fp, 814.807_fp, 840.016_fp, 865.640_fp, 891.679_fp, 918.130_fp, 944.993_fp, 972.264_fp, & + 999.942_fp,1028.025_fp,1056.510_fp,1085.394_fp/) + + atm(1)%Temperature = & + (/256.186_fp, 252.608_fp, 247.762_fp, 243.314_fp, 239.018_fp, 235.282_fp, 233.777_fp, 234.909_fp, & + 237.889_fp, 241.238_fp, 243.194_fp, 243.304_fp, 242.977_fp, 243.133_fp, 242.920_fp, 242.026_fp, & + 240.695_fp, 239.379_fp, 238.252_fp, 236.928_fp, 235.452_fp, 234.561_fp, 234.192_fp, 233.774_fp, & + 233.305_fp, 233.053_fp, 233.103_fp, 233.307_fp, 233.702_fp, 234.219_fp, 234.959_fp, 235.940_fp, & + 236.744_fp, 237.155_fp, 237.374_fp, 238.244_fp, 239.736_fp, 240.672_fp, 240.688_fp, 240.318_fp, & + 239.888_fp, 239.411_fp, 238.512_fp, 237.048_fp, 235.388_fp, 233.551_fp, 231.620_fp, 230.418_fp, & + 229.927_fp, 229.511_fp, 229.197_fp, 228.947_fp, 228.772_fp, 228.649_fp, 228.567_fp, 228.517_fp, & + 228.614_fp, 228.861_fp, 229.376_fp, 230.223_fp, 231.291_fp, 232.591_fp, 234.013_fp, 235.508_fp, & + 237.041_fp, 238.589_fp, 240.165_fp, 241.781_fp, 243.399_fp, 244.985_fp, 246.495_fp, 247.918_fp, & + 249.073_fp, 250.026_fp, 251.113_fp, 252.321_fp, 253.550_fp, 254.741_fp, 256.089_fp, 257.692_fp, & + 259.358_fp, 261.010_fp, 262.779_fp, 264.702_fp, 266.711_fp, 268.863_fp, 271.103_fp, 272.793_fp, & + 273.356_fp, 273.356_fp, 273.356_fp, 273.356_fp/) + + atm(1)%Absorber(:,1) = & + (/4.187E-03_fp,4.401E-03_fp,4.250E-03_fp,3.688E-03_fp,3.516E-03_fp,3.739E-03_fp,3.694E-03_fp,3.449E-03_fp, & + 3.228E-03_fp,3.212E-03_fp,3.245E-03_fp,3.067E-03_fp,2.886E-03_fp,2.796E-03_fp,2.704E-03_fp,2.617E-03_fp, & + 2.568E-03_fp,2.536E-03_fp,2.506E-03_fp,2.468E-03_fp,2.427E-03_fp,2.438E-03_fp,2.493E-03_fp,2.543E-03_fp, & + 2.586E-03_fp,2.632E-03_fp,2.681E-03_fp,2.703E-03_fp,2.636E-03_fp,2.512E-03_fp,2.453E-03_fp,2.463E-03_fp, & + 2.480E-03_fp,2.499E-03_fp,2.526E-03_fp,2.881E-03_fp,3.547E-03_fp,4.023E-03_fp,4.188E-03_fp,4.223E-03_fp, & + 4.252E-03_fp,4.275E-03_fp,4.105E-03_fp,3.675E-03_fp,3.196E-03_fp,2.753E-03_fp,2.338E-03_fp,2.347E-03_fp, & + 2.768E-03_fp,3.299E-03_fp,3.988E-03_fp,4.531E-03_fp,4.625E-03_fp,4.488E-03_fp,4.493E-03_fp,4.614E-03_fp, & + 7.523E-03_fp,1.329E-02_fp,2.468E-02_fp,4.302E-02_fp,6.688E-02_fp,9.692E-02_fp,1.318E-01_fp,1.714E-01_fp, & + 2.149E-01_fp,2.622E-01_fp,3.145E-01_fp,3.726E-01_fp,4.351E-01_fp,5.002E-01_fp,5.719E-01_fp,6.507E-01_fp, & + 7.110E-01_fp,7.552E-01_fp,8.127E-01_fp,8.854E-01_fp,9.663E-01_fp,1.050E+00_fp,1.162E+00_fp,1.316E+00_fp, & + 1.494E+00_fp,1.690E+00_fp,1.931E+00_fp,2.226E+00_fp,2.574E+00_fp,2.939E+00_fp,3.187E+00_fp,3.331E+00_fp, & + 3.352E+00_fp,3.260E+00_fp,3.172E+00_fp,3.087E+00_fp/) + + atm(1)%Absorber(:,2) = & + (/3.035E+00_fp,3.943E+00_fp,4.889E+00_fp,5.812E+00_fp,6.654E+00_fp,7.308E+00_fp,7.660E+00_fp,7.745E+00_fp, & + 7.696E+00_fp,7.573E+00_fp,7.413E+00_fp,7.246E+00_fp,7.097E+00_fp,6.959E+00_fp,6.797E+00_fp,6.593E+00_fp, & + 6.359E+00_fp,6.110E+00_fp,5.860E+00_fp,5.573E+00_fp,5.253E+00_fp,4.937E+00_fp,4.625E+00_fp,4.308E+00_fp, & + 3.986E+00_fp,3.642E+00_fp,3.261E+00_fp,2.874E+00_fp,2.486E+00_fp,2.102E+00_fp,1.755E+00_fp,1.450E+00_fp, & + 1.208E+00_fp,1.087E+00_fp,1.030E+00_fp,1.005E+00_fp,1.010E+00_fp,1.028E+00_fp,1.068E+00_fp,1.109E+00_fp, & + 1.108E+00_fp,1.071E+00_fp,9.928E-01_fp,8.595E-01_fp,7.155E-01_fp,5.778E-01_fp,4.452E-01_fp,3.372E-01_fp, & + 2.532E-01_fp,1.833E-01_fp,1.328E-01_fp,9.394E-02_fp,6.803E-02_fp,5.152E-02_fp,4.569E-02_fp,4.855E-02_fp, & + 5.461E-02_fp,6.398E-02_fp,7.205E-02_fp,7.839E-02_fp,8.256E-02_fp,8.401E-02_fp,8.412E-02_fp,8.353E-02_fp, & + 8.269E-02_fp,8.196E-02_fp,8.103E-02_fp,7.963E-02_fp,7.741E-02_fp,7.425E-02_fp,7.067E-02_fp,6.702E-02_fp, & + 6.368E-02_fp,6.070E-02_fp,5.778E-02_fp,5.481E-02_fp,5.181E-02_fp,4.920E-02_fp,4.700E-02_fp,4.478E-02_fp, & + 4.207E-02_fp,3.771E-02_fp,3.012E-02_fp,1.941E-02_fp,9.076E-03_fp,2.980E-03_fp,5.117E-03_fp,1.160E-02_fp, & + 1.428E-02_fp,1.428E-02_fp,1.428E-02_fp,1.428E-02_fp/) + + + ! Load CO2 absorber data if there are three absorrbers + IF ( atm(1)%n_Absorbers > 2 ) THEN + atm(1)%Absorber_Id(3) = CO2_ID + atm(1)%Absorber_Units(3) = VOLUME_MIXING_RATIO_UNITS + atm(1)%Absorber(:,3) = 380.0_fp + END IF + + + ! Cloud data + IF ( atm(1)%n_Clouds > 0 ) THEN + k1 = 75 + k2 = 79 + DO nc = 1, atm(1)%n_Clouds + atm(1)%Cloud(nc)%Type = WATER_CLOUD + atm(1)%Cloud(nc)%Effective_Radius(k1:k2) = 20.0_fp ! microns + atm(1)%Cloud(nc)%Water_Content(k1:k2) = 5.0_fp ! kg/m^2 + END DO + END IF + + + ! Aerosol data. Three aerosol types can be loaded: + ! Dust, Sulphate, and Sea Salt SSCM3 + Load_Aerosol_Data_1: IF ( atm(1)%n_Aerosols > 0 ) THEN + atm(1)%Aerosol(1)%Type = DUST_AEROSOL + atm(1)%Aerosol(1)%Effective_Radius = & ! microns + (/0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 5.305110E-16_fp, & + 7.340409E-16_fp, 1.037097E-15_fp, 1.496791E-15_fp, 2.207471E-15_fp, 3.327732E-15_fp, & + 5.128933E-15_fp, 8.083748E-15_fp, 1.303055E-14_fp, 2.148368E-14_fp, 3.622890E-14_fp, & + 6.248544E-14_fp, 1.102117E-13_fp, 1.987557E-13_fp, 3.663884E-13_fp, 6.901587E-13_fp, & + 1.327896E-12_fp, 2.608405E-12_fp, 5.228012E-12_fp, 1.068482E-11_fp, 2.225098E-11_fp, & + 4.717675E-11_fp, 1.017447E-10_fp, 2.229819E-10_fp, 4.960579E-10_fp, 1.118899E-09_fp, & + 2.555617E-09_fp, 5.902789E-09_fp, 1.376717E-08_fp, 3.237321E-08_fp, 7.662427E-08_fp, & + 1.822344E-07_fp, 4.346896E-07_fp, 1.037940E-06_fp, 2.475858E-06_fp, 5.887266E-06_fp, & + 1.392410E-05_fp, 3.267943E-05_fp, 7.592447E-05_fp, 1.741777E-04_fp, 3.935216E-04_fp, & + 8.732308E-04_fp, 1.897808E-03_fp, 4.027868E-03_fp, 8.323272E-03_fp, 1.669418E-02_fp, & + 3.239702E-02_fp, 6.063055E-02_fp, 1.090596E-01_fp, 1.878990E-01_fp, 3.089856E-01_fp, & + 4.832092E-01_fp, 7.159947E-01_fp, 1.001436E+00_fp, 1.317052E+00_fp, 1.622354E+00_fp, & + 1.864304E+00_fp, 1.990457E+00_fp, 1.966354E+00_fp, 1.789883E+00_fp, 1.494849E+00_fp, & + 1.140542E+00_fp, 7.915451E-01_fp, 4.974823E-01_fp, 2.818937E-01_fp, 1.433668E-01_fp, & + 6.514795E-02_fp, 2.633057E-02_fp, 9.421763E-03_fp, 2.971053E-03_fp, 8.218245E-04_fp/) + atm(1)%Aerosol(1)%Concentration = & ! kg/m^2 + (/0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 2.458105E-18_fp, 1.983430E-16_fp, & + 1.191432E-14_fp, 5.276880E-13_fp, 1.710270E-11_fp, 4.035105E-10_fp, 6.911389E-09_fp, & + 8.594215E-08_fp, 7.781797E-07_fp, 5.162773E-06_fp, 2.534018E-05_fp, 9.325154E-05_fp, & + 2.617738E-04_fp, 5.727150E-04_fp, 1.002153E-03_fp, 1.446048E-03_fp, 1.782757E-03_fp, & + 1.955759E-03_fp, 1.999206E-03_fp, 1.994698E-03_fp, 1.913109E-03_fp, 1.656122E-03_fp, & + 1.206328E-03_fp, 6.847261E-04_fp, 2.785695E-04_fp, 7.418821E-05_fp, 1.172680E-05_fp, & + 9.900895E-07_fp, 3.987399E-08_fp, 6.786932E-10_fp, 4.291151E-12_fp, 8.785440E-15_fp/) + + IF ( atm(1)%n_Aerosols > 1 ) THEN + atm(1)%Aerosol(2)%Type = SULFATE_AEROSOL + atm(1)%Aerosol(2)%Effective_Radius = & ! microns + (/0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.060238E-01_fp, 3.652677E-01_fp, 4.139419E-01_fp, 4.438249E-01_fp, & + 4.486394E-01_fp, 4.261471E-01_fp, 3.795067E-01_fp, 3.174571E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.243099E-01_fp, 4.662931E-01_fp, & + 6.103025E-01_fp, 6.958640E-01_fp, 6.776480E-01_fp, 5.570077E-01_fp, 3.828734E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp/) + atm(1)%Aerosol(2)%Concentration = & ! kg/m^2 + (/0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 7.299549E-21_fp, 2.154532E-20_fp, 6.848207E-20_fp, & + 2.339296E-19_fp, 8.562906E-19_fp, 3.346100E-18_fp, 1.389284E-17_fp, 6.094260E-17_fp, & + 2.805828E-16_fp, 1.345656E-15_fp, 6.665967E-15_fp, 3.378989E-14_fp, 1.734933E-13_fp, & + 8.924837E-13_fp, 4.546743E-12_fp, 2.266249E-11_fp, 1.091369E-10_fp, 5.013496E-10_fp, & + 2.168936E-09_fp, 8.725800E-09_fp, 3.224980E-08_fp, 1.082545E-07_fp, 3.266343E-07_fp, & + 8.780083E-07_fp, 2.087760E-06_fp, 4.370441E-06_fp, 8.038113E-06_fp, 1.300537E-05_fp, & + 1.860671E-05_fp, 2.376757E-05_fp, 2.751048E-05_fp, 2.945706E-05_fp, 2.998589E-05_fp, & + 2.995521E-05_fp, 2.909387E-05_fp, 2.609907E-05_fp, 2.031620E-05_fp, 1.274989E-05_fp, & + 5.920554E-06_fp, 1.842346E-06_fp, 3.429331E-07_fp, 3.355556E-08_fp, 1.506455E-09_fp, & + 1.720306E-10_fp, 1.161071E-09_fp, 7.599420E-09_fp, 4.096076E-08_fp, 1.815570E-07_fp, & + 6.623233E-07_fp, 1.994766E-06_fp, 4.987904E-06_fp, 1.044158E-05_fp, 1.850659E-05_fp, & + 2.817442E-05_fp, 3.750360E-05_fp, 4.459276E-05_fp, 4.857087E-05_fp, 4.990199E-05_fp, & + 4.998888E-05_fp, 4.922362E-05_fp, 4.582548E-05_fp, 3.844906E-05_fp, 2.757877E-05_fp, & + 1.615474E-05_fp, 9.509965E-06_fp, 1.672265E-05_fp, 4.602962E-05_fp, 8.740809E-05_fp, & + 1.165118E-04_fp, 1.248318E-04_fp, 1.240508E-04_fp, 1.095622E-04_fp, 7.116027E-05_fp, & + 2.756351E-05_fp, 5.072010E-06_fp, 3.467497E-07_fp, 6.759169E-09_fp, 2.828000E-11_fp/) + END IF + + IF ( atm(1)%n_Aerosols > 2 ) THEN + atm(1)%Aerosol(3)%Type = SEASALT_SSCM3_AEROSOL + atm(1)%Aerosol(3)%Effective_Radius = & ! microns + (/7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp/) + atm(1)%Aerosol(3)%Concentration = & ! kg/m^2 + (/1.834405E-15_fp, 2.004881E-15_fp, & + 2.234084E-15_fp, 2.543453E-15_fp, 2.964461E-15_fp, 3.544295E-15_fp, 4.355235E-15_fp, & + 5.510452E-15_fp, 7.191267E-15_fp, 9.695182E-15_fp, 1.352261E-14_fp, 1.953716E-14_fp, & + 2.926925E-14_fp, 4.550553E-14_fp, 7.346181E-14_fp, 1.231759E-13_fp, 2.145104E-13_fp, & + 3.878653E-13_fp, 7.276576E-13_fp, 1.414927E-12_fp, 2.847645E-12_fp, 5.921044E-12_fp, & + 1.269153E-11_fp, 2.797048E-11_fp, 6.318984E-11_fp, 1.458383E-10_fp, 3.425444E-10_fp, & + 8.153831E-10_fp, 1.958067E-09_fp, 4.720525E-09_fp, 1.136570E-08_fp, 2.718180E-08_fp, & + 6.420674E-08_fp, 1.489302E-07_fp, 3.372331E-07_fp, 7.410874E-07_fp, 1.571399E-06_fp, & + 3.197064E-06_fp, 6.208220E-06_fp, 1.145048E-05_fp, 1.997373E-05_fp, 3.283395E-05_fp, & + 5.072822E-05_fp, 7.354173E-05_fp, 1.000035E-04_fp, 1.276931E-04_fp, 1.535301E-04_fp, & + 1.746342E-04_fp, 1.892127E-04_fp, 1.971011E-04_fp, 1.997815E-04_fp, 1.999842E-04_fp, & + 1.985580E-04_fp, 1.917087E-04_fp, 1.753846E-04_fp, 1.474980E-04_fp, 1.101113E-04_fp, & + 7.010137E-05_fp, 3.636523E-05_fp, 1.460058E-05_fp, 4.282477E-06_fp, 8.603007E-07_fp, & + 1.101800E-07_fp, 8.310010E-09_fp, 3.382006E-10_fp, 6.751810E-12_fp, 3.060195E-13_fp, & + 9.145434E-12_fp, 2.343817E-10_fp, 4.156377E-09_fp, 5.122906E-08_fp, 4.424084E-07_fp, & + 2.708849E-06_fp, 1.194846E-05_fp, 3.874236E-05_fp, 9.466062E-05_fp, 1.795200E-04_fp, & + 2.735688E-04_fp, 3.486493E-04_fp, 3.889143E-04_fp, 3.997242E-04_fp, 3.991008E-04_fp, & + 3.826235E-04_fp, 3.287943E-04_fp, 2.344766E-04_fp, 1.275907E-04_fp, 4.835821E-05_fp, & + 1.156687E-05_fp, 1.570009E-06_fp, 1.078885E-07_fp, 3.321985E-09_fp, 4.023206E-11_fp/) + END IF + END IF Load_Aerosol_Data_1 + + + + ! 4a.2 Profile #2 + ! --------------- + ! ...Profile and absorber definitions + atm(2)%Climatology = TROPICAL + atm(2)%Absorber_Id(1:2) = (/ H2O_ID , O3_ID /) + atm(2)%Absorber_Units(1:2) = (/ MASS_MIXING_RATIO_UNITS, VOLUME_MIXING_RATIO_UNITS /) + ! ...Profile data + atm(2)%Level_Pressure = & + (/0.714_fp, 0.975_fp, 1.297_fp, 1.687_fp, 2.153_fp, 2.701_fp, 3.340_fp, 4.077_fp, & + 4.920_fp, 5.878_fp, 6.957_fp, 8.165_fp, 9.512_fp, 11.004_fp, 12.649_fp, 14.456_fp, & + 16.432_fp, 18.585_fp, 20.922_fp, 23.453_fp, 26.183_fp, 29.121_fp, 32.274_fp, 35.650_fp, & + 39.257_fp, 43.100_fp, 47.188_fp, 51.528_fp, 56.126_fp, 60.990_fp, 66.125_fp, 71.540_fp, & + 77.240_fp, 83.231_fp, 89.520_fp, 96.114_fp, 103.017_fp, 110.237_fp, 117.777_fp, 125.646_fp, & + 133.846_fp, 142.385_fp, 151.266_fp, 160.496_fp, 170.078_fp, 180.018_fp, 190.320_fp, 200.989_fp, & + 212.028_fp, 223.441_fp, 235.234_fp, 247.409_fp, 259.969_fp, 272.919_fp, 286.262_fp, 300.000_fp, & + 314.137_fp, 328.675_fp, 343.618_fp, 358.967_fp, 374.724_fp, 390.893_fp, 407.474_fp, 424.470_fp, & + 441.882_fp, 459.712_fp, 477.961_fp, 496.630_fp, 515.720_fp, 535.232_fp, 555.167_fp, 575.525_fp, & + 596.306_fp, 617.511_fp, 639.140_fp, 661.192_fp, 683.667_fp, 706.565_fp, 729.886_fp, 753.627_fp, & + 777.790_fp, 802.371_fp, 827.371_fp, 852.788_fp, 878.620_fp, 904.866_fp, 931.524_fp, 958.591_fp, & + 986.067_fp,1013.948_fp,1042.232_fp,1070.917_fp,1100.000_fp/) + + atm(2)%Pressure = & + (/0.838_fp, 1.129_fp, 1.484_fp, 1.910_fp, 2.416_fp, 3.009_fp, 3.696_fp, 4.485_fp, & + 5.385_fp, 6.402_fp, 7.545_fp, 8.822_fp, 10.240_fp, 11.807_fp, 13.532_fp, 15.423_fp, & + 17.486_fp, 19.730_fp, 22.163_fp, 24.793_fp, 27.626_fp, 30.671_fp, 33.934_fp, 37.425_fp, & + 41.148_fp, 45.113_fp, 49.326_fp, 53.794_fp, 58.524_fp, 63.523_fp, 68.797_fp, 74.353_fp, & + 80.198_fp, 86.338_fp, 92.778_fp, 99.526_fp, 106.586_fp, 113.965_fp, 121.669_fp, 129.703_fp, & + 138.072_fp, 146.781_fp, 155.836_fp, 165.241_fp, 175.001_fp, 185.121_fp, 195.606_fp, 206.459_fp, & + 217.685_fp, 229.287_fp, 241.270_fp, 253.637_fp, 266.392_fp, 279.537_fp, 293.077_fp, 307.014_fp, & + 321.351_fp, 336.091_fp, 351.236_fp, 366.789_fp, 382.751_fp, 399.126_fp, 415.914_fp, 433.118_fp, & + 450.738_fp, 468.777_fp, 487.236_fp, 506.115_fp, 525.416_fp, 545.139_fp, 565.285_fp, 585.854_fp, & + 606.847_fp, 628.263_fp, 650.104_fp, 672.367_fp, 695.054_fp, 718.163_fp, 741.693_fp, 765.645_fp, & + 790.017_fp, 814.807_fp, 840.016_fp, 865.640_fp, 891.679_fp, 918.130_fp, 944.993_fp, 972.264_fp, & + 999.942_fp,1028.025_fp,1056.510_fp,1085.394_fp/) + + atm(2)%Temperature = & + (/266.536_fp, 269.608_fp, 270.203_fp, 264.526_fp, 251.578_fp, 240.264_fp, 235.095_fp, 232.959_fp, & + 233.017_fp, 233.897_fp, 234.385_fp, 233.681_fp, 232.436_fp, 231.607_fp, 231.192_fp, 230.808_fp, & + 230.088_fp, 228.603_fp, 226.407_fp, 223.654_fp, 220.525_fp, 218.226_fp, 216.668_fp, 215.107_fp, & + 213.538_fp, 212.006_fp, 210.507_fp, 208.883_fp, 206.793_fp, 204.415_fp, 202.058_fp, 199.718_fp, & + 197.668_fp, 196.169_fp, 194.993_fp, 194.835_fp, 195.648_fp, 196.879_fp, 198.830_fp, 201.091_fp, & + 203.558_fp, 206.190_fp, 208.900_fp, 211.736_fp, 214.601_fp, 217.522_fp, 220.457_fp, 223.334_fp, & + 226.156_fp, 228.901_fp, 231.557_fp, 234.173_fp, 236.788_fp, 239.410_fp, 242.140_fp, 244.953_fp, & + 247.793_fp, 250.665_fp, 253.216_fp, 255.367_fp, 257.018_fp, 258.034_fp, 258.778_fp, 259.454_fp, & + 260.225_fp, 261.251_fp, 262.672_fp, 264.614_fp, 266.854_fp, 269.159_fp, 271.448_fp, 273.673_fp, & + 275.955_fp, 278.341_fp, 280.822_fp, 283.349_fp, 285.826_fp, 288.288_fp, 290.721_fp, 293.135_fp, & + 295.609_fp, 298.173_fp, 300.787_fp, 303.379_fp, 305.960_fp, 308.521_fp, 310.916_fp, 313.647_fp, & + 315.244_fp, 315.244_fp, 315.244_fp, 315.244_fp/) + + atm(2)%Absorber(:,1) = & + (/3.887E-03_fp,3.593E-03_fp,3.055E-03_fp,2.856E-03_fp,2.921E-03_fp,2.555E-03_fp,2.392E-03_fp,2.605E-03_fp, & + 2.573E-03_fp,2.368E-03_fp,2.354E-03_fp,2.333E-03_fp,2.312E-03_fp,2.297E-03_fp,2.287E-03_fp,2.283E-03_fp, & + 2.282E-03_fp,2.286E-03_fp,2.296E-03_fp,2.309E-03_fp,2.324E-03_fp,2.333E-03_fp,2.335E-03_fp,2.335E-03_fp, & + 2.333E-03_fp,2.340E-03_fp,2.361E-03_fp,2.388E-03_fp,2.421E-03_fp,2.458E-03_fp,2.492E-03_fp,2.523E-03_fp, & + 2.574E-03_fp,2.670E-03_fp,2.789E-03_fp,2.944E-03_fp,3.135E-03_fp,3.329E-03_fp,3.530E-03_fp,3.759E-03_fp, & + 4.165E-03_fp,4.718E-03_fp,5.352E-03_fp,6.099E-03_fp,6.845E-03_fp,7.524E-03_fp,8.154E-03_fp,8.381E-03_fp, & + 8.214E-03_fp,8.570E-03_fp,9.672E-03_fp,1.246E-02_fp,1.880E-02_fp,2.720E-02_fp,3.583E-02_fp,4.462E-02_fp, & + 4.548E-02_fp,3.811E-02_fp,3.697E-02_fp,4.440E-02_fp,2.130E-01_fp,6.332E-01_fp,9.945E-01_fp,1.073E+00_fp, & + 1.196E+00_fp,1.674E+00_fp,2.323E+00_fp,2.950E+00_fp,3.557E+00_fp,4.148E+00_fp,4.666E+00_fp,5.092E+00_fp, & + 5.487E+00_fp,5.852E+00_fp,6.137E+00_fp,6.297E+00_fp,6.338E+00_fp,6.234E+00_fp,5.906E+00_fp,5.476E+00_fp, & + 5.176E+00_fp,4.994E+00_fp,4.884E+00_fp,4.832E+00_fp,4.791E+00_fp,4.760E+00_fp,4.736E+00_fp,6.368E+00_fp, & + 7.897E+00_fp,7.673E+00_fp,7.458E+00_fp,7.252E+00_fp/) + + atm(2)%Absorber(:,2) = & + (/2.742E+00_fp,3.386E+00_fp,4.164E+00_fp,5.159E+00_fp,6.357E+00_fp,7.430E+00_fp,8.174E+00_fp,8.657E+00_fp, & + 8.930E+00_fp,9.056E+00_fp,9.077E+00_fp,8.988E+00_fp,8.778E+00_fp,8.480E+00_fp,8.123E+00_fp,7.694E+00_fp, & + 7.207E+00_fp,6.654E+00_fp,6.060E+00_fp,5.464E+00_fp,4.874E+00_fp,4.299E+00_fp,3.739E+00_fp,3.202E+00_fp, & + 2.688E+00_fp,2.191E+00_fp,1.710E+00_fp,1.261E+00_fp,8.835E-01_fp,5.551E-01_fp,3.243E-01_fp,1.975E-01_fp, & + 1.071E-01_fp,7.026E-02_fp,6.153E-02_fp,5.869E-02_fp,6.146E-02_fp,6.426E-02_fp,6.714E-02_fp,6.989E-02_fp, & + 7.170E-02_fp,7.272E-02_fp,7.346E-02_fp,7.383E-02_fp,7.406E-02_fp,7.418E-02_fp,7.424E-02_fp,7.411E-02_fp, & + 7.379E-02_fp,7.346E-02_fp,7.312E-02_fp,7.284E-02_fp,7.274E-02_fp,7.273E-02_fp,7.272E-02_fp,7.270E-02_fp, & + 7.257E-02_fp,7.233E-02_fp,7.167E-02_fp,7.047E-02_fp,6.920E-02_fp,6.803E-02_fp,6.729E-02_fp,6.729E-02_fp, & + 6.753E-02_fp,6.756E-02_fp,6.717E-02_fp,6.615E-02_fp,6.510E-02_fp,6.452E-02_fp,6.440E-02_fp,6.463E-02_fp, & + 6.484E-02_fp,6.487E-02_fp,6.461E-02_fp,6.417E-02_fp,6.382E-02_fp,6.378E-02_fp,6.417E-02_fp,6.482E-02_fp, & + 6.559E-02_fp,6.638E-02_fp,6.722E-02_fp,6.841E-02_fp,6.944E-02_fp,6.720E-02_fp,6.046E-02_fp,4.124E-02_fp, & + 2.624E-02_fp,2.623E-02_fp,2.622E-02_fp,2.622E-02_fp/) + + + ! Load CO2 absorrber data if there are three absorrbers + IF ( atm(2)%n_Absorbers > 2 ) THEN + atm(2)%Absorber_Id(3) = CO2_ID + atm(2)%Absorber_Units(3) = VOLUME_MIXING_RATIO_UNITS + atm(2)%Absorber(:,3) = & + (/1.100e+02_fp,2.700e+02_fp,3.200e+02_fp,3.300e+02_fp,3.200e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp, & + 3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp, & + 3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp, & + 3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp, & + 3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp, & + 3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp, & + 3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp, & + 3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp, & + 3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp, & + 3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp, & + 3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp, & + 3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp /) + END IF + + + ! Cloud data + IF ( atm(2)%n_Clouds > 0 ) THEN + k1 = 73 + k2 = 90 + DO nc = 1, atm(2)%n_Clouds + atm(2)%Cloud(nc)%Type = RAIN_CLOUD + atm(2)%Cloud(nc)%Effective_Radius(k1:k2) = 1000.0_fp ! microns + atm(2)%Cloud(nc)%Water_Content(k1:k2) = 5.0_fp ! kg/m^2 + END DO + END IF + + + ! Aerosol data. Three aerosol types can be loaded: + ! Sea Sat SSAM, Sea Salt SSCM1, and Sea Salt SSCM2 + Load_Aerosol_Data_2: IF ( atm(2)%n_Aerosols > 0 ) THEN + + atm(2)%Aerosol(1)%Type = SEASALT_SSAM_AEROSOL + atm(2)%Aerosol(1)%Effective_Radius = & ! microns + (/0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, & + 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, & + 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, & + 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, & + 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, & + 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, & + 3.500000E-01_fp, 4.172383E-01_fp, 5.083015E-01_fp, 6.111266E-01_fp, 7.244139E-01_fp, & + 8.457720E-01_fp, 9.716019E-01_fp, 1.097090E+00_fp, 1.216347E+00_fp, 1.322729E+00_fp, & + 1.400000E+00_fp, 1.400000E+00_fp, 1.400000E+00_fp, 1.400000E+00_fp, 1.400000E+00_fp, & + 1.370222E+00_fp, 1.261597E+00_fp, 1.129123E+00_fp, 9.811745E-01_fp, 8.268477E-01_fp/) + atm(2)%Aerosol(1)%Concentration = & ! kg/m^2 + (/0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 3.112058E-19_fp, 1.184702E-18_fp, 4.577011E-18_fp, 1.789488E-17_fp, 7.059239E-17_fp, & + 2.801093E-16_fp, 1.114424E-15_fp, 4.430982E-15_fp, 1.754743E-14_fp, 6.897637E-14_fp, & + 2.681926E-13_fp, 1.027837E-12_fp, 3.868968E-12_fp, 1.425352E-11_fp, 5.121245E-11_fp, & + 1.788308E-10_fp, 6.048330E-10_fp, 1.974708E-09_fp, 6.203527E-09_fp, 1.869357E-08_fp, & + 5.387408E-08_fp, 1.480799E-07_fp, 3.871910E-07_fp, 9.608434E-07_fp, 2.258279E-06_fp, & + 5.017946E-06_fp, 1.052599E-05_fp, 2.082121E-05_fp, 3.880948E-05_fp, 6.814300E-05_fp, & + 1.127227E-04_fp, 1.757803E-04_fp, 2.586908E-04_fp, 3.598829E-04_fp, 4.743266E-04_fp, & + 5.939634E-04_fp, 7.091114E-04_fp, 8.104756E-04_fp, 8.911259E-04_fp, 9.478373E-04_fp, & + 9.814733E-04_fp, 9.964914E-04_fp, 9.999501E-04_fp, 9.994838E-04_fp, 9.921395E-04_fp, & + 9.678320E-04_fp, 9.171414E-04_fp, 8.337592E-04_fp, 7.173667E-04_fp, 5.757384E-04_fp/) + + IF ( atm(2)%n_Aerosols > 1 ) THEN + atm(2)%Aerosol(2)%Type = SEASALT_SSCM1_AEROSOL + atm(2)%Aerosol(2)%Effective_Radius = & ! microns + (/0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 1.200000E+00_fp, 1.200000E+00_fp, 1.200000E+00_fp, 1.200000E+00_fp, & + 1.200000E+00_fp, 1.200000E+00_fp, 1.200000E+00_fp, 1.200000E+00_fp, 1.200000E+00_fp, & + 2.035608E+00_fp, 3.433539E+00_fp, 4.500000E+00_fp, 4.500000E+00_fp, 4.500000E+00_fp, & + 4.500000E+00_fp, 4.500000E+00_fp, 4.500000E+00_fp, 4.500000E+00_fp, 4.500000E+00_fp/) + atm(2)%Aerosol(2)%Concentration = & ! kg/m^2 + (/0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 1.718665E-20_fp, 6.364432E-18_fp, 1.294130E-15_fp, 1.453633E-13_fp, & + 9.116027E-12_fp, 3.241673E-10_fp, 6.673036E-09_fp, 8.162075E-08_fp, 6.123529E-07_fp, & + 2.926244E-06_fp, 9.306878E-06_fp, 2.071874E-05_fp, 3.418072E-05_fp, 4.455191E-05_fp, & + 4.926597E-05_fp, 5.000000E-05_fp, 4.924296E-05_fp, 4.412128E-05_fp, 3.247284E-05_fp/) + END IF + + IF ( atm(2)%n_Aerosols > 2 ) THEN + atm(2)%Aerosol(3)%Type = SEASALT_SSCM2_AEROSOL + atm(2)%Aerosol(3)%Effective_Radius = & ! microns + (/0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, & + 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, & + 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, & + 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, & + 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, & + 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, & + 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, & + 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, & + 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, & + 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, & + 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, & + 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, & + 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp/) + atm(2)%Aerosol(3)%Concentration = & ! kg/m^2 + (/0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 7.258759E-21_fp, 1.408580E-19_fp, 2.671985E-18_fp, & + 4.861044E-17_fp, 8.316902E-16_fp, 1.311926E-14_fp, 1.870485E-13_fp, 2.363806E-12_fp, & + 2.598250E-11_fp, 2.440107E-10_fp, 1.926085E-09_fp, 1.259490E-08_fp, 6.741174E-08_fp, & + 2.926595E-07_fp, 1.024936E-06_fp, 2.891988E-06_fp, 6.598725E-06_fp, 1.228990E-05_fp, & + 1.898153E-05_fp, 2.488012E-05_fp, 2.855754E-05_fp, 2.988952E-05_fp, 2.999200E-05_fp, & + 2.927621E-05_fp, 2.600524E-05_fp, 1.925823E-05_fp, 1.073490E-05_fp, 4.002469E-06_fp, & + 8.719108E-07_fp, 9.516156E-08_fp, 4.374152E-09_fp, 6.968124E-11_fp, 3.094494E-13_fp, & + 3.007755E-16_fp, 1.306643E-19_fp, 8.973748E-18_fp, 6.907477E-16_fp, 3.699227E-14_fp, & + 1.371784E-12_fp, 3.515726E-11_fp, 6.234566E-10_fp, 7.684359E-09_fp, 6.636126E-08_fp, & + 4.063274E-07_fp, 1.792269E-06_fp, 5.811355E-06_fp, 1.419909E-05_fp, 2.692800E-05_fp, & + 4.103532E-05_fp, 5.229739E-05_fp, 5.833714E-05_fp, 5.995863E-05_fp, 5.986513E-05_fp, & + 5.739352E-05_fp, 4.931915E-05_fp, 3.517150E-05_fp, 1.913860E-05_fp, 7.253731E-06_fp, & + 1.735030E-06_fp, 2.355013E-07_fp, 1.618327E-08_fp, 4.982977E-10_fp, 6.034809E-12_fp/) + END IF + END IF Load_Aerosol_Data_2 + + END SUBROUTINE Load_Atm_Data diff --git a/test/mains/regression/tangent_linear/test_Aircraft/Load_Sfc_Data.inc b/test/mains/regression/tangent_linear/test_Aircraft/Load_Sfc_Data.inc new file mode 100644 index 00000000..3b2aec4a --- /dev/null +++ b/test/mains/regression/tangent_linear/test_Aircraft/Load_Sfc_Data.inc @@ -0,0 +1,55 @@ + ! + ! Include file containing an internal subprogam to load some test surface data + ! + SUBROUTINE Load_Sfc_Data() + + + ! 4a.0 Surface type definitions for default SfcOptics definitions + ! For IR and VIS, this is the NPOESS reflectivities. + ! --------------------------------------------------------------- + INTEGER, PARAMETER :: TUNDRA_SURFACE_TYPE = 10 ! NPOESS Land surface type for IR/VIS Land SfcOptics + INTEGER, PARAMETER :: SCRUB_SURFACE_TYPE = 7 ! NPOESS Land surface type for IR/VIS Land SfcOptics + INTEGER, PARAMETER :: COARSE_SOIL_TYPE = 1 ! Soil type for MW land SfcOptics + INTEGER, PARAMETER :: GROUNDCOVER_VEGETATION_TYPE = 7 ! Vegetation type for MW Land SfcOptics + INTEGER, PARAMETER :: BARE_SOIL_VEGETATION_TYPE = 11 ! Vegetation type for MW Land SfcOptics + INTEGER, PARAMETER :: SEA_WATER_TYPE = 1 ! Water type for all SfcOptics + INTEGER, PARAMETER :: FRESH_SNOW_TYPE = 2 ! NPOESS Snow type for IR/VIS SfcOptics + INTEGER, PARAMETER :: FRESH_ICE_TYPE = 1 ! NPOESS Ice type for IR/VIS SfcOptics + + + + ! 4a.1 Profile #1 + ! --------------- + ! ...Land surface characteristics + sfc(1)%Land_Coverage = 0.1_fp + sfc(1)%Land_Type = TUNDRA_SURFACE_TYPE + sfc(1)%Land_Temperature = 272.0_fp + sfc(1)%Lai = 0.17_fp + sfc(1)%Soil_Type = COARSE_SOIL_TYPE + sfc(1)%Vegetation_Type = GROUNDCOVER_VEGETATION_TYPE + ! ...Water surface characteristics + sfc(1)%Water_Coverage = 0.5_fp + sfc(1)%Water_Type = SEA_WATER_TYPE + sfc(1)%Water_Temperature = 275.0_fp + ! ...Snow coverage characteristics + sfc(1)%Snow_Coverage = 0.25_fp + sfc(1)%Snow_Type = FRESH_SNOW_TYPE + sfc(1)%Snow_Temperature = 265.0_fp + ! ...Ice surface characteristics + sfc(1)%Ice_Coverage = 0.15_fp + sfc(1)%Ice_Type = FRESH_ICE_TYPE + sfc(1)%Ice_Temperature = 269.0_fp + + + + ! 4a.2 Profile #2 + ! --------------- + ! Surface data + sfc(2)%Land_Coverage = 1.0_fp + sfc(2)%Land_Type = SCRUB_SURFACE_TYPE + sfc(2)%Land_Temperature = 318.0_fp + sfc(2)%Lai = 0.65_fp + sfc(2)%Soil_Type = COARSE_SOIL_TYPE + sfc(2)%Vegetation_Type = BARE_SOIL_VEGETATION_TYPE + + END SUBROUTINE Load_Sfc_Data diff --git a/test/mains/regression/tangent_linear/test_Aircraft/Makefile.in b/test/mains/regression/tangent_linear/test_Aircraft/Makefile.in new file mode 100644 index 00000000..9cbb3210 --- /dev/null +++ b/test/mains/regression/tangent_linear/test_Aircraft/Makefile.in @@ -0,0 +1,65 @@ +# @configure_input@ + +# individual test makefile template + +# The file definitions. This include must occur before targets. +EXE_FILE=$(shell echo ${PWD} | sed 's,.*/,,') +SRC_FILE=$(EXE_FILE).f90 +OBJ_FILE=${SRC_FILE:.f90=.o} + +# The test type (e.g. forward, k_matrix, etc) +TEST_TYPE=`dirname ${PWD} | sed 's,.*/,,'` + +# Tool-specific substitution variables +FC = @FC@ +FCFLAGS = @FCFLAGS@ -I../../incsrc +LDFLAGS = @LDFLAGS@ +LIBS = @LIBS@ + +# The targets +all: $(EXE_FILE) + +$(OBJ_FILE): $(SRC_FILE) + +$(EXE_FILE): $(OBJ_FILE) + @echo; echo; \ + echo "=============================================="; \ + echo "Building $(TEST_TYPE) $(EXE_FILE) using:"; \ + echo " FC : $(FC)"; \ + echo " FCFLAGS : $(FCFLAGS)"; \ + echo " LDFLAGS : $(LDFLAGS)"; \ + echo "==============================================" + $(FC) $(LDFLAGS) $(OBJ_FILE) -o $(EXE_FILE) $(LIBS) + +clean: + @echo; echo; \ + echo "=============================================="; \ + echo "Cleaning up $(TEST_TYPE) $(EXE_FILE)"; \ + echo "==============================================" + rm -fr $(OBJ_FILE) $(EXE_FILE) gmon.out *.output *.bin results/*.signal + +update: + @update() \ + { files=`find . -maxdepth 1 -name "$$1" -print`; \ + if [ -n "$$files" ]; then \ + mv $$files results; \ + else \ + echo "No $$1 files to update."; \ + fi \ + }; \ + echo; echo; \ + echo "=============================================="; \ + echo "Updating results for $(TEST_TYPE) $(EXE_FILE)"; \ + echo "=============================================="; \ + update "*.output"; update "*.bin" + +realclean: clean + -rm Makefile + +# Specify targets that do not generate filesystem objects +.PHONY: all clean update realclean + +# Specify suffix rules +.SUFFIXES: .f90 .o +.f90.o: + @$(FC) $(FCFLAGS) -c $< diff --git a/test/mains/regression/tangent_linear/test_Aircraft/SignalFile_Create.inc b/test/mains/regression/tangent_linear/test_Aircraft/SignalFile_Create.inc new file mode 100644 index 00000000..7fd142ae --- /dev/null +++ b/test/mains/regression/tangent_linear/test_Aircraft/SignalFile_Create.inc @@ -0,0 +1,9 @@ + SUBROUTINE SignalFile_Create() + CHARACTER(256) :: Filename + INTEGER :: fid + Filename = RESULTS_PATH//TRIM(PROGRAM_NAME)//'_'//TRIM(Sensor_Id)//'.signal' + fid = Get_Lun() + OPEN( fid, FILE = Filename ) + WRITE( fid,* ) TRIM(Filename) + CLOSE( fid ) + END SUBROUTINE SignalFile_Create diff --git a/test/mains/regression/tangent_linear/test_Aircraft/sensor_id.list b/test/mains/regression/tangent_linear/test_Aircraft/sensor_id.list new file mode 100644 index 00000000..a7b1e247 --- /dev/null +++ b/test/mains/regression/tangent_linear/test_Aircraft/sensor_id.list @@ -0,0 +1 @@ +crisB1_npp diff --git a/test/mains/regression/tangent_linear/test_Aircraft/test_Aircraft.f90 b/test/mains/regression/tangent_linear/test_Aircraft/test_Aircraft.f90 new file mode 100644 index 00000000..81235cb7 --- /dev/null +++ b/test/mains/regression/tangent_linear/test_Aircraft/test_Aircraft.f90 @@ -0,0 +1,342 @@ +! +! test_Aircraft +! +! Test program for the aircraft instrument option, Tangent-Linear function +! +! + +PROGRAM test_Aircraft + + ! ============================================================================ + ! **** ENVIRONMENT SETUP FOR RTM USAGE **** + ! + ! Module usage + USE CRTM_Module + ! Disable all implicit typing + IMPLICIT NONE + ! ============================================================================ + + + ! ---------- + ! Parameters + ! ---------- + CHARACTER(*), PARAMETER :: PROGRAM_NAME = 'test_Aircraft' + CHARACTER(*), PARAMETER :: COEFFICIENTS_PATH = './testinput/' + CHARACTER(*), PARAMETER :: RESULTS_PATH = './results/tangent_linear/' + + ! ============================================================================ + ! 0. **** SOME SET UP PARAMETERS FOR THIS TEST **** + ! + ! Profile dimensions... + INTEGER, PARAMETER :: N_PROFILES = 2 + INTEGER, PARAMETER :: N_LAYERS = 92 + INTEGER, PARAMETER :: N_ABSORBERS = 2 + INTEGER, PARAMETER :: N_CLOUDS = 1 + INTEGER, PARAMETER :: N_AEROSOLS = 1 + ! ...but only ONE Sensor at a time + INTEGER, PARAMETER :: N_SENSORS = 1 + + ! Test GeometryInfo angles. The test scan angle is based + ! on the default Re (earth radius) and h (satellite height) + REAL(fp), PARAMETER :: ZENITH_ANGLE = 30.0_fp + REAL(fp), PARAMETER :: SCAN_ANGLE = 26.37293341421_fp + REAL(fp), PARAMETER :: SOURCE_ZENITH_ANGLE = 0.0_fp + ! ============================================================================ + + + ! --------- + ! Variables + ! --------- + CHARACTER(256) :: Message + CHARACTER(256) :: Version + CHARACTER(256) :: Sensor_Id + INTEGER :: Error_Status + INTEGER :: Allocate_Status + INTEGER :: n_Channels + INTEGER :: l, m + ! Declarations for RTSolution comparison + INTEGER :: n_l, n_m + CHARACTER(256) :: rts_File + TYPE(CRTM_RTSolution_type), ALLOCATABLE :: rts_TL(:,:) + + + ! ============================================================================ + ! 1. **** DEFINE THE CRTM INTERFACE STRUCTURES **** + ! + TYPE(CRTM_ChannelInfo_type) :: ChannelInfo(N_SENSORS) + TYPE(CRTM_Geometry_type) :: Geometry(N_PROFILES) + TYPE(CRTM_Atmosphere_type) :: Atm(N_PROFILES), Atm_TL(N_PROFILES) + TYPE(CRTM_Surface_type) :: Sfc(N_PROFILES), Sfc_TL(N_PROFILES) + TYPE(CRTM_RTSolution_type), ALLOCATABLE :: RTSolution(:,:), RTSolution_TL(:,:) + TYPE(CRTM_Options_type) :: Opt(N_PROFILES) + ! ============================================================================ + + + + !First, make sure the right number of inputs have been provided + IF(COMMAND_ARGUMENT_COUNT().NE.1)THEN + WRITE(*,*) TRIM(PROGRAM_NAME)//': ERROR, ONLY one command-line argument required, returning' + STOP 1 + ENDIF + CALL GET_COMMAND_ARGUMENT(1,Sensor_Id) !read in the value + + + ! Program header + ! -------------- + CALL CRTM_Version( Version ) + CALL Program_Message( PROGRAM_NAME, & + 'Test program for the aircraft instrument option under clear sky conditions.', & + 'CRTM Version: '//TRIM(Version) ) + + + ! Get sensor id from user + ! ----------------------- + Sensor_Id = ADJUSTL(Sensor_Id) + WRITE( *,'(//5x,"Running CRTM for ",a," sensor...")' ) TRIM(Sensor_Id) + + + + ! ============================================================================ + ! 2. **** INITIALIZE THE CRTM **** + ! + ! 2a. Initialise for the requested sensor + ! --------------------------------------- + WRITE( *,'(/5x,"Initializing the CRTM...")' ) + Error_Status = CRTM_Init( (/Sensor_Id/), & + ChannelInfo, & + File_Path=COEFFICIENTS_PATH, & + Load_CloudCoeff = .TRUE., & + Load_AerosolCoeff = .TRUE.) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error initializing CRTM' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + + + ! 2b. Determine the number of channels the + ! CRTM is to process + ! ------------------------------------------ + n_Channels = SUM(CRTM_ChannelInfo_n_Channels(ChannelInfo)) + ! ============================================================================ + + + + + ! ============================================================================ + ! 3. **** ALLOCATE STRUCTURE ARRAYS **** + ! + ! 3a. Allocate the ARRAYS + ! ----------------------- + ALLOCATE( RTSolution( n_Channels, N_PROFILES ), & + RTSolution_TL( n_Channels, N_PROFILES ), & + STAT=Allocate_Status ) + IF ( Allocate_Status /= 0 ) THEN + Message = 'Error allocating structure arrays' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + + ! 3b. Allocate the STRUCTURES + ! --------------------------- + CALL CRTM_Atmosphere_Create( Atm, N_LAYERS, N_ABSORBERS, N_CLOUDS, N_AEROSOLS ) + IF ( ANY(.NOT. CRTM_Atmosphere_Associated(Atm)) ) THEN + Message = 'Error allocating CRTM Atmosphere structures' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + ! ============================================================================ + + + + + ! ============================================================================ + ! 4. **** ASSIGN INPUT DATA **** + ! + ! 4a. Atmosphere and Surface input + ! -------------------------------- + CALL Load_Atm_Data() + CALL Load_Sfc_Data() + + + ! 4b. GeometryInfo input + ! ---------------------- + ! All profiles are given the same value + ! The Sensor_Scan_Angle is optional. + CALL CRTM_Geometry_SetValue( Geometry, & + Sensor_Zenith_Angle = ZENITH_ANGLE, & + Sensor_Scan_Angle = SCAN_ANGLE, & + Source_Zenith_Angle = SOURCE_ZENITH_ANGLE ) + + + ! 4c. Set the aircraft pressure altitude + ! -------------------------------------- + Opt%Aircraft_Pressure = 320.0_fp + ! ============================================================================ + + + ! ============================================================================ + ! 5. **** INITIALIZE THE TANGENT-LINEAR ARGUMENTS **** + ! + ! 5a. Zero the tangent-liner INPUT structures + ! --------------------------------------- + ! Copy... + Atm_TL = Atm + ! ...zero... + CALL CRTM_Atmosphere_Zero(Atm_TL) + ! ...and perturb temperature by 0.5K + DO m = 1, N_PROFILES + Atm_TL(m)%Temperature = 0.5_fp + END DO + + ! Copy... + Sfc_TL = Sfc + ! ...and zero. + CALL CRTM_Surface_Zero(Sfc_TL) + ! ============================================================================ + + ! ============================================================================ + ! 6. **** CALL THE CRTM TANGENT-LINEAR MODEL **** + ! + Error_Status = CRTM_Tangent_Linear( Atm , & + Sfc , & + Atm_TL , & + Sfc_TL , & + Geometry , & + ChannelInfo , & + RTSolution , & + RTSolution_TL, & + Options = Opt ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error in CRTM Tangent-Linear Model' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + ! ============================================================================ + + + ! ============================================================================ + ! 7. **** OUTPUT THE RESULTS TO SCREEN **** + ! + DO m = 1, N_PROFILES + WRITE( *,'(//7x,"Profile ",i0," output for ",a )') m, TRIM(Sensor_Id) + DO l = 1, n_Channels + WRITE( *, '(/5x,"Channel ",i0," results")') RTSolution_TL(l,m)%Sensor_Channel + CALL CRTM_RTSolution_Inspect(RTSolution_TL(l,m)) + END DO + END DO + ! ============================================================================ + + ! ============================================================================ + ! 9. **** COMPARE RTSolution_TL RESULTS TO SAVED VALUES **** + ! + WRITE( *, '( /5x, "Comparing calculated results with saved ones..." )' ) + + ! 9a. Create the output file if it does not exist + ! ----------------------------------------------- + ! ...Generate a filename + rts_File = RESULTS_PATH//TRIM(PROGRAM_NAME)//'_'//TRIM(Sensor_Id)//'.RTSolution_TL.bin' + ! ...Check if the file exists + IF ( .NOT. File_Exists(rts_File) ) THEN + Message = 'RTSolution_TL save file does not exist. Creating...' + CALL Display_Message( PROGRAM_NAME, Message, INFORMATION ) + ! ...File not found, so write RTSolution_TL structure to file + Error_Status = CRTM_RTSolution_WriteFile( rts_File, RTSolution_TL, Quiet=.TRUE. ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error creating RTSolution_TL save file' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + END IF + + ! 9b. Inquire the saved file + ! -------------------------- + Error_Status = CRTM_RTSolution_InquireFile( rts_File, & + n_Channels = n_l, & + n_Profiles = n_m ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error inquiring RTSolution_TL save file' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + + ! 9c. Compare the dimensions + ! -------------------------- + IF ( n_l /= n_Channels .OR. n_m /= N_PROFILES ) THEN + Message = 'Dimensions of saved data different from that calculated!' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + + ! 9d. Allocate the structure to read in saved data + ! ------------------------------------------------ + ALLOCATE( rts_TL( n_l, n_m ), STAT=Allocate_Status ) + IF ( Allocate_Status /= 0 ) THEN + Message = 'Error allocating RTSolution_TL saved data array' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + + ! 9e. Read the saved data + ! ----------------------- + Error_Status = CRTM_RTSolution_ReadFile( rts_File, rts_TL, Quiet=.TRUE. ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error reading RTSolution_TL save file' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + + ! 9f. Compare the structures + ! -------------------------- + IF ( ALL(CRTM_RTSolution_Compare(RTSolution_TL, rts_TL)) ) THEN + Message = 'RTSolution_TL results are the same!' + CALL Display_Message( PROGRAM_NAME, Message, INFORMATION ) + ELSE + Message = 'RTSolution_TL results are different!' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + ! Write the current RTSolution results to file + rts_File = TRIM(Sensor_Id)//'.RTSolution_TL.bin' + Error_Status = CRTM_RTSolution_WriteFile( rts_File, RTSolution_TL, Quiet=.TRUE. ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error creating temporary RTSolution_TL save file for failed comparison' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + END IF + STOP 1 + END IF + ! ============================================================================ + + + ! ============================================================================ + ! 8. **** DESTROY THE CRTM **** + ! + WRITE( *, '( /5x, "Destroying the CRTM..." )' ) + Error_Status = CRTM_Destroy( ChannelInfo ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error destroying CRTM' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + ! ============================================================================ + + ! ============================================================================ + ! 10. **** CLEAN UP **** + ! + ! 10a. Deallocate the structures + ! ------------------------------ + CALL CRTM_Atmosphere_Destroy(Atm) + CALL CRTM_Atmosphere_Destroy(Atm_TL) + + ! 9b. Deallocate the arrays + ! ------------------------- + DEALLOCATE(RTSolution, RTSolution_TL, rts_TL, STAT=Allocate_Status) + ! ============================================================================ + + + ! Signal the completion of the program. It is not a necessary step for running CRTM. + +CONTAINS + + INCLUDE 'Load_Atm_Data.inc' + INCLUDE 'Load_Sfc_Data.inc' + +END PROGRAM test_Aircraft diff --git a/test/mains/regression/tangent_linear/test_Downwelling_Radiance/Load_Atm_Data.inc b/test/mains/regression/tangent_linear/test_Downwelling_Radiance/Load_Atm_Data.inc new file mode 100644 index 00000000..d8357b8a --- /dev/null +++ b/test/mains/regression/tangent_linear/test_Downwelling_Radiance/Load_Atm_Data.inc @@ -0,0 +1,489 @@ + ! + ! Include file containing an internal subprogam to load some test profile data + ! + SUBROUTINE Load_Atm_Data() + ! Local variables + INTEGER :: nc + INTEGER :: k1, k2 + + + ! 4a.1 Profile #1 + ! --------------- + ! ...Profile and absorber definitions + atm(1)%Climatology = US_STANDARD_ATMOSPHERE + atm(1)%Absorber_Id(1:2) = (/ H2O_ID , O3_ID /) + atm(1)%Absorber_Units(1:2) = (/ MASS_MIXING_RATIO_UNITS, VOLUME_MIXING_RATIO_UNITS /) + ! ...Profile data + atm(1)%Level_Pressure = & + (/0.714_fp, 0.975_fp, 1.297_fp, 1.687_fp, 2.153_fp, 2.701_fp, 3.340_fp, 4.077_fp, & + 4.920_fp, 5.878_fp, 6.957_fp, 8.165_fp, 9.512_fp, 11.004_fp, 12.649_fp, 14.456_fp, & + 16.432_fp, 18.585_fp, 20.922_fp, 23.453_fp, 26.183_fp, 29.121_fp, 32.274_fp, 35.650_fp, & + 39.257_fp, 43.100_fp, 47.188_fp, 51.528_fp, 56.126_fp, 60.990_fp, 66.125_fp, 71.540_fp, & + 77.240_fp, 83.231_fp, 89.520_fp, 96.114_fp, 103.017_fp, 110.237_fp, 117.777_fp, 125.646_fp, & + 133.846_fp, 142.385_fp, 151.266_fp, 160.496_fp, 170.078_fp, 180.018_fp, 190.320_fp, 200.989_fp, & + 212.028_fp, 223.441_fp, 235.234_fp, 247.409_fp, 259.969_fp, 272.919_fp, 286.262_fp, 300.000_fp, & + 314.137_fp, 328.675_fp, 343.618_fp, 358.967_fp, 374.724_fp, 390.893_fp, 407.474_fp, 424.470_fp, & + 441.882_fp, 459.712_fp, 477.961_fp, 496.630_fp, 515.720_fp, 535.232_fp, 555.167_fp, 575.525_fp, & + 596.306_fp, 617.511_fp, 639.140_fp, 661.192_fp, 683.667_fp, 706.565_fp, 729.886_fp, 753.627_fp, & + 777.790_fp, 802.371_fp, 827.371_fp, 852.788_fp, 878.620_fp, 904.866_fp, 931.524_fp, 958.591_fp, & + 986.067_fp,1013.948_fp,1042.232_fp,1070.917_fp,1100.000_fp/) + + atm(1)%Pressure = & + (/0.838_fp, 1.129_fp, 1.484_fp, 1.910_fp, 2.416_fp, 3.009_fp, 3.696_fp, 4.485_fp, & + 5.385_fp, 6.402_fp, 7.545_fp, 8.822_fp, 10.240_fp, 11.807_fp, 13.532_fp, 15.423_fp, & + 17.486_fp, 19.730_fp, 22.163_fp, 24.793_fp, 27.626_fp, 30.671_fp, 33.934_fp, 37.425_fp, & + 41.148_fp, 45.113_fp, 49.326_fp, 53.794_fp, 58.524_fp, 63.523_fp, 68.797_fp, 74.353_fp, & + 80.198_fp, 86.338_fp, 92.778_fp, 99.526_fp, 106.586_fp, 113.965_fp, 121.669_fp, 129.703_fp, & + 138.072_fp, 146.781_fp, 155.836_fp, 165.241_fp, 175.001_fp, 185.121_fp, 195.606_fp, 206.459_fp, & + 217.685_fp, 229.287_fp, 241.270_fp, 253.637_fp, 266.392_fp, 279.537_fp, 293.077_fp, 307.014_fp, & + 321.351_fp, 336.091_fp, 351.236_fp, 366.789_fp, 382.751_fp, 399.126_fp, 415.914_fp, 433.118_fp, & + 450.738_fp, 468.777_fp, 487.236_fp, 506.115_fp, 525.416_fp, 545.139_fp, 565.285_fp, 585.854_fp, & + 606.847_fp, 628.263_fp, 650.104_fp, 672.367_fp, 695.054_fp, 718.163_fp, 741.693_fp, 765.645_fp, & + 790.017_fp, 814.807_fp, 840.016_fp, 865.640_fp, 891.679_fp, 918.130_fp, 944.993_fp, 972.264_fp, & + 999.942_fp,1028.025_fp,1056.510_fp,1085.394_fp/) + + atm(1)%Temperature = & + (/256.186_fp, 252.608_fp, 247.762_fp, 243.314_fp, 239.018_fp, 235.282_fp, 233.777_fp, 234.909_fp, & + 237.889_fp, 241.238_fp, 243.194_fp, 243.304_fp, 242.977_fp, 243.133_fp, 242.920_fp, 242.026_fp, & + 240.695_fp, 239.379_fp, 238.252_fp, 236.928_fp, 235.452_fp, 234.561_fp, 234.192_fp, 233.774_fp, & + 233.305_fp, 233.053_fp, 233.103_fp, 233.307_fp, 233.702_fp, 234.219_fp, 234.959_fp, 235.940_fp, & + 236.744_fp, 237.155_fp, 237.374_fp, 238.244_fp, 239.736_fp, 240.672_fp, 240.688_fp, 240.318_fp, & + 239.888_fp, 239.411_fp, 238.512_fp, 237.048_fp, 235.388_fp, 233.551_fp, 231.620_fp, 230.418_fp, & + 229.927_fp, 229.511_fp, 229.197_fp, 228.947_fp, 228.772_fp, 228.649_fp, 228.567_fp, 228.517_fp, & + 228.614_fp, 228.861_fp, 229.376_fp, 230.223_fp, 231.291_fp, 232.591_fp, 234.013_fp, 235.508_fp, & + 237.041_fp, 238.589_fp, 240.165_fp, 241.781_fp, 243.399_fp, 244.985_fp, 246.495_fp, 247.918_fp, & + 249.073_fp, 250.026_fp, 251.113_fp, 252.321_fp, 253.550_fp, 254.741_fp, 256.089_fp, 257.692_fp, & + 259.358_fp, 261.010_fp, 262.779_fp, 264.702_fp, 266.711_fp, 268.863_fp, 271.103_fp, 272.793_fp, & + 273.356_fp, 273.356_fp, 273.356_fp, 273.356_fp/) + + atm(1)%Absorber(:,1) = & + (/4.187E-03_fp,4.401E-03_fp,4.250E-03_fp,3.688E-03_fp,3.516E-03_fp,3.739E-03_fp,3.694E-03_fp,3.449E-03_fp, & + 3.228E-03_fp,3.212E-03_fp,3.245E-03_fp,3.067E-03_fp,2.886E-03_fp,2.796E-03_fp,2.704E-03_fp,2.617E-03_fp, & + 2.568E-03_fp,2.536E-03_fp,2.506E-03_fp,2.468E-03_fp,2.427E-03_fp,2.438E-03_fp,2.493E-03_fp,2.543E-03_fp, & + 2.586E-03_fp,2.632E-03_fp,2.681E-03_fp,2.703E-03_fp,2.636E-03_fp,2.512E-03_fp,2.453E-03_fp,2.463E-03_fp, & + 2.480E-03_fp,2.499E-03_fp,2.526E-03_fp,2.881E-03_fp,3.547E-03_fp,4.023E-03_fp,4.188E-03_fp,4.223E-03_fp, & + 4.252E-03_fp,4.275E-03_fp,4.105E-03_fp,3.675E-03_fp,3.196E-03_fp,2.753E-03_fp,2.338E-03_fp,2.347E-03_fp, & + 2.768E-03_fp,3.299E-03_fp,3.988E-03_fp,4.531E-03_fp,4.625E-03_fp,4.488E-03_fp,4.493E-03_fp,4.614E-03_fp, & + 7.523E-03_fp,1.329E-02_fp,2.468E-02_fp,4.302E-02_fp,6.688E-02_fp,9.692E-02_fp,1.318E-01_fp,1.714E-01_fp, & + 2.149E-01_fp,2.622E-01_fp,3.145E-01_fp,3.726E-01_fp,4.351E-01_fp,5.002E-01_fp,5.719E-01_fp,6.507E-01_fp, & + 7.110E-01_fp,7.552E-01_fp,8.127E-01_fp,8.854E-01_fp,9.663E-01_fp,1.050E+00_fp,1.162E+00_fp,1.316E+00_fp, & + 1.494E+00_fp,1.690E+00_fp,1.931E+00_fp,2.226E+00_fp,2.574E+00_fp,2.939E+00_fp,3.187E+00_fp,3.331E+00_fp, & + 3.352E+00_fp,3.260E+00_fp,3.172E+00_fp,3.087E+00_fp/) + + atm(1)%Absorber(:,2) = & + (/3.035E+00_fp,3.943E+00_fp,4.889E+00_fp,5.812E+00_fp,6.654E+00_fp,7.308E+00_fp,7.660E+00_fp,7.745E+00_fp, & + 7.696E+00_fp,7.573E+00_fp,7.413E+00_fp,7.246E+00_fp,7.097E+00_fp,6.959E+00_fp,6.797E+00_fp,6.593E+00_fp, & + 6.359E+00_fp,6.110E+00_fp,5.860E+00_fp,5.573E+00_fp,5.253E+00_fp,4.937E+00_fp,4.625E+00_fp,4.308E+00_fp, & + 3.986E+00_fp,3.642E+00_fp,3.261E+00_fp,2.874E+00_fp,2.486E+00_fp,2.102E+00_fp,1.755E+00_fp,1.450E+00_fp, & + 1.208E+00_fp,1.087E+00_fp,1.030E+00_fp,1.005E+00_fp,1.010E+00_fp,1.028E+00_fp,1.068E+00_fp,1.109E+00_fp, & + 1.108E+00_fp,1.071E+00_fp,9.928E-01_fp,8.595E-01_fp,7.155E-01_fp,5.778E-01_fp,4.452E-01_fp,3.372E-01_fp, & + 2.532E-01_fp,1.833E-01_fp,1.328E-01_fp,9.394E-02_fp,6.803E-02_fp,5.152E-02_fp,4.569E-02_fp,4.855E-02_fp, & + 5.461E-02_fp,6.398E-02_fp,7.205E-02_fp,7.839E-02_fp,8.256E-02_fp,8.401E-02_fp,8.412E-02_fp,8.353E-02_fp, & + 8.269E-02_fp,8.196E-02_fp,8.103E-02_fp,7.963E-02_fp,7.741E-02_fp,7.425E-02_fp,7.067E-02_fp,6.702E-02_fp, & + 6.368E-02_fp,6.070E-02_fp,5.778E-02_fp,5.481E-02_fp,5.181E-02_fp,4.920E-02_fp,4.700E-02_fp,4.478E-02_fp, & + 4.207E-02_fp,3.771E-02_fp,3.012E-02_fp,1.941E-02_fp,9.076E-03_fp,2.980E-03_fp,5.117E-03_fp,1.160E-02_fp, & + 1.428E-02_fp,1.428E-02_fp,1.428E-02_fp,1.428E-02_fp/) + + + ! Load CO2 absorber data if there are three absorrbers + IF ( atm(1)%n_Absorbers > 2 ) THEN + atm(1)%Absorber_Id(3) = CO2_ID + atm(1)%Absorber_Units(3) = VOLUME_MIXING_RATIO_UNITS + atm(1)%Absorber(:,3) = 380.0_fp + END IF + + + ! Cloud data + IF ( atm(1)%n_Clouds > 0 ) THEN + k1 = 75 + k2 = 79 + DO nc = 1, atm(1)%n_Clouds + atm(1)%Cloud(nc)%Type = WATER_CLOUD + atm(1)%Cloud(nc)%Effective_Radius(k1:k2) = 20.0_fp ! microns + atm(1)%Cloud(nc)%Water_Content(k1:k2) = 5.0_fp ! kg/m^2 + END DO + END IF + + + ! Aerosol data. Three aerosol types can be loaded: + ! Dust, Sulphate, and Sea Salt SSCM3 + Load_Aerosol_Data_1: IF ( atm(1)%n_Aerosols > 0 ) THEN + atm(1)%Aerosol(1)%Type = DUST_AEROSOL + atm(1)%Aerosol(1)%Effective_Radius = & ! microns + (/0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 5.305110E-16_fp, & + 7.340409E-16_fp, 1.037097E-15_fp, 1.496791E-15_fp, 2.207471E-15_fp, 3.327732E-15_fp, & + 5.128933E-15_fp, 8.083748E-15_fp, 1.303055E-14_fp, 2.148368E-14_fp, 3.622890E-14_fp, & + 6.248544E-14_fp, 1.102117E-13_fp, 1.987557E-13_fp, 3.663884E-13_fp, 6.901587E-13_fp, & + 1.327896E-12_fp, 2.608405E-12_fp, 5.228012E-12_fp, 1.068482E-11_fp, 2.225098E-11_fp, & + 4.717675E-11_fp, 1.017447E-10_fp, 2.229819E-10_fp, 4.960579E-10_fp, 1.118899E-09_fp, & + 2.555617E-09_fp, 5.902789E-09_fp, 1.376717E-08_fp, 3.237321E-08_fp, 7.662427E-08_fp, & + 1.822344E-07_fp, 4.346896E-07_fp, 1.037940E-06_fp, 2.475858E-06_fp, 5.887266E-06_fp, & + 1.392410E-05_fp, 3.267943E-05_fp, 7.592447E-05_fp, 1.741777E-04_fp, 3.935216E-04_fp, & + 8.732308E-04_fp, 1.897808E-03_fp, 4.027868E-03_fp, 8.323272E-03_fp, 1.669418E-02_fp, & + 3.239702E-02_fp, 6.063055E-02_fp, 1.090596E-01_fp, 1.878990E-01_fp, 3.089856E-01_fp, & + 4.832092E-01_fp, 7.159947E-01_fp, 1.001436E+00_fp, 1.317052E+00_fp, 1.622354E+00_fp, & + 1.864304E+00_fp, 1.990457E+00_fp, 1.966354E+00_fp, 1.789883E+00_fp, 1.494849E+00_fp, & + 1.140542E+00_fp, 7.915451E-01_fp, 4.974823E-01_fp, 2.818937E-01_fp, 1.433668E-01_fp, & + 6.514795E-02_fp, 2.633057E-02_fp, 9.421763E-03_fp, 2.971053E-03_fp, 8.218245E-04_fp/) + atm(1)%Aerosol(1)%Concentration = & ! kg/m^2 + (/0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 2.458105E-18_fp, 1.983430E-16_fp, & + 1.191432E-14_fp, 5.276880E-13_fp, 1.710270E-11_fp, 4.035105E-10_fp, 6.911389E-09_fp, & + 8.594215E-08_fp, 7.781797E-07_fp, 5.162773E-06_fp, 2.534018E-05_fp, 9.325154E-05_fp, & + 2.617738E-04_fp, 5.727150E-04_fp, 1.002153E-03_fp, 1.446048E-03_fp, 1.782757E-03_fp, & + 1.955759E-03_fp, 1.999206E-03_fp, 1.994698E-03_fp, 1.913109E-03_fp, 1.656122E-03_fp, & + 1.206328E-03_fp, 6.847261E-04_fp, 2.785695E-04_fp, 7.418821E-05_fp, 1.172680E-05_fp, & + 9.900895E-07_fp, 3.987399E-08_fp, 6.786932E-10_fp, 4.291151E-12_fp, 8.785440E-15_fp/) + + IF ( atm(1)%n_Aerosols > 1 ) THEN + atm(1)%Aerosol(2)%Type = SULFATE_AEROSOL + atm(1)%Aerosol(2)%Effective_Radius = & ! microns + (/0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.060238E-01_fp, 3.652677E-01_fp, 4.139419E-01_fp, 4.438249E-01_fp, & + 4.486394E-01_fp, 4.261471E-01_fp, 3.795067E-01_fp, 3.174571E-01_fp, 3.000000E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.243099E-01_fp, 4.662931E-01_fp, & + 6.103025E-01_fp, 6.958640E-01_fp, 6.776480E-01_fp, 5.570077E-01_fp, 3.828734E-01_fp, & + 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp, 3.000000E-01_fp/) + atm(1)%Aerosol(2)%Concentration = & ! kg/m^2 + (/0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 7.299549E-21_fp, 2.154532E-20_fp, 6.848207E-20_fp, & + 2.339296E-19_fp, 8.562906E-19_fp, 3.346100E-18_fp, 1.389284E-17_fp, 6.094260E-17_fp, & + 2.805828E-16_fp, 1.345656E-15_fp, 6.665967E-15_fp, 3.378989E-14_fp, 1.734933E-13_fp, & + 8.924837E-13_fp, 4.546743E-12_fp, 2.266249E-11_fp, 1.091369E-10_fp, 5.013496E-10_fp, & + 2.168936E-09_fp, 8.725800E-09_fp, 3.224980E-08_fp, 1.082545E-07_fp, 3.266343E-07_fp, & + 8.780083E-07_fp, 2.087760E-06_fp, 4.370441E-06_fp, 8.038113E-06_fp, 1.300537E-05_fp, & + 1.860671E-05_fp, 2.376757E-05_fp, 2.751048E-05_fp, 2.945706E-05_fp, 2.998589E-05_fp, & + 2.995521E-05_fp, 2.909387E-05_fp, 2.609907E-05_fp, 2.031620E-05_fp, 1.274989E-05_fp, & + 5.920554E-06_fp, 1.842346E-06_fp, 3.429331E-07_fp, 3.355556E-08_fp, 1.506455E-09_fp, & + 1.720306E-10_fp, 1.161071E-09_fp, 7.599420E-09_fp, 4.096076E-08_fp, 1.815570E-07_fp, & + 6.623233E-07_fp, 1.994766E-06_fp, 4.987904E-06_fp, 1.044158E-05_fp, 1.850659E-05_fp, & + 2.817442E-05_fp, 3.750360E-05_fp, 4.459276E-05_fp, 4.857087E-05_fp, 4.990199E-05_fp, & + 4.998888E-05_fp, 4.922362E-05_fp, 4.582548E-05_fp, 3.844906E-05_fp, 2.757877E-05_fp, & + 1.615474E-05_fp, 9.509965E-06_fp, 1.672265E-05_fp, 4.602962E-05_fp, 8.740809E-05_fp, & + 1.165118E-04_fp, 1.248318E-04_fp, 1.240508E-04_fp, 1.095622E-04_fp, 7.116027E-05_fp, & + 2.756351E-05_fp, 5.072010E-06_fp, 3.467497E-07_fp, 6.759169E-09_fp, 2.828000E-11_fp/) + END IF + + IF ( atm(1)%n_Aerosols > 2 ) THEN + atm(1)%Aerosol(3)%Type = SEASALT_SSCM3_AEROSOL + atm(1)%Aerosol(3)%Effective_Radius = & ! microns + (/7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, & + 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp, 7.600000E+00_fp/) + atm(1)%Aerosol(3)%Concentration = & ! kg/m^2 + (/1.834405E-15_fp, 2.004881E-15_fp, & + 2.234084E-15_fp, 2.543453E-15_fp, 2.964461E-15_fp, 3.544295E-15_fp, 4.355235E-15_fp, & + 5.510452E-15_fp, 7.191267E-15_fp, 9.695182E-15_fp, 1.352261E-14_fp, 1.953716E-14_fp, & + 2.926925E-14_fp, 4.550553E-14_fp, 7.346181E-14_fp, 1.231759E-13_fp, 2.145104E-13_fp, & + 3.878653E-13_fp, 7.276576E-13_fp, 1.414927E-12_fp, 2.847645E-12_fp, 5.921044E-12_fp, & + 1.269153E-11_fp, 2.797048E-11_fp, 6.318984E-11_fp, 1.458383E-10_fp, 3.425444E-10_fp, & + 8.153831E-10_fp, 1.958067E-09_fp, 4.720525E-09_fp, 1.136570E-08_fp, 2.718180E-08_fp, & + 6.420674E-08_fp, 1.489302E-07_fp, 3.372331E-07_fp, 7.410874E-07_fp, 1.571399E-06_fp, & + 3.197064E-06_fp, 6.208220E-06_fp, 1.145048E-05_fp, 1.997373E-05_fp, 3.283395E-05_fp, & + 5.072822E-05_fp, 7.354173E-05_fp, 1.000035E-04_fp, 1.276931E-04_fp, 1.535301E-04_fp, & + 1.746342E-04_fp, 1.892127E-04_fp, 1.971011E-04_fp, 1.997815E-04_fp, 1.999842E-04_fp, & + 1.985580E-04_fp, 1.917087E-04_fp, 1.753846E-04_fp, 1.474980E-04_fp, 1.101113E-04_fp, & + 7.010137E-05_fp, 3.636523E-05_fp, 1.460058E-05_fp, 4.282477E-06_fp, 8.603007E-07_fp, & + 1.101800E-07_fp, 8.310010E-09_fp, 3.382006E-10_fp, 6.751810E-12_fp, 3.060195E-13_fp, & + 9.145434E-12_fp, 2.343817E-10_fp, 4.156377E-09_fp, 5.122906E-08_fp, 4.424084E-07_fp, & + 2.708849E-06_fp, 1.194846E-05_fp, 3.874236E-05_fp, 9.466062E-05_fp, 1.795200E-04_fp, & + 2.735688E-04_fp, 3.486493E-04_fp, 3.889143E-04_fp, 3.997242E-04_fp, 3.991008E-04_fp, & + 3.826235E-04_fp, 3.287943E-04_fp, 2.344766E-04_fp, 1.275907E-04_fp, 4.835821E-05_fp, & + 1.156687E-05_fp, 1.570009E-06_fp, 1.078885E-07_fp, 3.321985E-09_fp, 4.023206E-11_fp/) + END IF + END IF Load_Aerosol_Data_1 + + + + ! 4a.2 Profile #2 + ! --------------- + ! ...Profile and absorber definitions + atm(2)%Climatology = TROPICAL + atm(2)%Absorber_Id(1:2) = (/ H2O_ID , O3_ID /) + atm(2)%Absorber_Units(1:2) = (/ MASS_MIXING_RATIO_UNITS, VOLUME_MIXING_RATIO_UNITS /) + ! ...Profile data + atm(2)%Level_Pressure = & + (/0.714_fp, 0.975_fp, 1.297_fp, 1.687_fp, 2.153_fp, 2.701_fp, 3.340_fp, 4.077_fp, & + 4.920_fp, 5.878_fp, 6.957_fp, 8.165_fp, 9.512_fp, 11.004_fp, 12.649_fp, 14.456_fp, & + 16.432_fp, 18.585_fp, 20.922_fp, 23.453_fp, 26.183_fp, 29.121_fp, 32.274_fp, 35.650_fp, & + 39.257_fp, 43.100_fp, 47.188_fp, 51.528_fp, 56.126_fp, 60.990_fp, 66.125_fp, 71.540_fp, & + 77.240_fp, 83.231_fp, 89.520_fp, 96.114_fp, 103.017_fp, 110.237_fp, 117.777_fp, 125.646_fp, & + 133.846_fp, 142.385_fp, 151.266_fp, 160.496_fp, 170.078_fp, 180.018_fp, 190.320_fp, 200.989_fp, & + 212.028_fp, 223.441_fp, 235.234_fp, 247.409_fp, 259.969_fp, 272.919_fp, 286.262_fp, 300.000_fp, & + 314.137_fp, 328.675_fp, 343.618_fp, 358.967_fp, 374.724_fp, 390.893_fp, 407.474_fp, 424.470_fp, & + 441.882_fp, 459.712_fp, 477.961_fp, 496.630_fp, 515.720_fp, 535.232_fp, 555.167_fp, 575.525_fp, & + 596.306_fp, 617.511_fp, 639.140_fp, 661.192_fp, 683.667_fp, 706.565_fp, 729.886_fp, 753.627_fp, & + 777.790_fp, 802.371_fp, 827.371_fp, 852.788_fp, 878.620_fp, 904.866_fp, 931.524_fp, 958.591_fp, & + 986.067_fp,1013.948_fp,1042.232_fp,1070.917_fp,1100.000_fp/) + + atm(2)%Pressure = & + (/0.838_fp, 1.129_fp, 1.484_fp, 1.910_fp, 2.416_fp, 3.009_fp, 3.696_fp, 4.485_fp, & + 5.385_fp, 6.402_fp, 7.545_fp, 8.822_fp, 10.240_fp, 11.807_fp, 13.532_fp, 15.423_fp, & + 17.486_fp, 19.730_fp, 22.163_fp, 24.793_fp, 27.626_fp, 30.671_fp, 33.934_fp, 37.425_fp, & + 41.148_fp, 45.113_fp, 49.326_fp, 53.794_fp, 58.524_fp, 63.523_fp, 68.797_fp, 74.353_fp, & + 80.198_fp, 86.338_fp, 92.778_fp, 99.526_fp, 106.586_fp, 113.965_fp, 121.669_fp, 129.703_fp, & + 138.072_fp, 146.781_fp, 155.836_fp, 165.241_fp, 175.001_fp, 185.121_fp, 195.606_fp, 206.459_fp, & + 217.685_fp, 229.287_fp, 241.270_fp, 253.637_fp, 266.392_fp, 279.537_fp, 293.077_fp, 307.014_fp, & + 321.351_fp, 336.091_fp, 351.236_fp, 366.789_fp, 382.751_fp, 399.126_fp, 415.914_fp, 433.118_fp, & + 450.738_fp, 468.777_fp, 487.236_fp, 506.115_fp, 525.416_fp, 545.139_fp, 565.285_fp, 585.854_fp, & + 606.847_fp, 628.263_fp, 650.104_fp, 672.367_fp, 695.054_fp, 718.163_fp, 741.693_fp, 765.645_fp, & + 790.017_fp, 814.807_fp, 840.016_fp, 865.640_fp, 891.679_fp, 918.130_fp, 944.993_fp, 972.264_fp, & + 999.942_fp,1028.025_fp,1056.510_fp,1085.394_fp/) + + atm(2)%Temperature = & + (/266.536_fp, 269.608_fp, 270.203_fp, 264.526_fp, 251.578_fp, 240.264_fp, 235.095_fp, 232.959_fp, & + 233.017_fp, 233.897_fp, 234.385_fp, 233.681_fp, 232.436_fp, 231.607_fp, 231.192_fp, 230.808_fp, & + 230.088_fp, 228.603_fp, 226.407_fp, 223.654_fp, 220.525_fp, 218.226_fp, 216.668_fp, 215.107_fp, & + 213.538_fp, 212.006_fp, 210.507_fp, 208.883_fp, 206.793_fp, 204.415_fp, 202.058_fp, 199.718_fp, & + 197.668_fp, 196.169_fp, 194.993_fp, 194.835_fp, 195.648_fp, 196.879_fp, 198.830_fp, 201.091_fp, & + 203.558_fp, 206.190_fp, 208.900_fp, 211.736_fp, 214.601_fp, 217.522_fp, 220.457_fp, 223.334_fp, & + 226.156_fp, 228.901_fp, 231.557_fp, 234.173_fp, 236.788_fp, 239.410_fp, 242.140_fp, 244.953_fp, & + 247.793_fp, 250.665_fp, 253.216_fp, 255.367_fp, 257.018_fp, 258.034_fp, 258.778_fp, 259.454_fp, & + 260.225_fp, 261.251_fp, 262.672_fp, 264.614_fp, 266.854_fp, 269.159_fp, 271.448_fp, 273.673_fp, & + 275.955_fp, 278.341_fp, 280.822_fp, 283.349_fp, 285.826_fp, 288.288_fp, 290.721_fp, 293.135_fp, & + 295.609_fp, 298.173_fp, 300.787_fp, 303.379_fp, 305.960_fp, 308.521_fp, 310.916_fp, 313.647_fp, & + 315.244_fp, 315.244_fp, 315.244_fp, 315.244_fp/) + + atm(2)%Absorber(:,1) = & + (/3.887E-03_fp,3.593E-03_fp,3.055E-03_fp,2.856E-03_fp,2.921E-03_fp,2.555E-03_fp,2.392E-03_fp,2.605E-03_fp, & + 2.573E-03_fp,2.368E-03_fp,2.354E-03_fp,2.333E-03_fp,2.312E-03_fp,2.297E-03_fp,2.287E-03_fp,2.283E-03_fp, & + 2.282E-03_fp,2.286E-03_fp,2.296E-03_fp,2.309E-03_fp,2.324E-03_fp,2.333E-03_fp,2.335E-03_fp,2.335E-03_fp, & + 2.333E-03_fp,2.340E-03_fp,2.361E-03_fp,2.388E-03_fp,2.421E-03_fp,2.458E-03_fp,2.492E-03_fp,2.523E-03_fp, & + 2.574E-03_fp,2.670E-03_fp,2.789E-03_fp,2.944E-03_fp,3.135E-03_fp,3.329E-03_fp,3.530E-03_fp,3.759E-03_fp, & + 4.165E-03_fp,4.718E-03_fp,5.352E-03_fp,6.099E-03_fp,6.845E-03_fp,7.524E-03_fp,8.154E-03_fp,8.381E-03_fp, & + 8.214E-03_fp,8.570E-03_fp,9.672E-03_fp,1.246E-02_fp,1.880E-02_fp,2.720E-02_fp,3.583E-02_fp,4.462E-02_fp, & + 4.548E-02_fp,3.811E-02_fp,3.697E-02_fp,4.440E-02_fp,2.130E-01_fp,6.332E-01_fp,9.945E-01_fp,1.073E+00_fp, & + 1.196E+00_fp,1.674E+00_fp,2.323E+00_fp,2.950E+00_fp,3.557E+00_fp,4.148E+00_fp,4.666E+00_fp,5.092E+00_fp, & + 5.487E+00_fp,5.852E+00_fp,6.137E+00_fp,6.297E+00_fp,6.338E+00_fp,6.234E+00_fp,5.906E+00_fp,5.476E+00_fp, & + 5.176E+00_fp,4.994E+00_fp,4.884E+00_fp,4.832E+00_fp,4.791E+00_fp,4.760E+00_fp,4.736E+00_fp,6.368E+00_fp, & + 7.897E+00_fp,7.673E+00_fp,7.458E+00_fp,7.252E+00_fp/) + + atm(2)%Absorber(:,2) = & + (/2.742E+00_fp,3.386E+00_fp,4.164E+00_fp,5.159E+00_fp,6.357E+00_fp,7.430E+00_fp,8.174E+00_fp,8.657E+00_fp, & + 8.930E+00_fp,9.056E+00_fp,9.077E+00_fp,8.988E+00_fp,8.778E+00_fp,8.480E+00_fp,8.123E+00_fp,7.694E+00_fp, & + 7.207E+00_fp,6.654E+00_fp,6.060E+00_fp,5.464E+00_fp,4.874E+00_fp,4.299E+00_fp,3.739E+00_fp,3.202E+00_fp, & + 2.688E+00_fp,2.191E+00_fp,1.710E+00_fp,1.261E+00_fp,8.835E-01_fp,5.551E-01_fp,3.243E-01_fp,1.975E-01_fp, & + 1.071E-01_fp,7.026E-02_fp,6.153E-02_fp,5.869E-02_fp,6.146E-02_fp,6.426E-02_fp,6.714E-02_fp,6.989E-02_fp, & + 7.170E-02_fp,7.272E-02_fp,7.346E-02_fp,7.383E-02_fp,7.406E-02_fp,7.418E-02_fp,7.424E-02_fp,7.411E-02_fp, & + 7.379E-02_fp,7.346E-02_fp,7.312E-02_fp,7.284E-02_fp,7.274E-02_fp,7.273E-02_fp,7.272E-02_fp,7.270E-02_fp, & + 7.257E-02_fp,7.233E-02_fp,7.167E-02_fp,7.047E-02_fp,6.920E-02_fp,6.803E-02_fp,6.729E-02_fp,6.729E-02_fp, & + 6.753E-02_fp,6.756E-02_fp,6.717E-02_fp,6.615E-02_fp,6.510E-02_fp,6.452E-02_fp,6.440E-02_fp,6.463E-02_fp, & + 6.484E-02_fp,6.487E-02_fp,6.461E-02_fp,6.417E-02_fp,6.382E-02_fp,6.378E-02_fp,6.417E-02_fp,6.482E-02_fp, & + 6.559E-02_fp,6.638E-02_fp,6.722E-02_fp,6.841E-02_fp,6.944E-02_fp,6.720E-02_fp,6.046E-02_fp,4.124E-02_fp, & + 2.624E-02_fp,2.623E-02_fp,2.622E-02_fp,2.622E-02_fp/) + + + ! Load CO2 absorrber data if there are three absorrbers + IF ( atm(2)%n_Absorbers > 2 ) THEN + atm(2)%Absorber_Id(3) = CO2_ID + atm(2)%Absorber_Units(3) = VOLUME_MIXING_RATIO_UNITS + atm(2)%Absorber(:,3) = & + (/1.100e+02_fp,2.700e+02_fp,3.200e+02_fp,3.300e+02_fp,3.200e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp, & + 3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp, & + 3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp, & + 3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp, & + 3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp, & + 3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp, & + 3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp, & + 3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp, & + 3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp, & + 3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp, & + 3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp, & + 3.300e+02_fp,3.300e+02_fp,3.300e+02_fp,3.300e+02_fp /) + END IF + + + ! Cloud data + IF ( atm(2)%n_Clouds > 0 ) THEN + k1 = 73 + k2 = 90 + DO nc = 1, atm(2)%n_Clouds + atm(2)%Cloud(nc)%Type = RAIN_CLOUD + atm(2)%Cloud(nc)%Effective_Radius(k1:k2) = 1000.0_fp ! microns + atm(2)%Cloud(nc)%Water_Content(k1:k2) = 5.0_fp ! kg/m^2 + END DO + END IF + + + ! Aerosol data. Three aerosol types can be loaded: + ! Sea Sat SSAM, Sea Salt SSCM1, and Sea Salt SSCM2 + Load_Aerosol_Data_2: IF ( atm(2)%n_Aerosols > 0 ) THEN + + atm(2)%Aerosol(1)%Type = SEASALT_SSAM_AEROSOL + atm(2)%Aerosol(1)%Effective_Radius = & ! microns + (/0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, & + 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, & + 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, & + 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, & + 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, & + 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, 3.500000E-01_fp, & + 3.500000E-01_fp, 4.172383E-01_fp, 5.083015E-01_fp, 6.111266E-01_fp, 7.244139E-01_fp, & + 8.457720E-01_fp, 9.716019E-01_fp, 1.097090E+00_fp, 1.216347E+00_fp, 1.322729E+00_fp, & + 1.400000E+00_fp, 1.400000E+00_fp, 1.400000E+00_fp, 1.400000E+00_fp, 1.400000E+00_fp, & + 1.370222E+00_fp, 1.261597E+00_fp, 1.129123E+00_fp, 9.811745E-01_fp, 8.268477E-01_fp/) + atm(2)%Aerosol(1)%Concentration = & ! kg/m^2 + (/0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 3.112058E-19_fp, 1.184702E-18_fp, 4.577011E-18_fp, 1.789488E-17_fp, 7.059239E-17_fp, & + 2.801093E-16_fp, 1.114424E-15_fp, 4.430982E-15_fp, 1.754743E-14_fp, 6.897637E-14_fp, & + 2.681926E-13_fp, 1.027837E-12_fp, 3.868968E-12_fp, 1.425352E-11_fp, 5.121245E-11_fp, & + 1.788308E-10_fp, 6.048330E-10_fp, 1.974708E-09_fp, 6.203527E-09_fp, 1.869357E-08_fp, & + 5.387408E-08_fp, 1.480799E-07_fp, 3.871910E-07_fp, 9.608434E-07_fp, 2.258279E-06_fp, & + 5.017946E-06_fp, 1.052599E-05_fp, 2.082121E-05_fp, 3.880948E-05_fp, 6.814300E-05_fp, & + 1.127227E-04_fp, 1.757803E-04_fp, 2.586908E-04_fp, 3.598829E-04_fp, 4.743266E-04_fp, & + 5.939634E-04_fp, 7.091114E-04_fp, 8.104756E-04_fp, 8.911259E-04_fp, 9.478373E-04_fp, & + 9.814733E-04_fp, 9.964914E-04_fp, 9.999501E-04_fp, 9.994838E-04_fp, 9.921395E-04_fp, & + 9.678320E-04_fp, 9.171414E-04_fp, 8.337592E-04_fp, 7.173667E-04_fp, 5.757384E-04_fp/) + + IF ( atm(2)%n_Aerosols > 1 ) THEN + atm(2)%Aerosol(2)%Type = SEASALT_SSCM1_AEROSOL + atm(2)%Aerosol(2)%Effective_Radius = & ! microns + (/0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 1.200000E+00_fp, 1.200000E+00_fp, 1.200000E+00_fp, 1.200000E+00_fp, & + 1.200000E+00_fp, 1.200000E+00_fp, 1.200000E+00_fp, 1.200000E+00_fp, 1.200000E+00_fp, & + 2.035608E+00_fp, 3.433539E+00_fp, 4.500000E+00_fp, 4.500000E+00_fp, 4.500000E+00_fp, & + 4.500000E+00_fp, 4.500000E+00_fp, 4.500000E+00_fp, 4.500000E+00_fp, 4.500000E+00_fp/) + atm(2)%Aerosol(2)%Concentration = & ! kg/m^2 + (/0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 1.718665E-20_fp, 6.364432E-18_fp, 1.294130E-15_fp, 1.453633E-13_fp, & + 9.116027E-12_fp, 3.241673E-10_fp, 6.673036E-09_fp, 8.162075E-08_fp, 6.123529E-07_fp, & + 2.926244E-06_fp, 9.306878E-06_fp, 2.071874E-05_fp, 3.418072E-05_fp, 4.455191E-05_fp, & + 4.926597E-05_fp, 5.000000E-05_fp, 4.924296E-05_fp, 4.412128E-05_fp, 3.247284E-05_fp/) + END IF + + IF ( atm(2)%n_Aerosols > 2 ) THEN + atm(2)%Aerosol(3)%Type = SEASALT_SSCM2_AEROSOL + atm(2)%Aerosol(3)%Effective_Radius = & ! microns + (/0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, & + 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, & + 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, & + 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, & + 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, & + 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, & + 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, & + 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, & + 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, & + 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, & + 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, & + 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, & + 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp, 3.500000E+00_fp/) + atm(2)%Aerosol(3)%Concentration = & ! kg/m^2 + (/0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, 0.000000E+00_fp, & + 0.000000E+00_fp, 0.000000E+00_fp, 7.258759E-21_fp, 1.408580E-19_fp, 2.671985E-18_fp, & + 4.861044E-17_fp, 8.316902E-16_fp, 1.311926E-14_fp, 1.870485E-13_fp, 2.363806E-12_fp, & + 2.598250E-11_fp, 2.440107E-10_fp, 1.926085E-09_fp, 1.259490E-08_fp, 6.741174E-08_fp, & + 2.926595E-07_fp, 1.024936E-06_fp, 2.891988E-06_fp, 6.598725E-06_fp, 1.228990E-05_fp, & + 1.898153E-05_fp, 2.488012E-05_fp, 2.855754E-05_fp, 2.988952E-05_fp, 2.999200E-05_fp, & + 2.927621E-05_fp, 2.600524E-05_fp, 1.925823E-05_fp, 1.073490E-05_fp, 4.002469E-06_fp, & + 8.719108E-07_fp, 9.516156E-08_fp, 4.374152E-09_fp, 6.968124E-11_fp, 3.094494E-13_fp, & + 3.007755E-16_fp, 1.306643E-19_fp, 8.973748E-18_fp, 6.907477E-16_fp, 3.699227E-14_fp, & + 1.371784E-12_fp, 3.515726E-11_fp, 6.234566E-10_fp, 7.684359E-09_fp, 6.636126E-08_fp, & + 4.063274E-07_fp, 1.792269E-06_fp, 5.811355E-06_fp, 1.419909E-05_fp, 2.692800E-05_fp, & + 4.103532E-05_fp, 5.229739E-05_fp, 5.833714E-05_fp, 5.995863E-05_fp, 5.986513E-05_fp, & + 5.739352E-05_fp, 4.931915E-05_fp, 3.517150E-05_fp, 1.913860E-05_fp, 7.253731E-06_fp, & + 1.735030E-06_fp, 2.355013E-07_fp, 1.618327E-08_fp, 4.982977E-10_fp, 6.034809E-12_fp/) + END IF + END IF Load_Aerosol_Data_2 + + END SUBROUTINE Load_Atm_Data diff --git a/test/mains/regression/tangent_linear/test_Downwelling_Radiance/Load_Sfc_Data.inc b/test/mains/regression/tangent_linear/test_Downwelling_Radiance/Load_Sfc_Data.inc new file mode 100644 index 00000000..3b2aec4a --- /dev/null +++ b/test/mains/regression/tangent_linear/test_Downwelling_Radiance/Load_Sfc_Data.inc @@ -0,0 +1,55 @@ + ! + ! Include file containing an internal subprogam to load some test surface data + ! + SUBROUTINE Load_Sfc_Data() + + + ! 4a.0 Surface type definitions for default SfcOptics definitions + ! For IR and VIS, this is the NPOESS reflectivities. + ! --------------------------------------------------------------- + INTEGER, PARAMETER :: TUNDRA_SURFACE_TYPE = 10 ! NPOESS Land surface type for IR/VIS Land SfcOptics + INTEGER, PARAMETER :: SCRUB_SURFACE_TYPE = 7 ! NPOESS Land surface type for IR/VIS Land SfcOptics + INTEGER, PARAMETER :: COARSE_SOIL_TYPE = 1 ! Soil type for MW land SfcOptics + INTEGER, PARAMETER :: GROUNDCOVER_VEGETATION_TYPE = 7 ! Vegetation type for MW Land SfcOptics + INTEGER, PARAMETER :: BARE_SOIL_VEGETATION_TYPE = 11 ! Vegetation type for MW Land SfcOptics + INTEGER, PARAMETER :: SEA_WATER_TYPE = 1 ! Water type for all SfcOptics + INTEGER, PARAMETER :: FRESH_SNOW_TYPE = 2 ! NPOESS Snow type for IR/VIS SfcOptics + INTEGER, PARAMETER :: FRESH_ICE_TYPE = 1 ! NPOESS Ice type for IR/VIS SfcOptics + + + + ! 4a.1 Profile #1 + ! --------------- + ! ...Land surface characteristics + sfc(1)%Land_Coverage = 0.1_fp + sfc(1)%Land_Type = TUNDRA_SURFACE_TYPE + sfc(1)%Land_Temperature = 272.0_fp + sfc(1)%Lai = 0.17_fp + sfc(1)%Soil_Type = COARSE_SOIL_TYPE + sfc(1)%Vegetation_Type = GROUNDCOVER_VEGETATION_TYPE + ! ...Water surface characteristics + sfc(1)%Water_Coverage = 0.5_fp + sfc(1)%Water_Type = SEA_WATER_TYPE + sfc(1)%Water_Temperature = 275.0_fp + ! ...Snow coverage characteristics + sfc(1)%Snow_Coverage = 0.25_fp + sfc(1)%Snow_Type = FRESH_SNOW_TYPE + sfc(1)%Snow_Temperature = 265.0_fp + ! ...Ice surface characteristics + sfc(1)%Ice_Coverage = 0.15_fp + sfc(1)%Ice_Type = FRESH_ICE_TYPE + sfc(1)%Ice_Temperature = 269.0_fp + + + + ! 4a.2 Profile #2 + ! --------------- + ! Surface data + sfc(2)%Land_Coverage = 1.0_fp + sfc(2)%Land_Type = SCRUB_SURFACE_TYPE + sfc(2)%Land_Temperature = 318.0_fp + sfc(2)%Lai = 0.65_fp + sfc(2)%Soil_Type = COARSE_SOIL_TYPE + sfc(2)%Vegetation_Type = BARE_SOIL_VEGETATION_TYPE + + END SUBROUTINE Load_Sfc_Data diff --git a/test/mains/regression/tangent_linear/test_Downwelling_Radiance/Makefile.in b/test/mains/regression/tangent_linear/test_Downwelling_Radiance/Makefile.in new file mode 100644 index 00000000..9cbb3210 --- /dev/null +++ b/test/mains/regression/tangent_linear/test_Downwelling_Radiance/Makefile.in @@ -0,0 +1,65 @@ +# @configure_input@ + +# individual test makefile template + +# The file definitions. This include must occur before targets. +EXE_FILE=$(shell echo ${PWD} | sed 's,.*/,,') +SRC_FILE=$(EXE_FILE).f90 +OBJ_FILE=${SRC_FILE:.f90=.o} + +# The test type (e.g. forward, k_matrix, etc) +TEST_TYPE=`dirname ${PWD} | sed 's,.*/,,'` + +# Tool-specific substitution variables +FC = @FC@ +FCFLAGS = @FCFLAGS@ -I../../incsrc +LDFLAGS = @LDFLAGS@ +LIBS = @LIBS@ + +# The targets +all: $(EXE_FILE) + +$(OBJ_FILE): $(SRC_FILE) + +$(EXE_FILE): $(OBJ_FILE) + @echo; echo; \ + echo "=============================================="; \ + echo "Building $(TEST_TYPE) $(EXE_FILE) using:"; \ + echo " FC : $(FC)"; \ + echo " FCFLAGS : $(FCFLAGS)"; \ + echo " LDFLAGS : $(LDFLAGS)"; \ + echo "==============================================" + $(FC) $(LDFLAGS) $(OBJ_FILE) -o $(EXE_FILE) $(LIBS) + +clean: + @echo; echo; \ + echo "=============================================="; \ + echo "Cleaning up $(TEST_TYPE) $(EXE_FILE)"; \ + echo "==============================================" + rm -fr $(OBJ_FILE) $(EXE_FILE) gmon.out *.output *.bin results/*.signal + +update: + @update() \ + { files=`find . -maxdepth 1 -name "$$1" -print`; \ + if [ -n "$$files" ]; then \ + mv $$files results; \ + else \ + echo "No $$1 files to update."; \ + fi \ + }; \ + echo; echo; \ + echo "=============================================="; \ + echo "Updating results for $(TEST_TYPE) $(EXE_FILE)"; \ + echo "=============================================="; \ + update "*.output"; update "*.bin" + +realclean: clean + -rm Makefile + +# Specify targets that do not generate filesystem objects +.PHONY: all clean update realclean + +# Specify suffix rules +.SUFFIXES: .f90 .o +.f90.o: + @$(FC) $(FCFLAGS) -c $< diff --git a/test/mains/regression/tangent_linear/test_Downwelling_Radiance/SignalFile_Create.inc b/test/mains/regression/tangent_linear/test_Downwelling_Radiance/SignalFile_Create.inc new file mode 100644 index 00000000..7fd142ae --- /dev/null +++ b/test/mains/regression/tangent_linear/test_Downwelling_Radiance/SignalFile_Create.inc @@ -0,0 +1,9 @@ + SUBROUTINE SignalFile_Create() + CHARACTER(256) :: Filename + INTEGER :: fid + Filename = RESULTS_PATH//TRIM(PROGRAM_NAME)//'_'//TRIM(Sensor_Id)//'.signal' + fid = Get_Lun() + OPEN( fid, FILE = Filename ) + WRITE( fid,* ) TRIM(Filename) + CLOSE( fid ) + END SUBROUTINE SignalFile_Create diff --git a/test/mains/regression/tangent_linear/test_Downwelling_Radiance/sensor_id.list b/test/mains/regression/tangent_linear/test_Downwelling_Radiance/sensor_id.list new file mode 100644 index 00000000..a7b1e247 --- /dev/null +++ b/test/mains/regression/tangent_linear/test_Downwelling_Radiance/sensor_id.list @@ -0,0 +1 @@ +crisB1_npp diff --git a/test/mains/regression/tangent_linear/test_Downwelling_Radiance/test_Downwelling_Radiance.f90 b/test/mains/regression/tangent_linear/test_Downwelling_Radiance/test_Downwelling_Radiance.f90 new file mode 100644 index 00000000..67977a1d --- /dev/null +++ b/test/mains/regression/tangent_linear/test_Downwelling_Radiance/test_Downwelling_Radiance.f90 @@ -0,0 +1,342 @@ +! +! test_Aircraft +! +! Test program for the downwelling radiance option, Tangent-Linear function +! +! + +PROGRAM test_Downwelling_Radiance + + ! ============================================================================ + ! **** ENVIRONMENT SETUP FOR RTM USAGE **** + ! + ! Module usage + USE CRTM_Module + ! Disable all implicit typing + IMPLICIT NONE + ! ============================================================================ + + + ! ---------- + ! Parameters + ! ---------- + CHARACTER(*), PARAMETER :: PROGRAM_NAME = 'test_Downwelling_Radiance' + CHARACTER(*), PARAMETER :: COEFFICIENTS_PATH = './testinput/' + CHARACTER(*), PARAMETER :: RESULTS_PATH = './results/tangent_linear/' + + ! ============================================================================ + ! 0. **** SOME SET UP PARAMETERS FOR THIS TEST **** + ! + ! Profile dimensions... + INTEGER, PARAMETER :: N_PROFILES = 2 + INTEGER, PARAMETER :: N_LAYERS = 92 + INTEGER, PARAMETER :: N_ABSORBERS = 2 + INTEGER, PARAMETER :: N_CLOUDS = 1 + INTEGER, PARAMETER :: N_AEROSOLS = 1 + ! ...but only ONE Sensor at a time + INTEGER, PARAMETER :: N_SENSORS = 1 + + ! Test GeometryInfo angles. The test scan angle is based + ! on the default Re (earth radius) and h (satellite height) + REAL(fp), PARAMETER :: ZENITH_ANGLE = 30.0_fp + REAL(fp), PARAMETER :: SCAN_ANGLE = 26.37293341421_fp + REAL(fp), PARAMETER :: SOURCE_ZENITH_ANGLE = 0.0_fp + ! ============================================================================ + + + ! --------- + ! Variables + ! --------- + CHARACTER(256) :: Message + CHARACTER(256) :: Version + CHARACTER(256) :: Sensor_Id + INTEGER :: Error_Status + INTEGER :: Allocate_Status + INTEGER :: n_Channels + INTEGER :: l, m + ! Declarations for RTSolution comparison + INTEGER :: n_l, n_m + CHARACTER(256) :: rts_File + TYPE(CRTM_RTSolution_type), ALLOCATABLE :: rts_TL(:,:) + + + ! ============================================================================ + ! 1. **** DEFINE THE CRTM INTERFACE STRUCTURES **** + ! + TYPE(CRTM_ChannelInfo_type) :: ChannelInfo(N_SENSORS) + TYPE(CRTM_Geometry_type) :: Geometry(N_PROFILES) + TYPE(CRTM_Atmosphere_type) :: Atm(N_PROFILES), Atm_TL(N_PROFILES) + TYPE(CRTM_Surface_type) :: Sfc(N_PROFILES), Sfc_TL(N_PROFILES) + TYPE(CRTM_RTSolution_type), ALLOCATABLE :: RTSolution(:,:), RTSolution_TL(:,:) + TYPE(CRTM_Options_type) :: Opt(N_PROFILES) + ! ============================================================================ + + + + !First, make sure the right number of inputs have been provided + IF(COMMAND_ARGUMENT_COUNT().NE.1)THEN + WRITE(*,*) TRIM(PROGRAM_NAME)//': ERROR, ONLY one command-line argument required, returning' + STOP 1 + ENDIF + CALL GET_COMMAND_ARGUMENT(1,Sensor_Id) !read in the value + + + ! Program header + ! -------------- + CALL CRTM_Version( Version ) + CALL Program_Message( PROGRAM_NAME, & + 'Test program for the aircraft instrument option under clear sky conditions.', & + 'CRTM Version: '//TRIM(Version) ) + + + ! Get sensor id from user + ! ----------------------- + Sensor_Id = ADJUSTL(Sensor_Id) + WRITE( *,'(//5x,"Running CRTM for ",a," sensor...")' ) TRIM(Sensor_Id) + + + + ! ============================================================================ + ! 2. **** INITIALIZE THE CRTM **** + ! + ! 2a. Initialise for the requested sensor + ! --------------------------------------- + WRITE( *,'(/5x,"Initializing the CRTM...")' ) + Error_Status = CRTM_Init( (/Sensor_Id/), & + ChannelInfo, & + File_Path=COEFFICIENTS_PATH, & + Load_CloudCoeff = .TRUE., & + Load_AerosolCoeff = .TRUE.) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error initializing CRTM' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + + + ! 2b. Determine the number of channels the + ! CRTM is to process + ! ------------------------------------------ + n_Channels = SUM(CRTM_ChannelInfo_n_Channels(ChannelInfo)) + ! ============================================================================ + + + + + ! ============================================================================ + ! 3. **** ALLOCATE STRUCTURE ARRAYS **** + ! + ! 3a. Allocate the ARRAYS + ! ----------------------- + ALLOCATE( RTSolution( n_Channels, N_PROFILES ), & + RTSolution_TL( n_Channels, N_PROFILES ), & + STAT=Allocate_Status ) + IF ( Allocate_Status /= 0 ) THEN + Message = 'Error allocating structure arrays' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + + ! 3b. Allocate the STRUCTURES + ! --------------------------- + CALL CRTM_Atmosphere_Create( Atm, N_LAYERS, N_ABSORBERS, N_CLOUDS, N_AEROSOLS ) + IF ( ANY(.NOT. CRTM_Atmosphere_Associated(Atm)) ) THEN + Message = 'Error allocating CRTM Atmosphere structures' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + ! ============================================================================ + + + + + ! ============================================================================ + ! 4. **** ASSIGN INPUT DATA **** + ! + ! 4a. Atmosphere and Surface input + ! -------------------------------- + CALL Load_Atm_Data() + CALL Load_Sfc_Data() + + + ! 4b. GeometryInfo input + ! ---------------------- + ! All profiles are given the same value + ! The Sensor_Scan_Angle is optional. + CALL CRTM_Geometry_SetValue( Geometry, & + Sensor_Zenith_Angle = ZENITH_ANGLE, & + Sensor_Scan_Angle = SCAN_ANGLE, & + Source_Zenith_Angle = SOURCE_ZENITH_ANGLE ) + + + ! 4c. Set the aircraft pressure altitude + ! -------------------------------------- + Opt%obs_4_downward_P = 320.0_fp + ! ============================================================================ + + + ! ============================================================================ + ! 5. **** INITIALIZE THE TANGENT-LINEAR ARGUMENTS **** + ! + ! 5a. Zero the tangent-liner INPUT structures + ! --------------------------------------- + ! Copy... + Atm_TL = Atm + ! ...zero... + CALL CRTM_Atmosphere_Zero(Atm_TL) + ! ...and perturb temperature by 0.5K + DO m = 1, N_PROFILES + Atm_TL(m)%Temperature = 0.5_fp + END DO + + ! Copy... + Sfc_TL = Sfc + ! ...and zero. + CALL CRTM_Surface_Zero(Sfc_TL) + ! ============================================================================ + + ! ============================================================================ + ! 6. **** CALL THE CRTM TANGENT-LINEAR MODEL **** + ! + Error_Status = CRTM_Tangent_Linear( Atm , & + Sfc , & + Atm_TL , & + Sfc_TL , & + Geometry , & + ChannelInfo , & + RTSolution , & + RTSolution_TL, & + Options = Opt ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error in CRTM Tangent-Linear Model' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + ! ============================================================================ + + + ! ============================================================================ + ! 7. **** OUTPUT THE RESULTS TO SCREEN **** + ! + DO m = 1, N_PROFILES + WRITE( *,'(//7x,"Profile ",i0," output for ",a )') m, TRIM(Sensor_Id) + DO l = 1, n_Channels + WRITE( *, '(/5x,"Channel ",i0," results")') RTSolution(l,m)%Sensor_Channel + CALL CRTM_RTSolution_Inspect(RTSolution(l,m)) + END DO + END DO + ! ============================================================================ + + ! ============================================================================ + ! 9. **** COMPARE RTSolution_TL RESULTS TO SAVED VALUES **** + ! + WRITE( *, '( /5x, "Comparing calculated results with saved ones..." )' ) + + ! 9a. Create the output file if it does not exist + ! ----------------------------------------------- + ! ...Generate a filename + rts_File = RESULTS_PATH//TRIM(PROGRAM_NAME)//'_'//TRIM(Sensor_Id)//'.RTSolution_TL.bin' + ! ...Check if the file exists + IF ( .NOT. File_Exists(rts_File) ) THEN + Message = 'RTSolution_TL save file does not exist. Creating...' + CALL Display_Message( PROGRAM_NAME, Message, INFORMATION ) + ! ...File not found, so write RTSolution_TL structure to file + Error_Status = CRTM_RTSolution_WriteFile( rts_File, RTSolution_TL, Quiet=.TRUE. ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error creating RTSolution_TL save file' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + END IF + + ! 9b. Inquire the saved file + ! -------------------------- + Error_Status = CRTM_RTSolution_InquireFile( rts_File, & + n_Channels = n_l, & + n_Profiles = n_m ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error inquiring RTSolution_TL save file' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + + ! 9c. Compare the dimensions + ! -------------------------- + IF ( n_l /= n_Channels .OR. n_m /= N_PROFILES ) THEN + Message = 'Dimensions of saved data different from that calculated!' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + + ! 9d. Allocate the structure to read in saved data + ! ------------------------------------------------ + ALLOCATE( rts_TL( n_l, n_m ), STAT=Allocate_Status ) + IF ( Allocate_Status /= 0 ) THEN + Message = 'Error allocating RTSolution_TL saved data array' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + + ! 9e. Read the saved data + ! ----------------------- + Error_Status = CRTM_RTSolution_ReadFile( rts_File, rts_TL, Quiet=.TRUE. ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error reading RTSolution_TL save file' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + + ! 9f. Compare the structures + ! -------------------------- + IF ( ALL(CRTM_RTSolution_Compare(RTSolution_TL, rts_TL)) ) THEN + Message = 'RTSolution_TL results are the same!' + CALL Display_Message( PROGRAM_NAME, Message, INFORMATION ) + ELSE + Message = 'RTSolution_TL results are different!' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + ! Write the current RTSolution results to file + rts_File = TRIM(Sensor_Id)//'.RTSolution_TL.bin' + Error_Status = CRTM_RTSolution_WriteFile( rts_File, RTSolution_TL, Quiet=.TRUE. ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error creating temporary RTSolution_TL save file for failed comparison' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + END IF + STOP 1 + END IF + ! ============================================================================ + + + ! ============================================================================ + ! 8. **** DESTROY THE CRTM **** + ! + WRITE( *, '( /5x, "Destroying the CRTM..." )' ) + Error_Status = CRTM_Destroy( ChannelInfo ) + IF ( Error_Status /= SUCCESS ) THEN + Message = 'Error destroying CRTM' + CALL Display_Message( PROGRAM_NAME, Message, FAILURE ) + STOP 1 + END IF + ! ============================================================================ + + ! ============================================================================ + ! 10. **** CLEAN UP **** + ! + ! 10a. Deallocate the structures + ! ------------------------------ + CALL CRTM_Atmosphere_Destroy(Atm) + CALL CRTM_Atmosphere_Destroy(Atm_TL) + + ! 9b. Deallocate the arrays + ! ------------------------- + DEALLOCATE(RTSolution, RTSolution_TL, rts_TL, STAT=Allocate_Status) + ! ============================================================================ + + + ! Signal the completion of the program. It is not a necessary step for running CRTM. + +CONTAINS + + INCLUDE 'Load_Atm_Data.inc' + INCLUDE 'Load_Sfc_Data.inc' + +END PROGRAM test_Downwelling_Radiance