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 @ 1218

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

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