MODULE IO_dep IMPLICIT NONE PUBLIC REAL :: DEFAULT_VALUE_REAL = -999. PUBLIC :: dep_type TYPE :: dep_type INTEGER :: AlgSN !MIRS Algorithm serial number (svn) INTEGER :: iTyp !0->DEP from Scene, 1->DEP from retrieved scene INTEGER :: ProfIndx !Profile Index !---Positioning Data REAL :: Angle !Satellite zenith angle REAL :: RelAziAngle!Relative Azimuth Angle REAL :: SolZenAngle!Solar Zenith Angle REAL :: lat !Latitude REAL :: lon !Longitude INTEGER :: node !=0->ASC, =1->DESC INTEGER :: scanDAY !Day INTEGER :: scanYear !Year REAL :: scanUTC !UTC time INTEGER :: iscanPos !Scan position INTEGER :: iscanLine !Scan Line index INTEGER :: nPosScan !Number of scan positions within scanline INTEGER :: nScanLines !Number of scan lines within orbit (msome might be missing) !---Atmospheric/Hydrometeors/Cloud-related information INTEGER :: iTypAtm !Atmospheric type ID CHARACTER(LEN=20) :: DescTypAtm !Label of the atmospheric class REAL :: TPW !Total precipitable Water REAL :: Clw !Integrated Cloud amount REAL :: RWP !Integrated Liquid Rain water path REAL :: LWP !Integrated Liquid Water Path REAL :: SWP !Integrated Snow water path REAL :: IWP !Integrated Ice water path REAL :: GWP !Integrated Graupel water path REAL :: RR !Surface rain rate REAL :: SFR !Snow falling rate REAL :: CldTop !Cloud Top Pressure REAL :: CldBase !Cloud Base Pressure REAL :: CldThick !Cloud thickness REAL :: PrecipType !Precipitation type (frozen/liquid) REAL :: RainFlag !Rain flag !---Surface -related information INTEGER :: iTypSfc !Surface type ID CHARACTER(LEN=20) :: DescTypSfc !Label of the surface class REAL :: SWE !Snow water equivalent REAL :: SnowGS !Snow Effective Grain Size REAL :: SnowCover !Snow cover extent REAL :: SM !Soil Moisture REAL :: SIC !Sea-ice concentration REAL :: SIC_MY !Multi-year Sea-ice concentration REAL :: SIC_FY !First-year Sea-ice concentration REAL :: WindSp !Wind speed REAL :: WindDir !Wind vector REAL :: WindU !U-direction wind speed REAL :: WindV !V-direction wind speed ! REAL :: Prob_SF = DEFAULT_VALUE_REAL !Probability of falling snow (%) ! REAL :: Prob_RF = DEFAULT_VALUE_REAL !Probability of falling rain (%) REAL :: Prob_SF = -999. !Probability of falling snow (%) REAL :: Prob_RF = -999. !Probability of falling rain (%) !---QC info INTEGER, DIMENSION(4) :: qc !QC vector !---Convergence items (when the DEP is coming from a retrieved scene ) INTEGER :: nIter !Number of iterations REAL :: ChiSq !Convergence metric END TYPE dep_type INTEGER, PARAMETER :: H2OID = 1, O3ID = 3 CONTAINS SUBROUTINE ReadHdrDep(iu,dep,nprf) ! CHARACTER(LEN=*) :: InputFile INTEGER :: iu,nprf TYPE(dep_type) :: dep ! OPEN(iu,file=InputFile,form='unformatted') READ(iu) DEP%iTyp,DEP%AlgSN !iTyp=0->Simple Scene, =1->Retrieved Scene READ(iu) nprf READ(iu) DEP%nPosScan READ(iu) DEP%nScanLines RETURN END SUBROUTINE ReadHdrdep SUBROUTINE Readdep(iu,dep) INTEGER :: iu, ierr TYPE(dep_type) :: dep ! READ(iu,iostat=ierr,end=10) dep%ProfIndx READ(iu,end=10) dep%ProfIndx ! ierr=0 ! IF (ierr.ne.0) THEN ! CALL ErrHandl(WarningType,Warn_readInvalid,'DEP invalid.') ! RETURN ! ENDIF !---Atmospheric , cloud and hydrometeors constituents READ(iu,err=20) DEP%iTypAtm,DEP%TPW,DEP%Clw,DEP%RWP,DEP%SWP, & DEP%IWP,DEP%GWP,DEP%RR,DEP%SFR,DEP%CldTop,DEP%CldBase, & DEP%CldThick,DEP%PrecipType,DEP%RainFlag,DEP%LWP !---Surface parameters READ(iu,err=20) DEP%iTypSfc,DEP%SWE,DEP%SnowCover,DEP%SM,DEP%SIC,& DEP%WindSp,DEP%WindDir,DEP%WindU,DEP%WindV,DEP%SnowGS,& DEP%SIC_FY,DEP%SIC_MY !---QC variables READ(iu,err=20) DEP%qc(1:4) !---Positioning variables READ(iu,err=20) DEP%lat,DEP%lon,DEP%node,DEP%scanUTC,DEP%scanYear,DEP%scanDay,DEP%iscanPos,DEP%iscanLine,& DEP%angle,DEP%RelAziAngle,DEP%SolZenAngle !---In case the DEP is from a retrieved scene IF (DEP%iTyp .eq. 1) THEN READ(iu,err=20) DEP%nIter,DEP%ChiSq ENDIF !---SFR new variables (2019-03-11) IF (DEP%AlgSN .ge. 4150) THEN READ(iu,err=20) DEP%Prob_SF,DEP%Prob_RF ELSE DEP%Prob_SF=DEFAULT_VALUE_REAL DEP%Prob_RF=DEFAULT_VALUE_REAL ENDIF RETURN 10 PRINT*, 'Warn_EndofFile Dep' !ykl 10 ierr=Warn_EndOfFile !ykl CALL ErrHandl(WarningType,Warn_EndOfFile,'Dep') RETURN !ykl 20 ierr=Warn_readInvalid !ykl CALL ErrHandl(WarningType,Warn_readInvalid,'(ReadDEP)') 20 PRINT*, 'Warn_readInvalid ReadDep' RETURN END SUBROUTINE Readdep INTEGER FUNCTION FindIndx(AbsorbID,ID) INTEGER, DIMENSION(:) :: AbsorbID INTEGER :: ID !---Local variables INTEGER :: iId,nIDs nIDs = SIZE(AbsorbID) FindIndx = -1 DO iId=1,nIDs IF (ID .eq. AbsorbID(iId)) THEN FindIndx = iId ENDIF ENDDO ! IF (FindIndx .eq. -1) CALL ErrHandl(WarningType,Warn_NoMolecIndxFound,'') RETURN END FUNCTION FindIndx END MODULE IO_dep