source: LMDZ4/trunk/libf/phylmd/oasis.psmile @ 682

Last change on this file since 682 was 626, checked in by Laurent Fairhead, 20 years ago

Modifications pour phasage avec OASIS3 AC
LF
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 17.9 KB
RevLine 
[524]1!
2! $Header$
3!
4
5  MODULE oasis
6
7! Module contenant les routines pour l'initialisation du couplage, la
8! lecture et l'ecriture des champs venant/transmis au coupleur
9!
10
11  IMPLICIT none
12
13  PRIVATE
14  PUBLIC :: inicma, fromcpl, intocpl
15
16  INTERFACE inicma
17    module procedure inicma
18  END INTERFACE 
19
20#include "param_cou.h"
21
22   integer, dimension(jpfldo2a), save              :: in_var_id
23   integer, dimension(jpflda2o1+jpflda2o2), save  :: il_out_var_id
[626]24   CHARACTER (len=8), dimension(jpmaxfld), public, save   :: cl_writ, cl_read
[524]25   CHARACTER (len=8), dimension(jpmaxfld), save   :: cl_f_writ, cl_f_read
26
[626]27  CONTAINS
[524]28
29!****
30!
31!**** *INICMA*  - Initialize coupled mode communication for atmosphere
32!                 and exchange some initial information with Oasis
33!
34!     Rewrite to take the PRISM/psmile library into account
35!     LF 09/2003
36!
37!     Input:
38!     -----
39!        im, jm: size of grid passed between gcm and coupler
40!
41!     -----------------------------------------------------------
42!
43   SUBROUTINE inicma(im, jm)
44
45   use mod_prism_proto
46   use mod_prism_def_partition_proto
47
48   implicit none
49
50#include "param_cou.h"
51
52!
53! parameters
54!
55   integer                  :: im, jm
56!
57! local variables
58!
59! integers
60!
61   integer                                  :: comp_id
[626]62   integer                                  :: ierror, il_commlocal
[524]63   integer                                  :: il_part_id
64   integer, dimension(:), allocatable       :: ig_paral
65   integer, dimension(2)                    :: il_var_nodims
66   integer, dimension(4)                    :: il_var_actual_shape
67   integer                                  :: il_var_type
68   integer                                  :: nuout = 6
69   integer                                  :: jf
70! characters
71!
72   character (len = 6)        :: clmodnam
73   character (len = 20),save  :: modname = 'inicma'
74   character (len = 80)       :: abort_message
75   
76!
77!     -----------------------------------------------------------
78!
79!*    1. Initializations
80!        ---------------
81!
82   WRITE(nuout,*) ' '
83   WRITE(nuout,*) ' '
84   WRITE(nuout,*) ' ROUTINE INICMA'
85   WRITE(nuout,*) ' **************'
86   WRITE(nuout,*) ' '
87   WRITE(nuout,*) ' '
88!
89!     Define the model name
90!
91   clmodnam = 'lmdz.x'       ! as in $NBMODEL in Cpl/Nam/namcouple.tmp
92!
93!
94! Here we go: psmile initialisation
95!
96   call prism_init_comp_proto (comp_id, clmodnam, ierror)
97
98   IF (ierror .ne. PRISM_Ok) THEN
99      abort_message=' Probleme init dans prism_init_comp '
100      call abort_gcm(modname,abort_message,1)
101   ELSE
102      WRITE(nuout,*) 'inicma : init psmile ok '
103   ENDIF
104
[626]105! PSMILe attribution of local communicator
[524]106!
[626]107   call prism_get_localcomm_proto (il_commlocal, ierror)
108!
[524]109! and domain decomposition
110!
111! monoproc case
112!
[626]113   allocate(ig_paral(5))
114   ig_paral (1) = 2
115   ig_paral (2) = 0
116   ig_paral (3) = im
117   ig_paral (4) = jm
118   ig_paral (5) = im
[524]119
120   call prism_def_partition_proto (il_part_id, ig_paral, ierror)
121   deallocate(ig_paral)
122!
123   IF (ierror .ne. PRISM_Ok) THEN
124     abort_message=' Probleme dans prism_def_partition '
125     call abort_gcm(modname,abort_message,1)
126   ELSE
127     WRITE(nuout,*) 'inicma : decomposition domaine psmile ok '
128   ENDIF
129
130!
131! Field Declarations
132!
133!     Define symbolic name for fields exchanged from atmos to coupler,
134!         must be the same as (1) of the field  definition in namcouple:
135!
[626]136      cl_writ(1)='COTAUXXU'
137      cl_writ(2)='COTAUYYU'
138      cl_writ(3)='COTAUZZU'
139      cl_writ(4)='COTAUXXV'
140      cl_writ(5)='COTAUYYV'
141      cl_writ(6)='COTAUZZV'
142c -- LOOP
143      cl_writ(7)='COWINDSP'
144c -- LOOP
145      cl_writ(8)='COSHFICE'
146      cl_writ(9)='COSHFOCE'
147      cl_writ(10)='CONSFICE'
148      cl_writ(11)='CONSFOCE'
149      cl_writ(12)='CODFLXDT'
150      cl_writ(13)='COTFSICE'
151      cl_writ(14)='COTFSOCE'
152      cl_writ(15)='COTOLPSU'
153      cl_writ(16)='COTOSPSU'
154      cl_writ(17)='CORUNCOA'
155      cl_writ(18)='CORIVFLU'
156      cl_writ(19)='COCALVIN'
[524]157!
158!     Define symbolic name for fields exchanged from coupler to atmosphere,
159!         must be the same as (2) of the field  definition in namcouple:
160!
161   cl_read(1)='SISUTESW'
162   cl_read(2)='SIICECOV'
163   cl_read(3)='SIICEALW'
164   cl_read(4)='SIICTEMW'
165
166   il_var_nodims(1) = 2
167   il_var_nodims(2) = 1
168
169   il_var_actual_shape(1) = 1
170   il_var_actual_shape(2) = im
171   il_var_actual_shape(3) = 1
172   il_var_actual_shape(4) = jm
173   
174   il_var_type = PRISM_Real
175!
176! Oceanic Fields
177!
178   DO jf=1, jpfldo2a
179     call prism_def_var_proto(in_var_id(jf), cl_read(jf), il_part_id, &
180&               il_var_nodims, PRISM_In, il_var_actual_shape, il_var_type, &
181&               ierror)
182     IF (ierror .ne. PRISM_Ok) THEN
183        abort_message=' Probleme init dans prism_def_var_proto '
184        call abort_gcm(modname,abort_message,1)
185     ENDIF
186   END DO
187!
188! Atmospheric Fields
189!
190   DO jf=1, jpflda2o1+jpflda2o2
191     call prism_def_var_proto(il_out_var_id(jf), cl_writ(jf), il_part_id, &
192&               il_var_nodims, PRISM_Out, il_var_actual_shape, il_var_type, &
193&               ierror)
194     IF (ierror .ne. PRISM_Ok) THEN
195        abort_message=' Probleme init dans prism_def_var_proto '
196        call abort_gcm(modname,abort_message,1)
197     ENDIF
198   END DO
199!
200! End
201!
202   call prism_enddef_proto(ierror)
203   IF (ierror .ne. PRISM_Ok) THEN
204      abort_message=' Probleme init dans prism_ endef_proto'
205      call abort_gcm(modname,abort_message,1)
206   ELSE
207      WRITE(nuout,*) 'inicma : endef psmile ok '
208   ENDIF
209
210   END SUBROUTINE inicma
211
212   SUBROUTINE fromcpl(kt, im, jm, sst, gla, tice, albedo)
213! ======================================================================
214! L. Fairhead (09/2003) adapted From L.Z.X Li: this subroutine reads the SST
215! and Sea-Ice provided by the coupler. Adaptation to psmile library
216!======================================================================
217
218   use mod_prism_proto
219   use mod_prism_get_proto
220
221   IMPLICIT none
222
223!
224! parametres
225!
226   integer                 :: im, jm, kt
227   real, dimension(im, jm)   :: sst            ! sea-surface-temperature
228   real, dimension(im, jm)   :: gla     ! sea-ice
229   real, dimension(im, jm)   :: tice    ! temp glace
230   real, dimension(im, jm)   :: albedo  ! albedo glace
231!
232! local variables
233!
234   integer                 :: nuout  = 6             ! listing output unit
235   integer                 :: ierror
236   character (len = 20),save  :: modname = 'fromcpl'
237   character (len = 80)       :: abort_message
238!
239#include "param_cou.h"
240!
241!
242   WRITE (nuout,*) ' '
243   WRITE (nuout,*) 'Fromcpl: Reading fields from CPL, kt=',kt
244   WRITE (nuout,*) ' '
245   CALL flush (nuout)
246
247   call prism_get_proto(in_var_id(1), kt, sst, ierror)
[626]248   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. &
249 &     ierror.ne.PRISM_FromRest &
250 &     .and. ierror.ne.PRISM_Input .and. ierror.ne.PRISM_RecvOut &
251 &     .and. ierror.ne.PRISM_FromRestOut) THEN
[524]252     WRITE (nuout,*)  cl_read(1), kt   
253     abort_message=' Probleme dans prism_get_proto '
254     call abort_gcm(modname,abort_message,1)
255   endif
256   call prism_get_proto(in_var_id(2), kt, gla, ierror)
[626]257   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. &
258 &     ierror.ne.PRISM_FromRest &
259 &     .and. ierror.ne.PRISM_Input .and. ierror.ne.PRISM_RecvOut &
260 &     .and. ierror.ne.PRISM_FromRestOut) THEN
[524]261     WRITE (nuout,*)  cl_read(2), kt   
262     abort_message=' Probleme dans prism_get_proto '
263     call abort_gcm(modname,abort_message,1)
264   endif
265   call prism_get_proto(in_var_id(3), kt, albedo, ierror)
[626]266   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. &
267 &     ierror.ne.PRISM_FromRest &
268 &     .and. ierror.ne.PRISM_Input .and. ierror.ne.PRISM_RecvOut &
269 &     .and. ierror.ne.PRISM_FromRestOut) THEN
[524]270     WRITE (nuout,*)  cl_read(3), kt   
271     abort_message=' Probleme dans prism_get_proto '
272     call abort_gcm(modname,abort_message,1)
273   endif
274   call prism_get_proto(in_var_id(4), kt, tice, ierror)
[626]275   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. &
276 &     ierror.ne.PRISM_FromRest &
277 &     .and. ierror.ne.PRISM_Input .and. ierror.ne.PRISM_RecvOut &
278 &     .and. ierror.ne.PRISM_FromRestOut) THEN
[524]279     WRITE (nuout,*)  cl_read(4), kt   
280     abort_message=' Probleme dans prism_get_proto '
281     call abort_gcm(modname,abort_message,1)
282   endif
283
284!
285   RETURN
286   END SUBROUTINE fromcpl
287
288   SUBROUTINE intocpl(kt, im, jm, fsolice, fsolwat, fnsolice, fnsolwat, &
289 &    fnsicedt, evice, evwat, lpre, spre, dirunoff, rivrunoff, &
290 &    calving, tauxx_u, tauyy_u, tauzz_u, tauxx_v, tauyy_v, tauzz_v &
[626]291c -- LOOP
292     $    windsp,
293c -- LOOP
[524]294 &    , last)
295! ======================================================================
296! L. Fairhead (09/2003) adapted From L.Z.X Li: this subroutine provides the
297! atmospheric coupling fields to the coupler with the psmile library.
298! IF last time step, writes output fields to binary files.
299! ======================================================================
300
301   use mod_prism_proto
302   use mod_prism_put_proto
303
304   IMPLICIT NONE
305
306!
307! parametres
308!
309   integer               :: kt, im, jm
310   real, dimension(im, jm) :: fsolice, fsolwat, fnsolwat, fnsolice
311   real, dimension(im, jm) :: fnsicedt, evice, evwat, lpre, spre
312   real, dimension(im, jm) :: dirunoff, rivrunoff, calving
313   real, dimension(im, jm) :: tauxx_u, tauxx_v, tauyy_u
314   real, dimension(im, jm) :: tauyy_v, tauzz_u, tauzz_v
[626]315   real, dimension(im, jm) :: windsp
[524]316   logical               :: last
317!
318! local
319!
320   integer, parameter    :: nuout = 6
321   integer               :: ierror
322   character (len = 20),save  :: modname = 'intocpl'
323   character (len = 80)       :: abort_message
324!
325!
326      WRITE(nuout,*) ' '
327      WRITE(nuout,*) 'Intocpl: sending fields to CPL, kt= ', kt
328      WRITE(nuout,*) 'last  ', last
329      WRITE(nuout,*)
330
[626]331   call prism_put_proto(il_out_var_id(8), kt, fsolice, ierror)
332   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
333 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
334 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
335     WRITE (nuout,*)  cl_writ(8), kt   
[524]336     abort_message=' Probleme dans prism_put_proto '
337     call abort_gcm(modname,abort_message,1)
338   endif
[626]339   call prism_put_proto(il_out_var_id(9), kt, fsolwat, ierror)
340   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
341 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
342 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
343     WRITE (nuout,*)  cl_writ(9), kt   
[524]344     abort_message=' Probleme dans prism_put_proto '
345     call abort_gcm(modname,abort_message,1)
346   endif
[626]347   call prism_put_proto(il_out_var_id(10), kt, fnsolice, ierror)
348   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
349 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
350 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
351     WRITE (nuout,*)  cl_writ(10), kt   
[524]352     abort_message=' Probleme dans prism_put_proto '
353     call abort_gcm(modname,abort_message,1)
354   endif
[626]355   call prism_put_proto(il_out_var_id(11), kt, fnsolwat, ierror)
356   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
357 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
358 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
359     WRITE (nuout,*)  cl_writ(11), kt   
[524]360     abort_message=' Probleme dans prism_put_proto '
361     call abort_gcm(modname,abort_message,1)
362   endif
[626]363   call prism_put_proto(il_out_var_id(12), kt, fnsicedt, ierror)
364   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
365 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
366 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
367     WRITE (nuout,*)  cl_writ(12), kt   
[524]368     abort_message=' Probleme dans prism_put_proto '
369     call abort_gcm(modname,abort_message,1)
370   endif
[626]371   call prism_put_proto(il_out_var_id(13), kt, evice, ierror)
372   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
373 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
374 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
375     WRITE (nuout,*)  cl_writ(13), kt   
[524]376     abort_message=' Probleme dans prism_put_proto '
377     call abort_gcm(modname,abort_message,1)
378   endif
[626]379   call prism_put_proto(il_out_var_id(14), kt, evwat, ierror)
380   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
381 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
382 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
383     WRITE (nuout,*)  cl_writ(14), kt   
[524]384     abort_message=' Probleme dans prism_put_proto '
385     call abort_gcm(modname,abort_message,1)
386   endif
[626]387   call prism_put_proto(il_out_var_id(15), kt, lpre, ierror)
388   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
389 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
390 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
391     WRITE (nuout,*)  cl_writ(15), kt   
[524]392     abort_message=' Probleme dans prism_put_proto '
393     call abort_gcm(modname,abort_message,1)
394   endif
[626]395   call prism_put_proto(il_out_var_id(16), kt, spre, ierror)
396   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
397 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
398 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
399     WRITE (nuout,*)  cl_writ(16), kt   
[524]400     abort_message=' Probleme dans prism_put_proto '
401     call abort_gcm(modname,abort_message,1)
402   endif
[626]403   call prism_put_proto(il_out_var_id(17), kt, dirunoff, ierror)
404   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
405 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
406 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
407     WRITE (nuout,*)  cl_writ(17), kt   
[524]408     abort_message=' Probleme dans prism_put_proto '
409     call abort_gcm(modname,abort_message,1)
410   endif
[626]411   call prism_put_proto(il_out_var_id(18), kt, rivrunoff, ierror)
412   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
413 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
414 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
415     WRITE (nuout,*)  cl_writ(18), kt   
[524]416     abort_message=' Probleme dans prism_put_proto '
417     call abort_gcm(modname,abort_message,1)
418   endif
[626]419   call prism_put_proto(il_out_var_id(19), kt, calving, ierror)
420   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
421 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
422 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
423     WRITE (nuout,*)  cl_writ(19), kt   
[524]424     abort_message=' Probleme dans prism_put_proto '
425     call abort_gcm(modname,abort_message,1)
426   endif
[626]427   call prism_put_proto(il_out_var_id(1), kt, tauxx_u, ierror)
428   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
429 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
430 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
431     WRITE (nuout,*)  cl_writ(1), kt   
[524]432     abort_message=' Probleme dans prism_put_proto '
433     call abort_gcm(modname,abort_message,1)
434   endif
[626]435   call prism_put_proto(il_out_var_id(2), kt, tauyy_u, ierror)
436   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
437 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
438 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
439     WRITE (nuout,*)  cl_writ(2), kt   
[524]440     abort_message=' Probleme dans prism_put_proto '
441     call abort_gcm(modname,abort_message,1)
442   endif
[626]443   call prism_put_proto(il_out_var_id(3), kt, tauzz_u, ierror)
444   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
445 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
446 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
447     WRITE (nuout,*)  cl_writ(3), kt   
[524]448     abort_message=' Probleme dans prism_put_proto '
449     call abort_gcm(modname,abort_message,1)
450   endif
[626]451   call prism_put_proto(il_out_var_id(4), kt, tauxx_v, ierror)
452   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
453 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
454 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
455     WRITE (nuout,*)  cl_writ(4), kt   
[524]456     abort_message=' Probleme dans prism_put_proto '
457     call abort_gcm(modname,abort_message,1)
458   endif
[626]459   call prism_put_proto(il_out_var_id(5), kt, tauyy_v, ierror)
460   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
461 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
462 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
463     WRITE (nuout,*)  cl_writ(5), kt   
[524]464     abort_message=' Probleme dans prism_put_proto '
465     call abort_gcm(modname,abort_message,1)
466   endif
[626]467   call prism_put_proto(il_out_var_id(6), kt, tauzz_v, ierror)
468   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
469 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
470 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
471     WRITE (nuout,*)  cl_writ(6), kt   
[524]472     abort_message=' Probleme dans prism_put_proto '
473     call abort_gcm(modname,abort_message,1)
474   endif
[626]475   call prism_put_proto(il_out_var_id(7), kt, windsp, ierror)
476   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
477 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
478 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
479     WRITE (nuout,*)  cl_writ(7), kt   
480     abort_message=' Probleme dans prism_put_proto '
481     call abort_gcm(modname,abort_message,1)
482   endif
[524]483
484   if (last) then
485     call prism_terminate_proto(ierror)
486     IF (ierror .ne. PRISM_Ok) THEN
487       abort_message=' Probleme dans prism_terminate_proto '
488       call abort_gcm(modname,abort_message,1)
489     endif
490   endif
491
492
493   RETURN
494   END SUBROUTINE intocpl
495
496   END MODULE oasis
Note: See TracBrowser for help on using the repository browser.