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

Last change on this file since 1698 was 1698, checked in by smasson, 14 years ago

compatibility between oasis3 and oasis4, see ticket:580
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 15.2 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 Laboratories Europe, St Augustin, Germany) Original code
9   !!   " "  !  04-11  (R. Redler, NEC Laboratories Europe; N. Keenlyside, W. Park, IFM-GEOMAR, Kiel, Germany) 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 lbclnk          ! ocean lateral boundary conditions (or mpp link)
37   IMPLICIT NONE
38   PRIVATE
39!
40   LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .TRUE.   ! coupled flag
41   INTEGER, PUBLIC            :: OASIS_Rcv  = 1    ! return code if received field
42   INTEGER, PUBLIC            :: OASIS_idle = 0    ! return code if nothing done by oasis
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      ! WARNING: No write in numout in this routine
89      !============================================
90
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      CALL prism_put_proto ( ssnd(kid)%nid, kstep, pdata(nldi:nlei, nldj:nlej), kinfo )
225     
226      IF ( ln_ctl ) THEN       
227         IF ( kinfo == PRISM_Sent     .OR. kinfo == PRISM_ToRest .OR.   &
228            & kinfo == PRISM_SentOut  .OR. kinfo == PRISM_ToRestOut ) THEN
229            WRITE(numout,*) '****************'
230            WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%clname
231            WRITE(numout,*) 'prism_put_proto: ivarid ', ssnd(kid)%nid
232            WRITE(numout,*) 'prism_put_proto:  kstep ', kstep
233            WRITE(numout,*) 'prism_put_proto:   info ', kinfo
234            WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata)
235            WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata)
236            WRITE(numout,*) '     -     Sum value is ', SUM(pdata)
237            WRITE(numout,*) '****************'
238        ENDIF
239     ENDIF
240    END SUBROUTINE cpl_prism_snd
241
242
243   SUBROUTINE cpl_prism_rcv( kid, kstep, pdata, kinfo )
244
245      !!---------------------------------------------------------------------
246      !!              ***  ROUTINE cpl_prism_rcv  ***
247      !!
248      !! ** Purpose : - At each coupling time-step,this routine receives fields
249      !!      like stresses and fluxes from the coupler or remote application.
250      !!----------------------------------------------------------------------
251      INTEGER,                      INTENT( IN    )   :: kid       ! variable intex in the array
252      INTEGER,                      INTENT( IN    )   :: kstep     ! ocean time-step in seconds
253      REAL(wp), DIMENSION(jpi,jpj), INTENT( INOUT )   :: pdata     ! IN to keep the value if nothing is done
254      INTEGER,                      INTENT(   OUT )   :: kinfo     ! OASIS3 info argument
255      !!
256      LOGICAL                :: llaction
257      !!--------------------------------------------------------------------
258      !
259      ! receive local data from OASIS3 on every process
260      !
261      CALL prism_get_proto ( srcv(kid)%nid, kstep, exfld, kinfo )         
262
263      llaction = .false.
264      IF( kinfo == PRISM_Recvd   .OR. kinfo == PRISM_FromRest .OR.   &
265          kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut )   llaction = .TRUE.
266
267      IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid
268
269      IF ( llaction ) THEN
270
271         kinfo = OASIS_Rcv
272         pdata(nldi:nlei, nldj:nlej) = exfld(:,:)
273         
274         !--- Fill the overlap areas and extra hallows (mpp)
275         !--- check periodicity conditions (all cases)
276         CALL lbc_lnk( pdata, srcv(kid)%clgrid, srcv(kid)%nsgn )   
277         
278         IF ( ln_ctl ) THEN       
279            WRITE(numout,*) '****************'
280            WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname
281            WRITE(numout,*) 'prism_get_proto: ivarid '  , srcv(kid)%nid
282            WRITE(numout,*) 'prism_get_proto:   kstep', kstep
283            WRITE(numout,*) 'prism_get_proto:   info ', kinfo
284            WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata)
285            WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata)
286            WRITE(numout,*) '     -     Sum value is ', SUM(pdata)
287            WRITE(numout,*) '****************'
288         ENDIF
289     
290      ELSE
291         kinfo = OASIS_idle     
292      ENDIF
293
294   END SUBROUTINE cpl_prism_rcv
295
296
297   SUBROUTINE cpl_prism_finalize
298
299      !!---------------------------------------------------------------------
300      !!              ***  ROUTINE cpl_prism_finalize  ***
301      !!
302      !! ** Purpose : - Finalizes the coupling. If MPI_init has not been
303      !!      called explicitly before cpl_prism_init it will also close
304      !!      MPI communication.
305      !!----------------------------------------------------------------------
306
307      DEALLOCATE(exfld)
308      CALL prism_terminate_proto ( nerror )         
309
310   END SUBROUTINE cpl_prism_finalize
311
312#else
313
314   !!----------------------------------------------------------------------
315   !!   Default case                                Forced Ocean/Atmosphere
316   !!----------------------------------------------------------------------
317   !!   Empty module
318   !!----------------------------------------------------------------------
319   USE in_out_manager               ! I/O manager
320   LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .FALSE.   !: coupled flag
321   PUBLIC cpl_prism_init
322   PUBLIC cpl_prism_finalize
323
324CONTAINS
325
326   SUBROUTINE cpl_prism_init (kl_comm) 
327      INTEGER, INTENT(   OUT )   :: kl_comm       ! local communicator of the model
328      kl_comm = -1
329      WRITE(numout,*) 'cpl_prism_init: Error you sould not be there...'
330   END SUBROUTINE cpl_prism_init
331
332   SUBROUTINE cpl_prism_finalize
333      WRITE(numout,*) 'cpl_prism_finalize: Error you sould not be there...'
334   END SUBROUTINE cpl_prism_finalize
335
336#endif
337
338END MODULE cpl_oasis3
Note: See TracBrowser for help on using the repository browser.