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 branches/dev_003_CPL/NEMO/OPA_SRC/SBC – NEMO

source: branches/dev_003_CPL/NEMO/OPA_SRC/SBC/cpl_oasis3.F90 @ 991

Last change on this file since 991 was 991, checked in by smasson, 16 years ago

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