New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
cpl_oasis3.F90 in trunk/NEMO/OPA_SRC/SBC – NEMO

source: trunk/NEMO/OPA_SRC/SBC/cpl_oasis3.F90 @ 1226

Last change on this file since 1226 was 1226, checked in by smasson, 15 years ago

bugfix of the coupling interface (commited during changeset:1218), see ticket:155
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 15.3 KB
Line 
1MODULE cpl_oasis3
2   !!======================================================================
3   !!                    ***  MODULE cpl_oasis  ***
4   !! Coupled O/A : coupled ocean-atmosphere case using OASIS3 V. prism_2_4
5   !!               special case: NEMO OPA/LIM coupled to ECHAM5
6   !!=====================================================================
7   !! History :   
8   !!   9.0  !  04-06  (R. Redler, NEC CCRLE, Germany) Original code
9   !!   " "  !  04-11  (R. Redler, N. Keenlyside) revision
10   !!   " "  !  04-11  (V. Gayler, MPI M&D) Grid writing
11   !!   " "  !  05-08  (R. Redler, W. Park) frld initialization, paral(2) revision
12   !!   " "  !  05-09  (R. Redler) extended to allow for communication over root only
13   !!   " "  !  06-01  (W. Park) modification of physical part
14   !!   " "  !  06-02  (R. Redler, W. Park) buffer array fix for root exchange
15   !!----------------------------------------------------------------------
16#if defined key_oasis3
17   !!----------------------------------------------------------------------
18   !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3
19   !!----------------------------------------------------------------------
20   !!----------------------------------------------------------------------
21   !!   cpl_prism_init     : initialization of coupled mode communication
22   !!   cpl_prism_define   : definition of grid and fields
23   !!   cpl_prism_snd     : snd out fields in coupled mode
24   !!   cpl_prism_rcv     : receive fields in coupled mode
25   !!   cpl_prism_finalize : finalize the coupled mode communication
26   !!----------------------------------------------------------------------
27   USE mod_prism_proto              ! OASIS3 prism module
28   USE mod_prism_def_partition_proto! OASIS3 prism module for partitioning
29   USE mod_prism_grids_writing      ! OASIS3 prism module for writing grid files
30   USE mod_prism_put_proto          ! OASIS3 prism module for snding
31   USE mod_prism_get_proto          ! OASIS3 prism module for receiving
32   USE mod_prism_grids_writing      ! OASIS3 prism module for writing grids
33   USE par_oce                      ! ocean parameters
34   USE dom_oce                      ! ocean space and time domain
35   USE in_out_manager               ! I/O manager
36   USE lib_mpp
37   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
38   IMPLICIT NONE
39   PRIVATE
40!
41   INTEGER, PUBLIC            :: nlocalComm
42   LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .TRUE.   ! coupled flag
43   INTEGER                    :: ncomp_id          ! id returned by prism_init_comp
44   INTEGER                    :: nerror            ! return error code
45
46   INTEGER, PARAMETER :: nmaxfld=40    ! Maximum number of coupling fields
47   
48   TYPE, PUBLIC ::   FLD_CPL            ! Type for coupling field information
49      LOGICAL            ::   laction   ! To be coupled or not
50      CHARACTER(len = 8) ::   clname    ! Name of the coupling field   
51      CHARACTER(len = 1) ::   clgrid    ! Grid type 
52      REAL(wp)           ::   nsgn      ! Control of the sign change
53      INTEGER            ::   nid       ! Id of the field
54   END TYPE FLD_CPL
55
56   TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC :: srcv, ssnd   ! Coupling fields
57
58   REAL(wp), DIMENSION(:,:), ALLOCATABLE :: exfld  ! Temporary buffer for receiving
59
60   !! Routine accessibility
61   PUBLIC cpl_prism_init
62   PUBLIC cpl_prism_define
63   PUBLIC cpl_prism_snd
64   PUBLIC cpl_prism_rcv
65   PUBLIC cpl_prism_finalize
66
67   !!----------------------------------------------------------------------
68   !!   OPA 9.0 , LOCEAN-IPSL (2006)
69   !! $Header$
70   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
71   !!----------------------------------------------------------------------
72
73CONTAINS
74
75   SUBROUTINE cpl_prism_init (kl_comm) 
76
77      !!-------------------------------------------------------------------
78      !!             ***  ROUTINE cpl_prism_init  ***
79      !!
80      !! ** Purpose :   Initialize coupled mode communication for ocean
81      !!    exchange between AGCM, OGCM and COUPLER. (OASIS3 software)
82      !!
83      !! ** Method  :   OASIS3 MPI communication
84      !!--------------------------------------------------------------------
85      INTEGER, INTENT(   OUT )   :: kl_comm       ! local communicator of the model
86      !!--------------------------------------------------------------------
87
88      IF(lwp) WRITE(numout,*) 'cpl_prism_init : initialization in coupled ocean/atmosphere case'
89      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~'
90      IF(lwp) WRITE(numout,*)
91      !------------------------------------------------------------------
92      ! 1st Initialize the PRISM system for the application
93      !------------------------------------------------------------------
94      CALL prism_init_comp_proto ( ncomp_id, 'oceanx', nerror )
95      IF ( nerror /= PRISM_Ok ) &
96         CALL prism_abort_proto (ncomp_id, 'cpl_prism_init', 'Failure in prism_init_comp_proto')
97
98      !------------------------------------------------------------------
99      ! 3rd Get an MPI communicator for OPA local communication
100      !------------------------------------------------------------------
101
102      CALL prism_get_localcomm_proto ( kl_comm, nerror )
103      IF ( nerror /= PRISM_Ok ) &
104         CALL prism_abort_proto (ncomp_id, 'cpl_prism_init','Failure in prism_get_localcomm_proto' )
105
106   END SUBROUTINE cpl_prism_init
107
108
109   SUBROUTINE cpl_prism_define (krcv, ksnd)
110
111      !!-------------------------------------------------------------------
112      !!             ***  ROUTINE cpl_prism_define  ***
113      !!
114      !! ** Purpose :   Define grid and field information for ocean
115      !!    exchange between AGCM, OGCM and COUPLER. (OASIS3 software)
116      !!
117      !! ** Method  :   OASIS3 MPI communication
118      !!--------------------------------------------------------------------
119      INTEGER, INTENT( IN    )   :: krcv, ksnd     ! Number of received and sent coupling fields
120      !
121      INTEGER                    :: id_part
122      INTEGER                    :: paral(5)       ! OASIS3 box partition
123      INTEGER                    :: ishape(2,2)    ! shape of arrays passed to PSMILe
124      INTEGER                    :: ji             ! local loop indicees
125      !!
126      !!--------------------------------------------------------------------
127
128      IF(lwp) WRITE(numout,*)
129      IF(lwp) WRITE(numout,*) 'cpl_prism_define : initialization in coupled ocean/atmosphere case'
130      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
131      IF(lwp) WRITE(numout,*)
132
133      !
134      ! ... Define the shape for the area that excludes the halo
135      !     For serial configuration (key_mpp_mpi not being active)
136      !     nl* is set to the global values 1 and jp*glo.
137      !
138      ishape(:,1) = (/ 1, nlei-nldi+1 /)
139      ishape(:,2) = (/ 1, nlej-nldj+1 /)
140      !
141      ! ... Allocate memory for data exchange
142      !
143      ALLOCATE(exfld(nlei-nldi+1, nlej-nldj+1), stat = nerror)
144      IF (nerror > 0) THEN
145         CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in allocating exfld')
146         RETURN
147      ENDIF
148      !
149      ! -----------------------------------------------------------------
150      ! ... Define the partition
151      ! -----------------------------------------------------------------
152     
153      paral(1) = 2                                              ! box partitioning
154      paral(2) = jpiglo * (nldj-1+njmpp-1) + (nldi-1+nimpp-1)   ! NEMO lower left corner global offset   
155      paral(3) = nlei-nldi+1                                    ! local extent in i
156      paral(4) = nlej-nldj+1                                    ! local extent in j
157      paral(5) = jpiglo                                         ! global extent in x
158     
159      IF( ln_ctl ) THEN
160         WRITE(numout,*) ' multiexchg: paral (1:5)', paral
161         WRITE(numout,*) ' multiexchg: jpi, jpj =', jpi, jpj
162         WRITE(numout,*) ' multiexchg: nldi, nlei, nimpp =', nldi, nlei, nimpp
163         WRITE(numout,*) ' multiexchg: nldj, nlej, njmpp =', nldj, nlej, njmpp
164      ENDIF
165     
166      CALL prism_def_partition_proto ( id_part, paral, nerror )
167      !
168      ! ... Announce send variables.
169      !
170      DO ji = 1, ksnd
171         IF ( ssnd(ji)%laction ) THEN
172            CALL prism_def_var_proto (ssnd(ji)%nid, ssnd(ji)%clname, id_part, (/ 2, 0/),  &
173               &                      PRISM_Out   , ishape   , PRISM_REAL, nerror)
174            IF ( nerror /= PRISM_Ok ) THEN
175               WRITE(numout,*) 'Failed to define transient ', ji, TRIM(ssnd(ji)%clname)
176               CALL prism_abort_proto ( ssnd(ji)%nid, 'cpl_prism_define', 'Failure in prism_def_var')
177            ENDIF
178         ENDIF
179      END DO
180      !
181      ! ... Announce received variables.
182      !
183      DO ji = 1, krcv
184         IF ( srcv(ji)%laction ) THEN
185            CALL prism_def_var_proto ( srcv(ji)%nid, srcv(ji)%clname, id_part, (/ 2, 0/),   &
186               &                      PRISM_In    , ishape   , PRISM_REAL, nerror)
187            IF ( nerror /= PRISM_Ok ) THEN
188               WRITE(numout,*) 'Failed to define transient ', ji, TRIM(srcv(ji)%clname)
189               CALL prism_abort_proto ( srcv(ji)%nid, 'cpl_prism_define', 'Failure in prism_def_var')
190            ENDIF
191         ENDIF
192      END DO
193     
194      !------------------------------------------------------------------
195      ! End of definition phase
196      !------------------------------------------------------------------
197     
198      CALL prism_enddef_proto(nerror)
199      IF ( nerror /= PRISM_Ok )   CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in prism_enddef')
200     
201   END SUBROUTINE cpl_prism_define
202   
203   
204   SUBROUTINE cpl_prism_snd( kid, kstep, pdata, kinfo )
205
206      !!---------------------------------------------------------------------
207      !!              ***  ROUTINE cpl_prism_snd  ***
208      !!
209      !! ** Purpose : - At each coupling time-step,this routine sends fields
210      !!      like sst or ice cover to the coupler or remote application.
211      !!----------------------------------------------------------------------
212      !! * Arguments
213      !!
214      INTEGER,                      INTENT( IN    )   :: kid       ! variable intex in the array
215      INTEGER,                      INTENT(   OUT )   :: kinfo     ! OASIS3 info argument
216      INTEGER,                      INTENT( IN    )   :: kstep     ! ocean time-step in seconds
217      REAL(wp), DIMENSION(jpi,jpj), INTENT( IN    )   :: pdata
218      !!
219      !!
220      !!--------------------------------------------------------------------
221      !
222      ! snd data to OASIS3
223      !
224      IF( lk_mpp ) THEN   ;   CALL prism_put_proto ( ssnd(kid)%nid, kstep, pdata(nldi:nlei, nldj:nlej), kinfo )
225      ELSE                ;   CALL prism_put_proto ( ssnd(kid)%nid, kstep, pdata                      , kinfo )
226      ENDIF
227     
228      IF ( ln_ctl ) THEN       
229         IF ( kinfo == PRISM_Sent     .OR. kinfo == PRISM_ToRest .OR.   &
230            & kinfo == PRISM_SentOut  .OR. kinfo == PRISM_ToRestOut ) THEN
231            WRITE(numout,*) '****************'
232            WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%clname
233            WRITE(numout,*) 'prism_put_proto: ivarid ', ssnd(kid)%nid
234            WRITE(numout,*) 'prism_put_proto:  kstep ', kstep
235            WRITE(numout,*) 'prism_put_proto:   info ', kinfo
236            WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata)
237            WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata)
238            WRITE(numout,*) '     -     Sum value is ', SUM(pdata)
239            WRITE(numout,*) '****************'
240        ENDIF
241     ENDIF
242    END SUBROUTINE cpl_prism_snd
243
244
245   SUBROUTINE cpl_prism_rcv( kid, kstep, pdata, kinfo )
246
247      !!---------------------------------------------------------------------
248      !!              ***  ROUTINE cpl_prism_rcv  ***
249      !!
250      !! ** Purpose : - At each coupling time-step,this routine receives fields
251      !!      like stresses and fluxes from the coupler or remote application.
252      !!----------------------------------------------------------------------
253      INTEGER,                      INTENT( IN    )   :: kid       ! variable intex in the array
254      INTEGER,                      INTENT( IN    )   :: kstep     ! ocean time-step in seconds
255      REAL(wp), DIMENSION(jpi,jpj), INTENT( INOUT )   :: pdata     ! IN to keep the value if nothing is done
256      INTEGER,                      INTENT(   OUT )   :: kinfo     ! OASIS3 info argument
257      !!
258      LOGICAL                :: llaction
259      !!--------------------------------------------------------------------
260      !
261      ! receive local data from OASIS3 on every process
262      !
263      CALL prism_get_proto ( srcv(kid)%nid, kstep, exfld, kinfo )         
264
265      llaction = .false.
266      IF( kinfo == PRISM_Recvd   .OR. kinfo == PRISM_FromRest .OR.   &
267          kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut )   llaction = .TRUE.
268
269      IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid
270
271      IF ( llaction ) THEN
272
273         IF( lk_mpp ) THEN   ;   pdata(nldi:nlei, nldj:nlej) = exfld(:,:)
274         ELSE                ;   pdata(    :    ,     :    ) = exfld(:,:)
275         ENDIF
276         
277         !--- Fill the overlap areas and extra hallows (mpp)
278         !--- check periodicity conditions (all cases)
279         CALL lbc_lnk( pdata, srcv(kid)%clgrid, srcv(kid)%nsgn )   
280         
281         IF ( ln_ctl ) THEN       
282            WRITE(numout,*) '****************'
283            WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname
284            WRITE(numout,*) 'prism_get_proto: ivarid '  , srcv(kid)%nid
285            WRITE(numout,*) 'prism_get_proto:   kstep', kstep
286            WRITE(numout,*) 'prism_get_proto:   info ', kinfo
287            WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata)
288            WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata)
289            WRITE(numout,*) '     -     Sum value is ', SUM(pdata)
290            WRITE(numout,*) '****************'
291         ENDIF
292     
293      ENDIF
294
295   END SUBROUTINE cpl_prism_rcv
296
297
298   SUBROUTINE cpl_prism_finalize
299
300      !!---------------------------------------------------------------------
301      !!              ***  ROUTINE cpl_prism_finalize  ***
302      !!
303      !! ** Purpose : - Finalizes the coupling. If MPI_init has not been
304      !!      called explicitly before cpl_prism_init it will also close
305      !!      MPI communication.
306      !!----------------------------------------------------------------------
307
308      DEALLOCATE(exfld)
309      CALL prism_terminate_proto ( nerror )         
310
311   END SUBROUTINE cpl_prism_finalize
312
313#else
314
315   !!----------------------------------------------------------------------
316   !!   Default case                                Forced Ocean/Atmosphere
317   !!----------------------------------------------------------------------
318   !!   Empty module
319   !!----------------------------------------------------------------------
320   USE in_out_manager               ! I/O manager
321   LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .FALSE.   !: coupled flag
322   PUBLIC cpl_prism_init
323   PUBLIC cpl_prism_finalize
324
325CONTAINS
326
327   SUBROUTINE cpl_prism_init (kl_comm) 
328      INTEGER, INTENT(   OUT )   :: kl_comm       ! local communicator of the model
329      kl_comm = -1
330      WRITE(numout,*) 'cpl_prism_init: Error you sould not be there...'
331   END SUBROUTINE cpl_prism_init
332
333   SUBROUTINE cpl_prism_finalize
334      WRITE(numout,*) 'cpl_prism_finalize: Error you sould not be there...'
335   END SUBROUTINE cpl_prism_finalize
336
337#endif
338
339END MODULE cpl_oasis3
Note: See TracBrowser for help on using the repository browser.