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

source: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90 @ 2715

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

First attempt to put dynamic allocation on the trunk
  • Property svn:keywords set to Id
File size: 15.5 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, Germany) Original code
9   !!   " "  !  04-11  (R. Redler, NEC Laboratories Europe; N. Keenlyside, W. Park, IFM-GEOMAR, 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   !!   cpl_prism_init     : initialization of coupled mode communication
21   !!   cpl_prism_define   : definition of grid and fields
22   !!   cpl_prism_snd     : snd out fields in coupled mode
23   !!   cpl_prism_rcv     : receive fields in coupled mode
24   !!   cpl_prism_finalize : finalize the coupled mode communication
25   !!----------------------------------------------------------------------
26   USE mod_prism_proto              ! OASIS3 prism module
27   USE mod_prism_def_partition_proto! OASIS3 prism module for partitioning
28   USE mod_prism_put_proto          ! OASIS3 prism module for snding
29   USE mod_prism_get_proto          ! OASIS3 prism module for receiving
30   USE mod_comprism_proto           ! OASIS3 prism module to get coupling frequency
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
36   IMPLICIT NONE
37   PRIVATE
38
39   PUBLIC   cpl_prism_init
40   PUBLIC   cpl_prism_define
41   PUBLIC   cpl_prism_snd
42   PUBLIC   cpl_prism_rcv
43   PUBLIC   cpl_prism_freq
44   PUBLIC   cpl_prism_finalize
45
46   LOGICAL, PUBLIC, PARAMETER ::   lk_cpl = .TRUE.   !: coupled flag
47   INTEGER, PUBLIC            ::   OASIS_Rcv  = 1    !: return code if received field
48   INTEGER, PUBLIC            ::   OASIS_idle = 0    !: return code if nothing done by oasis
49   INTEGER                    ::   ncomp_id          ! id returned by prism_init_comp
50   INTEGER                    ::   nerror            ! return error code
51
52   INTEGER, PARAMETER ::   nmaxfld=40    ! Maximum number of coupling fields
53   
54   TYPE, PUBLIC ::   FLD_CPL            !: Type for coupling field information
55      LOGICAL            ::   laction   ! To be coupled or not
56      CHARACTER(len = 8) ::   clname    ! Name of the coupling field   
57      CHARACTER(len = 1) ::   clgrid    ! Grid type 
58      REAL(wp)           ::   nsgn      ! Control of the sign change
59      INTEGER            ::   nid       ! Id of the field
60   END TYPE FLD_CPL
61
62   TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC ::   srcv, ssnd   !: Coupling fields
63
64   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   exfld   ! Temporary buffer for receiving
65
66   !!----------------------------------------------------------------------
67   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
68   !! $Id$
69   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
70   !!----------------------------------------------------------------------
71CONTAINS
72
73   SUBROUTINE cpl_prism_init( kl_comm )
74      !!-------------------------------------------------------------------
75      !!             ***  ROUTINE cpl_prism_init  ***
76      !!
77      !! ** Purpose :   Initialize coupled mode communication for ocean
78      !!    exchange between AGCM, OGCM and COUPLER. (OASIS3 software)
79      !!
80      !! ** Method  :   OASIS3 MPI communication
81      !!--------------------------------------------------------------------
82      INTEGER, INTENT(out) ::   kl_comm   ! local communicator of the model
83      !!--------------------------------------------------------------------
84
85      ! WARNING: No write in numout in this routine
86      !============================================
87
88      !------------------------------------------------------------------
89      ! 1st Initialize the PRISM system for the application
90      !------------------------------------------------------------------
91      CALL prism_init_comp_proto ( ncomp_id, 'oceanx', nerror )
92      IF ( nerror /= PRISM_Ok ) &
93         CALL prism_abort_proto (ncomp_id, 'cpl_prism_init', 'Failure in prism_init_comp_proto')
94
95      !------------------------------------------------------------------
96      ! 3rd Get an MPI communicator for OPA local communication
97      !------------------------------------------------------------------
98
99      CALL prism_get_localcomm_proto ( kl_comm, nerror )
100      IF ( nerror /= PRISM_Ok ) &
101         CALL prism_abort_proto (ncomp_id, 'cpl_prism_init','Failure in prism_get_localcomm_proto' )
102      !
103   END SUBROUTINE cpl_prism_init
104
105
106   SUBROUTINE cpl_prism_define( krcv, ksnd )
107      !!-------------------------------------------------------------------
108      !!             ***  ROUTINE cpl_prism_define  ***
109      !!
110      !! ** Purpose :   Define grid and field information for ocean
111      !!    exchange between AGCM, OGCM and COUPLER. (OASIS3 software)
112      !!
113      !! ** Method  :   OASIS3 MPI communication
114      !!--------------------------------------------------------------------
115      INTEGER, INTENT(in) ::   krcv, ksnd     ! Number of received and sent coupling fields
116      !
117      INTEGER :: id_part
118      INTEGER :: paral(5)       ! OASIS3 box partition
119      INTEGER :: ishape(2,2)    ! shape of arrays passed to PSMILe
120      INTEGER :: ji             ! local loop indicees
121      !!--------------------------------------------------------------------
122
123      IF(lwp) WRITE(numout,*)
124      IF(lwp) WRITE(numout,*) 'cpl_prism_define : initialization in coupled ocean/atmosphere case'
125      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
126      IF(lwp) WRITE(numout,*)
127
128      !
129      ! ... Define the shape for the area that excludes the halo
130      !     For serial configuration (key_mpp_mpi not being active)
131      !     nl* is set to the global values 1 and jp*glo.
132      !
133      ishape(:,1) = (/ 1, nlei-nldi+1 /)
134      ishape(:,2) = (/ 1, nlej-nldj+1 /)
135      !
136      ! ... Allocate memory for data exchange
137      !
138      ALLOCATE(exfld(nlei-nldi+1, nlej-nldj+1), stat = nerror)
139      IF( nerror > 0 ) THEN
140         CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in allocating exfld')   ;   RETURN
141      ENDIF
142      !
143      ! -----------------------------------------------------------------
144      ! ... Define the partition
145      ! -----------------------------------------------------------------
146     
147      paral(1) = 2                                              ! box partitioning
148      paral(2) = jpiglo * (nldj-1+njmpp-1) + (nldi-1+nimpp-1)   ! NEMO lower left corner global offset   
149      paral(3) = nlei-nldi+1                                    ! local extent in i
150      paral(4) = nlej-nldj+1                                    ! local extent in j
151      paral(5) = jpiglo                                         ! global extent in x
152     
153      IF( ln_ctl ) THEN
154         WRITE(numout,*) ' multiexchg: paral (1:5)', paral
155         WRITE(numout,*) ' multiexchg: jpi, jpj =', jpi, jpj
156         WRITE(numout,*) ' multiexchg: nldi, nlei, nimpp =', nldi, nlei, nimpp
157         WRITE(numout,*) ' multiexchg: nldj, nlej, njmpp =', nldj, nlej, njmpp
158      ENDIF
159     
160      CALL prism_def_partition_proto ( id_part, paral, nerror )
161      !
162      ! ... Announce send variables.
163      !
164      DO ji = 1, ksnd
165         IF ( ssnd(ji)%laction ) THEN
166            CALL prism_def_var_proto (ssnd(ji)%nid, ssnd(ji)%clname, id_part, (/ 2, 0/),  &
167               &                      PRISM_Out   , ishape   , PRISM_REAL, nerror)
168            IF ( nerror /= PRISM_Ok ) THEN
169               WRITE(numout,*) 'Failed to define transient ', ji, TRIM(ssnd(ji)%clname)
170               CALL prism_abort_proto ( ssnd(ji)%nid, 'cpl_prism_define', 'Failure in prism_def_var')
171            ENDIF
172         ENDIF
173      END DO
174      !
175      ! ... Announce received variables.
176      !
177      DO ji = 1, krcv
178         IF ( srcv(ji)%laction ) THEN
179            CALL prism_def_var_proto ( srcv(ji)%nid, srcv(ji)%clname, id_part, (/ 2, 0/),   &
180               &                      PRISM_In    , ishape   , PRISM_REAL, nerror)
181            IF ( nerror /= PRISM_Ok ) THEN
182               WRITE(numout,*) 'Failed to define transient ', ji, TRIM(srcv(ji)%clname)
183               CALL prism_abort_proto ( srcv(ji)%nid, 'cpl_prism_define', 'Failure in prism_def_var')
184            ENDIF
185         ENDIF
186      END DO
187     
188      !------------------------------------------------------------------
189      ! End of definition phase
190      !------------------------------------------------------------------
191     
192      CALL prism_enddef_proto(nerror)
193      IF( nerror /= PRISM_Ok )   CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in prism_enddef')
194      !
195   END SUBROUTINE cpl_prism_define
196   
197   
198   SUBROUTINE cpl_prism_snd( kid, kstep, pdata, kinfo )
199      !!---------------------------------------------------------------------
200      !!              ***  ROUTINE cpl_prism_snd  ***
201      !!
202      !! ** Purpose : - At each coupling time-step,this routine sends fields
203      !!      like sst or ice cover to the coupler or remote application.
204      !!----------------------------------------------------------------------
205      INTEGER                 , INTENT(in   ) ::   kid       ! variable index in the array
206      INTEGER                 , INTENT(  out) ::   kinfo     ! OASIS3 info argument
207      INTEGER                 , INTENT(in   ) ::   kstep     ! ocean time-step in seconds
208      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   pdata
209      !!--------------------------------------------------------------------
210      !
211      ! snd data to OASIS3
212      !
213      CALL prism_put_proto ( ssnd(kid)%nid, kstep, pdata(nldi:nlei, nldj:nlej), kinfo )
214     
215      IF ( ln_ctl ) THEN       
216         IF ( kinfo == PRISM_Sent     .OR. kinfo == PRISM_ToRest .OR.   &
217            & kinfo == PRISM_SentOut  .OR. kinfo == PRISM_ToRestOut ) THEN
218            WRITE(numout,*) '****************'
219            WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%clname
220            WRITE(numout,*) 'prism_put_proto: ivarid ', ssnd(kid)%nid
221            WRITE(numout,*) 'prism_put_proto:  kstep ', kstep
222            WRITE(numout,*) 'prism_put_proto:   info ', kinfo
223            WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata)
224            WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata)
225            WRITE(numout,*) '     -     Sum value is ', SUM(pdata)
226            WRITE(numout,*) '****************'
227         ENDIF
228      ENDIF
229      !
230    END SUBROUTINE cpl_prism_snd
231
232
233   SUBROUTINE cpl_prism_rcv( kid, kstep, pdata, kinfo )
234      !!---------------------------------------------------------------------
235      !!              ***  ROUTINE cpl_prism_rcv  ***
236      !!
237      !! ** Purpose : - At each coupling time-step,this routine receives fields
238      !!      like stresses and fluxes from the coupler or remote application.
239      !!----------------------------------------------------------------------
240      INTEGER                 , INTENT(in   ) ::   kid       ! variable index in the array
241      INTEGER                 , INTENT(in   ) ::   kstep     ! ocean time-step in seconds
242      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pdata     ! IN to keep the value if nothing is done
243      INTEGER                 , INTENT(  out) ::   kinfo     ! OASIS3 info argument
244      !!
245      LOGICAL ::   llaction
246      !!--------------------------------------------------------------------
247      !
248      ! receive local data from OASIS3 on every process
249      !
250      CALL prism_get_proto ( srcv(kid)%nid, kstep, exfld, kinfo )         
251
252      llaction = .false.
253      IF( kinfo == PRISM_Recvd   .OR. kinfo == PRISM_FromRest .OR.   &
254          kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut )   llaction = .TRUE.
255
256      IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid
257
258      IF ( llaction ) THEN
259
260         kinfo = OASIS_Rcv
261         pdata(nldi:nlei, nldj:nlej) = exfld(:,:)
262         
263         !--- Fill the overlap areas and extra hallows (mpp)
264         !--- check periodicity conditions (all cases)
265         CALL lbc_lnk( pdata, srcv(kid)%clgrid, srcv(kid)%nsgn )   
266         
267         IF ( ln_ctl ) THEN       
268            WRITE(numout,*) '****************'
269            WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname
270            WRITE(numout,*) 'prism_get_proto: ivarid '  , srcv(kid)%nid
271            WRITE(numout,*) 'prism_get_proto:   kstep', kstep
272            WRITE(numout,*) 'prism_get_proto:   info ', kinfo
273            WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata)
274            WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata)
275            WRITE(numout,*) '     -     Sum value is ', SUM(pdata)
276            WRITE(numout,*) '****************'
277         ENDIF
278     
279      ELSE
280         kinfo = OASIS_idle     
281      ENDIF
282      !
283   END SUBROUTINE cpl_prism_rcv
284
285
286   INTEGER FUNCTION cpl_prism_freq( kid ) 
287      !!---------------------------------------------------------------------
288      !!              ***  ROUTINE cpl_prism_freq  ***
289      !!
290      !! ** Purpose : - send back the coupling frequency for a particular field
291      !!----------------------------------------------------------------------
292      INTEGER,INTENT(in) ::   kid   ! variable index
293      !!----------------------------------------------------------------------
294      cpl_prism_freq = ig_def_freq( kid )
295      !
296   END FUNCTION cpl_prism_freq
297
298
299   SUBROUTINE cpl_prism_finalize
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   !!   Default case          Dummy module          Forced Ocean/Atmosphere
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
321CONTAINS
322   SUBROUTINE cpl_prism_init (kl_comm) 
323      INTEGER, INTENT(out)   :: kl_comm       ! local communicator of the model
324      kl_comm = -1
325      WRITE(numout,*) 'cpl_prism_init: Error you sould not be there...'
326   END SUBROUTINE cpl_prism_init
327   SUBROUTINE cpl_prism_finalize
328      WRITE(numout,*) 'cpl_prism_finalize: Error you sould not be there...'
329   END SUBROUTINE cpl_prism_finalize
330#endif
331
332   !!=====================================================================
333END MODULE cpl_oasis3
Note: See TracBrowser for help on using the repository browser.