source: CPL/oasis3/trunk/src/lib/clim/src/mod_clim_def.F90 @ 1677

Last change on this file since 1677 was 1677, checked in by aclsce, 12 years ago

Imported oasis3 (tag ipslcm5a) from cvs server to svn server (igcmg project).
File size: 7.0 KB
Line 
1MODULE mod_clim_def
2!
3!
4!**** DEFINE
5!
6!     Purpose:
7!      Routines CLIM_Define and CLIM_Defport are now in a module.
8!     
9!     Interface:
10!       none
11!   
12!     Method:
13!       Uses assumed shape array method to dimension local arrays.       
14!
15!     External:
16!       none
17!
18!     Files:
19!       none
20!   
21!     References:
22!
23!     History:
24!     --------
25!       Version   Programmer     Date        Description
26!       ------------------------------------------------
27!       2.5       A.Caubel       2002/06     created
28!
29!*-----------------------------------------------------------------------
30
31CONTAINS
32!
33 SUBROUTINE CLIM_Define(id_nports, cdport,kinout,ktype,kparal,kinfo)
34!
35!*    *** Define ***   CLIM 2.0
36!
37!     purpose:
38!     --------
39!        define a port
40!
41!     interface:
42!     ----------
43!        id_nports : port number of the field
44!        cdport : symbolic name of the field
45!        kinout : port status in/out
46!        ktype  : type of data
47!        kparal : type of parallel decomposition
48!        kinfo  : output status
49!
50!     lib mp:
51!     -------
52!        mpi-1
53!
54!     author:
55!     -------
56!        Eric Sevault   - METEO FRANCE
57!        Laurent Terray - CERFACS
58!        Arnaud Caubel - Fecit
59!     ----------------------------------------------------------------
60#if defined use_comm_MPI1 || defined use_comm_MPI2 || !defined use_comm_MPI1 && !defined use_comm_MPI2 && !defined use_comm_SIPC && !defined use_comm_GMEM && !defined use_comm_PIPE && !defined use_comm_NONE
61   USE mod_kinds_oasis
62   USE mod_clim
63   USE mod_comclim
64!     ----------------------------------------------------------------
65   INTEGER(kind=ip_intwp_p)       kinout, ktype, kinfo, id_nports
66   INTEGER(kind=ip_intwp_p), DIMENSION(:) :: kparal
67   CHARACTER*(*) cdport
68!     ----------------------------------------------------------------
69!
70!*    0. First Check
71!     --------------
72!
73   IF ( nexit.NE.1 ) THEN
74       kinfo = CLIM_FastExit
75       WRITE(nulprt,FMT='(A)') 'Define - should not be called'
76       GO TO 1010
77   ENDIF
78   kinfo = CLIM_Ok
79!
80!*    1. define the port
81!     ------------------
82!
83   WRITE(nulprt,*) 'Define - port name, status : ',cdport,kinout
84   WRITE(nulprt,*) 'Define - data type: ',ktype
85!
86   IF ( kinout.EQ.CLIM_InOut ) THEN
87       CALL CLIM_Defport (id_nports,cdport, CLIM_In, ktype, kparal, kinfo )
88       IF (kinfo.EQ.CLIM_Ok) THEN
89           CALL CLIM_Defport (id_nports,cdport,CLIM_Out,ktype,kparal,kinfo )
90       ENDIF
91   ELSE
92       CALL CLIM_Defport ( id_nports,cdport, kinout,  ktype, kparal, kinfo )
93   ENDIF
94!
95!     ----------------------------------------------------------------
96!
971010 CONTINUE
98   CALL FLUSH(nulprt)
99#endif
100   RETURN
101 END SUBROUTINE CLIM_Define
102!
103! ====================================================================
104
105 SUBROUTINE CLIM_Defport(id_nports,cdport,kinout,ktype,kparal,kinfo)
106!
107!*    *** Define ***   CLIM 2.2
108!
109!     purpose:
110!     --------
111!        define a port
112!
113!     interface:
114!     ----------
115!        id_nports : port number of the field
116!        cdport : symbolic name of the field
117!        kinout : port status in/out
118!        ktype  : type of data
119!        kparal : type of parallel decomposition
120!        kinfo  : output status
121!
122!     lib mp:
123!     -------
124!        mpi-2
125!
126!     author:
127!     -------
128!        Eric Sevault   - METEO FRANCE
129!        Laurent Terray - CERFACS
130!        Jean Latour    - F.S.E.   (mpi-2)
131!
132!     ----------------------------------------------------------------
133#if defined use_comm_MPI1 || defined use_comm_MPI2 || !defined use_comm_MPI1 && !defined use_comm_MPI2 && !defined use_comm_SIPC && !defined use_comm_GMEM && !defined use_comm_PIPE && !defined use_comm_NONE
134   USE mod_kinds_oasis
135   USE mod_clim
136   USE mod_comclim
137!     ----------------------------------------------------------------
138   INTEGER(kind=ip_intwp_p)       kinout, ktype, kinfo
139   INTEGER(kind=ip_intwp_p), DIMENSION(:) :: kparal
140   CHARACTER*(*) cdport
141!     ----------------------------------------------------------------
142   INTEGER(kind=ip_intwp_p)     ip, is, id_nports
143   INTEGER(kind=ip_intwp_p)       il_testvar
144   REAL(kind=ip_realwp_p)          rl_testvar
145   REAL(kind=ip_double_p)  dl_testvar
146   CHARACTER*32  cltest
147!     ----------------------------------------------------------------
148!
149!*    1. check if this port already exist
150!     -----------------------------------
151!
152   cltest= cdport
153   il_testvar = 0
154   rl_testvar = 0.0
155   dl_testvar = 0.0
156!
157   DO ip=1,nports
158     IF (cltest.EQ.cports(ip).AND.kinout.EQ.myport(1,ip)) THEN
159         kinfo = CLIM_DoubleDef
160         WRITE(nulprt,FMT='(A,A)') &
161            'Define - WARNING - duplicate definition of port ', & 
162            cdport
163         GO TO 1010
164     ENDIF
165   ENDDO
166!
167!*    2. save arguments as half a link
168!     --------------------------------
169!
170   nports = nports + 1
171   id_nports = nports
172   cports(nports) = cdport
173!
174   myport(1,nports) = kinout
175   myport(5,nports) = 0
176!
177!   IF ( ktype.EQ.CLIM_Integer ) THEN
178!       myport(2,nports) = CLIM_Integer
179!       myport(3,nports) = kind(il_testvar)
180!   ELSEIF ( ktype.EQ.CLIM_Real ) THEN
181   IF ( ktype.EQ.CLIM_Real ) THEN
182       myport(2,nports) = CLIM_Real
183       myport(3,nports) = kind(rl_testvar)
184!   ELSEIF ( ktype.EQ.CLIM_Double ) THEN
185!       myport(2,nports) = CLIM_Double
186!       myport(3,nports) = kind(dl_testvar)
187   ELSE
188       kinfo = CLIM_BadType
189       WRITE(nulprt,FMT='(A,I4)') &
190          'Define - WARNING - Bad data type:',ktype
191   ENDIF
192!
193   IF (kparal(CLIM_Strategy).EQ.CLIM_Serial) THEN
194!
195       mydist(CLIM_Strategy,nports)   = CLIM_Serial
196       mydist(CLIM_Segments,nports)   = 1
197       mydist(CLIM_Segments+1,nports) = 0
198       mydist(CLIM_Segments+2,nports) = kparal(CLIM_Length)
199       myport(4,nports) = kparal(CLIM_Length)
200!
201   ELSEIF (kparal(CLIM_Strategy).EQ.CLIM_Apple) THEN
202!
203       mydist(CLIM_Strategy,nports)   = CLIM_Apple
204       mydist(CLIM_Segments,nports)   = 1
205       mydist(CLIM_Segments+1,nports) = kparal(CLIM_Offset)
206       mydist(CLIM_Segments+2,nports) = kparal(CLIM_Length)
207       myport(4,nports) = kparal(CLIM_Length)
208!
209   ELSEIF (kparal(CLIM_strategy).EQ.CLIM_Box) THEN
210!
211       mydist(CLIM_Strategy,nports)   = CLIM_Box
212       mydist(CLIM_Segments,nports)   = kparal(CLIM_SizeY)
213       DO is=1,kparal(CLIM_SizeY)
214         mydist(CLIM_Segments+2*is-1,nports) = &
215            kparal(CLIM_Offset) + (is-1) * kparal(CLIM_LdX)
216         mydist(CLIM_Segments+2*is,nports) = kparal(CLIM_SizeX)
217       ENDDO
218       myport(4,nports) = kparal(CLIM_SizeX) * kparal(CLIM_SizeY)
219!
220   ELSEIF (kparal(CLIM_strategy).EQ.CLIM_Orange) THEN
221!
222       mydist(CLIM_Strategy,nports)   = CLIM_Orange
223       mydist(CLIM_Segments,nports)   = kparal(CLIM_Segments)
224       myport(4,nports) = 0
225       DO is=1,2*kparal(CLIM_Segments)
226         mydist(CLIM_Segments+is,nports) = kparal(CLIM_Segments+is)
227         IF (MOD(is,2).EQ.0) THEN
228             myport(4,nports) = myport(4,nports) + &
229                kparal(CLIM_Segments+is)
230         ENDIF
231       ENDDO
232   ENDIF
233!
234!     ----------------------------------------------------------------
235!
2361010 CONTINUE
237   CALL FLUSH(nulprt)
238#endif
239   RETURN
240 END SUBROUTINE CLIM_Defport
241END MODULE mod_clim_def
Note: See TracBrowser for help on using the repository browser.