source: LMDZ4/trunk/libf/phylmd/oasis.dummy @ 717

Last change on this file since 717 was 675, checked in by Laurent Fairhead, 19 years ago

Pour compatibilite avec g95
LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 22.3 KB
RevLine 
[524]1!
2! $Header$
3!
4C $Id: oasis.dummy 675 2005-12-01 11:27:29Z fairhead $
5C****
6C
7C**** *INICMA*  - Initialize coupled mode communication for atmosphere
8C                 and exchange some initial information with Oasis
9C
10C     Input:
11C     -----
12C       KASTP  : total number of timesteps in atmospheric model
13C       KEXCH  : frequency of exchange (in time steps)
14C       KSTEP  : length of timestep (in seconds)
15C
16C     -----------------------------------------------------------
17C
18      SUBROUTINE inicma(kastp,kexch,kstep,imjm)
19c
20c     INCLUDE "param.h"
21c
[675]22      INTEGER kastp, kexch, kstep,imjm
[524]23      INTEGER iparal(3)
24      INTEGER ifcpl, idt, info, imxtag, istep, jf
[590]25
26c -- LOOP
27c
28#include "dimensions.h"
29      INTEGER jjmp1
30      PARAMETER (jjmp1=jjm+1-1/jjm)
31#include "dimphy.h"
32       REAL zwindsp(klon)
[524]33c
[590]34c -- LOOP
35c
[524]36#include "param_cou.h"
37#include "inc_cpl.h"
38      CHARACTER*3 cljobnam      ! experiment name
39      CHARACTER*6 clmodnam      ! model name
40c     EM: not used by Oasis2.4
41CEM      CHARACTER*6 clbid(2)      ! for CLIM_Init call (not used)
42CEM                                ! must be dimensioned by the number of models
43CEM      INTEGER nbid(2)           ! for CLIM_Init call (not used)
44CEM                                ! must be dimensioned by the number of models
45      CHARACTER*5 cloasis       ! coupler name (Oasis)
46      INTEGER imess(4)
47      INTEGER getpid            ! system functions
48      INTEGER nuout
49CEM      LOGICAL llmodel
50      PARAMETER (nuout = 6)
51c
52#include "clim.h"
53#include "mpiclim.h"
54c
55#include "oasis.h"     
56                        ! contains the name of communication technique. Here
57                        ! cchan=CLIM only is possible.
58c                       ! ctype=MPI2
59c
60C     -----------------------------------------------------------
61C
62C*    1. Initializations
63C        ---------------
64C
65      WRITE(nuout,*) ' '
66      WRITE(nuout,*) ' '
67      WRITE(nuout,*) ' ROUTINE INICMA'
68      WRITE(nuout,*) ' **************'
69      WRITE(nuout,*) ' '
70      WRITE(nuout,*) ' '
71c
72c     Define the model name
73c
74      clmodnam = 'lmdz.x'       ! as in $NBMODEL in Cpl/Nam/namcouple.tmp
75c
76c     Define the coupler name
77c
78      cloasis = 'Oasis'        !  always 'Oasis' as in the coupler
79c
80c
81c     Define symbolic name for fields exchanged from atmos to coupler,
82c         must be the same as (1) of the field  definition in namcouple:
83c
[590]84      cl_writ(8)='COSHFICE'
85      cl_writ(9)='COSHFOCE'
86      cl_writ(10)='CONSFICE'
87      cl_writ(11)='CONSFOCE'
88      cl_writ(12)='CODFLXDT'
[524]89c      cl_writ(6)='COICTEMP'
[590]90      cl_writ(13)='COTFSICE'
91      cl_writ(14)='COTFSOCE'
92      cl_writ(15)='COTOLPSU'
93      cl_writ(16)='COTOSPSU'
94      cl_writ(17)='CORUNCOA'
95      cl_writ(18)='CORIVFLU'
96      cl_writ(19)='COCALVIN'
[524]97c$$$      cl_writ(13)='COZOTAUX'
98c$$$      cl_writ(14)='COZOTAUV'
99c$$$      cl_writ(15)='COMETAUY'
100c$$$      cl_writ(16)='COMETAUU'
[590]101      cl_writ(1)='COTAUXXU'
102      cl_writ(2)='COTAUYYU'
103      cl_writ(3)='COTAUZZU'
104      cl_writ(4)='COTAUXXV'
105      cl_writ(5)='COTAUYYV'
106      cl_writ(6)='COTAUZZV'
107c -- LOOP
108      cl_writ(7)='COWINDSP'
109c -- LOOP
[524]110c
111c     Define files name for fields exchanged from atmos to coupler,
112c         must be the same as (6) of the field  definition in namcouple:
113c
114      cl_f_writ(1)='flxatmos'
115      cl_f_writ(2)='flxatmos'
116      cl_f_writ(3)='flxatmos'
117      cl_f_writ(4)='flxatmos'
118      cl_f_writ(5)='flxatmos'
119      cl_f_writ(6)='flxatmos'
120      cl_f_writ(7)='flxatmos'
121      cl_f_writ(8)='flxatmos'
122      cl_f_writ(9)='flxatmos'
123      cl_f_writ(10)='flxatmos'
124      cl_f_writ(11)='flxatmos'
125      cl_f_writ(12)='flxatmos'
126      cl_f_writ(13)='flxatmos'
127      cl_f_writ(14)='flxatmos'
128      cl_f_writ(15)='flxatmos'
129      cl_f_writ(16)='flxatmos'
130      cl_f_writ(17)='flxatmos'
131      cl_f_writ(18)='flxatmos'
[590]132c -- LOOP
133      cl_f_writ(19)='flxatmos'
134c -- LOOP
[524]135
136c
137c
138c     Define symbolic name for fields exchanged from coupler to atmosphere,
139c         must be the same as (2) of the field  definition in namcouple:
140c
141      cl_read(1)='SISUTESW'
142      cl_read(2)='SIICECOV'
143      cl_read(3)='SIICEALW'
144      cl_read(4)='SIICTEMW'
145c
146c     Define files names for fields exchanged from coupler to atmosphere,
147c         must be the same as (7) of the field  definition in namcouple:
148c
149      cl_f_read(1)='sstatmos'
150      cl_f_read(2)='sstatmos'
151      cl_f_read(3)='sstatmos'
152      cl_f_read(4)='sstatmos'
153c
154c
155c     Define the number of processors involved in the coupling for
156c     Oasis (=1) and each model (as last two INTEGER on $CHATYPE line
157c     in the namcouple); they will be stored in a COMMON in mpiclim.h
158c     (used for CLIM/MPI2 only)
159      mpi_nproc(0)=1
160      mpi_nproc(1)=1
161      mpi_nproc(2)=1
162c
163c     Define infos to be sent initially to oasis
164c
165      imess(1) = kastp      ! total number of timesteps in atmospheric model
166      imess(2) = kexch      ! period of exchange (in time steps)
167      imess(3) = kstep      ! length of atmospheric timestep (in seconds)
168      imess(4) = getpid()   ! PID of atmospheric model
169c
170c     Initialization and exchange of initial info in the CLIM technique
171c
172      IF (cchan.eq.'CLIM') THEN
173c
174c     Define the experiment name :
175c
176          cljobnam = 'CLI'      ! as $JOBNAM in namcouple
177c
178c         Start the coupling
179c         (see lib/clim/src/CLIM_Init for the definition of input parameters)
180c
181cEM          clbid(1)='      '
182cEM          clbid(2)='      '
183cEM          nbid(1)=0
184cEM          nbid(2)=0
185CEM          llmodel=.true.
186c
187c         Define the number of processors used by each model as in
188c         $CHATYPE line of namcouple (used for CLIM/MPI2 only)
189          mpi_totproc(1)=1
190          mpi_totproc(2)=1
191c
192c         Define names of each model as in $NBMODEL line of namcouple
193c         (used for CLIM/MPI2 only)       
194          cmpi_modnam(1)='lmdz.x'
195          cmpi_modnam(2)='opa.xx'
196c         Start the coupling
197c
198          CALL CLIM_Init ( cljobnam, clmodnam, 3, 7,
199     *                 kastp, kexch, kstep,
200     *                 5, 3600, 3600, info )
201c
202          IF (info.ne.CLIM_Ok) THEN
203              WRITE ( nuout, *) ' inicma : pb init clim '
204              WRITE ( nuout, *) ' error code is = ', info
205              CALL halte('STOP in inicma')
206            ELSE
207              WRITE(nuout,*) 'inicma : init clim ok '
208          ENDIF
209c
210c         For each coupling field, association of a port to its symbolic name
211c
212c         -Define the parallel decomposition associated to the port of each
213c          field; here no decomposition for all ports.
214          iparal ( clim_strategy ) = clim_serial
215          iparal ( clim_length   ) = imjm
216          iparal ( clim_offset   ) = 0
217c
218c         -Loop on total number of coupler-to-atmosphere fields
219c         (see lib/clim/src/CLIM_Define for the definition of input parameters)
220          DO jf=1, jpfldo2a
221            CALL CLIM_Define (cl_read(jf), clim_in , clim_double, iparal
222     $          , info ) 
223            WRITE(nuout,*) 'inicma : clim define done for ',jf
224     $          ,cl_read(jf)
225          END DO
226c
227c         -Loop on total number of atmosphere-to-coupler fields
228c         (see lib/clim/src/CLIM_Define for the definition of input parameters)
229          DO jf=1, jpflda2o1+jpflda2o2
230            CALL CLIM_Define (cl_writ(jf), clim_out , clim_double,
231     $          iparal, info )   
232            WRITE(nuout,*) 'inicma : clim define done for ',jf
233     $          ,cl_writ(jf)
234          END DO
235c
236          WRITE(nuout,*) 'inicma : clim_define ok '
237c
238c         -Join a pvm group, wait for other programs and broadcast usefull
239c          informations to Oasis and to the ocean (see lib/clim/src/CLIM_Start)
240          CALL CLIM_Start ( imxtag, info )
241          IF (info.ne.clim_ok) THEN
242              WRITE ( nuout, *) 'inicma : pb start clim '
243              WRITE ( nuout, *) ' error code is = ', info
244              CALL halte('stop in inicma')
245            ELSE
246              WRITE ( nuout, *)  'inicma : start clim ok '
247          ENDIF
248c
249c         -Get initial information from Oasis
250c          (see lib/clim/src/CLIM_Stepi)
251          CALL CLIM_Stepi (cloasis, istep, ifcpl, idt, info)
252          IF (info .NE. clim_ok) THEN
253              WRITE ( UNIT = nuout, FMT = *)
254     $            ' warning : problem in getting step info ',
255     $            'from oasis '
256              WRITE (UNIT = nuout, FMT = *)
257     $            ' =======   error code number = ', info
258            ELSE
259              WRITE (UNIT = nuout, FMT = *)
260     $            ' got step information from oasis '
261          ENDIF
262          WRITE ( nuout, *) ' number of tstep in oasis ', istep
263          WRITE ( nuout, *) ' exchange frequency in oasis ', ifcpl
264          WRITE ( nuout, *) ' length of tstep in oasis ', idt
265      ENDIF
266
267      RETURN
268      END
269
270c $Id: oasis.dummy 675 2005-12-01 11:27:29Z fairhead $
271      SUBROUTINE fromcpl(kt, imjm, sst, gla, tice, albedo)
272c ======================================================================
273c S. Valcke (02/99) adapted From L.Z.X Li: this subroutine reads the SST
274c and Sea-Ice provided by the coupler with the CLIM (PVM exchange messages)
275c technique.
276c======================================================================
277      IMPLICIT none
278      INTEGER imjm, kt
279      REAL sst(imjm)          ! sea-surface-temperature
280      REAL gla(imjm)          ! sea-ice
281      REAL tice(imjm)          ! temp glace
282      REAL albedo(imjm)          ! albedo glace
283c
284      INTEGER nuout             ! listing output unit
285      PARAMETER (nuout=6)
286c
287      INTEGER nuread, ios, iflag, icpliter
288      INTEGER info, jf
289c
290#include "clim.h"
291c
292#include "oasis.h"
293#include "param_cou.h"
294c
295#include "inc_cpl.h"
296c
297c
298      WRITE (nuout,*) ' '
299      WRITE (nuout,*) 'Fromcpl: Reading fields from CPL, kt=',kt
300      WRITE (nuout,*) ' '
301      CALL flush (nuout)
302
303
304      IF (cchan.eq.'CLIM') THEN
305
306c
307c     -Get interpolated oceanic fields from Oasis
308c
309          DO jf=1,jpfldo2a
310            IF (jf.eq.1) CALL CLIM_Import (cl_read(jf) , kt, sst, info)
311            IF (jf.eq.2) CALL CLIM_Import (cl_read(jf) , kt, gla, info)
312            IF (jf.eq.3) CALL CLIM_Import (cl_read(jf), kt,albedo, info)
313            IF (jf.eq.4) CALL CLIM_Import (cl_read(jf) , kt, tice, info)
314            IF ( info .NE. CLIM_Ok) THEN
315                WRITE(nuout,*)'Pb in reading ', cl_read(jf), jf
316                WRITE(nuout,*)'Couplage kt is = ',kt
317                WRITE(nuout,*)'CLIM error code is = ', info
318                CALL halte('STOP in fromcpl.F')
319            ENDIF
320          END DO
321
322      ENDIF
323c
324      RETURN
325      END
326
327c $Id: oasis.dummy 675 2005-12-01 11:27:29Z fairhead $
[590]328c -- LOOP
[524]329      SUBROUTINE intocpl(kt, imjm, fsolice, fsolwat, fnsolice, fnsolwat,
330     $    fnsicedt, evice, evwat, lpre, spre, dirunoff, rivrunoff,
[590]331     $    calving, tauxx_u, tauyy_u, tauzz_u, tauxx_v, tauyy_v, tauzz_v,
332     $    windsp, last)
333c -- LOOP
[524]334c ======================================================================
335c S. Valcke (02/99) adapted From L.Z.X Li: this subroutine provides the
336c atmospheric coupling fields to the coupler with the CLIM (PVM exchange
337c messages) technique.
338c IF last time step, writes output fields to binary files.
339c ======================================================================
340      IMPLICIT NONE
[590]341c -- LOOP
342c
343#include "dimensions.h"
344      INTEGER jjmp1
345      PARAMETER (jjmp1=jjm+1-1/jjm)
346#include "dimphy.h"
347c      REAL zu10m(klon), zv10m(klon)
348       REAL zwindsp(klon)
349c
350c -- LOOP
351c
352
[524]353      INTEGER kt, imjm
354c
355      REAL fsolice(imjm)
356      REAL fsolwat(imjm)
357      REAL fnsolwat(imjm)
358      REAL fnsolice(imjm)
359      REAL fnsicedt(imjm)
360      REAL evice(imjm)
361      REAL evwat(imjm)
362      REAL lpre(imjm)
363      REAL spre(imjm)
364      REAL dirunoff(imjm)
365      REAL rivrunoff(imjm)
366      REAL calving(imjm)
367c$$$      REAL tauxu(imjm)
368c$$$      REAL tauxv(imjm)
369c$$$      REAL tauyu(imjm)
370c$$$      REAL tauyv(imjm)
371      REAL tauxx_u(imjm)
372      REAL tauxx_v(imjm)
373      REAL tauyy_u(imjm)
374      REAL tauyy_v(imjm)
375      REAL tauzz_u(imjm)
376      REAL tauzz_v(imjm)
[590]377c -- LOOP
378       REAL windsp(imjm)
379c -- LOOP
[524]380      LOGICAL last
381c
382      INTEGER nuout
383      PARAMETER (nuout = 6)
384c
385#include "clim.h"
386#include "param_cou.h"
387#include "inc_cpl.h"
388c
389      CHARACTER*8 file_name(jpmaxfld)
390      INTEGER max_file
391      INTEGER file_unit_max, file_unit(jpmaxfld),
392     $    file_unit_field(jpmaxfld)
393
394      INTEGER icstep, info, jn, jf, ierror
395      LOGICAL trouve
396c
397#include "oasis.h"
398c
399      icstep=kt
400c
401      WRITE(nuout,*) ' '
402      WRITE(nuout,*) 'Intocpl: sending fields to CPL, kt= ', kt
403      WRITE(nuout,*) 'last  ', last
404      WRITE(nuout,*)
405
406      IF (last) THEN
407c
408c     -WRITE fields to binary files for coupler restart at last time step
409c
410c         -initialisation and files opening
411c
412          max_file=1
413          file_unit_max=99
414c         -keeps first file name
415          file_name(max_file)=cl_f_writ(max_file)
416c         -keeps first file unit
417          file_unit(max_file)=file_unit_max
418c         -decrements file unit maximum
419          file_unit_max=file_unit_max-1
420c         -keeps file unit for field
421          file_unit_field(1)=file_unit(max_file)
422c
423c         -different files names counter
424c
425          DO jf= 2, jpflda2o1 + jpflda2o2
426            trouve=.false.
427            DO jn= 1, max_file
428              IF (.not.trouve) THEN
429                  IF (cl_f_writ(jf).EQ.file_name(jn)) THEN
430c                 -keep file unit for field
431                      file_unit_field(jf)=file_unit(jn)
432                      trouve=.true.
433                  END IF
434              END IF
435            END DO
436            IF (.not.trouve) then
437c           -increment the number of different files
438                max_file=max_file+1
439c           -keep file name
440                file_name(max_file)=cl_f_writ(jf)
441c           -keep file unit for file
442                file_unit(max_file)=file_unit_max
443c           -keep file unit for field
444                file_unit_field(jf)=file_unit(max_file)
445c           -decrement unit maximum number from 99 to 98, ...
446                file_unit_max=file_unit_max-1
447            END IF
448          END DO
449c         
450          DO jn=1, max_file
451            OPEN (file_unit(jn), FILE=file_name(jn), FORM='UNFORMATTED')
452            WRITE(*,*) 'Opening FILE ', file_unit(jn), ' '
453     $          , file_name(jn)
454            REWIND(file_unit(jn))
455          END DO
456c
457c         WRITE fields to files         
458          DO jf=1, jpflda2o1 + jpflda2o2
[590]459            IF (jf.eq.8)
[524]460     $          CALL locwrite(cl_writ(jf),fsolice, imjm,
461     $          file_unit_field(jf), ierror)
[590]462            IF (jf.eq.9)
[524]463     $          CALL locwrite(cl_writ(jf),fsolwat, imjm,
464     $          file_unit_field(jf), ierror)
[590]465            IF (jf.eq.10)
[524]466     $          CALL locwrite(cl_writ(jf),fnsolice, imjm,
467     $          file_unit_field(jf), ierror)
[590]468            IF (jf.eq.11)
[524]469     $          CALL locwrite(cl_writ(jf),fnsolwat, imjm,
470     $          file_unit_field(jf), ierror)
[590]471            IF (jf.eq.12)
[524]472     $          CALL locwrite(cl_writ(jf),fnsicedt, imjm,
473     $          file_unit_field(jf), ierror)
[590]474c            IF (jf.eq.13)
[524]475c     $          CALL locwrite(cl_writ(jf),ictemp, imjm,
476c     $          file_unit_field(jf), ierror)
[590]477            IF (jf.eq.13)
[524]478     $          CALL locwrite(cl_writ(jf),evice, imjm,
479     $          file_unit_field(jf), ierror)
[590]480            IF (jf.eq.14)
[524]481     $          CALL locwrite(cl_writ(jf),evwat, imjm,
482     $          file_unit_field(jf), ierror)
[590]483            IF (jf.eq.15)
[524]484     $          CALL locwrite(cl_writ(jf),lpre, imjm,
485     $          file_unit_field(jf), ierror)
[590]486            IF (jf.eq.16)
[524]487     $          CALL locwrite(cl_writ(jf),spre, imjm,
488     $          file_unit_field(jf), ierror)
[590]489            IF (jf.eq.17)
[524]490     $          CALL locwrite(cl_writ(jf),dirunoff, imjm,
491     $          file_unit_field(jf), ierror)
[590]492            IF (jf.eq.18)
[524]493     $          CALL locwrite(cl_writ(jf),rivrunoff, imjm,
494     $          file_unit_field(jf), ierror)
[590]495            IF (jf.eq.19)
[524]496     $          CALL locwrite(cl_writ(jf),calving, imjm,
497     $          file_unit_field(jf), ierror)
498c$$$            IF (jf.eq.13)
499c$$$     $          CALL locwrite(cl_writ(jf),tauxu, imjm,
500c$$$     $          file_unit_field(jf),ierror)
501c$$$            IF (jf.eq.1')
502c$$$     $          CALL locwrite(cl_writ(jf),tauxv, imjm,
503c$$$     $          file_unit_field(jf),ierror)
504c$$$            IF (jf.eq.15)
505c$$$     $          CALL locwrite(cl_writ(jf),tauyv, imjm,
506c$$$     $          file_unit_field(jf),ierror)
507c$$$            IF (jf.eq.16)
508c$$$     $          CALL locwrite(cl_writ(jf),tauyu, imjm,
509c$$$     $          file_unit_field(jf), ierror)
[590]510            IF (jf.eq.1)
[524]511     $          CALL locwrite(cl_writ(jf),tauxx_u, imjm,
512     $          file_unit_field(jf),ierror)
[590]513            IF (jf.eq.2)
[524]514     $          CALL locwrite(cl_writ(jf),tauyy_u, imjm,
515     $          file_unit_field(jf),ierror)
[590]516            IF (jf.eq.3)
[524]517     $          CALL locwrite(cl_writ(jf),tauzz_u, imjm,
518     $          file_unit_field(jf),ierror)
[590]519            IF (jf.eq.4)
[524]520     $          CALL locwrite(cl_writ(jf),tauxx_v, imjm,
521     $          file_unit_field(jf),ierror)
[590]522            IF (jf.eq.5)
[524]523     $          CALL locwrite(cl_writ(jf),tauyy_v, imjm,
524     $          file_unit_field(jf),ierror)
[590]525            IF (jf.eq.6)
[524]526     $          CALL locwrite(cl_writ(jf),tauzz_v, imjm,
527     $          file_unit_field(jf),ierror)
[590]528c -- LOOP
529            IF (jf.eq.7)
[608]530     $         CALL locwrite(cl_writ(jf),windsp, imjm,
[590]531     $         file_unit_field(jf),ierror)
532c -- LOOP
533
[524]534          END DO
535C
536C         -simulate a FLUSH
537C
538          DO jn=1, max_file
539            CLOSE (file_unit(jn))
540          END DO
541C
542C
543          IF(cchan.eq.'CLIM') THEN
544C
545C         -inform PVM daemon that message exchange is finished
546C
547              CALL CLIM_Quit (CLIM_ContPvm, info)
548              IF (info .NE. CLIM_Ok) THEN
549                  WRITE (6, *)
550     $                'An error occured while leaving CLIM. Error = ',
551     $                info
552              ENDIF
553          END IF
554          RETURN   
555      END IF
556C
557      IF(cchan.eq.'CLIM') THEN
558C
559C     -Give atmospheric fields to Oasis
560C
561          DO jn=1, jpflda2o1 + jpflda2o2
562C           
[590]563          IF (jn.eq.8) CALL CLIM_Export(cl_writ(jn), kt, fsolice, info)
564          IF (jn.eq.9) CALL CLIM_Export(cl_writ(jn), kt, fsolwat, info)
565         IF (jn.eq.10) CALL CLIM_Export(cl_writ(jn), kt, fnsolice, info)
566         IF (jn.eq.11) CALL CLIM_Export(cl_writ(jn), kt, fnsolwat, info)
567         IF (jn.eq.12) CALL CLIM_Export(cl_writ(jn), kt, fnsicedt, info)
[524]568c          IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, ictemp, info)
[590]569          IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, evice, info)
570          IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, evwat, info)
571          IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, lpre, info)
572          IF (jn.eq.16) CALL CLIM_Export(cl_writ(jn), kt, spre, info)
573          IF (jn.eq.17) CALL CLIM_Export(cl_writ(jn),kt,dirunoff, info)
574          IF (jn.eq.18) CALL CLIM_Export(cl_writ(jn),kt,rivrunoff,info)
575          IF (jn.eq.19) CALL CLIM_Export(cl_writ(jn),kt,calving,info)
[524]576c$$$          IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauxu, info)
577c$$$          IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauxv, info)
578c$$$          IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauyv, info)
579c$$$          IF (jn.eq.16) CALL CLIM_Export(cl_writ(jn), kt, tauyu, info)
[590]580          IF (jn.eq.1) CALL CLIM_Export(cl_writ(jn), kt, tauxx_u, info)
581          IF (jn.eq.2) CALL CLIM_Export(cl_writ(jn), kt, tauyy_u, info)
582          IF (jn.eq.3) CALL CLIM_Export(cl_writ(jn), kt, tauzz_u, info)
583          IF (jn.eq.4) CALL CLIM_Export(cl_writ(jn), kt, tauxx_v, info)
584          IF (jn.eq.5) CALL CLIM_Export(cl_writ(jn), kt, tauyy_v, info)
585          IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, tauzz_v, info)
586c -- LOOP
587          IF (jn.eq.7) CALL CLIM_Export(cl_writ(jn), kt, windsp, info)
588c -- LOOP         
[524]589            IF (info .NE. CLIM_Ok) THEN
590                WRITE (nuout,*) 'STEP : Pb giving ',cl_writ(jn), ':',jn
591                WRITE (nuout,*) ' at timestep = ', icstep,'kt = ',kt
592                WRITE (nuout,*) 'Clim error code is = ',info
593                CALL halte('STOP in intocpl ')
594            ENDIF
595          END DO
596      ENDIF
597C
598      RETURN
599      END
600
601      SUBROUTINE halte
602      print *, 'Attention dans oasis.F, halte est non defini'
603      RETURN
604      END
605
606      SUBROUTINE locread
607      print *, 'Attention dans oasis.F, locread est non defini'
608      RETURN
609      END
610
611      SUBROUTINE locwrite
612      print *, 'Attention dans oasis.F, locwrite est non defini'
613      RETURN
614      END
615
616      SUBROUTINE pipe_model_define
617      print*,'Attention dans oasis.F, pipe_model_define est non defini'
618      RETURN
619      END
620
621      SUBROUTINE pipe_model_stepi
622      print*,'Attention dans oasis.F, pipe_model_stepi est non defini'
623      RETURN
624      END
625
626      SUBROUTINE pipe_model_recv
627      print *, 'Attention dans oasis.F, pipe_model_recv est non defini'
628      RETURN
629      END
630
631      SUBROUTINE pipe_model_send
632      print *, 'Attention dans oasis.F, pipe_model_send est non defini'
633      RETURN
634      END
635
636      SUBROUTINE clim_stepi
637      print *, 'Attention dans oasis.F, clim_stepi est non defini'
638      RETURN
639      END
640
641      SUBROUTINE clim_start
642      print *, 'Attention dans oasis.F, clim_start est non defini'
643      RETURN
644      END
645
646      SUBROUTINE clim_import
647      print *, 'Attention dans oasis.F, clim_import est non defini'
648      RETURN
649      END
650
651      SUBROUTINE clim_export
652      print *, 'Attention dans oasis.F, clim_export est non defini'
653      RETURN
654      END
655
656      SUBROUTINE clim_init
657      print *, 'Attention dans oasis.F, clim_init est non defini'
658      RETURN
659      END
660
661      SUBROUTINE clim_define
662      print *, 'Attention dans oasis.F, clim_define est non defini'
663      RETURN
664      END
665
666      SUBROUTINE clim_quit
667      print *, 'Attention dans oasis.F, clim_quit est non defini'
668      RETURN
669      END
670
671      SUBROUTINE svipc_write
672      print *, 'Attention dans oasis.F, svipc_write est non defini'
673      RETURN
674      END
675
676      SUBROUTINE svipc_close
677      print *, 'Attention dans oasis.F, svipc_close est non defini'
678      RETURN
679      END
680
681      SUBROUTINE svipc_read
682      print *, 'Attention dans oasis.F, svipc_read est non defini'
683      RETURN
684      END
685
686      SUBROUTINE quitcpl
687      print *, 'Attention dans oasis.F, quitcpl est non defini'
688      RETURN
689      END
690
691      SUBROUTINE sipc_write_model
692      print *, 'Attention dans oasis.F, sipc_write_model est non defini'
693      RETURN
694      END
695
696      SUBROUTINE sipc_attach
697      print *, 'Attention dans oasis.F, sipc_attach est non defini'
698      RETURN
699      END
700
701      SUBROUTINE sipc_init_model
702      print *, 'Attention dans oasis.F, sipc_init_model est non defini'
703      RETURN
704      END
705
706      SUBROUTINE sipc_read_model
707      print *, 'Attention dans oasis.F, sipc_read_model est non defini'
708      RETURN
709      END
Note: See TracBrowser for help on using the repository browser.