| 1 | SUBROUTINE ropp_fm_roprof2obs1drefrac(ro_data, y)
|
|---|
| 2 |
|
|---|
| 3 | ! 2.1 Declarations
|
|---|
| 4 | ! ----------------
|
|---|
| 5 |
|
|---|
| 6 | USE typesizes, ONLY: wp => EightByteReal
|
|---|
| 7 | USE ropp_utils
|
|---|
| 8 | USE ropp_io
|
|---|
| 9 | USE ropp_io_types, ONLY: ROprof
|
|---|
| 10 | USE ropp_fm
|
|---|
| 11 | USE ropp_fm_types, ONLY: Obs1dRefrac
|
|---|
| 12 | USE ropp_fm_copy, not_this => ropp_fm_roprof2obs1drefrac
|
|---|
| 13 |
|
|---|
| 14 | IMPLICIT NONE
|
|---|
| 15 |
|
|---|
| 16 | TYPE(ROprof), INTENT(in) :: ro_data ! RO data structure
|
|---|
| 17 | TYPE(Obs1dRefrac), INTENT(inout) :: y ! Refractivity structure
|
|---|
| 18 |
|
|---|
| 19 | INTEGER :: i, n
|
|---|
| 20 | INTEGER, DIMENSION(8) :: DT8
|
|---|
| 21 |
|
|---|
| 22 | CHARACTER(len = 256) :: routine
|
|---|
| 23 | CHARACTER(len = 10) :: err_val
|
|---|
| 24 |
|
|---|
| 25 | ! 2.2 Error handling
|
|---|
| 26 | ! ------------------
|
|---|
| 27 |
|
|---|
| 28 | CALL message_get_routine(routine)
|
|---|
| 29 | CALL message_set_routine('ropp_fm_roprof2obs (1D refractivity)')
|
|---|
| 30 |
|
|---|
| 31 | y%obs_ok = .TRUE.
|
|---|
| 32 |
|
|---|
| 33 | ! 2.3 Check and copy geolocation and time
|
|---|
| 34 | ! ---------------------------------------
|
|---|
| 35 |
|
|---|
| 36 | IF (isinrange(ro_data%georef%lon, ro_data%georef%range%lon)) THEN
|
|---|
| 37 | y%lon = ro_data%georef%lon
|
|---|
| 38 | ELSE
|
|---|
| 39 | WRITE(err_val, '(e8.1)') ro_data%georef%lon
|
|---|
| 40 | CALL message(msg_warn, &
|
|---|
| 41 | "Longitude data for observations out of range or missing. " // &
|
|---|
| 42 | "(longitude value = " // TRIM(err_val) // ")")
|
|---|
| 43 | CALL message(msg_warn, "Check input data and valid_range attributes")
|
|---|
| 44 | ENDIF
|
|---|
| 45 |
|
|---|
| 46 | IF (isinrange(ro_data%georef%lat, ro_data%georef%range%lat)) THEN
|
|---|
| 47 | y%lat = ro_data%georef%lat
|
|---|
| 48 | ELSE
|
|---|
| 49 | WRITE(err_val, '(e8.1)') ro_data%georef%lat
|
|---|
| 50 | CALL message(msg_warn, &
|
|---|
| 51 | "Latitude data for observations out of range or missing. " // &
|
|---|
| 52 | "(latitude value = " // TRIM(err_val) // ")")
|
|---|
| 53 | CALL message(msg_warn, "Check input data and valid_range attributes")
|
|---|
| 54 | ENDIF
|
|---|
| 55 |
|
|---|
| 56 | IF ( isinrange(ro_data%DTocc%year, ro_data%DTocc%range%year) .AND. &
|
|---|
| 57 | isinrange(ro_data%DTocc%month, ro_data%DTocc%range%month) .AND. &
|
|---|
| 58 | isinrange(ro_data%DTocc%day, ro_data%DTocc%range%day) .AND. &
|
|---|
| 59 | isinrange(ro_data%DTocc%hour, ro_data%DTocc%range%hour) .AND. &
|
|---|
| 60 | isinrange(ro_data%DTocc%minute, ro_data%DTocc%range%minute) .AND. &
|
|---|
| 61 | isinrange(ro_data%DTocc%second, ro_data%DTocc%range%second) ) THEN
|
|---|
| 62 | DT8 = (/ro_data%DTocc%year, ro_data%DTocc%month, &
|
|---|
| 63 | ro_data%DTocc%day, 0, &
|
|---|
| 64 | ro_data%DTocc%hour, ro_data%DTocc%minute, &
|
|---|
| 65 | ro_data%DTocc%second, ro_data%DTocc%msec/)
|
|---|
| 66 | CALL TimeSince ( DT8, y%time, 1, Base="JS2000" )
|
|---|
| 67 | ELSE
|
|---|
| 68 | CALL message(msg_warn, &
|
|---|
| 69 | "Time data for observations out of range or missing.")
|
|---|
| 70 | CALL message(msg_warn, "Check input data and valid_range attributes")
|
|---|
| 71 | CALL message(msg_warn, "Set status flag state%ok to FALSE")
|
|---|
| 72 | y%obs_ok = .FALSE.
|
|---|
| 73 | ENDIF
|
|---|
| 74 |
|
|---|
| 75 | ! 2.4 Check that profiles are increasing in height - 1st element towards surface
|
|---|
| 76 | ! ------------------------------------------------
|
|---|
| 77 |
|
|---|
| 78 | CALL ropp_io_ascend(ro_data)
|
|---|
| 79 |
|
|---|
| 80 | ! 2.5 Check and copy observation data
|
|---|
| 81 | ! -----------------------------------
|
|---|
| 82 |
|
|---|
| 83 | IF (ro_data%Lev2a%Npoints == 0) THEN
|
|---|
| 84 | CALL message(msg_warn, &
|
|---|
| 85 | "RO data has no Level 2a (refractivity) data.")
|
|---|
| 86 | CALL message(msg_warn, "Check input data and valid_range attributes")
|
|---|
| 87 | CALL message(msg_warn, "Set status flag state%ok to FALSE")
|
|---|
| 88 | y%obs_ok = .FALSE.
|
|---|
| 89 | ENDIF
|
|---|
| 90 |
|
|---|
| 91 | n = ro_data%Lev2a%Npoints
|
|---|
| 92 |
|
|---|
| 93 | ALLOCATE(y%geop(n), y%refrac(n), y%weights(n))
|
|---|
| 94 | y%geop = ro_data%Lev2a%geop_refrac(1:n)
|
|---|
| 95 | y%refrac = ro_data%Lev2a%refrac(1:n)
|
|---|
| 96 | y%weights = 1.0_wp
|
|---|
| 97 |
|
|---|
| 98 | ! 2.6 Check and copy sigmas to diagonal error covariance
|
|---|
| 99 | ! ------------------------------------------------------
|
|---|
| 100 |
|
|---|
| 101 | y%cov_ok = .TRUE.
|
|---|
| 102 |
|
|---|
| 103 | IF (ASSOCIATED(y%cov%d)) DEALLOCATE(y%cov%d)
|
|---|
| 104 | CALL callocate(y%cov%d, (n*(n+1)/2))
|
|---|
| 105 |
|
|---|
| 106 | DO i = 1, n
|
|---|
| 107 | IF (ro_data%Lev2a%refrac(i) > 0.0_wp) THEN
|
|---|
| 108 | IF (ro_data%Lev2a%refrac_sigma(i) > 0.0_wp) THEN
|
|---|
| 109 | ! matrix_pp type, uplo = 'U'
|
|---|
| 110 | y%cov%d(i + i*(i-1)/2) = ro_data%Lev2a%refrac_sigma(i)**2
|
|---|
| 111 | ELSE
|
|---|
| 112 | y%cov_ok = .FALSE.
|
|---|
| 113 | END IF
|
|---|
| 114 | ELSE
|
|---|
| 115 | y%cov%d(i + i*(i-1)/2) = 0.0003_wp
|
|---|
| 116 | ENDIF
|
|---|
| 117 | END DO
|
|---|
| 118 |
|
|---|
| 119 | IF (ASSOCIATED(y%cov%e)) DEALLOCATE(y%cov%e)
|
|---|
| 120 | IF (ASSOCIATED(y%cov%f)) DEALLOCATE(y%cov%f)
|
|---|
| 121 | IF (ASSOCIATED(y%cov%s)) DEALLOCATE(y%cov%s)
|
|---|
| 122 |
|
|---|
| 123 | y%cov%fact_chol = .FALSE.
|
|---|
| 124 | y%cov%equi_chol = 'N'
|
|---|
| 125 |
|
|---|
| 126 | ! 2.7 Clean up
|
|---|
| 127 | ! ------------
|
|---|
| 128 |
|
|---|
| 129 | CALL message_set_routine(routine)
|
|---|
| 130 |
|
|---|
| 131 | END SUBROUTINE ropp_fm_roprof2obs1drefrac
|
|---|
