[4773] | 1 | SUBROUTINE MODIFY_WV_CONTINUUM(NWVCONTINUUM) |
---|
| 2 | |
---|
| 3 | ! MODIFY_WV_CONTINUUM - Adjust the shortwave continuum coefficients |
---|
| 4 | ! |
---|
| 5 | ! PURPOSE |
---|
| 6 | ! ------- |
---|
| 7 | ! The default water vapour continuum model in SRTM is MT_CKD 2.5, |
---|
| 8 | ! but some measurement programmes, notably from the CAVIAR project |
---|
| 9 | ! (Shine et al., J. Mol. Spectrosc., 2016) suggest a much stronger |
---|
| 10 | ! absorption in the near infrared. This routine provides the option |
---|
| 11 | ! to implement an approximate scaling of the shortwave continuum |
---|
| 12 | ! coefficients to match the CAVIAR continuum. Further details on the |
---|
| 13 | ! impact were provided by Hogan et al. (2017, ECMWF Tech. Memo. 816). |
---|
| 14 | ! |
---|
| 15 | ! INTERFACE |
---|
| 16 | ! --------- |
---|
| 17 | ! This routine is called from SUECRAD. If its argument is 0, it does |
---|
| 18 | ! nothing so that the default SRTM continuum is used. If its |
---|
| 19 | ! argument is 1 then it implements the CAVIAR continuum by scaling |
---|
| 20 | ! coefficients within the relevant SRTM modules. |
---|
| 21 | ! |
---|
| 22 | ! AUTHOR |
---|
| 23 | ! ------ |
---|
| 24 | ! Robin Hogan, ECMWF |
---|
| 25 | ! Original: 2018-02-21 |
---|
| 26 | ! |
---|
| 27 | ! MODIFICATIONS |
---|
| 28 | ! ------------- |
---|
| 29 | ! |
---|
| 30 | ! ----------------------------------------------------------------------- |
---|
| 31 | |
---|
| 32 | USE PARKIND1 , ONLY : JPIM, JPRB |
---|
| 33 | USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK |
---|
| 34 | ! Load the coefficients for each relevant shortwave band |
---|
| 35 | USE YOESRTA16, ONLY : SELFREF16 => SELFREF, FORREF16 => FORREF |
---|
| 36 | USE YOESRTA17, ONLY : SELFREF17 => SELFREF, FORREF17 => FORREF |
---|
| 37 | USE YOESRTA18, ONLY : SELFREF18 => SELFREF, FORREF18 => FORREF |
---|
| 38 | USE YOESRTA19, ONLY : SELFREF19 => SELFREF, FORREF19 => FORREF |
---|
| 39 | USE YOESRTA20, ONLY : SELFREF20 => SELFREF, FORREF20 => FORREF |
---|
| 40 | USE YOESRTA21, ONLY : SELFREF21 => SELFREF, FORREF21 => FORREF |
---|
| 41 | USE YOESRTA22, ONLY : SELFREF22 => SELFREF, FORREF22 => FORREF |
---|
| 42 | USE YOESRTA23, ONLY : SELFREF23 => SELFREF, FORREF23 => FORREF |
---|
| 43 | USE YOESRTA29, ONLY : SELFREF29 => SELFREF, FORREF29 => FORREF |
---|
| 44 | |
---|
| 45 | IMPLICIT NONE |
---|
| 46 | |
---|
| 47 | ! CAVIAR continuum enhancements |
---|
| 48 | REAL(KIND=JPRB), PARAMETER :: SELF_ENH16(16) = (/ 2.42, 2.42, 2.91, 2.91, 2.52, & |
---|
| 49 | & 2.52, 2.53, 2.53, 2.51, 2.51, 2.51, 2.51, 2.58, 2.58, 2.58, 2.58 /) |
---|
| 50 | REAL(KIND=JPRB), PARAMETER :: FORE_ENH16(16) = (/ 3.38, 3.38, 3.19, 3.19, 1.21, & |
---|
| 51 | & 1.21, 1.09, 1.09, 1.07, 1.07, 1.07, 1.07, 1.12, 1.12, 1.12, 1.12 /) |
---|
| 52 | REAL(KIND=JPRB), PARAMETER :: SELF_ENH17(16) = (/ 2.18, 1.40, 1.09, 1.19, 1.02, 1.00, & |
---|
| 53 | & 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00 /) |
---|
| 54 | REAL(KIND=JPRB), PARAMETER :: FORE_ENH17(16) = (/ 3.17, 3.40, 1.66, 1.00, 1.00, 1.00, & |
---|
| 55 | & 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00 /) |
---|
| 56 | REAL(KIND=JPRB), PARAMETER :: SELF_ENH18(16) = (/ 9.67, 12.36, 9.22, 3.71, 1.12, 1.12, & |
---|
| 57 | & 0.53, 0.53, 0.49, 0.49, 0.49, 0.49, 0.35, 0.35, 0.35, 0.35 /) |
---|
| 58 | REAL(KIND=JPRB), PARAMETER :: FORE_ENH18(16) = (/ 38.90, 15.37, 16.55, 14.81, 4.91, 4.91, & |
---|
| 59 | & 2.59, 2.59, 2.21, 2.21, 2.21, 2.21, 1.77, 1.77, 1.77, 1.77 /) |
---|
| 60 | REAL(KIND=JPRB), PARAMETER :: SELF_ENH19(16) = (/ 28.53, 26.12, 19.14, 10.12, 3.69, & |
---|
| 61 | & 3.69, 1.63, 1.63, 2.52, 2.52, 2.52, 2.52, 2.40, 2.40, 2.40, 2.40 /) |
---|
| 62 | REAL(KIND=JPRB), PARAMETER :: FORE_ENH19(16) = (/ 11.66, 9.78, 9.57, 9.55, 4.96, & |
---|
| 63 | & 4.96, 2.68, 2.68, 2.61, 2.61, 2.61, 2.61, 2.37, 2.37, 2.37, 2.37 /) |
---|
| 64 | REAL(KIND=JPRB), PARAMETER :: SELF_ENH20(16) = (/ 4.93, 2.76, 1.23, 0.66, 1.41, & |
---|
| 65 | & 1.11, 1.07, 1.03, 1.03, 1.03, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00 /) |
---|
| 66 | REAL(KIND=JPRB), PARAMETER :: FORE_ENH20(16) = (/ 24.16, 9.04, 2.73, 2.17, 1.05, & |
---|
| 67 | & 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00 /) |
---|
| 68 | REAL(KIND=JPRB), PARAMETER :: SELF_ENH21(16) = (/ 9.70, 4.56, 0.99, 1.21, 1.37, & |
---|
| 69 | & 1.25, 0.94, 0.99, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00 /) |
---|
| 70 | REAL(KIND=JPRB), PARAMETER :: FORE_ENH21(16) = (/ 50.84, 19.27, 1.49, 1.16, 0.97, & |
---|
| 71 | & 1.64, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00 /) |
---|
| 72 | REAL(KIND=JPRB), PARAMETER :: SELF_ENH22(16) = (/ 3.37, 3.37, 3.37, 3.37, 3.37, & |
---|
| 73 | & 3.37, 3.37, 3.37, 1.42, 1.42, 1.42, 1.42, 1.42, 1.42, 1.42, 1.42 /) |
---|
| 74 | REAL(KIND=JPRB), PARAMETER :: FORE_ENH22(16) = (/ 12.31, 12.31, 12.31, 12.31, 12.31, & |
---|
| 75 | & 12.31, 12.31, 12.31, 3.20, 3.20, 3.20, 3.20, 3.20, 3.20, 3.20, 3.20 /) |
---|
| 76 | REAL(KIND=JPRB), PARAMETER :: SELF_ENH23(16) = (/ 1.00, 1.00, 1.19, 1.19, 1.65, & |
---|
| 77 | & 1.46, 1.32, 1.07, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00 /) |
---|
| 78 | REAL(KIND=JPRB), PARAMETER :: FORE_ENH23(16) = (/ 1.04, 1.04, 1.08, 1.08, 1.12, & |
---|
| 79 | & 1.10, 1.18, 1.06, 1.01, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00 /) |
---|
| 80 | REAL(KIND=JPRB), PARAMETER :: SELF_ENH29(16) = (/ 1.70, 1.00, 1.00, 1.03, 1.19, & |
---|
| 81 | & 1.19, 1.43, 1.43, 1.30, 1.30, 1.33, 1.33, 1.28, 1.28, 1.08, 1.23 /) |
---|
| 82 | REAL(KIND=JPRB), PARAMETER :: FORE_ENH29(16) = (/ 107.42, 5.87, 3.26, 2.42, 1.39, & |
---|
| 83 | & 1.39, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00 /) |
---|
| 84 | |
---|
| 85 | INTEGER(KIND=JPIM), INTENT(IN) :: NWVCONTINUUM |
---|
| 86 | |
---|
| 87 | INTEGER(KIND=JPIM) :: JG |
---|
| 88 | |
---|
| 89 | REAL(KIND=JPHOOK) :: ZHOOK_HANDLE |
---|
| 90 | |
---|
| 91 | IF (LHOOK) CALL DR_HOOK('MODIFY_WV_CONTINUUM',0,ZHOOK_HANDLE) |
---|
| 92 | ! ----------------------------------------------------------------------- |
---|
| 93 | |
---|
| 94 | IF (NWVCONTINUUM == 1) THEN |
---|
| 95 | ! Apply CAVIAR continuum enhancements |
---|
| 96 | DO JG = 1,16 |
---|
| 97 | FORREF16(:,JG) = FORREF16(:,JG) * FORE_ENH16(JG) |
---|
| 98 | SELFREF16(:,JG) = SELFREF16(:,JG) * SELF_ENH16(JG) |
---|
| 99 | ENDDO |
---|
| 100 | DO JG = 1,16 |
---|
| 101 | FORREF17(:,JG) = FORREF17(:,JG) * FORE_ENH17(JG) |
---|
| 102 | SELFREF17(:,JG) = SELFREF17(:,JG) * SELF_ENH17(JG) |
---|
| 103 | ENDDO |
---|
| 104 | DO JG = 1,16 |
---|
| 105 | FORREF18(:,JG) = FORREF18(:,JG) * FORE_ENH18(JG) |
---|
| 106 | SELFREF18(:,JG) = SELFREF18(:,JG) * SELF_ENH18(JG) |
---|
| 107 | ENDDO |
---|
| 108 | DO JG = 1,16 |
---|
| 109 | FORREF19(:,JG) = FORREF19(:,JG) * FORE_ENH19(JG) |
---|
| 110 | SELFREF19(:,JG) = SELFREF19(:,JG) * SELF_ENH19(JG) |
---|
| 111 | ENDDO |
---|
| 112 | DO JG = 1,16 |
---|
| 113 | FORREF20(:,JG) = FORREF20(:,JG) * FORE_ENH20(JG) |
---|
| 114 | SELFREF20(:,JG) = SELFREF20(:,JG) * SELF_ENH20(JG) |
---|
| 115 | ENDDO |
---|
| 116 | DO JG = 1,16 |
---|
| 117 | FORREF21(:,JG) = FORREF21(:,JG) * FORE_ENH21(JG) |
---|
| 118 | SELFREF21(:,JG) = SELFREF21(:,JG) * SELF_ENH21(JG) |
---|
| 119 | ENDDO |
---|
| 120 | DO JG = 1,16 |
---|
| 121 | FORREF22(:,JG) = FORREF22(:,JG) * FORE_ENH22(JG) |
---|
| 122 | SELFREF22(:,JG) = SELFREF22(:,JG) * SELF_ENH22(JG) |
---|
| 123 | ENDDO |
---|
| 124 | DO JG = 1,16 |
---|
| 125 | FORREF23(:,JG) = FORREF23(:,JG) * FORE_ENH23(JG) |
---|
| 126 | SELFREF23(:,JG) = SELFREF23(:,JG) * SELF_ENH23(JG) |
---|
| 127 | ENDDO |
---|
| 128 | DO JG = 1,16 |
---|
| 129 | FORREF29(:,JG) = FORREF29(:,JG) * FORE_ENH29(JG) |
---|
| 130 | SELFREF29(:,JG) = SELFREF29(:,JG) * SELF_ENH29(JG) |
---|
| 131 | ENDDO |
---|
| 132 | ENDIF |
---|
| 133 | |
---|
| 134 | ! ----------------------------------------------------------------------- |
---|
| 135 | |
---|
| 136 | IF (LHOOK) CALL DR_HOOK('MODIFY_WV_CONTINUUM',1,ZHOOK_HANDLE) |
---|
| 137 | |
---|
| 138 | END SUBROUTINE MODIFY_WV_CONTINUUM |
---|