[3880] | 1 | SUBROUTINE SRTM_KGB28 |
---|
| 2 | |
---|
| 3 | ! Originally by J.Delamere, Atmospheric & Environmental Research. |
---|
| 4 | ! Revision: 2.4 |
---|
| 5 | ! BAND 28: 38000-50000 cm-1 (low - O3,O2; high - O3,O2) |
---|
| 6 | ! Reformatted for F90 by JJMorcrette, ECMWF |
---|
| 7 | ! R. Elkhatib 12-10-2005 Split for faster and more robust compilation. |
---|
| 8 | ! G.Mozdzynski March 2011 read constants from files |
---|
| 9 | ! T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring. |
---|
| 10 | ! ------------------------------------------------------------------ |
---|
| 11 | |
---|
| 12 | USE PARKIND1 , ONLY : JPRB |
---|
| 13 | USE YOMHOOK , ONLY : LHOOK, DR_HOOK |
---|
| 14 | USE YOMLUN , ONLY : NULRAD |
---|
| 15 | USE YOMMP0 , ONLY : NPROC, MYPROC |
---|
| 16 | USE MPL_MODULE, ONLY : MPL_BROADCAST |
---|
| 17 | USE YOMTAG , ONLY : MTAGRAD |
---|
| 18 | USE YOESRTA28 , ONLY : KA, KB, KA_D, KB_D, SFLUXREF, RAYL, STRRAT, LAYREFFR |
---|
| 19 | |
---|
| 20 | ! ------------------------------------------------------------------ |
---|
| 21 | |
---|
| 22 | IMPLICIT NONE |
---|
| 23 | |
---|
| 24 | ! KURUCZ |
---|
| 25 | REAL(KIND=JPRB) :: ZHOOK_HANDLE |
---|
| 26 | |
---|
| 27 | #include "abor1.intfb.h" |
---|
| 28 | |
---|
| 29 | IF (LHOOK) CALL DR_HOOK('SRTM_KGB28',0,ZHOOK_HANDLE) |
---|
| 30 | |
---|
| 31 | IF( MYPROC==1 )THEN |
---|
| 32 | READ(NULRAD,ERR=1001) KA_D,KB_D |
---|
| 33 | KA = REAL(KA_D,JPRB) |
---|
| 34 | KB = REAL(KB_D,JPRB) |
---|
| 35 | ENDIF |
---|
| 36 | IF( NPROC>1 )THEN |
---|
| 37 | CALL MPL_BROADCAST (KA,MTAGRAD,1,CDSTRING='SRTM_KGB28:') |
---|
| 38 | CALL MPL_BROADCAST (KB,MTAGRAD,1,CDSTRING='SRTM_KGB28:') |
---|
| 39 | ENDIF |
---|
| 40 | |
---|
| 41 | SFLUXREF(:,1) = (/ & |
---|
| 42 | & 1.06156_JPRB , 0.599910_JPRB , 0.422462_JPRB , 0.400077_JPRB , & |
---|
| 43 | & 0.282221_JPRB , 0.187893_JPRB , 6.77357E-02_JPRB, 3.04572E-02_JPRB, & |
---|
| 44 | & 2.00442E-02_JPRB, 2.30786E-03_JPRB, 2.08824E-03_JPRB, 1.42604E-03_JPRB, & |
---|
| 45 | & 9.67384E-04_JPRB, 6.35362E-04_JPRB, 1.47727E-04_JPRB, 6.87639E-06_JPRB /) |
---|
| 46 | SFLUXREF(:,2) = (/ & |
---|
| 47 | & 1.07598_JPRB , 0.585099_JPRB , 0.422852_JPRB , 0.400077_JPRB , & |
---|
| 48 | & 0.282221_JPRB , 0.187893_JPRB , 6.69686E-02_JPRB, 3.09070E-02_JPRB, & |
---|
| 49 | & 2.02400E-02_JPRB, 2.47760E-03_JPRB, 1.89411E-03_JPRB, 1.41122E-03_JPRB, & |
---|
| 50 | & 1.12449E-03_JPRB, 5.73505E-04_JPRB, 2.04160E-04_JPRB, 1.58371E-05_JPRB /) |
---|
| 51 | SFLUXREF(:,3) = (/ & |
---|
| 52 | & 0.461647_JPRB , 0.406113_JPRB , 0.332506_JPRB , 0.307508_JPRB , & |
---|
| 53 | & 0.211167_JPRB , 0.235457_JPRB , 0.495886_JPRB , 0.363921_JPRB , & |
---|
| 54 | & 0.192700_JPRB , 2.04678E-02_JPRB, 1.55407E-02_JPRB, 1.03882E-02_JPRB, & |
---|
| 55 | & 1.10778E-02_JPRB, 1.00504E-02_JPRB, 4.93497E-03_JPRB, 5.73410E-04_JPRB /) |
---|
| 56 | SFLUXREF(:,4) = (/ & |
---|
| 57 | & 0.132669_JPRB , 0.175058_JPRB , 0.359263_JPRB , 0.388142_JPRB , & |
---|
| 58 | & 0.350359_JPRB , 0.475892_JPRB , 0.489593_JPRB , 0.408437_JPRB , & |
---|
| 59 | & 0.221049_JPRB , 1.94514E-02_JPRB, 1.54848E-02_JPRB, 1.44999E-02_JPRB, & |
---|
| 60 | & 1.44568E-02_JPRB, 1.00527E-02_JPRB, 4.95897E-03_JPRB, 5.73327E-04_JPRB /) |
---|
| 61 | SFLUXREF(:,5) = (/ & |
---|
| 62 | & 7.54800E-02_JPRB, 0.232246_JPRB , 0.359263_JPRB , 0.388142_JPRB , & |
---|
| 63 | & 0.350359_JPRB , 0.426317_JPRB , 0.493485_JPRB , 0.432016_JPRB , & |
---|
| 64 | & 0.239203_JPRB , 1.74951E-02_JPRB, 1.74477E-02_JPRB, 1.83566E-02_JPRB, & |
---|
| 65 | & 1.44818E-02_JPRB, 1.01048E-02_JPRB, 4.97487E-03_JPRB, 5.66831E-04_JPRB /) |
---|
| 66 | |
---|
| 67 | ! Rayleigh extinction coefficient at v = ????? cm-1. |
---|
| 68 | RAYL = 2.02E-05_JPRB |
---|
| 69 | |
---|
| 70 | STRRAT = 6.67029E-07_JPRB |
---|
| 71 | |
---|
| 72 | LAYREFFR = 58 |
---|
| 73 | ! The following improves this band (Eli Mlawer, personal |
---|
| 74 | ! communication, confirmed by comparison with LBLRTM) |
---|
| 75 | !LAYREFFR = 40 |
---|
| 76 | |
---|
| 77 | ! ------------------------------------------------------------------ |
---|
| 78 | |
---|
| 79 | ! The array KA contains absorption coefs at the 16 chosen g-values |
---|
| 80 | ! for a range of pressure levels> ~100mb, temperatures, and binary |
---|
| 81 | ! species parameters (see taumol.f for definition). The first |
---|
| 82 | ! index in the array, JS, runs from 1 to 9, and corresponds to |
---|
| 83 | ! different values of the binary species parameter. For instance, |
---|
| 84 | ! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, |
---|
| 85 | ! JS = 3 corresponds to the parameter value 2/8, etc. The second index |
---|
| 86 | ! in the array, JT, which runs from 1 to 5, corresponds to different |
---|
| 87 | ! temperatures. More specifically, JT = 3 means that the data are for |
---|
| 88 | ! the reference temperature TREF for this pressure level, JT = 2 refers |
---|
| 89 | ! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 |
---|
| 90 | ! is for TREF+30. The third index, JP, runs from 1 to 13 and refers |
---|
| 91 | ! to the JPth reference pressure level (see taumol.f for these levels |
---|
| 92 | ! in mb). The fourth index, IG, goes from 1 to 16, and indicates |
---|
| 93 | ! which g-interval the absorption coefficients are for. |
---|
| 94 | ! ----------------------------------------------------------------- |
---|
| 95 | |
---|
| 96 | ! ----------------------------------------------------------------- |
---|
| 97 | ! The array KB contains absorption coefs at the 16 chosen g-values |
---|
| 98 | ! for a range of pressure levels < ~100mb and temperatures. The first |
---|
| 99 | ! index in the array, JT, which runs from 1 to 5, corresponds to |
---|
| 100 | ! different temperatures. More specifically, JT = 3 means that the |
---|
| 101 | ! data are for the reference temperature TREF for this pressure |
---|
| 102 | ! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for |
---|
| 103 | ! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. |
---|
| 104 | ! The second index, JP, runs from 13 to 59 and refers to the JPth |
---|
| 105 | ! reference pressure level (see taumol.f for the value of these |
---|
| 106 | ! pressure levels in mb). The third index, IG, goes from 1 to 16, |
---|
| 107 | ! and tells us which g-interval the absorption coefficients are for. |
---|
| 108 | ! ----------------------------------------------------------------- |
---|
| 109 | |
---|
| 110 | |
---|
| 111 | IF (LHOOK) CALL DR_HOOK('SRTM_KGB28',1,ZHOOK_HANDLE) |
---|
| 112 | RETURN |
---|
| 113 | |
---|
| 114 | 1001 CONTINUE |
---|
| 115 | CALL ABOR1("SRTM_KGB28:ERROR READING FILE RADSRTM") |
---|
| 116 | |
---|
| 117 | END SUBROUTINE SRTM_KGB28 |
---|