source: LMDZ5/branches/IPSLCM5A2.1_ISO/libf/phyiso/rrtm/surrtab.F90 @ 5308

Last change on this file since 5308 was 3331, checked in by acozic, 6 years ago

Add modification for isotopes

  • Property svn:executable set to *
File size: 877 bytes
RevLine 
[3331]1SUBROUTINE SURRTAB
2
3!     -----------------------------------------------------------------
4!        * E.C.M.W.F. PHYSICS PACKAGE ** AER'S RRTM LW RADIATION **
5
6!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
7
8!     -----------------------------------------------------------------
9
10USE PARKIND1  ,ONLY : JPIM     ,JPRB
11USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
12
13USE YOERRTAB , ONLY : TRANS, BPADE
14
15IMPLICIT NONE
16
17INTEGER(KIND=JPIM) :: ITR
18
19REAL(KIND=JPRB) :: ZTAU, ZTFN
20REAL(KIND=JPRB) :: ZHOOK_HANDLE
21
22IF (LHOOK) CALL DR_HOOK('SURRTAB',0,ZHOOK_HANDLE)
23BPADE=1.0_JPRB/0.278_JPRB
24TRANS(0)   =1.0_JPRB
25TRANS(5000)=0.0_JPRB
26DO ITR=1,4999
27  ZTFN=REAL(ITR)/5000._JPRB
28  ZTAU=BPADE*ZTFN/(1.0_JPRB-ZTFN)
29  TRANS(ITR)=EXP(-ZTAU)
30ENDDO
31
32!     -----------------------------------------------------------------
33
34IF (LHOOK) CALL DR_HOOK('SURRTAB',1,ZHOOK_HANDLE)
35END SUBROUTINE SURRTAB
Note: See TracBrowser for help on using the repository browser.