source: LMDZ6/trunk/libf/phylmd/ecrad/ifsrrtm/rrtm_taumol10.F90 @ 4824

Last change on this file since 4824 was 4773, checked in by idelkadi, 12 months ago
  • Update of Ecrad in LMDZ The same organization of the Ecrad offline version is retained in order to facilitate the updating of Ecrad in LMDZ and the comparison between online and offline results. version 1.6.1 of Ecrad (​https://github.com/lguez/ecrad.git)
  • Implementation of the double call of Ecrad in LMDZ


File size: 4.7 KB
Line 
1!*******************************************************************************
2SUBROUTINE RRTM_TAUMOL10 (KIDIA,KFDIA,KLEV,P_TAU,&
3 & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,&
4 & P_COLH2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC) 
5
6!     BAND 10:  1390-1480 cm-1 (low - H2O; high - H2O)
7
8!     AUTHOR.
9!     -------
10!     JJMorcrette, ECMWF
11
12!     MODIFICATIONS.
13!     --------------
14!      M.Hamrud      01-Oct-2003 CY28 Cleaning
15!      NEC           25-Oct-2007 Optimisations
16!      JJMorcrette 20110613 flexible number of g-points
17!      ABozzo 201306 updated to rrtmg v4.85
18! ---------------------------------------------------------------------------
19
20USE PARKIND1  ,ONLY : JPIM     ,JPRB
21USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK, JPHOOK
22
23USE PARRRTM  , ONLY : JPBAND
24USE YOERRTM  , ONLY : JPGPT  ,NG10   ,NGS9
25USE YOERRTWN , ONLY : NSPA   ,NSPB
26USE YOERRTA10, ONLY : ABSA   ,ABSB   ,FRACREFA, FRACREFB, FORREF   ,SELFREF
27
28IMPLICIT NONE
29
30INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
31INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
32INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
33REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV)
34REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
35REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV)
36REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV)
37REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV)
38REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV)
39INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV)
40INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV)
41INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV)
42REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV)
43INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA)
44REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV)
45
46REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV)
47REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
48INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV)
49INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDFOR(KIDIA:KFDIA,KLEV)
50REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFRAC(KIDIA:KFDIA,KLEV)
51REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFAC(KIDIA:KFDIA,KLEV)
52! ---------------------------------------------------------------------------
53
54INTEGER(KIND=JPIM) :: IND0(KLEV),IND1(KLEV)
55INTEGER(KIND=JPIM) :: INDS(KLEV),INDF(KLEV)
56
57INTEGER(KIND=JPIM) :: IG, JLAY
58INTEGER(KIND=JPIM) :: JLON
59REAL(KIND=JPRB) :: ZTAUFOR,ZTAUSELF
60REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
61
62!     Compute the optical depth by interpolating in ln(pressure) and
63!     temperature. 
64
65ASSOCIATE(NFLEVG=>KLEV)
66IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL10',0,ZHOOK_HANDLE)
67
68DO JLAY = 1, KLEV
69  DO JLON = KIDIA, KFDIA
70    IF (JLAY <= K_LAYTROP(JLON)) THEN
71      IND0(JLAY) = ((K_JP(JLON,JLAY)-1)*5+(K_JT(JLON,JLAY)-1))*NSPA(10) + 1
72      IND1(JLAY) = (K_JP(JLON,JLAY)*5+(K_JT1(JLON,JLAY)-1))*NSPA(10) + 1
73      INDS(JLAY) = K_INDSELF(JLON,JLAY)
74      INDF(JLAY) = K_INDFOR(JLON,JLAY)
75
76!-- DS_000515
77!CDIR UNROLL=NG10
78      DO IG = 1, NG10
79
80        ZTAUSELF = P_SELFFAC(JLON,JLAY) * (SELFREF(INDS(JLAY),IG) + P_SELFFRAC(JLON,JLAY) * &
81                 & (SELFREF(INDS(JLAY)+1,IG) - SELFREF(INDS(JLAY),IG)))
82        ZTAUFOR =  P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + P_FORFRAC(JLON,JLAY) * &
83                 & (FORREF(INDF(JLAY)+1,IG) - FORREF(INDF(JLAY),IG)))
84!-- DS_000515
85        P_TAU(JLON,NGS9+IG,JLAY) = P_COLH2O(JLON,JLAY) *&
86         & (P_FAC00(JLON,JLAY) * ABSA(IND0(JLAY)  ,IG) +&
87         & P_FAC10(JLON,JLAY) * ABSA(IND0(JLAY)+1,IG) +&
88         & P_FAC01(JLON,JLAY) * ABSA(IND1(JLAY)  ,IG) +&
89         & P_FAC11(JLON,JLAY) * ABSA(IND1(JLAY)+1,IG)) + &
90         & ZTAUSELF + ZTAUFOR &
91         & + P_TAUAERL(JLON,JLAY,10) 
92        PFRAC(JLON,NGS9+IG,JLAY) = FRACREFA(IG)
93      ENDDO
94    ENDIF
95
96    IF (JLAY > K_LAYTROP(JLON)) THEN
97      IND0(JLAY) = ((K_JP(JLON,JLAY)-13)*5+(K_JT(JLON,JLAY)-1))*NSPB(10) + 1
98      IND1(JLAY) = ((K_JP(JLON,JLAY)-12)*5+(K_JT1(JLON,JLAY)-1))*NSPB(10) + 1
99      INDF(JLAY) = K_INDFOR(JLON,JLAY)
100!-- JJM_000517
101!CDIR UNROLL=NG10
102      DO IG = 1, NG10
103        ZTAUFOR = P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + &
104                &  P_FORFRAC(JLON,JLAY) * (FORREF(INDF(JLAY)+1,IG) - FORREF(INDF(JLAY),IG)))
105!-- JJM_000517
106        P_TAU(JLON,NGS9+IG,JLAY) = P_COLH2O(JLON,JLAY) *&
107         & (P_FAC00(JLON,JLAY) * ABSB(IND0(JLAY)  ,IG) +&
108         & P_FAC10(JLON,JLAY) * ABSB(IND0(JLAY)+1,IG) +&
109         & P_FAC01(JLON,JLAY) * ABSB(IND1(JLAY)  ,IG) +&
110         & P_FAC11(JLON,JLAY) * ABSB(IND1(JLAY)+1,IG)) &
111         & + ZTAUFOR + P_TAUAERL(JLON,JLAY,10) 
112        PFRAC(JLON,NGS9+IG,JLAY) = FRACREFB(IG)
113      ENDDO
114    ENDIF
115  ENDDO
116ENDDO
117
118IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL10',1,ZHOOK_HANDLE)
119
120END ASSOCIATE
121END SUBROUTINE RRTM_TAUMOL10
Note: See TracBrowser for help on using the repository browser.