source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/rrtm/set2pe_mod.F90

Last change on this file was 1990, checked in by Laurent Fairhead, 11 years ago

Corrections à la version r1989 pour permettre la compilation avec RRTM
Inclusion de la licence CeCILL_V2 pour RRTM


Changes to revision r1989 to enable RRTM code compilation
RRTM part put under CeCILL_V2 licence

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 3.4 KB
Line 
1MODULE SET2PE_MOD
2CONTAINS
3SUBROUTINE SET2PE(KPE,KPRGPNS,KPRGPEW,KPRTRW,KPRTRV)
4
5#ifdef DOC
6
7!**** *SET2PE* - Convert from set numbers to PE number
8
9!     Purpose.
10!     --------
11!        Convert from set numbers in either grid-point space or spectral space
12!        to PE number
13
14!**   Interface.
15!     ----------
16!        *CALL* *SET2PE(KPRGPNS,KPRGPEW,KPRTRW,KPRTRV,KPE)
17
18!        Explicit arguments : 
19!        --------------------
20
21!                  input :  KPRGPNS - integer A set number in grid space
22!                                     in the range 1 .. NPRGPNS
23!                           KPRGPEW - integer B set number in grid space
24!                                     in the range 1 .. NPRGPEW
25!                           KPRTRW  - integer A set number in spectral space
26!                                     in the range 1 .. NPRTRW
27!                           KPRTRV  - integer B set number in spectral space
28!                                     in the range 1 .. NPRTRV
29!                  output:  KPE     - integer processor number
30!                                     in the range 1 .. NPROC
31
32!                  Normally, one pair of input set numbers will be set to zero
33!                  SET2PE will compute KPE from the first pair if they are valid numbers.
34!                  else from the other pair,
35
36!        Implicit arguments :  YOMMP parameters
37!                              NPRGPNS,NPRGPEW,NPRTRW,NPRTRV,NPROC
38
39!        --------------------
40!     Method.
41!     -------
42
43!     Externals.
44!     ----------
45!         NONE
46
47!     Reference.
48!     ----------
49!        ECMWF Research Department documentation of the IFS
50
51!     Author.
52!     -------
53!        David Dent *ECMWF*
54
55!     Modifications.
56!     --------------
57!        Original : 98-08-19
58!     ------------------------------------------------------------------
59#endif
60
61USE PARKIND1  ,ONLY : JPIM     ,JPRB
62
63USE TPM_DISTR
64USE EQ_REGIONS_MOD
65USE ABORT_TRANS_MOD
66
67IMPLICIT NONE
68INTEGER(KIND=JPIM),INTENT(IN) :: KPRGPNS,KPRGPEW,KPRTRW,KPRTRV
69INTEGER(KIND=JPIM),INTENT(OUT)  :: KPE
70
71INTEGER(KIND=JPIM) :: IPE,JA
72!     ------------------------------------------------------------------
73
74!*       1.    Choose from input parameters
75!              ----------------------------
76
77IF(KPRGPNS > 0.AND.KPRGPEW > 0) THEN
78
79  IF( LEQ_REGIONS )THEN
80    IF( KPRGPNS > N_REGIONS_NS )THEN
81      WRITE(*,'(A,2I8)') ' SET2PE INVALID ARGUMENT ',KPRGPNS,N_REGIONS_NS
82      CALL ABOR1(' SET2PE INVALID ARGUMENT ')
83    ENDIF
84    IF( KPRGPEW > N_REGIONS(KPRGPNS) )THEN
85      WRITE(*,'(A,2I8)') ' SET2PE INVALID ARGUMENT ',KPRGPEW,N_REGIONS(KPRGPNS)
86      CALL ABOR1(' SET2PE INVALID ARGUMENT ')
87    ENDIF
88    KPE=0
89    DO JA=1,KPRGPNS-1
90      KPE=KPE+N_REGIONS(JA)
91    ENDDO
92    KPE=KPE+KPRGPEW   
93  ELSE
94    IF(KPRGPNS <= NPRGPNS.AND.KPRGPEW <= NPRGPEW) THEN
95
96!*       2.    Grid-space set values supplied
97!              ------------------------------
98
99      KPE=(KPRGPNS-1)*NPRGPEW + KPRGPEW
100    ELSE
101      WRITE(*,'(A,2I8)') ' SET2PE INVALID ARGUMENT ',KPRGPNS,KPRGPEW
102      CALL ABORT_TRANS(' SET2PE INVALID ARGUMENT ')
103    ENDIF
104  ENDIF
105
106ELSE
107
108!*       3.    Spectral space set values supplied
109!              ----------------------------------
110
111  IF(KPRTRW <= NPRTRW.AND.KPRTRV <= NPRTRV) THEN
112    KPE=(KPRTRW-1)*NPRTRV + KPRTRV
113  ELSE
114    WRITE(*,'(A,2I8)') ' SET2PE INVALID ARGUMENT ',KPRTRW,KPRTRV
115    CALL ABORT_TRANS(' SET2PE INVALID ARGUMENT ')
116  ENDIF
117
118ENDIF
119
120END SUBROUTINE SET2PE
121END MODULE SET2PE_MOD
Note: See TracBrowser for help on using the repository browser.