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_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

source: branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90 @ 2160

Last change on this file since 2160 was 2160, checked in by rblod, 13 years ago

FCM branch : add correct reference to CeCILL license

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