source: LMDZ6/branches/Ocean_skin/libf/phylmd/oasis.F90 @ 3605

Last change on this file since 3605 was 3605, checked in by lguez, 4 years ago

Merge revisions 3427:3600 of trunk into branch Ocean_skin
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 20.3 KB
Line 
1!
2MODULE oasis
3!
4! This module contains subroutines for initialization, sending and receiving
5! towards the coupler OASIS3. It also contains some parameters for the coupling.
6!
7! This module should always be compiled. With the coupler OASIS3 available the cpp key
8! CPP_COUPLE should be set and the entier of this file will then be compiled.
9! In a forced mode CPP_COUPLE should not be defined and the compilation ends before
10! the CONTAINS, without compiling the subroutines.
11!
12  USE dimphy
13  USE mod_phys_lmdz_para
14  USE write_field_phy
15
16#ifdef CPP_COUPLE
17! Use of Oasis-MCT coupler
18#if defined CPP_OMCT
19  USE mod_prism
20! Use of Oasis3 coupler
21#else
22  USE mod_prism_proto
23  USE mod_prism_def_partition_proto
24  USE mod_prism_get_proto
25  USE mod_prism_put_proto
26#endif
27#endif
28 
29  IMPLICIT NONE
30 
31  ! Id for fields sent to ocean
32  INTEGER, PARAMETER :: ids_tauxxu = 1
33  INTEGER, PARAMETER :: ids_tauyyu = 2
34  INTEGER, PARAMETER :: ids_tauzzu = 3
35  INTEGER, PARAMETER :: ids_tauxxv = 4
36  INTEGER, PARAMETER :: ids_tauyyv = 5
37  INTEGER, PARAMETER :: ids_tauzzv = 6
38  INTEGER, PARAMETER :: ids_windsp = 7
39  INTEGER, PARAMETER :: ids_shfice = 8
40  INTEGER, PARAMETER :: ids_shfoce = 9
41  INTEGER, PARAMETER :: ids_shftot = 10
42  INTEGER, PARAMETER :: ids_nsfice = 11
43  INTEGER, PARAMETER :: ids_nsfoce = 12
44  INTEGER, PARAMETER :: ids_nsftot = 13
45  INTEGER, PARAMETER :: ids_dflxdt = 14
46  INTEGER, PARAMETER :: ids_totrai = 15
47  INTEGER, PARAMETER :: ids_totsno = 16
48  INTEGER, PARAMETER :: ids_toteva = 17
49  INTEGER, PARAMETER :: ids_icevap = 18
50  INTEGER, PARAMETER :: ids_ocevap = 19
51  INTEGER, PARAMETER :: ids_calvin = 20
52  INTEGER, PARAMETER :: ids_liqrun = 21
53  INTEGER, PARAMETER :: ids_runcoa = 22
54  INTEGER, PARAMETER :: ids_rivflu = 23
55  INTEGER, PARAMETER :: ids_atmco2 = 24
56  INTEGER, PARAMETER :: ids_taumod = 25
57  INTEGER, PARAMETER :: ids_qraioc = 26
58  INTEGER, PARAMETER :: ids_qsnooc = 27
59  INTEGER, PARAMETER :: ids_qraiic = 28
60  INTEGER, PARAMETER :: ids_qsnoic = 29
61  INTEGER, PARAMETER :: maxsend    = 29  ! Maximum number of fields to send
62 
63  ! Id for fields received from ocean
64  INTEGER, PARAMETER :: idr_sisutw = 1
65  INTEGER, PARAMETER :: idr_icecov = 2
66  INTEGER, PARAMETER :: idr_icealw = 3
67  INTEGER, PARAMETER :: idr_icetem = 4
68  INTEGER, PARAMETER :: idr_curenx = 5
69  INTEGER, PARAMETER :: idr_cureny = 6
70  INTEGER, PARAMETER :: idr_curenz = 7
71  INTEGER, PARAMETER :: idr_oceco2 = 8
72  INTEGER, PARAMETER :: maxrecv    = 8  ! Maximum number of fields to receive
73 
74
75  TYPE, PUBLIC ::   FLD_CPL            ! Type for coupling field information
76     CHARACTER(len = 8) ::   name      ! Name of the coupling field   
77     LOGICAL            ::   action    ! To be exchanged or not
78     INTEGER            ::   nid       ! Id of the field
79  END TYPE FLD_CPL
80
81  TYPE(FLD_CPL), DIMENSION(maxsend), SAVE, PUBLIC :: infosend   ! Information for sending coupling fields
82!$OMP THREADPRIVATE(infosend)
83  TYPE(FLD_CPL), DIMENSION(maxrecv), SAVE, PUBLIC :: inforecv   ! Information for receiving coupling fields
84!$OMP THREADPRIVATE(inforecv)
85 
86  LOGICAL,SAVE :: cpl_current
87!$OMP THREADPRIVATE(cpl_current)
88
89#ifdef CPP_COUPLE
90
91CONTAINS
92
93  SUBROUTINE inicma
94!************************************************************************************
95!**** *INICMA*  - Initialize coupled mode communication for atmosphere
96!                 and exchange some initial information with Oasis
97!
98!     Rewrite to take the PRISM/psmile library into account
99!     LF 09/2003
100!
101    USE IOIPSL
102    USE surface_data, ONLY : version_ocean
103    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
104#ifdef CPP_XIOS
105    USE wxios, ONLY : wxios_context_init
106    USE xios 
107#endif
108    USE print_control_mod, ONLY: lunout
109    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, grid_type, unstructured, regular_lonlat
110    USE geometry_mod, ONLY: ind_cell_glo                   
111    USE mod_phys_lmdz_mpi_data, ONLY: klon_mpi_para_nb
112   
113
114
115! Local variables
116!************************************************************************************
117    INTEGER                            :: comp_id
118    INTEGER                            :: ierror, il_commlocal
119    INTEGER                            :: il_part_id
120    INTEGER, ALLOCATABLE               :: ig_paral(:)
121    INTEGER, DIMENSION(2)              :: il_var_nodims
122    INTEGER, DIMENSION(4)              :: il_var_actual_shape
123    INTEGER                            :: il_var_type
124    INTEGER                            :: jf
125    CHARACTER (len = 6)                :: clmodnam
126    CHARACTER (len = 20)               :: modname = 'inicma'
127    CHARACTER (len = 80)               :: abort_message
128    LOGICAL, SAVE                      :: cpl_current_omp
129
130!*    1. Initializations
131!        ---------------
132!************************************************************************************
133    WRITE(lunout,*) ' '
134    WRITE(lunout,*) ' '
135    WRITE(lunout,*) ' ROUTINE INICMA'
136    WRITE(lunout,*) ' **************'
137    WRITE(lunout,*) ' '
138    WRITE(lunout,*) ' '
139
140!
141! Define the model name
142!
143    IF (grid_type==unstructured) THEN
144        clmodnam = 'icosa'                 ! as in $NBMODEL in Cpl/Nam/namcouple.tmp
145    ELSE IF (grid_type==regular_lonlat) THEN
146        clmodnam = 'LMDZ'                  ! as in $NBMODEL in Cpl/Nam/namcouple.tmp
147    ELSE
148        abort_message='Pb : type of grid unknown'
149        CALL abort_physic(modname,abort_message,1)
150    ENDIF
151
152
153!************************************************************************************
154! Define if coupling ocean currents or not
155!************************************************************************************
156!$OMP MASTER
157    cpl_current_omp = .FALSE.
158    CALL getin('cpl_current', cpl_current_omp)
159!$OMP END MASTER
160!$OMP BARRIER
161    cpl_current = cpl_current_omp
162    WRITE(lunout,*) 'Couple ocean currents, cpl_current = ',cpl_current
163
164!************************************************************************************
165! Define coupling variables
166!************************************************************************************
167
168! Atmospheric variables to send
169
170!$OMP MASTER
171    infosend(:)%action = .FALSE.
172
173    infosend(ids_tauxxu)%action = .TRUE. ; infosend(ids_tauxxu)%name = 'COTAUXXU'
174    infosend(ids_tauyyu)%action = .TRUE. ; infosend(ids_tauyyu)%name = 'COTAUYYU'
175    infosend(ids_tauzzu)%action = .TRUE. ; infosend(ids_tauzzu)%name = 'COTAUZZU'
176    infosend(ids_tauxxv)%action = .TRUE. ; infosend(ids_tauxxv)%name = 'COTAUXXV'
177    infosend(ids_tauyyv)%action = .TRUE. ; infosend(ids_tauyyv)%name = 'COTAUYYV'
178    infosend(ids_tauzzv)%action = .TRUE. ; infosend(ids_tauzzv)%name = 'COTAUZZV'
179    infosend(ids_windsp)%action = .TRUE. ; infosend(ids_windsp)%name = 'COWINDSP'
180    infosend(ids_shfice)%action = .TRUE. ; infosend(ids_shfice)%name = 'COSHFICE'
181    infosend(ids_nsfice)%action = .TRUE. ; infosend(ids_nsfice)%name = 'CONSFICE'
182    infosend(ids_dflxdt)%action = .TRUE. ; infosend(ids_dflxdt)%name = 'CODFLXDT'
183    infosend(ids_calvin)%action = .TRUE. ; infosend(ids_calvin)%name = 'COCALVIN'
184   
185    IF (version_ocean=='nemo') THEN
186        infosend(ids_shftot)%action = .TRUE. ; infosend(ids_shftot)%name = 'COQSRMIX'
187        infosend(ids_nsftot)%action = .TRUE. ; infosend(ids_nsftot)%name = 'COQNSMIX'
188        infosend(ids_totrai)%action = .TRUE. ; infosend(ids_totrai)%name = 'COTOTRAI'
189        infosend(ids_totsno)%action = .TRUE. ; infosend(ids_totsno)%name = 'COTOTSNO'
190        infosend(ids_toteva)%action = .TRUE. ; infosend(ids_toteva)%name = 'COTOTEVA'
191        infosend(ids_icevap)%action = .TRUE. ; infosend(ids_icevap)%name = 'COICEVAP'
192        infosend(ids_liqrun)%action = .TRUE. ; infosend(ids_liqrun)%name = 'COLIQRUN'
193        infosend(ids_taumod)%action = .TRUE. ; infosend(ids_taumod)%name = 'COTAUMOD'
194        IF (carbon_cycle_cpl) THEN
195            infosend(ids_atmco2)%action = .TRUE. ; infosend(ids_atmco2)%name = 'COATMCO2'
196        ENDIF
197        infosend(ids_qraioc)%action = .TRUE. ; infosend(ids_qraioc)%name = 'COQRAIOC'
198        infosend(ids_qsnooc)%action = .TRUE. ; infosend(ids_qsnooc)%name = 'COQSNOOC'
199        infosend(ids_qraiic)%action = .TRUE. ; infosend(ids_qraiic)%name = 'COQRAIIC'
200        infosend(ids_qsnoic)%action = .TRUE. ; infosend(ids_qsnoic)%name = 'COQSNOIC'
201       
202    ELSE IF (version_ocean=='opa8') THEN
203        infosend(ids_shfoce)%action = .TRUE. ; infosend(ids_shfoce)%name = 'COSHFOCE'
204        infosend(ids_nsfoce)%action = .TRUE. ; infosend(ids_nsfoce)%name = 'CONSFOCE'
205        infosend(ids_icevap)%action = .TRUE. ; infosend(ids_icevap)%name = 'COTFSICE'
206        infosend(ids_ocevap)%action = .TRUE. ; infosend(ids_ocevap)%name = 'COTFSOCE'
207        infosend(ids_totrai)%action = .TRUE. ; infosend(ids_totrai)%name = 'COTOLPSU'
208        infosend(ids_totsno)%action = .TRUE. ; infosend(ids_totsno)%name = 'COTOSPSU'
209        infosend(ids_runcoa)%action = .TRUE. ; infosend(ids_runcoa)%name = 'CORUNCOA'
210        infosend(ids_rivflu)%action = .TRUE. ; infosend(ids_rivflu)%name = 'CORIVFLU'
211   ENDIF
212       
213! Oceanic variables to receive
214
215   inforecv(:)%action = .FALSE.
216
217   inforecv(idr_sisutw)%action = .TRUE. ; inforecv(idr_sisutw)%name = 'SISUTESW'
218   inforecv(idr_icecov)%action = .TRUE. ; inforecv(idr_icecov)%name = 'SIICECOV'
219   inforecv(idr_icealw)%action = .TRUE. ; inforecv(idr_icealw)%name = 'SIICEALW'
220   inforecv(idr_icetem)%action = .TRUE. ; inforecv(idr_icetem)%name = 'SIICTEMW'
221   
222   IF (cpl_current ) THEN
223       inforecv(idr_curenx)%action = .TRUE. ; inforecv(idr_curenx)%name = 'CURRENTX'
224       inforecv(idr_cureny)%action = .TRUE. ; inforecv(idr_cureny)%name = 'CURRENTY'
225       inforecv(idr_curenz)%action = .TRUE. ; inforecv(idr_curenz)%name = 'CURRENTZ'
226   ENDIF
227
228   IF (carbon_cycle_cpl ) THEN
229       inforecv(idr_oceco2)%action = .TRUE. ; inforecv(idr_oceco2)%name = 'SICO2FLX'
230   ENDIF
231
232!************************************************************************************
233! Here we go: psmile initialisation
234!************************************************************************************
235    IF (is_sequential) THEN
236       CALL prism_init_comp_proto (comp_id, clmodnam, ierror)
237       
238       IF (ierror .NE. PRISM_Ok) THEN
239          abort_message=' Probleme init dans prism_init_comp '
240          CALL abort_physic(modname,abort_message,1)
241       ELSE
242          WRITE(lunout,*) 'inicma : init psmile ok '
243       ENDIF
244    ENDIF
245
246    CALL prism_get_localcomm_proto (il_commlocal, ierror)
247!************************************************************************************
248! Domain decomposition
249!************************************************************************************
250    IF (grid_type==unstructured) THEN
251
252      ALLOCATE( ig_paral(klon_mpi_para_nb(mpi_rank) + 2) )
253
254      ig_paral(1) = 4                                      ! points partition for //
255      ig_paral(2) = klon_mpi_para_nb(mpi_rank)             ! nb of local cells
256
257      DO jf=1, klon_mpi_para_nb(mpi_rank)
258        ig_paral(2+jf) = ind_cell_glo(jf)
259      ENDDO
260
261    ELSE IF (grid_type==regular_lonlat) THEN
262
263      ALLOCATE( ig_paral(3) )
264
265      ig_paral(1) = 1                            ! apple partition for //
266      ig_paral(2) = (jj_begin-1)*nbp_lon+ii_begin-1  ! offset
267      ig_paral(3) = (jj_end*nbp_lon+ii_end) - (jj_begin*nbp_lon+ii_begin) + 1
268
269      IF (mpi_rank==mpi_size-1) ig_paral(3)=ig_paral(3)+nbp_lon-1
270    ELSE
271      abort_message='Pb : type of grid unknown'
272      CALL abort_physic(modname,abort_message,1)
273    ENDIF
274
275
276    WRITE(lunout,*) mpi_rank,'ig_paral--->',ig_paral(2),ig_paral(3)
277   
278    ierror=PRISM_Ok
279    CALL prism_def_partition_proto (il_part_id, ig_paral, ierror)
280
281    IF (ierror .NE. PRISM_Ok) THEN
282       abort_message=' Probleme dans prism_def_partition '
283       CALL abort_physic(modname,abort_message,1)
284    ELSE
285       WRITE(lunout,*) 'inicma : decomposition domaine psmile ok '
286    ENDIF
287
288    il_var_nodims(1) = 2                        ! rank of field array (1d or 2d)
289    il_var_nodims(2) = 1                        ! always 1 in current oasis version" doc oasis3mct p18
290
291    il_var_actual_shape(1) = 1                  ! min of 1st dimension (always 1)
292    il_var_actual_shape(2) = nbp_lon            ! max of 1st dimension
293    il_var_actual_shape(3) = 1                  ! min of 2nd dimension (always 1)
294    il_var_actual_shape(4) = nbp_lat            ! max of 2nd dimension
295   
296    il_var_type = PRISM_Real
297
298!************************************************************************************
299! Oceanic Fields to receive
300! Loop over all possible variables
301!************************************************************************************
302    DO jf=1, maxrecv
303       IF (inforecv(jf)%action) THEN
304          CALL prism_def_var_proto(inforecv(jf)%nid, inforecv(jf)%name, il_part_id, &
305               il_var_nodims, PRISM_In, il_var_actual_shape, il_var_type, &
306               ierror)
307          IF (ierror .NE. PRISM_Ok) THEN
308             WRITE(lunout,*) 'inicma : Problem with prism_def_var_proto for field : ',&
309                  inforecv(jf)%name
310             abort_message=' Problem in call to prism_def_var_proto for fields to receive'
311             CALL abort_physic(modname,abort_message,1)
312          ENDIF
313       ENDIF
314    END DO
315   
316!************************************************************************************
317! Atmospheric Fields to send
318! Loop over all possible variables
319!************************************************************************************
320    DO jf=1,maxsend
321       IF (infosend(jf)%action) THEN
322          CALL prism_def_var_proto(infosend(jf)%nid, infosend(jf)%name, il_part_id, &
323               il_var_nodims, PRISM_Out, il_var_actual_shape, il_var_type, &
324               ierror)
325          IF (ierror .NE. PRISM_Ok) THEN
326             WRITE(lunout,*) 'inicma : Problem with prism_def_var_proto for field : ',&
327                  infosend(jf)%name
328             abort_message=' Problem in call to prism_def_var_proto for fields to send'
329             CALL abort_physic(modname,abort_message,1)
330          ENDIF
331       ENDIF
332    END DO
333   
334!************************************************************************************
335! End definition
336!************************************************************************************
337#ifdef CPP_XIOS
338    CALL xios_oasis_enddef()
339#endif
340    CALL prism_enddef_proto(ierror)
341    IF (ierror .NE. PRISM_Ok) THEN
342       abort_message=' Problem in call to prism_endef_proto'
343       CALL abort_physic(modname,abort_message,1)
344    ELSE
345       WRITE(lunout,*) 'inicma : endef psmile ok '
346    ENDIF
347
348#ifdef CPP_XIOS
349!    CALL wxios_context_init()
350#endif
351
352!$OMP END MASTER
353   
354  END SUBROUTINE inicma
355
356!
357!************************************************************************************
358!
359
360  SUBROUTINE fromcpl(ktime, tab_get)
361! ======================================================================
362! L. Fairhead (09/2003) adapted From L.Z.X Li: this subroutine reads the SST
363! and Sea-Ice provided by the coupler. Adaptation to psmile library
364!======================================================================
365!
366    USE print_control_mod, ONLY: lunout
367    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
368! Input arguments
369!************************************************************************************
370    INTEGER, INTENT(IN)                               ::  ktime
371
372! Output arguments
373!************************************************************************************
374    REAL, DIMENSION(nbp_lon, jj_nb,maxrecv), INTENT(OUT) :: tab_get
375
376! Local variables
377!************************************************************************************
378    INTEGER                       :: ierror, i
379    INTEGER                       :: istart,iend
380    CHARACTER (len = 20)          :: modname = 'fromcpl'
381    CHARACTER (len = 80)          :: abort_message
382    REAL, DIMENSION(nbp_lon*jj_nb)    :: field
383
384!************************************************************************************
385    WRITE (lunout,*) ' '
386    WRITE (lunout,*) 'Fromcpl: Reading fields from CPL, ktime=',ktime
387    WRITE (lunout,*) ' '
388   
389    istart=ii_begin
390    IF (is_south_pole_dyn) THEN
391       iend=(jj_end-jj_begin)*nbp_lon+nbp_lon
392    ELSE
393       iend=(jj_end-jj_begin)*nbp_lon+ii_end
394    ENDIF
395   
396    DO i = 1, maxrecv
397      IF (inforecv(i)%action .AND. inforecv(i)%nid .NE. -1) THEN
398          field(:) = -99999.
399          CALL prism_get_proto(inforecv(i)%nid, ktime, field(istart:iend), ierror)
400          tab_get(:,:,i) = RESHAPE(field(:),(/nbp_lon,jj_nb/))
401       
402          IF (ierror .NE. PRISM_Ok .AND. ierror.NE.PRISM_Recvd .AND. &
403             ierror.NE.PRISM_FromRest &
404             .AND. ierror.NE.PRISM_Input .AND. ierror.NE.PRISM_RecvOut &
405             .AND. ierror.NE.PRISM_FromRestOut) THEN
406              WRITE (lunout,*)  'Error with receiving filed : ', inforecv(i)%name, ktime   
407              abort_message=' Problem in prism_get_proto '
408              CALL abort_physic(modname,abort_message,1)
409          ENDIF
410      ENDIF
411    END DO
412   
413   
414  END SUBROUTINE fromcpl
415
416!
417!************************************************************************************
418!
419
420  SUBROUTINE intocpl(ktime, last, tab_put)
421! ======================================================================
422! L. Fairhead (09/2003) adapted From L.Z.X Li: this subroutine provides the
423! atmospheric coupling fields to the coupler with the psmile library.
424! IF last time step, writes output fields to binary files.
425! ======================================================================
426!
427!
428    USE print_control_mod, ONLY: lunout
429    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
430! Input arguments
431!************************************************************************************
432    INTEGER, INTENT(IN)                              :: ktime
433    LOGICAL, INTENT(IN)                              :: last
434    REAL, DIMENSION(nbp_lon, jj_nb, maxsend), INTENT(IN) :: tab_put
435
436! Local variables
437!************************************************************************************
438    LOGICAL                          :: checkout
439    INTEGER                          :: istart,iend
440    INTEGER                          :: wstart,wend
441    INTEGER                          :: ierror, i
442    REAL, DIMENSION(nbp_lon*jj_nb)       :: field
443    CHARACTER (len = 20),PARAMETER   :: modname = 'intocpl'
444    CHARACTER (len = 80)             :: abort_message
445
446!************************************************************************************
447    checkout=.FALSE.
448
449    WRITE(lunout,*) ' '
450    WRITE(lunout,*) 'Intocpl: sending fields to CPL, ktime= ', ktime
451    WRITE(lunout,*) 'last = ', last
452    WRITE(lunout,*)
453
454
455    istart=ii_begin
456    IF (is_south_pole_dyn) THEN
457       iend=(jj_end-jj_begin)*nbp_lon+nbp_lon
458    ELSE
459       iend=(jj_end-jj_begin)*nbp_lon+ii_end
460    ENDIF
461   
462    IF (checkout) THEN   
463       wstart=istart
464       wend=iend
465       IF (is_north_pole_dyn) wstart=istart+nbp_lon-1
466       IF (is_south_pole_dyn) wend=iend-nbp_lon+1
467       
468       DO i = 1, maxsend
469          IF (infosend(i)%action) THEN
470             field = RESHAPE(tab_put(:,:,i),(/nbp_lon*jj_nb/))
471             CALL writefield_phy(infosend(i)%name,field(wstart:wend),1)
472          END IF
473       END DO
474    END IF
475
476!************************************************************************************
477! PRISM_PUT
478!************************************************************************************
479
480    DO i = 1, maxsend
481      IF (infosend(i)%action .AND. infosend(i)%nid .NE. -1 ) THEN
482          field = RESHAPE(tab_put(:,:,i),(/nbp_lon*jj_nb/))
483          CALL prism_put_proto(infosend(i)%nid, ktime, field(istart:iend), ierror)
484         
485          IF (ierror .NE. PRISM_Ok .AND. ierror.NE.PRISM_Sent .AND. ierror.NE.PRISM_ToRest &
486             .AND. ierror.NE.PRISM_LocTrans .AND. ierror.NE.PRISM_Output .AND. &
487             ierror.NE.PRISM_SentOut .AND. ierror.NE.PRISM_ToRestOut) THEN
488              WRITE (lunout,*) 'Error with sending field :', infosend(i)%name, ktime   
489              abort_message=' Problem in prism_put_proto '
490              CALL abort_physic(modname,abort_message,1)
491          ENDIF
492      ENDIF
493    END DO
494   
495!************************************************************************************
496! Finalize PSMILE for the case is_sequential, if parallel finalization is done
497! from Finalize_parallel in dyn3dpar/parallel.F90
498!************************************************************************************
499
500    IF (last) THEN
501       IF (is_sequential) THEN
502          CALL prism_terminate_proto(ierror)
503          IF (ierror .NE. PRISM_Ok) THEN
504             abort_message=' Problem in prism_terminate_proto '
505             CALL abort_physic(modname,abort_message,1)
506          ENDIF
507       ENDIF
508    ENDIF
509   
510   
511  END SUBROUTINE intocpl
512
513#endif
514 
515END MODULE oasis
Note: See TracBrowser for help on using the repository browser.