source: LMDZ4/branches/IPSL-CM4_IPCC_branch/libf/phylmd/oasis.psmile @ 5420

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

Modif pour compatibilité avec OASIS3 AC
LF
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 17.4 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
[628]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
27CONTAINS
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
[628]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
[628]105! PSMILe attribution of local communicator
[524]106!
[628]107   call prism_get_localcomm_proto (il_commlocal, ierror)
108!
[524]109! and domain decomposition
110!
111! monoproc case
112!
[628]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!
136   cl_writ(1)='COSHFICE'
137   cl_writ(2)='COSHFOCE'
138   cl_writ(3)='CONSFICE'
139   cl_writ(4)='CONSFOCE'
140   cl_writ(5)='CODFLXDT'
141   cl_writ(6)='COTFSICE'
142   cl_writ(7)='COTFSOCE'
143   cl_writ(8)='COTOLPSU'
144   cl_writ(9)='COTOSPSU'
145   cl_writ(10)='CORUNCOA'
146   cl_writ(11)='CORIVFLU'
147   cl_writ(12)='COCALVIN'
148   cl_writ(13)='COTAUXXU'
149   cl_writ(14)='COTAUYYU'
150   cl_writ(15)='COTAUZZU'
151   cl_writ(16)='COTAUXXV'
152   cl_writ(17)='COTAUYYV'
153   cl_writ(18)='COTAUZZV'
154!
155!     Define symbolic name for fields exchanged from coupler to atmosphere,
156!         must be the same as (2) of the field  definition in namcouple:
157!
158   cl_read(1)='SISUTESW'
159   cl_read(2)='SIICECOV'
160   cl_read(3)='SIICEALW'
161   cl_read(4)='SIICTEMW'
162
163   il_var_nodims(1) = 2
164   il_var_nodims(2) = 1
165
166   il_var_actual_shape(1) = 1
167   il_var_actual_shape(2) = im
168   il_var_actual_shape(3) = 1
169   il_var_actual_shape(4) = jm
170   
171   il_var_type = PRISM_Real
172!
173! Oceanic Fields
174!
175   DO jf=1, jpfldo2a
176     call prism_def_var_proto(in_var_id(jf), cl_read(jf), il_part_id, &
177&               il_var_nodims, PRISM_In, il_var_actual_shape, il_var_type, &
178&               ierror)
179     IF (ierror .ne. PRISM_Ok) THEN
180        abort_message=' Probleme init dans prism_def_var_proto '
181        call abort_gcm(modname,abort_message,1)
182     ENDIF
183   END DO
184!
185! Atmospheric Fields
186!
187   DO jf=1, jpflda2o1+jpflda2o2
188     call prism_def_var_proto(il_out_var_id(jf), cl_writ(jf), il_part_id, &
189&               il_var_nodims, PRISM_Out, il_var_actual_shape, il_var_type, &
190&               ierror)
191     IF (ierror .ne. PRISM_Ok) THEN
192        abort_message=' Probleme init dans prism_def_var_proto '
193        call abort_gcm(modname,abort_message,1)
194     ENDIF
195   END DO
196!
197! End
198!
199   call prism_enddef_proto(ierror)
200   IF (ierror .ne. PRISM_Ok) THEN
201      abort_message=' Probleme init dans prism_ endef_proto'
202      call abort_gcm(modname,abort_message,1)
203   ELSE
204      WRITE(nuout,*) 'inicma : endef psmile ok '
205   ENDIF
206
207   END SUBROUTINE inicma
208
209   SUBROUTINE fromcpl(kt, im, jm, sst, gla, tice, albedo)
210! ======================================================================
211! L. Fairhead (09/2003) adapted From L.Z.X Li: this subroutine reads the SST
212! and Sea-Ice provided by the coupler. Adaptation to psmile library
213!======================================================================
214
215   use mod_prism_proto
216   use mod_prism_get_proto
217
218   IMPLICIT none
219
220!
221! parametres
222!
223   integer                 :: im, jm, kt
224   real, dimension(im, jm)   :: sst            ! sea-surface-temperature
225   real, dimension(im, jm)   :: gla     ! sea-ice
226   real, dimension(im, jm)   :: tice    ! temp glace
227   real, dimension(im, jm)   :: albedo  ! albedo glace
228!
229! local variables
230!
231   integer                 :: nuout  = 6             ! listing output unit
232   integer                 :: ierror
233   character (len = 20),save  :: modname = 'fromcpl'
234   character (len = 80)       :: abort_message
235!
236#include "param_cou.h"
237!
238!
239   WRITE (nuout,*) ' '
240   WRITE (nuout,*) 'Fromcpl: Reading fields from CPL, kt=',kt
241   WRITE (nuout,*) ' '
242   CALL flush (nuout)
243
244   call prism_get_proto(in_var_id(1), kt, sst, ierror)
[628]245   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. &
246 &     ierror.ne.PRISM_FromRest &
247 &     .and. ierror.ne.PRISM_Input .and. ierror.ne.PRISM_RecvOut &
248 &     .and. ierror.ne.PRISM_FromRestOut) THEN
[524]249     WRITE (nuout,*)  cl_read(1), kt   
250     abort_message=' Probleme dans prism_get_proto '
251     call abort_gcm(modname,abort_message,1)
252   endif
253   call prism_get_proto(in_var_id(2), kt, gla, ierror)
[628]254   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. &
255 &     ierror.ne.PRISM_FromRest &
256 &     .and. ierror.ne.PRISM_Input .and. ierror.ne.PRISM_RecvOut &
257 &     .and. ierror.ne.PRISM_FromRestOut) THEN
[524]258     WRITE (nuout,*)  cl_read(2), kt   
259     abort_message=' Probleme dans prism_get_proto '
260     call abort_gcm(modname,abort_message,1)
261   endif
262   call prism_get_proto(in_var_id(3), kt, albedo, ierror)
[628]263   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. &
264 &     ierror.ne.PRISM_FromRest &
265 &     .and. ierror.ne.PRISM_Input .and. ierror.ne.PRISM_RecvOut &
266 &     .and. ierror.ne.PRISM_FromRestOut) THEN
[524]267     WRITE (nuout,*)  cl_read(3), kt   
268     abort_message=' Probleme dans prism_get_proto '
269     call abort_gcm(modname,abort_message,1)
270   endif
271   call prism_get_proto(in_var_id(4), kt, tice, ierror)
[628]272   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Recvd .and. &
273 &     ierror.ne.PRISM_FromRest &
274 &     .and. ierror.ne.PRISM_Input .and. ierror.ne.PRISM_RecvOut &
275 &     .and. ierror.ne.PRISM_FromRestOut) THEN
[524]276     WRITE (nuout,*)  cl_read(4), kt   
277     abort_message=' Probleme dans prism_get_proto '
278     call abort_gcm(modname,abort_message,1)
279   endif
280
281!
282   RETURN
283   END SUBROUTINE fromcpl
284
285   SUBROUTINE intocpl(kt, im, jm, fsolice, fsolwat, fnsolice, fnsolwat, &
286 &    fnsicedt, evice, evwat, lpre, spre, dirunoff, rivrunoff, &
287 &    calving, tauxx_u, tauyy_u, tauzz_u, tauxx_v, tauyy_v, tauzz_v &
288 &    , last)
289! ======================================================================
290! L. Fairhead (09/2003) adapted From L.Z.X Li: this subroutine provides the
291! atmospheric coupling fields to the coupler with the psmile library.
292! IF last time step, writes output fields to binary files.
293! ======================================================================
294
295   use mod_prism_proto
296   use mod_prism_put_proto
297
298   IMPLICIT NONE
299
300!
301! parametres
302!
303   integer               :: kt, im, jm
304   real, dimension(im, jm) :: fsolice, fsolwat, fnsolwat, fnsolice
305   real, dimension(im, jm) :: fnsicedt, evice, evwat, lpre, spre
306   real, dimension(im, jm) :: dirunoff, rivrunoff, calving
307   real, dimension(im, jm) :: tauxx_u, tauxx_v, tauyy_u
308   real, dimension(im, jm) :: tauyy_v, tauzz_u, tauzz_v
309   logical               :: last
310!
311! local
312!
313   integer, parameter    :: nuout = 6
314   integer               :: ierror
315   character (len = 20),save  :: modname = 'intocpl'
316   character (len = 80)       :: abort_message
317!
318!
319      WRITE(nuout,*) ' '
320      WRITE(nuout,*) 'Intocpl: sending fields to CPL, kt= ', kt
321      WRITE(nuout,*) 'last  ', last
322      WRITE(nuout,*)
323
324   call prism_put_proto(il_out_var_id(1), kt, fsolice, ierror)
[628]325   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
326 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
327 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
[524]328     WRITE (nuout,*)  cl_writ(1), kt   
329     abort_message=' Probleme dans prism_put_proto '
330     call abort_gcm(modname,abort_message,1)
331   endif
332   call prism_put_proto(il_out_var_id(2), kt, fsolwat, ierror)
[628]333   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
334 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
335 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
[524]336     WRITE (nuout,*)  cl_writ(2), kt   
337     abort_message=' Probleme dans prism_put_proto '
338     call abort_gcm(modname,abort_message,1)
339   endif
340   call prism_put_proto(il_out_var_id(3), kt, fnsolice, ierror)
[628]341   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
342 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
343 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
[524]344     WRITE (nuout,*)  cl_writ(3), kt   
345     abort_message=' Probleme dans prism_put_proto '
346     call abort_gcm(modname,abort_message,1)
347   endif
348   call prism_put_proto(il_out_var_id(4), kt, fnsolwat, ierror)
[628]349   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
350 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
351 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
[524]352     WRITE (nuout,*)  cl_writ(4), kt   
353     abort_message=' Probleme dans prism_put_proto '
354     call abort_gcm(modname,abort_message,1)
355   endif
356   call prism_put_proto(il_out_var_id(5), kt, fnsicedt, ierror)
[628]357   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
358 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
359 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
[524]360     WRITE (nuout,*)  cl_writ(5), kt   
361     abort_message=' Probleme dans prism_put_proto '
362     call abort_gcm(modname,abort_message,1)
363   endif
364   call prism_put_proto(il_out_var_id(6), kt, evice, ierror)
[628]365   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
366 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
367 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
[524]368     WRITE (nuout,*)  cl_writ(6), kt   
369     abort_message=' Probleme dans prism_put_proto '
370     call abort_gcm(modname,abort_message,1)
371   endif
372   call prism_put_proto(il_out_var_id(7), kt, evwat, ierror)
[628]373   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
374 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
375 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
[524]376     WRITE (nuout,*)  cl_writ(7), kt   
377     abort_message=' Probleme dans prism_put_proto '
378     call abort_gcm(modname,abort_message,1)
379   endif
380   call prism_put_proto(il_out_var_id(8), kt, lpre, ierror)
[628]381   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
382 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
383 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
[524]384     WRITE (nuout,*)  cl_writ(8), kt   
385     abort_message=' Probleme dans prism_put_proto '
386     call abort_gcm(modname,abort_message,1)
387   endif
388   call prism_put_proto(il_out_var_id(9), kt, spre, ierror)
[628]389   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
390 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
391 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
[524]392     WRITE (nuout,*)  cl_writ(9), kt   
393     abort_message=' Probleme dans prism_put_proto '
394     call abort_gcm(modname,abort_message,1)
395   endif
396   call prism_put_proto(il_out_var_id(10), kt, dirunoff, ierror)
[628]397   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
398 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
399 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
[524]400     WRITE (nuout,*)  cl_writ(10), kt   
401     abort_message=' Probleme dans prism_put_proto '
402     call abort_gcm(modname,abort_message,1)
403   endif
404   call prism_put_proto(il_out_var_id(11), kt, rivrunoff, ierror)
[628]405   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
406 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
407 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
[524]408     WRITE (nuout,*)  cl_writ(11), kt   
409     abort_message=' Probleme dans prism_put_proto '
410     call abort_gcm(modname,abort_message,1)
411   endif
412   call prism_put_proto(il_out_var_id(12), kt, calving, ierror)
[628]413   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
414 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
415 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
[524]416     WRITE (nuout,*)  cl_writ(12), kt   
417     abort_message=' Probleme dans prism_put_proto '
418     call abort_gcm(modname,abort_message,1)
419   endif
420   call prism_put_proto(il_out_var_id(13), kt, tauxx_u, ierror)
[628]421   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
422 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
423 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
[524]424     WRITE (nuout,*)  cl_writ(13), kt   
425     abort_message=' Probleme dans prism_put_proto '
426     call abort_gcm(modname,abort_message,1)
427   endif
428   call prism_put_proto(il_out_var_id(14), kt, tauyy_u, ierror)
[628]429   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
430 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
431 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
[524]432     WRITE (nuout,*)  cl_writ(14), kt   
433     abort_message=' Probleme dans prism_put_proto '
434     call abort_gcm(modname,abort_message,1)
435   endif
436   call prism_put_proto(il_out_var_id(15), kt, tauzz_u, ierror)
[628]437   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
438 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
439 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
[524]440     WRITE (nuout,*)  cl_writ(15), kt   
441     abort_message=' Probleme dans prism_put_proto '
442     call abort_gcm(modname,abort_message,1)
443   endif
444   call prism_put_proto(il_out_var_id(16), kt, tauxx_v, ierror)
[628]445   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
446 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
447 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
[524]448     WRITE (nuout,*)  cl_writ(16), kt   
449     abort_message=' Probleme dans prism_put_proto '
450     call abort_gcm(modname,abort_message,1)
451   endif
452   call prism_put_proto(il_out_var_id(17), kt, tauyy_v, ierror)
[628]453   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
454 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
455 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
[524]456     WRITE (nuout,*)  cl_writ(17), kt   
457     abort_message=' Probleme dans prism_put_proto '
458     call abort_gcm(modname,abort_message,1)
459   endif
460   call prism_put_proto(il_out_var_id(18), kt, tauzz_v, ierror)
[628]461   IF (ierror .ne. PRISM_Ok .and. ierror.ne.PRISM_Sent .and. ierror.ne.PRISM_ToRest &
462 &     .and. ierror.ne.PRISM_LocTrans .and. ierror.ne.PRISM_Output .and. &
463 &     ierror.ne.PRISM_SentOut .and. ierror.ne.PRISM_ToRestOut) THEN
[524]464     WRITE (nuout,*)  cl_writ(18), kt   
465     abort_message=' Probleme dans prism_put_proto '
466     call abort_gcm(modname,abort_message,1)
467   endif
468
469   if (last) then
470     call prism_terminate_proto(ierror)
471     IF (ierror .ne. PRISM_Ok) THEN
472       WRITE (nuout,*)  cl_writ(18), kt   
473       abort_message=' Probleme dans prism_terminate_proto '
474       call abort_gcm(modname,abort_message,1)
475     endif
476   endif
477
478
479   RETURN
480   END SUBROUTINE intocpl
481
482   END MODULE oasis
Note: See TracBrowser for help on using the repository browser.