source: LMDZ6/trunk/libf/phymar/rrtm_init_140gp.F90 @ 3472

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

Inclusion de la physique de MAR


Integration of MAR physics

File size: 2.4 KB
Line 
1!***************************************************************************
2SUBROUTINE RRTM_INIT_140GP
3!***************************************************************************
4!     Reformatted for F90 by JJMorcrette, ECMWF, 980714
5
6! Parameters
7#include "tsmbkind.h"
8
9USE PARRRTM  , ONLY : JPBAND   ,JPG      ,JPXSEC   ,JPGPT
10USE YOERRTWN , ONLY : NG       ,NSPA     ,NSPB
11USE YOERRTFTR, ONLY : NGC      ,NGS      ,NGN      ,NGB       ,NGM     , WT
12! Output
13USE YOERRTBG2, ONLY : CORR1    ,CORR2
14USE YOERRTRWT, ONLY : FREFA    ,FREFB    ,FREFADF  ,FREFBDF   ,RWGT
15
16! Local
17
18IMPLICIT NONE
19REAL_B :: WTSM(JPG)
20
21!     LOCAL INTEGER SCALARS
22INTEGER_M :: I, IBND, IG, IGC, IGCSM, IND, IPR, IPRSM, IPT
23
24!     LOCAL REAL SCALARS
25REAL_B :: FP, RTFP, WTSUM
26
27
28!  Calculate lookup tables for functions needed in routine TAUMOL (TAUGB2)
29CORR1(0) = _ONE_
30CORR1(200) = _ONE_
31CORR2(0) = _ONE_
32CORR2(200) = _ONE_
33DO I = 1,199
34  FP = 0.005_JPRB*REAL(I)
35  RTFP = SQRT(FP)
36  CORR1(I) = RTFP/FP
37  CORR2(I) = (_ONE_-RTFP)/(_ONE_-FP)
38ENDDO
39
40!  Perform g-point reduction from 16 per band (256 total points) to
41!  a band dependant number (140 total points) for all absorption
42!  coefficient input data and Planck fraction input data.
43!  Compute relative weighting for new g-point combinations.
44
45IGCSM = 0
46DO IBND = 1,JPBAND
47  IPRSM = 0
48  IF (NGC(IBND) < 16) THEN
49    DO IGC = 1,NGC(IBND)
50      IGCSM = IGCSM + 1
51      WTSUM = _ZERO_
52      DO IPR = 1, NGN(IGCSM)
53        IPRSM = IPRSM + 1
54        WTSUM = WTSUM + WT(IPRSM)
55      ENDDO
56      WTSM(IGC) = WTSUM
57    ENDDO
58    DO IG = 1,NG(IBND)
59      IND = (IBND-1)*16 + IG
60      RWGT(IND) = WT(IG)/WTSM(NGM(IND))
61    ENDDO
62  ELSE
63    DO IG = 1,NG(IBND)
64      IGCSM = IGCSM + 1
65      IND = (IBND-1)*16 + IG
66      RWGT(IND) = _ONE_
67    ENDDO
68  ENDIF
69ENDDO
70
71!  Initialize arrays for combined Planck fraction data.
72
73DO IPT = 1,13
74  DO IPR = 1, JPGPT
75    FREFA(IPR,IPT) = _ZERO_
76    FREFADF(IPR,IPT) = _ZERO_
77  ENDDO
78ENDDO
79DO IPT = 1,6
80  DO IPR = 1, JPGPT
81    FREFB(IPR,IPT) = _ZERO_
82    FREFBDF(IPR,IPT) = _ZERO_
83  ENDDO
84ENDDO
85
86!  Reduce g-points for relevant data in each LW spectral band.
87
88CALL RRTM_CMBGB1
89CALL RRTM_CMBGB2
90CALL RRTM_CMBGB3
91CALL RRTM_CMBGB4
92CALL RRTM_CMBGB5
93CALL RRTM_CMBGB6
94CALL RRTM_CMBGB7
95CALL RRTM_CMBGB8
96CALL RRTM_CMBGB9
97CALL RRTM_CMBGB10
98CALL RRTM_CMBGB11
99CALL RRTM_CMBGB12
100CALL RRTM_CMBGB13
101CALL RRTM_CMBGB14
102CALL RRTM_CMBGB15
103CALL RRTM_CMBGB16
104
105RETURN
106END SUBROUTINE RRTM_INIT_140GP
Note: See TracBrowser for help on using the repository browser.