source: LMDZ5/branches/testing/libf/phymar/rrtm_taumol10.F90 @ 5407

Last change on this file since 5407 was 2160, checked in by Laurent Fairhead, 10 years ago

Merged trunk changes -r2070:2158 into testing branch. Compilation problems introduced by revision r2155 have been corrected by hand

File size: 2.3 KB
RevLine 
[2089]1!*******************************************************************************
2SUBROUTINE RRTM_TAUMOL10 (KLEV,TAU,&
3  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,&
4  &COLH2O,LAYTROP,PFRAC)
5
6!     BAND 10:  1390-1480 cm-1 (low - H2O; high - H2O)
7
8! Modifications
9!
10!     D Salmond   2000-05-15 speed-up
11!     JJMorcrette 2000-05-17 speed-up
12
13
14#include "tsmbkind.h"
15
16USE PARRRTM  , ONLY : JPLAY  ,JPBAND ,JPGPT  ,JPXSEC  , NGS9
17USE YOERRTWN , ONLY : NG     ,NSPA   ,NSPB
18USE YOERRTA10, ONLY : NG10   ,ABSA   ,ABSB   ,FRACREFA, FRACREFB, KA , KB
19
20!  Input
21!#include "yoeratm.h"
22
23!      REAL TAUAER(JPLAY)
24
25IMPLICIT NONE
26
27!  Output
28REAL_B :: TAU   (JPGPT,JPLAY)
29
30!     DUMMY INTEGER SCALARS
31INTEGER_M :: KLEV
32
33!- from AER
34REAL_B :: TAUAERL(JPLAY,JPBAND)
35
36!- from INTFAC     
37REAL_B :: FAC00(JPLAY)
38REAL_B :: FAC01(JPLAY)
39REAL_B :: FAC10(JPLAY)
40REAL_B :: FAC11(JPLAY)
41
42!- from INTIND
43INTEGER_M :: JP(JPLAY)
44INTEGER_M :: JT(JPLAY)
45INTEGER_M :: JT1(JPLAY)
46
47!- from PROFDATA             
48REAL_B :: COLH2O(JPLAY)
49INTEGER_M :: LAYTROP
50
51!- from SP             
52REAL_B :: PFRAC(JPGPT,JPLAY)
53
54INTEGER_M :: IND0(JPLAY),IND1(JPLAY)
55
56!     LOCAL INTEGER SCALARS
57INTEGER_M :: IG, LAY
58
59!      EQUIVALENCE (TAUAERL(1,10),TAUAER)
60
61!     Compute the optical depth by interpolating in ln(pressure) and
62!     temperature. 
63
64DO LAY = 1, LAYTROP
65  IND0(LAY) = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(10) + 1
66  IND1(LAY) = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(10) + 1
67ENDDO
68
69!-- DS_000515
70DO IG = 1, NG10
71  DO LAY = 1, LAYTROP
72!-- DS_000515
73    TAU (NGS9+IG,LAY) = COLH2O(LAY) *&
74     &(FAC00(LAY) * ABSA(IND0(LAY)  ,IG) +&
75     & FAC10(LAY) * ABSA(IND0(LAY)+1,IG) +&
76     & FAC01(LAY) * ABSA(IND1(LAY)  ,IG) +&
77     & FAC11(LAY) * ABSA(IND1(LAY)+1,IG)) &
78     &+ TAUAERL(LAY,10)
79    PFRAC(NGS9+IG,LAY) = FRACREFA(IG)
80  ENDDO
81ENDDO
82
83DO LAY = LAYTROP+1, KLEV
84  IND0(LAY) = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(10) + 1
85  IND1(LAY) = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(10) + 1
86ENDDO
87
88!-- JJM_000517
89DO IG = 1, NG10
90  DO LAY = LAYTROP+1, KLEV
91!-- JJM_000517
92    TAU (NGS9+IG,LAY) = COLH2O(LAY) *&
93     &(FAC00(LAY) * ABSB(IND0(LAY)  ,IG) +&
94     & FAC10(LAY) * ABSB(IND0(LAY)+1,IG) +&
95     & FAC01(LAY) * ABSB(IND1(LAY)  ,IG) +&
96     & FAC11(LAY) * ABSB(IND1(LAY)+1,IG)) &
97     &+ TAUAERL(LAY,10)
98    PFRAC(NGS9+IG,LAY) = FRACREFB(IG)
99  ENDDO
100ENDDO
101
102RETURN
103END SUBROUTINE RRTM_TAUMOL10
Note: See TracBrowser for help on using the repository browser.