source: LMDZ5/branches/IPSLCM5A2.1_ISO/libf/phyiso/rrtm/suwavedi_mod.F90 @ 3331

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

Add modification for isotopes

  • Property svn:executable set to *
File size: 5.0 KB
Line 
1MODULE SUWAVEDI_MOD
2CONTAINS
3SUBROUTINE SUWAVEDI(KSMAX,KTMAX,KPRTRW,KMYSETW,KASM0,KSPOLEGL,KPROCM,&
4                    &KUMPP,KSPEC,KSPEC2,KSPEC2MX,KPOSSP,KMYMS,&
5                    &KPTRMS,KALLMS,KDIM0G)
6
7!**** *SUWAVEDI * - Routine to initialize spectral wave distribution
8
9!     Purpose.
10!     --------
11!           Initialize arrays controlling spectral wave distribution
12
13!**   Interface.
14!     ----------
15!        *CALL* *SUWAVEDI *
16
17!        Explicit arguments :
18!        --------------------
19!           KSMAX    - Spectral truncation limit (input)
20!           KTMAX    - Overtruncation for KSMAX (input)
21!           KPRTRW   - Number of processors in A-direction (input)
22!           KMYSETW  - A-set for present processor (input)
23!           KASM0    - Offsets for spectral waves (output)
24!           KSPOLEGL - Local version of NSPOLEG (output)
25!           KPROCM   - Where a certain spectral wave belongs  (output)
26!           KUMPP    - Number of spectral waves on this PE (output)
27!           KSPEC    - Local version on NSPEC (output)
28!           KSPEC2   - Local version on NSPEC2 (output)
29!           KSPEC2MX - Maximum KSPEC2 across PEs (output)
30!           KPOSSP   - Global spectral fields partitioning (output)
31!           KMYMS    - This PEs spectral zonal wavenumbers (output)
32
33!        Implicit arguments : NONE
34!        --------------------
35
36!     Method.
37!     -------
38!        See documentation
39
40!     Externals.   NONE.
41!     ----------
42
43!     Reference.
44!     ----------
45!        ECMWF Research Department documentation of the IFS
46
47!     Author.
48!     -------
49!        MPP Group *ECMWF*
50
51!     Modifications.
52!     --------------
53!        Original : 96-01-10
54!        L.Isaksen: 96-02-02 - Calculation of KSPEC2MX added
55!        K.YESSAD : 97-02-18 - Add KTMAX, bug correction for KSPOLEGL.
56!     ------------------------------------------------------------------
57
58USE PARKIND1  ,ONLY : JPIM     ,JPRB
59
60IMPLICIT NONE
61
62
63!     DUMMY
64INTEGER(KIND=JPIM),INTENT(IN)  :: KSMAX
65INTEGER(KIND=JPIM),INTENT(IN)  :: KTMAX
66INTEGER(KIND=JPIM),INTENT(IN)  :: KPRTRW
67INTEGER(KIND=JPIM),INTENT(IN)  :: KMYSETW
68INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KSPEC
69INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KSPEC2
70INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KSPEC2MX
71INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KSPOLEGL
72
73INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KASM0(0:KSMAX)
74INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KPROCM(0:KSMAX)
75INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KUMPP(KPRTRW)
76INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KMYMS(KSMAX+1)
77INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KPOSSP(KPRTRW+1)
78INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KPTRMS(KPRTRW)
79INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KALLMS(KSMAX+1)
80INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KDIM0G(0:KSMAX)
81
82!     LOCAL
83INTEGER(KIND=JPIM) :: IK, IL, IND, IPOS, ISPEC2P, JA, JM,JMLOC,IM
84INTEGER(KIND=JPIM) :: ISPOLEGL,ISPEC2MX,IASM0(0:KSMAX),IPROCM(0:KSMAX)
85INTEGER(KIND=JPIM) :: IUMPP(KPRTRW),IMYMS(KSMAX+1),IPOSSP(KPRTRW+1)
86INTEGER(KIND=JPIM) :: IPTRMS(KPRTRW),IALLMS(KSMAX+1),IDIM0G(0:KSMAX)
87INTEGER(KIND=JPIM) :: ISPEC(KPRTRW),IC(KPRTRW)
88
89
90!      -----------------------------------------------------------------
91
92!*       1.    Initialize partitioning of wave numbers to PEs
93!              ----------------------------------------------
94
95ISPEC(:) = 0
96
97IUMPP(:) = 0
98IASM0(:) = -99
99ISPOLEGL = 0
100
101IL  = 1
102IND = 1
103IK  = 0
104IPOS = 1
105DO JM=0,KSMAX
106  IK = IK + IND
107  IF (IK > KPRTRW) THEN
108    IK = KPRTRW
109    IND = -1
110  ELSEIF (IK < 1) THEN
111    IK = 1
112    IND = 1
113  ENDIF
114  IPROCM(JM) = IK
115  ISPEC(IK) = ISPEC(IK)+KSMAX-JM+1
116  IUMPP(IK) = IUMPP(IK)+1
117  IF (IK == KMYSETW) THEN
118    ISPOLEGL = ISPOLEGL +KTMAX+1-JM+1
119    IMYMS(IL) = JM
120    IASM0(JM) = IPOS
121    IPOS = IPOS+(KSMAX-JM+1)*2
122    IL = IL+1
123  ENDIF
124ENDDO
125
126IPOSSP(1) = 1
127ISPEC2P = 2*ISPEC(1)
128ISPEC2MX = ISPEC2P
129IPTRMS(1) = 1
130DO JA=2,KPRTRW
131  IPOSSP(JA) = IPOSSP(JA-1)+ISPEC2P
132  ISPEC2P = 2*ISPEC(JA)
133  ISPEC2MX = MAX(ISPEC2MX,ISPEC2P)
134! pointer to the first wave number of a given wave-set in NALLMS array
135  IPTRMS(JA) = IPTRMS(JA-1)+IUMPP(JA-1)
136ENDDO
137IPOSSP(KPRTRW+1) = IPOSSP(KPRTRW)+ISPEC2P
138
139!  IALLMS :  wave numbers for all wave-set concatenated together to give all
140!            wave numbers in wave-set order.
141IC(:) = 0
142DO JM=0,KSMAX
143  IALLMS(IC(IPROCM(JM))+IPTRMS(IPROCM(JM))) = JM
144  IC(IPROCM(JM)) = IC(IPROCM(JM))+1
145ENDDO
146
147IPOS = 1
148DO JA=1,KPRTRW
149  DO JMLOC=1,IUMPP(JA)
150    IM = IALLMS(IPTRMS(JA)+JMLOC-1)
151    IDIM0G(IM) = IPOS
152    IPOS = IPOS+(KSMAX+1-IM)*2
153  ENDDO
154ENDDO
155
156IF(PRESENT(KSPEC))    KSPEC  = ISPEC(KMYSETW)
157IF(PRESENT(KSPEC2))   KSPEC2 = 2*ISPEC(KMYSETW)
158IF(PRESENT(KSPEC2MX)) KSPEC2MX = ISPEC2MX
159IF(PRESENT(KSPOLEGL)) KSPOLEGL = ISPOLEGL
160
161IF(PRESENT(KASM0))  KASM0(:)  = IASM0(:)
162IF(PRESENT(KPROCM)) KPROCM(:) = IPROCM(:)
163IF(PRESENT(KUMPP))  KUMPP(:)  = IUMPP(:)
164IF(PRESENT(KMYMS))  KMYMS(:)  = IMYMS(:)
165IF(PRESENT(KPOSSP)) KPOSSP(:) = IPOSSP(:)
166IF(PRESENT(KPTRMS)) KPTRMS(:) = IPTRMS(:)
167IF(PRESENT(KALLMS)) KALLMS(:) = IALLMS(:)
168IF(PRESENT(KDIM0G)) KDIM0G(:) = IDIM0G(:)
169
170END SUBROUTINE SUWAVEDI
171END MODULE SUWAVEDI_MOD
172
173
Note: See TracBrowser for help on using the repository browser.