source: CONFIG/UNIFORM/v6/IPSLCM6/SOURCES/NEMO/cpl_oasis3.F90 @ 2302

Last change on this file since 2302 was 2302, checked in by aclsce, 10 years ago
  • Use of ORCA2 by default (instead of ORCA1)
  • Modified cpl_oasis3 NEMO subroutine in order to have a "clean" crash in coupled mode.
File size: 17.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, 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   !!   3.4  !  11-11  (C. Harris) Changes to allow mutiple category fields
16   !!----------------------------------------------------------------------
17#if defined key_oasis3
18   !!----------------------------------------------------------------------
19   !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3
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#if defined key_oasis_mct
28   USE mod_prism
29#else
30   USE mod_prism_proto              ! OASIS3 prism module
31   USE mod_prism_def_partition_proto! OASIS3 prism module for partitioning
32   USE mod_prism_put_proto          ! OASIS3 prism module for snding
33   USE mod_prism_get_proto          ! OASIS3 prism module for receiving
34   USE mod_comprism_proto           ! OASIS3 prism module to get coupling frequency
35#endif
36   USE par_oce                      ! ocean parameters
37   USE dom_oce                      ! ocean space and time domain
38   USE in_out_manager               ! I/O manager
39   USE lbclnk                       ! ocean lateral boundary conditions (or mpp link)
40
41   IMPLICIT NONE
42   PRIVATE
43
44   PUBLIC   cpl_prism_init
45   PUBLIC   cpl_prism_define
46   PUBLIC   cpl_prism_snd
47   PUBLIC   cpl_prism_rcv
48   PUBLIC   cpl_prism_freq
49   PUBLIC   cpl_prism_finalize
50
51   LOGICAL, PUBLIC, PARAMETER ::   lk_cpl = .TRUE.   !: coupled flag
52   INTEGER, PUBLIC            ::   OASIS_Rcv  = 1    !: return code if received field
53   INTEGER, PUBLIC            ::   OASIS_idle = 0    !: return code if nothing done by oasis
54   INTEGER                    ::   ncomp_id          ! id returned by prism_init_comp
55   INTEGER                    ::   nerror            ! return error code
56
57   INTEGER, PARAMETER ::   nmaxfld=40    ! Maximum number of coupling fields
58   
59   TYPE, PUBLIC ::   FLD_CPL               !: Type for coupling field information
60      LOGICAL               ::   laction   ! To be coupled or not
61      CHARACTER(len = 8)    ::   clname    ! Name of the coupling field   
62      CHARACTER(len = 1)    ::   clgrid    ! Grid type 
63      REAL(wp)              ::   nsgn      ! Control of the sign change
64      INTEGER, DIMENSION(9) ::   nid       ! Id of the field (no more than 9 categories)
65      INTEGER               ::   nct       ! Number of categories in field
66   END TYPE FLD_CPL
67
68   TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC ::   srcv, ssnd   !: Coupling fields
69
70   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   exfld   ! Temporary buffer for receiving
71
72   !!----------------------------------------------------------------------
73   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
74   !! $Id: cpl_oasis3.F90 3294 2012-01-28 16:44:18Z rblod $
75   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
76   !!----------------------------------------------------------------------
77CONTAINS
78
79   SUBROUTINE cpl_prism_init( kl_comm )
80      !!-------------------------------------------------------------------
81      !!             ***  ROUTINE cpl_prism_init  ***
82      !!
83      !! ** Purpose :   Initialize coupled mode communication for ocean
84      !!    exchange between AGCM, OGCM and COUPLER. (OASIS3 software)
85      !!
86      !! ** Method  :   OASIS3 MPI communication
87      !!--------------------------------------------------------------------
88      INTEGER, INTENT(out) ::   kl_comm   ! local communicator of the model
89      !!--------------------------------------------------------------------
90
91      ! WARNING: No write in numout in this routine
92      !============================================
93
94      !------------------------------------------------------------------
95      ! 1st Initialize the PRISM system for the application
96      !------------------------------------------------------------------
97      CALL prism_init_comp_proto ( ncomp_id, 'oceanx', nerror )
98      IF ( nerror /= PRISM_Ok ) &
99         CALL prism_abort_proto (ncomp_id, 'cpl_prism_init', 'Failure in prism_init_comp_proto')
100
101      !------------------------------------------------------------------
102      ! 3rd Get an MPI communicator for OPA local communication
103      !------------------------------------------------------------------
104
105      CALL prism_get_localcomm_proto ( kl_comm, nerror )
106      IF ( nerror /= PRISM_Ok ) &
107         CALL prism_abort_proto (ncomp_id, 'cpl_prism_init','Failure in prism_get_localcomm_proto' )
108      !
109   END SUBROUTINE cpl_prism_init
110
111
112   SUBROUTINE cpl_prism_define( krcv, ksnd )
113      !!-------------------------------------------------------------------
114      !!             ***  ROUTINE cpl_prism_define  ***
115      !!
116      !! ** Purpose :   Define grid and field information for ocean
117      !!    exchange between AGCM, OGCM and COUPLER. (OASIS3 software)
118      !!
119      !! ** Method  :   OASIS3 MPI communication
120      !!--------------------------------------------------------------------
121      INTEGER, INTENT(in) ::   krcv, ksnd     ! Number of received and sent coupling fields
122      !
123      INTEGER :: id_part
124      INTEGER :: paral(5)       ! OASIS3 box partition
125      INTEGER :: ishape(2,2)    ! shape of arrays passed to PSMILe
126      INTEGER :: ji,jc          ! local loop indicees
127      CHARACTER(LEN=8) :: zclname
128      !!--------------------------------------------------------------------
129
130      IF(lwp) WRITE(numout,*)
131      IF(lwp) WRITE(numout,*) 'cpl_prism_define : initialization in coupled ocean/atmosphere case'
132      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
133      IF(lwp) WRITE(numout,*)
134
135      !
136      ! ... Define the shape for the area that excludes the halo
137      !     For serial configuration (key_mpp_mpi not being active)
138      !     nl* is set to the global values 1 and jp*glo.
139      !
140      ishape(:,1) = (/ 1, nlei-nldi+1 /)
141      ishape(:,2) = (/ 1, nlej-nldj+1 /)
142      !
143      ! ... Allocate memory for data exchange
144      !
145      ALLOCATE(exfld(nlei-nldi+1, nlej-nldj+1), stat = nerror)
146      IF( nerror > 0 ) THEN
147         CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in allocating exfld')   ;   RETURN
148      ENDIF
149      !
150      ! -----------------------------------------------------------------
151      ! ... Define the partition
152      ! -----------------------------------------------------------------
153     
154      paral(1) = 2                                              ! box partitioning
155      paral(2) = jpiglo * (nldj-1+njmpp-1) + (nldi-1+nimpp-1)   ! NEMO lower left corner global offset   
156      paral(3) = nlei-nldi+1                                    ! local extent in i
157      paral(4) = nlej-nldj+1                                    ! local extent in j
158      paral(5) = jpiglo                                         ! global extent in x
159     
160      IF( ln_ctl ) THEN
161         WRITE(numout,*) ' multiexchg: paral (1:5)', paral
162         WRITE(numout,*) ' multiexchg: jpi, jpj =', jpi, jpj
163         WRITE(numout,*) ' multiexchg: nldi, nlei, nimpp =', nldi, nlei, nimpp
164         WRITE(numout,*) ' multiexchg: nldj, nlej, njmpp =', nldj, nlej, njmpp
165      ENDIF
166     
167      CALL prism_def_partition_proto ( id_part, paral, nerror )
168      !
169      ! ... Announce send variables.
170      !
171      DO ji = 1, ksnd
172         IF ( ssnd(ji)%laction ) THEN
173            DO jc = 1, ssnd(ji)%nct
174               IF ( ssnd(ji)%nct .gt. 1 ) THEN
175                  WRITE(zclname,'( a7, i1)') ssnd(ji)%clname,jc
176               ELSE
177                  zclname=ssnd(ji)%clname
178               ENDIF
179               WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_Out
180               CALL prism_def_var_proto (ssnd(ji)%nid(jc), zclname, id_part, (/ 2, 0/),   &
181                    PRISM_Out, ishape, PRISM_REAL, nerror)
182               IF ( nerror /= PRISM_Ok ) THEN
183                  WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname)
184                  CALL prism_abort_proto ( ssnd(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var')
185               ENDIF
186            END DO
187         ENDIF
188      END DO
189      !
190      ! ... Announce received variables.
191      !
192      DO ji = 1, krcv
193         IF ( srcv(ji)%laction ) THEN
194            DO jc = 1, srcv(ji)%nct
195               IF ( srcv(ji)%nct .gt. 1 ) THEN
196                  WRITE(zclname,'( a7, i1)') srcv(ji)%clname,jc
197               ELSE
198                  zclname=srcv(ji)%clname
199               ENDIF
200               WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_In
201               CALL prism_def_var_proto ( srcv(ji)%nid(jc), zclname, id_part, (/ 2, 0/),   &
202                    &                      PRISM_In    , ishape   , PRISM_REAL, nerror)
203               IF ( nerror /= PRISM_Ok ) THEN
204                  WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname)
205                  CALL prism_abort_proto ( srcv(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var')
206               ENDIF
207            END DO
208         ENDIF
209      END DO
210     
211      !------------------------------------------------------------------
212      ! End of definition phase
213      !------------------------------------------------------------------
214     
215      CALL prism_enddef_proto(nerror)
216      IF( nerror /= PRISM_Ok )   CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in prism_enddef')
217      !
218   END SUBROUTINE cpl_prism_define
219   
220   
221   SUBROUTINE cpl_prism_snd( kid, kstep, pdata, kinfo )
222      !!---------------------------------------------------------------------
223      !!              ***  ROUTINE cpl_prism_snd  ***
224      !!
225      !! ** Purpose : - At each coupling time-step,this routine sends fields
226      !!      like sst or ice cover to the coupler or remote application.
227      !!----------------------------------------------------------------------
228      INTEGER                   , INTENT(in   ) ::   kid       ! variable index in the array
229      INTEGER                   , INTENT(  out) ::   kinfo     ! OASIS3 info argument
230      INTEGER                   , INTENT(in   ) ::   kstep     ! ocean time-step in seconds
231      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pdata
232      !!
233      INTEGER                                   ::   jc        ! local loop index
234      !!--------------------------------------------------------------------
235      !
236      ! snd data to OASIS3
237      !
238      DO jc = 1, ssnd(kid)%nct
239
240         CALL prism_put_proto ( ssnd(kid)%nid(jc), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo )
241         
242         IF ( ln_ctl ) THEN       
243            IF ( kinfo == PRISM_Sent     .OR. kinfo == PRISM_ToRest .OR.   &
244                 & kinfo == PRISM_SentOut  .OR. kinfo == PRISM_ToRestOut ) THEN
245               WRITE(numout,*) '****************'
246               WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%clname
247               WRITE(numout,*) 'prism_put_proto: ivarid ', ssnd(kid)%nid(jc)
248               WRITE(numout,*) 'prism_put_proto:  kstep ', kstep
249               WRITE(numout,*) 'prism_put_proto:   info ', kinfo
250               WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc))
251               WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc))
252               WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc))
253               WRITE(numout,*) '****************'
254            ENDIF
255         ENDIF
256
257      ENDDO
258      !
259    END SUBROUTINE cpl_prism_snd
260
261
262   SUBROUTINE cpl_prism_rcv( kid, kstep, pdata, kinfo )
263      !!---------------------------------------------------------------------
264      !!              ***  ROUTINE cpl_prism_rcv  ***
265      !!
266      !! ** Purpose : - At each coupling time-step,this routine receives fields
267      !!      like stresses and fluxes from the coupler or remote application.
268      !!----------------------------------------------------------------------
269      INTEGER                   , INTENT(in   ) ::   kid       ! variable index in the array
270      INTEGER                   , INTENT(in   ) ::   kstep     ! ocean time-step in seconds
271      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdata     ! IN to keep the value if nothing is done
272      INTEGER                   , INTENT(  out) ::   kinfo     ! OASIS3 info argument
273      !!
274      INTEGER                                   ::   jc        ! local loop index
275      LOGICAL                                   ::   llaction
276      !!--------------------------------------------------------------------
277      !
278      ! receive local data from OASIS3 on every process
279      !
280      DO jc = 1, srcv(kid)%nct
281
282         CALL prism_get_proto ( srcv(kid)%nid(jc), kstep, exfld, kinfo )         
283         
284         llaction = .false.
285         IF( kinfo == PRISM_Recvd   .OR. kinfo == PRISM_FromRest .OR.   &
286              kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut )   llaction = .TRUE.
287         
288         IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc)
289         
290         IF ( llaction ) THEN
291           
292            kinfo = OASIS_Rcv
293            pdata(nldi:nlei, nldj:nlej,jc) = exfld(:,:)
294           
295            !--- Fill the overlap areas and extra hallows (mpp)
296            !--- check periodicity conditions (all cases)
297            CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn )   
298           
299            IF ( ln_ctl ) THEN       
300               WRITE(numout,*) '****************'
301               WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname
302               WRITE(numout,*) 'prism_get_proto: ivarid '  , srcv(kid)%nid(jc)
303               WRITE(numout,*) 'prism_get_proto:   kstep', kstep
304               WRITE(numout,*) 'prism_get_proto:   info ', kinfo
305               WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(:,:,jc))
306               WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:,:,jc))
307               WRITE(numout,*) '     -     Sum value is ', SUM(pdata(:,:,jc))
308               WRITE(numout,*) '****************'
309            ENDIF
310           
311         ELSE
312            kinfo = OASIS_idle     
313         ENDIF
314         
315      ENDDO
316      !
317   END SUBROUTINE cpl_prism_rcv
318
319
320   INTEGER FUNCTION cpl_prism_freq( kid ) 
321      !!---------------------------------------------------------------------
322      !!              ***  ROUTINE cpl_prism_freq  ***
323      !!
324      !! ** Purpose : - send back the coupling frequency for a particular field
325      !!----------------------------------------------------------------------
326      INTEGER,INTENT(in) ::   kid   ! variable index
327      !!----------------------------------------------------------------------
328#if ! defined key_oasis_mct
329      cpl_prism_freq = ig_def_freq( kid )
330#else
331      cpl_prism_freq = 300
332#endif
333      !
334   END FUNCTION cpl_prism_freq
335
336
337   SUBROUTINE cpl_prism_finalize
338      !!---------------------------------------------------------------------
339      !!              ***  ROUTINE cpl_prism_finalize  ***
340      !!
341      !! ** Purpose : - Finalizes the coupling. If MPI_init has not been
342      !!      called explicitly before cpl_prism_init it will also close
343      !!      MPI communication.
344      !!----------------------------------------------------------------------
345      !
346      DEALLOCATE( exfld )
347      IF (nstop == 0) THEN
348          CALL prism_terminate_proto( nerror )         
349      ELSE
350          CALL prism_abort_proto(ncomp_id, "nemo crash", "nemo crash")
351      ENDIF
352      !
353   END SUBROUTINE cpl_prism_finalize
354
355#else
356   !!----------------------------------------------------------------------
357   !!   Default case          Dummy module          Forced Ocean/Atmosphere
358   !!----------------------------------------------------------------------
359   USE in_out_manager               ! I/O manager
360   LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .FALSE.   !: coupled flag
361   PUBLIC cpl_prism_init
362   PUBLIC cpl_prism_finalize
363CONTAINS
364   SUBROUTINE cpl_prism_init (kl_comm) 
365      INTEGER, INTENT(out)   :: kl_comm       ! local communicator of the model
366      kl_comm = -1
367      WRITE(numout,*) 'cpl_prism_init: Error you sould not be there...'
368   END SUBROUTINE cpl_prism_init
369   SUBROUTINE cpl_prism_finalize
370      WRITE(numout,*) 'cpl_prism_finalize: Error you sould not be there...'
371   END SUBROUTINE cpl_prism_finalize
372#endif
373
374   !!=====================================================================
375END MODULE cpl_oasis3
Note: See TracBrowser for help on using the repository browser.