| 1 | SUBROUTINE SRTM_KGB25 |
|---|
| 2 | |
|---|
| 3 | ! Originally by J.Delamere, Atmospheric & Environmental Research. |
|---|
| 4 | ! Revision: 2.4 |
|---|
| 5 | ! BAND 25: 16000-22650 cm-1 (low - H2O; high - nothing) |
|---|
| 6 | ! Reformatted for F90 by JJMorcrette, ECMWF |
|---|
| 7 | ! G.Mozdzynski March 2011 read constants from files |
|---|
| 8 | ! T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring. |
|---|
| 9 | ! F. Vana 05-Mar-2015 Support for single precision |
|---|
| 10 | ! ------------------------------------------------------------------ |
|---|
| 11 | |
|---|
| 12 | USE PARKIND1 , ONLY : JPRB |
|---|
| 13 | USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK |
|---|
| 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 YOESRTA25 , ONLY : KA, SFLUXREF, RAYL, ABSO3A, ABSO3B, LAYREFFR, KA_D |
|---|
| 19 | |
|---|
| 20 | ! ------------------------------------------------------------------ |
|---|
| 21 | |
|---|
| 22 | IMPLICIT NONE |
|---|
| 23 | |
|---|
| 24 | ! KURUCZ |
|---|
| 25 | REAL(KIND=JPHOOK) :: ZHOOK_HANDLE |
|---|
| 26 | |
|---|
| 27 | #include "abor1.intfb.h" |
|---|
| 28 | |
|---|
| 29 | IF (LHOOK) CALL DR_HOOK('SRTM_KGB25',0,ZHOOK_HANDLE) |
|---|
| 30 | |
|---|
| 31 | IF( MYPROC==1 )THEN |
|---|
| 32 | READ(NULRAD,ERR=1001) KA_D |
|---|
| 33 | KA = REAL(KA_D,JPRB) |
|---|
| 34 | ENDIF |
|---|
| 35 | IF( NPROC>1 )THEN |
|---|
| 36 | CALL MPL_BROADCAST (KA,MTAGRAD,1,CDSTRING='SRTM_KGB25:') |
|---|
| 37 | ENDIF |
|---|
| 38 | |
|---|
| 39 | SFLUXREF = (/ & |
|---|
| 40 | & 42.6858_JPRB , 45.7720_JPRB, 44.9872_JPRB, 45.9662_JPRB , & |
|---|
| 41 | & 46.5458_JPRB , 41.6926_JPRB, 32.2893_JPRB, 24.0928_JPRB , & |
|---|
| 42 | & 16.7686_JPRB , 1.86048_JPRB, 1.54057_JPRB, 1.23503_JPRB , & |
|---|
| 43 | & 0.915085_JPRB,0.590099_JPRB,0.218622_JPRB, 3.21287E-02_JPRB /) |
|---|
| 44 | |
|---|
| 45 | ! Rayleigh extinction coefficient at v = 2925 cm-1. |
|---|
| 46 | RAYL = (/ & |
|---|
| 47 | & 9.81132E-07_JPRB,8.25605E-07_JPRB,6.71302E-07_JPRB,5.53556E-07_JPRB, & |
|---|
| 48 | & 3.97383E-07_JPRB,3.68206E-07_JPRB,4.42379E-07_JPRB,4.57799E-07_JPRB, & |
|---|
| 49 | & 4.22683E-07_JPRB,3.87113E-07_JPRB,3.79810E-07_JPRB,3.63192E-07_JPRB, & |
|---|
| 50 | & 3.51921E-07_JPRB,3.34231E-07_JPRB,3.34294E-07_JPRB,3.32673E-07_JPRB /) |
|---|
| 51 | |
|---|
| 52 | ABSO3A = (/ & |
|---|
| 53 | & 2.32664E-02_JPRB,5.76154E-02_JPRB,0.125389_JPRB,0.250158_JPRB, & |
|---|
| 54 | & 0.378756_JPRB ,0.402196_JPRB ,0.352026_JPRB,0.352036_JPRB, & |
|---|
| 55 | & 0.386253_JPRB ,0.414598_JPRB ,0.420079_JPRB,0.435471_JPRB, & |
|---|
| 56 | & 0.445487_JPRB ,0.459549_JPRB ,0.452920_JPRB,0.456838_JPRB /) |
|---|
| 57 | |
|---|
| 58 | ABSO3B = (/ & |
|---|
| 59 | & 1.76917E-02_JPRB,4.64185E-02_JPRB,1.03640E-01_JPRB,0.189469_JPRB, & |
|---|
| 60 | & 0.303858_JPRB ,0.400248_JPRB ,0.447357_JPRB ,0.470009_JPRB, & |
|---|
| 61 | & 0.498673_JPRB ,0.515696_JPRB ,0.517053_JPRB ,0.517930_JPRB, & |
|---|
| 62 | & 0.518345_JPRB ,0.524952_JPRB ,0.508244_JPRB ,0.468981_JPRB /) |
|---|
| 63 | |
|---|
| 64 | LAYREFFR = 2 |
|---|
| 65 | |
|---|
| 66 | ! ------------------------------------------------------------------ |
|---|
| 67 | |
|---|
| 68 | ! The array KA contains absorption coefs at the 16 chosen g-values |
|---|
| 69 | ! for a range of pressure levels> ~100mb, temperatures, and binary |
|---|
| 70 | ! species parameters (see taumol.f for definition). The first |
|---|
| 71 | ! index in the array, JS, runs from 1 to 9, and corresponds to |
|---|
| 72 | ! different values of the binary species parameter. For instance, |
|---|
| 73 | ! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, |
|---|
| 74 | ! JS = 3 corresponds to the parameter value 2/8, etc. The second index |
|---|
| 75 | ! in the array, JT, which runs from 1 to 5, corresponds to different |
|---|
| 76 | ! temperatures. More specifically, JT = 3 means that the data are for |
|---|
| 77 | ! the reference temperature TREF for this pressure level, JT = 2 refers |
|---|
| 78 | ! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 |
|---|
| 79 | ! is for TREF+30. The third index, JP, runs from 1 to 13 and refers |
|---|
| 80 | ! to the JPth reference pressure level (see taumol.f for these levels |
|---|
| 81 | ! in mb). The fourth index, IG, goes from 1 to 16, and indicates |
|---|
| 82 | ! which g-interval the absorption coefficients are for. |
|---|
| 83 | ! ----------------------------------------------------------------- |
|---|
| 84 | |
|---|
| 85 | ! ----------------------------------------------------------------- |
|---|
| 86 | IF (LHOOK) CALL DR_HOOK('SRTM_KGB25',1,ZHOOK_HANDLE) |
|---|
| 87 | RETURN |
|---|
| 88 | |
|---|
| 89 | 1001 CONTINUE |
|---|
| 90 | CALL ABOR1("SRTM_KGB25:ERROR READING FILE RADSRTM") |
|---|
| 91 | |
|---|
| 92 | END SUBROUTINE SRTM_KGB25 |
|---|
