source: LMDZ4/branches/V3_test/libf/phylmd/oasis.psmile @ 735

Last change on this file since 735 was 704, checked in by Laurent Fairhead, 18 years ago

Inclusion des modifs de Y. Meurdesoif pour la version V3
LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 20.3 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
[704]47   use dimphy
[524]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!
[704]96!ym   call prism_init_comp_proto (comp_id, clmodnam, ierror)
97!ym
98!ym   IF (ierror .ne. PRISM_Ok) THEN
99!ym      abort_message=' Probleme init dans prism_init_comp '
100!ym      call abort_gcm(modname,abort_message,1)
101!ym   ELSE
102!ym      WRITE(nuout,*) 'inicma : init psmile ok '
103!ym   ENDIF
104      call prism_get_localcomm_proto (il_commlocal, ierror)
[524]105!
106! and domain decomposition
107!
108! monoproc case
109!
[704]110   allocate(ig_paral(3))
111!ym   ig_paral(1) = 0
112!ym   ig_paral(2) = 0
113!ym   ig_paral(3) = im * jm
114   ig_paral(1) = 1    ! apple partition for //
115   ig_paral(2) = (jjphy_begin-1)*im+iiphy_begin-1
116   ig_paral(3) = (jjphy_end*im+iiphy_end)-(jjphy_begin*im+iiphy_begin)+1
117   if (phy_rank==phy_size-1) ig_paral(3)=ig_paral(3)+im-1
118   print *,phy_rank,'ig_paral--->',ig_paral(2),ig_paral(3)
119   
120   ierror=PRISM_Ok
[524]121   call prism_def_partition_proto (il_part_id, ig_paral, ierror)
122   deallocate(ig_paral)
123!
124   IF (ierror .ne. PRISM_Ok) THEN
125     abort_message=' Probleme dans prism_def_partition '
126     call abort_gcm(modname,abort_message,1)
127   ELSE
128     WRITE(nuout,*) 'inicma : decomposition domaine psmile ok '
129   ENDIF
130
131!
132! Field Declarations
133!
134!     Define symbolic name for fields exchanged from atmos to coupler,
135!         must be the same as (1) of the field  definition in namcouple:
136!
[626]137      cl_writ(1)='COTAUXXU'
138      cl_writ(2)='COTAUYYU'
139      cl_writ(3)='COTAUZZU'
140      cl_writ(4)='COTAUXXV'
141      cl_writ(5)='COTAUYYV'
142      cl_writ(6)='COTAUZZV'
[704]143! -- LOOP
[626]144      cl_writ(7)='COWINDSP'
[704]145! -- LOOP
[626]146      cl_writ(8)='COSHFICE'
147      cl_writ(9)='COSHFOCE'
148      cl_writ(10)='CONSFICE'
149      cl_writ(11)='CONSFOCE'
150      cl_writ(12)='CODFLXDT'
151      cl_writ(13)='COTFSICE'
152      cl_writ(14)='COTFSOCE'
153      cl_writ(15)='COTOLPSU'
154      cl_writ(16)='COTOSPSU'
155      cl_writ(17)='CORUNCOA'
156      cl_writ(18)='CORIVFLU'
157      cl_writ(19)='COCALVIN'
[524]158!
159!     Define symbolic name for fields exchanged from coupler to atmosphere,
160!         must be the same as (2) of the field  definition in namcouple:
161!
162   cl_read(1)='SISUTESW'
163   cl_read(2)='SIICECOV'
164   cl_read(3)='SIICEALW'
165   cl_read(4)='SIICTEMW'
166
167   il_var_nodims(1) = 2
168   il_var_nodims(2) = 1
169
170   il_var_actual_shape(1) = 1
171   il_var_actual_shape(2) = im
172   il_var_actual_shape(3) = 1
173   il_var_actual_shape(4) = jm
174   
175   il_var_type = PRISM_Real
176!
177! Oceanic Fields
178!
179   DO jf=1, jpfldo2a
180     call prism_def_var_proto(in_var_id(jf), cl_read(jf), il_part_id, &
181&               il_var_nodims, PRISM_In, il_var_actual_shape, il_var_type, &
182&               ierror)
183     IF (ierror .ne. PRISM_Ok) THEN
184        abort_message=' Probleme init dans prism_def_var_proto '
185        call abort_gcm(modname,abort_message,1)
186     ENDIF
187   END DO
188!
189! Atmospheric Fields
190!
191   DO jf=1, jpflda2o1+jpflda2o2
192     call prism_def_var_proto(il_out_var_id(jf), cl_writ(jf), il_part_id, &
193&               il_var_nodims, PRISM_Out, il_var_actual_shape, il_var_type, &
194&               ierror)
195     IF (ierror .ne. PRISM_Ok) THEN
196        abort_message=' Probleme init dans prism_def_var_proto '
197        call abort_gcm(modname,abort_message,1)
198     ENDIF
199   END DO
200!
201! End
202!
203   call prism_enddef_proto(ierror)
204   IF (ierror .ne. PRISM_Ok) THEN
205      abort_message=' Probleme init dans prism_ endef_proto'
206      call abort_gcm(modname,abort_message,1)
207   ELSE
208      WRITE(nuout,*) 'inicma : endef psmile ok '
209   ENDIF
210
211   END SUBROUTINE inicma
212
213   SUBROUTINE fromcpl(kt, im, jm, sst, gla, tice, albedo)
214! ======================================================================
215! L. Fairhead (09/2003) adapted From L.Z.X Li: this subroutine reads the SST
216! and Sea-Ice provided by the coupler. Adaptation to psmile library
217!======================================================================
218
219   use mod_prism_proto
220   use mod_prism_get_proto
[704]221   use dimphy
[524]222   IMPLICIT none
223
224!
225! parametres
226!
227   integer                 :: im, jm, kt
[704]228   real, dimension(im*jm)   :: sst            ! sea-surface-temperature
229   real, dimension(im*jm)   :: gla     ! sea-ice
230   real, dimension(im*jm)   :: tice    ! temp glace
231   real, dimension(im*jm)   :: albedo  ! albedo glace
[524]232!
233! local variables
234!
235   integer                 :: nuout  = 6             ! listing output unit
236   integer                 :: ierror
237   character (len = 20),save  :: modname = 'fromcpl'
238   character (len = 80)       :: abort_message
[704]239   integer :: istart,iend
[524]240!
241#include "param_cou.h"
242!
243!
244   WRITE (nuout,*) ' '
245   WRITE (nuout,*) 'Fromcpl: Reading fields from CPL, kt=',kt
246   WRITE (nuout,*) ' '
247   CALL flush (nuout)
248
[704]249   istart=iiphy_begin
250   if (phy_rank==phy_size-1) then
251    iend=(jjphy_end-jjphy_begin)*im+im
252   else
253    iend=(jjphy_end-jjphy_begin)*im+iiphy_end
254   endif
255   
256   call prism_get_proto(in_var_id(1), kt, sst(istart:iend), 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(1), kt   
262     abort_message=' Probleme dans prism_get_proto '
263     call abort_gcm(modname,abort_message,1)
264   endif
[704]265   call prism_get_proto(in_var_id(2), kt, gla(istart:iend), 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(2), kt   
271     abort_message=' Probleme dans prism_get_proto '
272     call abort_gcm(modname,abort_message,1)
273   endif
[704]274   call prism_get_proto(in_var_id(3), kt, albedo(istart:iend), 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(3), kt   
280     abort_message=' Probleme dans prism_get_proto '
281     call abort_gcm(modname,abort_message,1)
282   endif
[704]283   call prism_get_proto(in_var_id(4), kt, tice(istart:iend), ierror)
[626]284   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. &
285 &     ierror.ne.PRISM_FromRest &
286 &     .and. ierror.ne.PRISM_Input .and. ierror.ne.PRISM_RecvOut &
287 &     .and. ierror.ne.PRISM_FromRestOut) THEN
[524]288     WRITE (nuout,*)  cl_read(4), kt   
289     abort_message=' Probleme dans prism_get_proto '
290     call abort_gcm(modname,abort_message,1)
291   endif
292
293!
294   RETURN
295   END SUBROUTINE fromcpl
296
297   SUBROUTINE intocpl(kt, im, jm, fsolice, fsolwat, fnsolice, fnsolwat, &
298 &    fnsicedt, evice, evwat, lpre, spre, dirunoff, rivrunoff, &
[704]299 &    calving, tauxx_u, tauyy_u, tauzz_u, tauxx_v, tauyy_v, tauzz_v, &
300! -- LOOP
301 &    windsp,                                                       &
302! -- LOOP
303 &    last)
[524]304! ======================================================================
305! L. Fairhead (09/2003) adapted From L.Z.X Li: this subroutine provides the
306! atmospheric coupling fields to the coupler with the psmile library.
307! IF last time step, writes output fields to binary files.
308! ======================================================================
309
310   use mod_prism_proto
311   use mod_prism_put_proto
[704]312   use dimphy
313   use write_field_phy
[524]314   IMPLICIT NONE
315
316!
317! parametres
318!
319   integer               :: kt, im, jm
[704]320   real, dimension(im* jm) :: fsolice, fsolwat, fnsolwat, fnsolice
321   real, dimension(im* jm) :: fnsicedt, evice, evwat, lpre, spre
322   real, dimension(im* jm) :: dirunoff, rivrunoff, calving
323   real, dimension(im* jm) :: tauxx_u, tauxx_v, tauyy_u
324   real, dimension(im* jm) :: tauyy_v, tauzz_u, tauzz_v
325   real, dimension(im*jm) :: windsp
[524]326   logical               :: last
[704]327   logical :: checkout=.FALSE.
328   integer :: istart,iend
329   integer :: wstart,wend
[524]330!
331! local
332!
333   integer, parameter    :: nuout = 6
334   integer               :: ierror
335   character (len = 20),save  :: modname = 'intocpl'
336   character (len = 80)       :: abort_message
337!
338!
339      WRITE(nuout,*) ' '
340      WRITE(nuout,*) 'Intocpl: sending fields to CPL, kt= ', kt
341      WRITE(nuout,*) 'last  ', last
342      WRITE(nuout,*)
343
[704]344   istart=iiphy_begin
345   if (phy_rank==phy_size-1) then
346    iend=(jjphy_end-jjphy_begin)*im+im
347   else
348    iend=(jjphy_end-jjphy_begin)*im+iiphy_end
349   endif
350
351   IF (checkout) THEN   
352     wstart=istart
353     wend=iend
354     IF (phy_rank==0) wstart=istart+im-1
355     IF (phy_rank==phy_size-1) wend=iend-im+1
356   
357     CALL writeField_phy("fsolice",fsolice(wstart:wend),1)
358     CALL writeField_phy("fsolwat",fsolwat(wstart:wend),1)
359     CALL writeField_phy("fnsolice",fnsolice(wstart:wend),1)
360     CALL writeField_phy("fnsolwat",fnsolwat(wstart:wend),1)
361     CALL writeField_phy("fnsicedt",fnsicedt(wstart:wend),1)
362     CALL writeField_phy("evice",evice(wstart:wend),1)
363     CALL writeField_phy("evwat",evwat(wstart:wend),1)
364     CALL writeField_phy("lpre",lpre(wstart:wend),1)
365     CALL writeField_phy("spre",spre(wstart:wend),1)
366     CALL writeField_phy("dirunoff",dirunoff(wstart:wend),1)
367     CALL writeField_phy("rivrunoff",rivrunoff(wstart:wend),1)
368     CALL writeField_phy("calving",calving(wstart:wend),1)
369     CALL writeField_phy("tauxx_u",tauxx_u(wstart:wend),1)
370     CALL writeField_phy("tauyy_u",tauyy_u(wstart:wend),1)
371     CALL writeField_phy("tauzz_u",tauzz_u(wstart:wend),1)
372     CALL writeField_phy("tauxx_v",tauxx_v(wstart:wend),1)
373     CALL writeField_phy("tauyy_v",tauyy_v(wstart:wend),1)
374     CALL writeField_phy("tauzz_v",tauzz_v(wstart:wend),1)
375     CALL writeField_phy("windsp",windsp(wstart:wend),1)
376   ENDIF
377   
378   call prism_put_proto(il_out_var_id(8), kt, fsolice(istart:iend), ierror)
[626]379   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
380 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
381 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
382     WRITE (nuout,*)  cl_writ(8), kt   
[524]383     abort_message=' Probleme dans prism_put_proto '
384     call abort_gcm(modname,abort_message,1)
385   endif
[704]386   call prism_put_proto(il_out_var_id(9), kt, fsolwat(istart:iend), ierror)
[626]387   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
388 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
389 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
390     WRITE (nuout,*)  cl_writ(9), kt   
[524]391     abort_message=' Probleme dans prism_put_proto '
392     call abort_gcm(modname,abort_message,1)
393   endif
[704]394   call prism_put_proto(il_out_var_id(10), kt, fnsolice(istart:iend), ierror)
[626]395   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
396 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
397 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
398     WRITE (nuout,*)  cl_writ(10), kt   
[524]399     abort_message=' Probleme dans prism_put_proto '
400     call abort_gcm(modname,abort_message,1)
401   endif
[704]402   call prism_put_proto(il_out_var_id(11), kt, fnsolwat(istart:iend), ierror)
[626]403   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
404 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
405 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
406     WRITE (nuout,*)  cl_writ(11), kt   
[524]407     abort_message=' Probleme dans prism_put_proto '
408     call abort_gcm(modname,abort_message,1)
409   endif
[704]410   call prism_put_proto(il_out_var_id(12), kt, fnsicedt(istart:iend), ierror)
[626]411   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
412 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
413 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
414     WRITE (nuout,*)  cl_writ(12), kt   
[524]415     abort_message=' Probleme dans prism_put_proto '
416     call abort_gcm(modname,abort_message,1)
417   endif
[704]418   call prism_put_proto(il_out_var_id(13), kt, evice(istart:iend), ierror)
[626]419   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
420 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
421 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
422     WRITE (nuout,*)  cl_writ(13), kt   
[524]423     abort_message=' Probleme dans prism_put_proto '
424     call abort_gcm(modname,abort_message,1)
425   endif
[704]426   call prism_put_proto(il_out_var_id(14), kt, evwat(istart:iend), ierror)
[626]427   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
428 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
429 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
430     WRITE (nuout,*)  cl_writ(14), kt   
[524]431     abort_message=' Probleme dans prism_put_proto '
432     call abort_gcm(modname,abort_message,1)
433   endif
[704]434   call prism_put_proto(il_out_var_id(15), kt, lpre(istart:iend), ierror)
[626]435   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
436 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
437 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
438     WRITE (nuout,*)  cl_writ(15), kt   
[524]439     abort_message=' Probleme dans prism_put_proto '
440     call abort_gcm(modname,abort_message,1)
441   endif
[704]442   call prism_put_proto(il_out_var_id(16), kt, spre(istart:iend), ierror)
[626]443   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
444 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
445 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
446     WRITE (nuout,*)  cl_writ(16), kt   
[524]447     abort_message=' Probleme dans prism_put_proto '
448     call abort_gcm(modname,abort_message,1)
449   endif
[704]450   call prism_put_proto(il_out_var_id(17), kt, dirunoff(istart:iend), ierror)
[626]451   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
452 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
453 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
454     WRITE (nuout,*)  cl_writ(17), kt   
[524]455     abort_message=' Probleme dans prism_put_proto '
456     call abort_gcm(modname,abort_message,1)
457   endif
[704]458   call prism_put_proto(il_out_var_id(18), kt, rivrunoff(istart:iend), ierror)
[626]459   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
460 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
461 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
462     WRITE (nuout,*)  cl_writ(18), kt   
[524]463     abort_message=' Probleme dans prism_put_proto '
464     call abort_gcm(modname,abort_message,1)
465   endif
[704]466   call prism_put_proto(il_out_var_id(19), kt, calving(istart:iend), ierror)
[626]467   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
468 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
469 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
470     WRITE (nuout,*)  cl_writ(19), kt   
[524]471     abort_message=' Probleme dans prism_put_proto '
472     call abort_gcm(modname,abort_message,1)
473   endif
[704]474   call prism_put_proto(il_out_var_id(1), kt, tauxx_u(istart:iend), ierror)
[626]475   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
476 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
477 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
478     WRITE (nuout,*)  cl_writ(1), kt   
[524]479     abort_message=' Probleme dans prism_put_proto '
480     call abort_gcm(modname,abort_message,1)
481   endif
[704]482   call prism_put_proto(il_out_var_id(2), kt, tauyy_u(istart:iend), ierror)
[626]483   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
484 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
485 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
486     WRITE (nuout,*)  cl_writ(2), kt   
[524]487     abort_message=' Probleme dans prism_put_proto '
488     call abort_gcm(modname,abort_message,1)
489   endif
[704]490   call prism_put_proto(il_out_var_id(3), kt, tauzz_u(istart:iend), ierror)
[626]491   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
492 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
493 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
494     WRITE (nuout,*)  cl_writ(3), kt   
[524]495     abort_message=' Probleme dans prism_put_proto '
496     call abort_gcm(modname,abort_message,1)
497   endif
[704]498   call prism_put_proto(il_out_var_id(4), kt, tauxx_v(istart:iend), ierror)
[626]499   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
500 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
501 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
502     WRITE (nuout,*)  cl_writ(4), kt   
[524]503     abort_message=' Probleme dans prism_put_proto '
504     call abort_gcm(modname,abort_message,1)
505   endif
[704]506   call prism_put_proto(il_out_var_id(5), kt, tauyy_v(istart:iend), ierror)
[626]507   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
508 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
509 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
510     WRITE (nuout,*)  cl_writ(5), kt   
[524]511     abort_message=' Probleme dans prism_put_proto '
512     call abort_gcm(modname,abort_message,1)
513   endif
[704]514   call prism_put_proto(il_out_var_id(6), kt, tauzz_v(istart:iend), ierror)
[626]515   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
516 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
517 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
518     WRITE (nuout,*)  cl_writ(6), kt   
[524]519     abort_message=' Probleme dans prism_put_proto '
520     call abort_gcm(modname,abort_message,1)
521   endif
[704]522   call prism_put_proto(il_out_var_id(7), kt, windsp(istart:iend), ierror)
[626]523   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
524 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
525 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
526     WRITE (nuout,*)  cl_writ(7), kt   
527     abort_message=' Probleme dans prism_put_proto '
528     call abort_gcm(modname,abort_message,1)
529   endif
[524]530
531   if (last) then
[704]532     IF (monocpu) THEN
533       call prism_terminate_proto(ierror)
534         IF (ierror .ne. PRISM_Ok) THEN
535         abort_message=' Probleme dans prism_terminate_proto '
536         call abort_gcm(modname,abort_message,1)
537       endif
538     ENDIF
[524]539   endif
540
541
542   RETURN
543   END SUBROUTINE intocpl
544
545   END MODULE oasis
Note: See TracBrowser for help on using the repository browser.