MODULE module_func ! -----------------------------------------------------------------------------! ! Define utilities functions used for handling the observation data structures ! ! D. GILL, April 1998 ! F. VANDENBERGHE, March 2001 ! -----------------------------------------------------------------------------! USE module_type CONTAINS ! -----------------------------------------------------------------------------! ! FUNCTIONS ! -----------------------------------------------------------------------------! !LOGICAL FUNCTION compare ( a , b, flag ) FUNCTION compare_loc ( a , b, flag ) RESULT (compare) ! This defines the comparison operator '.LT.' for use with the 'report' ! data type. NOTE that the other operators LE, GE, GT are NOT ! defined at all for the 'report' data type. IMPLICIT NONE INTEGER , INTENT ( IN ) :: flag TYPE ( report ) , INTENT ( IN ) :: a ! the first data item compared TYPE ( report ) , INTENT ( IN ) :: b ! the second data item compared LOGICAL :: compare integer :: a1, b1 compare = .FALSE. read (a%info%platform(4:6),'(I3)') a1 read (b%info%platform(4:6),'(I3)') b1 IF ( a1 < b1 ) THEN compare = .TRUE. ELSE IF ( a%info%platform(4:6) .EQ. b%info%platform(4:6) ) THEN IF ( a%location%longitude .LT. b%location%longitude ) THEN compare = .TRUE. ELSE IF ( a%location%longitude .eq. b%location%longitude ) THEN IF ( a%location%latitude .LT. b%location%latitude ) THEN compare = .TRUE. ELSE IF ( a%location%latitude .EQ. b%location%latitude ) THEN IF ( LLT ( a%location%id , b%location%id ) ) THEN compare = .TRUE. ELSE IF ( a%location%id .EQ. b%location%id ) THEN IF ( LLT ( a%location%name , b%location%name ) ) THEN compare = .TRUE. END IF END IF END IF END IF ENDIF IF (flag == 1) then IF ( a%info%platform(4:6) .EQ. b%info%platform(4:6) .and. & a%location%longitude .EQ. b%location%longitude .and. & a%location%latitude .EQ. b%location%latitude .and. & a%location%id .EQ. b%location%id .and. & a%location%name .EQ. b%location%name ) THEN compare = .TRUE. ENDIF ENDIF END FUNCTION compare_loc ! ! --------------------------------------------------------------------------- !LOGICAL FUNCTION compare ( a , b, flag ) FUNCTION compare_tim ( a , b, flag ) RESULT (compare) ! This defines the comparison operator '.LT.' for use with the 'report' ! data type. NOTE that the other operators LE, GE, GT are NOT ! defined at all for the 'report' data type. USE module_date IMPLICIT NONE INTEGER , INTENT ( IN ) :: flag TYPE ( report ) , INTENT ( IN ) :: a ! the first data item compared TYPE ( report ) , INTENT ( IN ) :: b ! the second data item compared LOGICAL :: compare CHARACTER (LEN = 19) :: time_a, time_b INTEGER :: its, fma, fmb ! Get time of a in MM5 string date format CCYY-MM-DD_HH:MN:SS WRITE (time_a, FMT='(A4,"-",A2,"-",A2,"_",A2,":",A2,":",A2)') & a % valid_time % date_char ( 1: 4), & a % valid_time % date_char ( 5: 6), & a % valid_time % date_char ( 7: 8), & a % valid_time % date_char ( 9:10), & a % valid_time % date_char (11:12), & a % valid_time % date_char (13:14) ! Get time of second in MM5 string date format CCYY-MM-DD_HH:MN:SS WRITE (time_b, FMT='(A4,"-",A2,"-",A2,"_",A2,":",A2,":",A2)') & b % valid_time % date_char ( 1: 4), & b % valid_time % date_char ( 5: 6), & b % valid_time % date_char ( 7: 8), & b % valid_time % date_char ( 9:10), & b % valid_time % date_char (11:12), & b % valid_time % date_char (13:14) ! Get the difference in s between first and second CALL GETH_IDTS (time_a, time_b, its) ! Negative difference indicates that a is prior to b compare = .FALSE. ! Negative difference indicates that a is prior to b IF (its .LT. 0) THEN compare = .TRUE. ELSE IF (its .EQ. 0) THEN ! Same time are sorted upon obs type READ (a % info % platform (4:6), '(I3)') fma READ (b % info % platform (4:6), '(I3)') fmb IF (fma .LT. fmb) THEN compare = .TRUE. ELSE IF (fma .EQ. fmb) THEN ! Same time and same type are sorted upon location IF (compare_loc (a, b, flag)) THEN compare = .TRUE. ENDIF ENDIF END IF ! WRITE (60,'(4A,L)') time_a,' < ',time_b,' is ',compare END FUNCTION compare_tim ! ! ------------------------------------------------------------------------- LOGICAL FUNCTION eps_equal ( a , b , eps ) ! Compare two real numbers a and b, and return TRUE if they are within ! parameter 'eps' of one another. IMPLICIT NONE REAL , INTENT ( IN ) :: a , b , eps IF ( ABS ( a - b ) .LT. eps ) THEN eps_equal = .TRUE. ELSE eps_equal = .FALSE. END IF END FUNCTION eps_equal ! ! ------------------------------------------------------------------------ LOGICAL FUNCTION field_eq ( a , b ) ! This defines operator .EQ. for 'field' data type IMPLICIT NONE TYPE ( field ) , INTENT ( IN ) :: a , b IF ( a%data .EQ. b%data .AND. a%qc .EQ. b%qc ) THEN field_eq = .TRUE. ELSE field_eq = .FALSE. END IF END FUNCTION field_eq ! ! ------------------------------------------------------------------------- LOGICAL FUNCTION ground_eq ( a , b ) ! This defines operator .EQ. for 'terrestrial' data type IMPLICIT NONE TYPE ( terrestrial ) , INTENT ( IN ) :: a , b IF ( eps_equal ( a%slp%data , b%slp%data , .01 ) .AND. & eps_equal ( a%ref_pres%data , b%ref_pres%data , .01 ) .AND. & eps_equal ( a%ground_t%data , b%ground_t%data , .01 ) .AND. & eps_equal ( a%sst%data , b%sst%data , .01 ) .AND. & eps_equal ( a%psfc%data , b%psfc%data , .01 ) .AND. & eps_equal ( a%precip%data , b%precip%data , .01 ) .AND. & eps_equal ( a%t_max%data , b%t_max%data , .01 ) .AND. & eps_equal ( a%t_min%data , b%t_min%data , .01 ) .AND. & eps_equal ( a%t_min_night%data , b%t_min_night%data , .01 ) .AND. & eps_equal ( a%p_tend03%data , b%p_tend03%data , .01 ) .AND. & eps_equal ( a%p_tend24%data , b%p_tend24%data , .01 ) .AND. & eps_equal ( a%cloud_cvr%data , b%cloud_cvr%data , .01 ) .AND. & eps_equal ( a%ceiling%data , b%ceiling%data , .01 ) .AND. & eps_equal ( a%pw%data , b%pw%data , .01 ) .AND. & eps_equal ( a%tb19v%data , b%tb19v%data , .01 ) .AND. & eps_equal ( a%tb19h%data , b%tb19h%data , .01 ) .AND. & eps_equal ( a%tb22v%data , b%tb22v%data , .01 ) .AND. & eps_equal ( a%tb37v%data , b%tb37v%data , .01 ) .AND. & eps_equal ( a%tb37h%data , b%tb37h%data , .01 ) .AND. & eps_equal ( a%tb85v%data , b%tb85v%data , .01 ) .AND. & eps_equal ( a%tb85h%data , b%tb85h%data , .01 ) .AND. & a%slp%qc .EQ. b%slp%qc .AND. a%ref_pres%qc .EQ. b%ref_pres%qc .AND. & a%ground_t%qc .EQ. b%ground_t%qc .AND. a%sst%qc .EQ. b%sst%qc .AND. & a%psfc%qc .EQ. b%psfc%qc .AND. a%precip%qc .EQ. b%precip%qc .AND. & a%t_max%qc .EQ. b%t_max%qc .AND. a%t_min%qc .EQ. b%t_min%qc .AND. & a%t_min_night%qc .EQ. b%t_min_night%qc .AND. & a%p_tend03%qc .EQ. b%p_tend03%qc .AND. & a%p_tend24%qc .EQ. b%p_tend24%qc .AND. & a%cloud_cvr%qc .EQ. b%cloud_cvr%qc .AND. & a%ceiling%qc .EQ. b%ceiling%qc .AND. a%pw%qc .EQ. b%pw%qc .AND. & a%tb19v%qc .EQ. b%tb19v%qc .AND. a%tb19h%qc .EQ. b%tb19h%qc .AND. & a%tb22v%qc .EQ. b%tb22v%qc .AND. a%tb37v%qc .EQ. b%tb37v%qc .AND. & a%tb37h%qc .EQ. b%tb37h%qc .AND. a%tb85v%qc .EQ. b%tb85v%qc .AND. & a%tb85h%qc .EQ. b%tb85h%qc) THEN ground_eq = .TRUE. ELSE ground_eq = .FALSE. END IF END FUNCTION ground_eq ! ! ------------------------------------------------------------------------- LOGICAL FUNCTION loc_eq ( a , b ) ! This defines operator .EQ. for 'location' data type IMPLICIT NONE TYPE ( report ) , INTENT ( IN ) :: a ! the first data item compared TYPE ( report ) , INTENT ( IN ) :: b ! the second data item compared IF ( eps_equal(a%location%latitude ,b%location%latitude , .001) .AND. & eps_equal(a%location%longitude,b%location%longitude, .001) .AND. & a%location%id .EQ. b%location%id .AND. & a%location%name .EQ. b%location%name .AND. & a%info%platform(4:6) .EQ. b%info%platform(4:6) ) THEN loc_eq = .TRUE. ELSE loc_eq = .FALSE. END IF END FUNCTION loc_eq ! ! ------------------------------------------------------------------------- LOGICAL FUNCTION time_eq_old ( a , b ) ! This defines operator .EQ. for 'time_info' data type IMPLICIT NONE TYPE ( time_info ) , INTENT ( IN ) :: a , b IF ( ( a%sut .EQ. b%sut ) .AND. & ( a%julian .EQ. b%julian ) .AND. & ( a%date_char .EQ. b%date_char ) ) THEN time_eq_old = .TRUE. ELSE time_eq_old = .FALSE. END IF END FUNCTION time_eq_old ! ! ------------------------------------------------------------------------- LOGICAL FUNCTION time_eq ( a , b , date , time ) ! This defines operator .EQ. for 'time_info' data type USE module_date IMPLICIT NONE TYPE ( time_info ) , INTENT ( INOUT ) :: a , b INTEGER , INTENT ( IN ) :: date , time ! Local variables. CHARACTER (LEN=19) :: target_date , a_date , b_date INTEGER :: diff_seconds , a_diff_seconds , b_diff_seconds ! Compute the character string date and time for the current analysis time. WRITE (target_date, '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) & date / 10000 , & ( date - (date / 10000 ) * 10000 ) / 100 , & date - ( date / 100 ) * 100 , & time / 10000 , & ( time - ( time / 10000 ) * 10000 ) / 100, & time - ( time / 100 ) * 100 ! Get the date/time for observations a and b in a YYYY-MM-DD_HH:mm:ss format a_date( 1: 5) = a%date_char( 1: 4) // '-' a_date( 6: 8) = a%date_char( 5: 6) // '-' a_date( 9:11) = a%date_char( 7: 8) // '_' a_date(12:14) = a%date_char( 9:10) // ':' a_date(15:17) = a%date_char(11:12) // ':' a_date(18:19) = a%date_char(13:14) b_date( 1: 5) = b%date_char( 1: 4) // '-' b_date( 6: 8) = b%date_char( 5: 6) // '-' b_date( 9:11) = b%date_char( 7: 8) // '_' b_date(12:14) = b%date_char( 9:10) // ':' b_date(15:17) = b%date_char(11:12) // ':' b_date(18:19) = b%date_char(13:14) ! Compute the time difference between the two observations in seconds. CALL geth_idts ( a_date , b_date , diff_seconds ) ! If the times (a and b) are within half an hour of each other, ! we say that they are the same time. IF ( ABS ( diff_seconds ) .LT. 1800 ) THEN ! Now that we know a and b are the same time, the important question is ! now are they the time that we want? If they are the same ! (which means either a or b is within an hour of the target time), ! we set both of these times to the target time. CALL geth_idts ( target_date , a_date , a_diff_seconds ) CALL geth_idts ( target_date , b_date , b_diff_seconds ) IF ( ( ABS ( a_diff_seconds ) .LT. 3600 ) .OR. & ( ABS ( b_diff_seconds ) .LT. 3600 ) ) THEN a%date_char( 1: 4) = target_date( 1: 4) a%date_char( 5: 6) = target_date( 6: 7) a%date_char( 7: 8) = target_date( 9:10) a%date_char( 9:10) = target_date(12:13) a%date_char(11:12) = target_date(15:16) a%date_char(13:14) = target_date(18:19) b%date_char( 1: 4) = target_date( 1: 4) b%date_char( 5: 6) = target_date( 6: 7) b%date_char( 7: 8) = target_date( 9:10) b%date_char( 9:10) = target_date(12:13) b%date_char(11:12) = target_date(15:16) b%date_char(13:14) = target_date(18:19) END IF time_eq = .TRUE. ELSE time_eq = .FALSE. END IF END FUNCTION time_eq ! ------------------------------------------------------------------------- FUNCTION info_levels (surface) RESULT (levels) ! This routine takes the sounding and makes sure that if a surface ! level exists, that it is the first level. IMPLICIT NONE TYPE ( measurement ) , POINTER :: surface INTEGER :: levels TYPE ( measurement ) , POINTER :: current ! Um, is there any data at all? levels = 0 IF ( ASSOCIATED ( surface ) ) THEN levels = levels + 1 current => surface%next DO WHILE ( ASSOCIATED ( current ) ) levels = levels + 1 current => current%next END DO END IF END FUNCTION info_levels ! ------------------------------------------------------------------------- END MODULE module_func