source: LMDZ.3.3/branches/rel-1-0-patch/libf/phylmd/oasis.F @ 5178

Last change on this file since 5178 was 66, checked in by lmdz, 25 years ago

Rajout d'appels bidons aux routines clim et svipc pour une bonne edition
de liens
LF

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 25.7 KB
Line 
1c
2C****
3C               *****************
4C               * OASIS ROUTINE *
5C               * ------------- *
6C               *****************
7C
8C**** *INICMA*  - Initialize coupled mode communication for atmosphere
9C
10C     Purpose:
11C     -------
12C     Exchange process identifiers and timestep information
13C     between AGCM, OGCM and COUPLER.
14C
15C     Input:
16C     -----
17C       KASTP  : total number of timesteps in atmospheric model
18C       KEXCH  : frequency of exchange (in time steps)
19C       KSTEP  : timestep value (in seconds)
20C
21C     Method:
22C     ------
23C     Use named pipes(FIFO) to exchange process identifiers
24C     between the programs
25C
26C     Externals:
27C     ---------
28C     GETPID, MKNOD
29C
30C     Reference:
31C     ---------
32C     See Epicoa 0803 (1992)
33C
34C     Author:
35C     -------
36C     Laurent Terray  92-09-01
37C
38C     -----------------------------------------------------------
39C
40      SUBROUTINE inicma(kastp,kexch,kstep)
41c
42      INTEGER kastp, kexch, kstep
43c
44      INTEGER ime
45      PARAMETER (ime = 1)
46
47      INTEGER iparal(3)
48      INTEGER ifcpl, idt, info, imxtag, istep
49c
50#include "dimensions.h"
51#include "dimphy.h"
52#include "oasis.h"
53#include "clim.h"
54c
55c     Addition for SIPC CASE
56#include "param_sipc.h"
57#include "param_cou.h"
58#include "inc_sipc.h"
59#include "inc_cpl.h"
60      CHARACTER*9 clpoolnam
61      INTEGER ipoolhandle, imrc, ipoolsize, index, jf
62      CHARACTER*3 cljobnam      ! experiment name
63      CHARACTER*6 clmodnam      ! model name
64      CHARACTER*5 cloasis       ! coupler name (Oasis)
65      INTEGER imess(4), imesso(4)
66      INTEGER getpid, mknod ! system functions
67      CHARACTER*80 clcmd
68      CHARACTER*8 pipnom, fldnom
69      INTEGER ierror, iretcode
70C
71      INTEGER nuout
72      PARAMETER (nuout = 6)
73c
74C
75c
76
77C     -----------------------------------------------------------
78C
79C*    1. Initializations
80C        ---------------
81C
82      WRITE(nuout,*) ' '
83      WRITE(nuout,*) ' '
84      WRITE(nuout,*) ' ROUTINE INICMA'
85      WRITE(nuout,*) ' **************'
86      WRITE(nuout,*) ' '
87      WRITE(nuout,*) ' '
88c
89c     1.2.1-Define the model name
90c
91      clmodnam = 'lmd.xx'       ! as $NBMODEL in namcouple
92c
93c     1.2.2-Define the coupler name
94c
95      cloasis = 'Oasis'        !  as in coupler
96c
97c
98c     1.3.1-Define symbolic name for fields exchanged from atmos to coupler,
99c         must be the same as (1) of the field  definition in namcouple:
100c
101      cl_writ(1)='CONSFTOT'
102      cl_writ(2)='COSHFTOT'
103      cl_writ(3)='COTOPRSU'
104      cl_writ(4)='COTFSHSU'
105      cl_writ(5)='CORUNCOA'
106      cl_writ(6)='CORIVFLU'
107      cl_writ(7)='COZOTAUX'
108      cl_writ(8)='COZOTAU2'
109      cl_writ(9)='COMETAUY'
110      cl_writ(10)='COMETAU2'
111c
112c     1.3.2-Define files name for fields exchanged from atmos to coupler,
113c         must be the same as (6) of the field  definition in namcouple:
114c
115      cl_f_writ(1)='atmflx'
116      cl_f_writ(2)='atmflx'
117      cl_f_writ(3)='atmflx'
118      cl_f_writ(4)='atmflx'
119      cl_f_writ(5)='atmflx'
120      cl_f_writ(6)='atmflx'
121      cl_f_writ(7)='atmtau'
122      cl_f_writ(8)='atmtau'
123      cl_f_writ(9)='atmtau'
124      cl_f_writ(10)='atmtau'
125c
126c
127c     1.4.1-Define symbolic name for fields exchanged from coupler to atmosphere,
128c         must be the same as (2) of the field  definition in namcouple:
129c
130      cl_read(1)='SISUTESU'
131      cl_read(2)='SIICECOV'
132c
133c     1.4.2-Define files names for fields exchanged from coupler to atmosphere,
134c         must be the same as (7) of the field  definition in namcouple:
135c
136      cl_f_read(1)='atmsst'
137      cl_f_read(2)='atmice'
138c
139c     1.5-Define infos for sending to oasis
140c
141      imess(1) = kastp
142      imess(2) = kexch
143      imess(3) = kstep
144      imess(4) = getpid()
145
146c
147c
148      IF (cchan.eq.'PIPE') THEN
149c
150          ierror=0
151c
152c
153          WRITE(nuout,*) ' '
154          WRITE(nuout,*) 'Making pipes for fields to receive from CPL'
155          WRITE(nuout,*) ' '
156c
157c loop to define pipes (ocean=CPL to atmos)
158c
159          DO jf=1, jpfldo2a
160            CALL PIPE_Model_Define(nuout, cl_read(jf), jpread, iretcode)
161            IF (iretcode.ne.0) ierror=ierror+1
162          END DO
163c
164          WRITE(nuout,*) ' '
165          WRITE(nuout,*) 'Making pipes for fields to send to CPL'
166          WRITE(nuout,*) ' '
167c
168c loop to define pipes (atmos to ocean=CPL)
169c
170          DO jf=1, jpflda2o
171            CALL PIPE_Model_Define(nuout, cl_writ(jf), jpwrit, iretcode)
172            IF (iretcode.ne.0) ierror=ierror+1
173          END DO
174c
175          IF (ierror.ne.0) THEN
176              WRITE (nuout,*) 'Error in pipes definitions'
177              WRITE (nuout,*) 'STOP inicma'
178              CALL abort
179          END IF
180c
181          WRITE(nuout,*) ' '
182          WRITE(nuout,*) 'All pipes have been made'
183          WRITE(nuout,*) ' '
184c
185          WRITE(nuout,*) ' '
186          WRITE(nuout,*) 'Communication test between ATM and CPL'
187          WRITE(nuout,*) ' '
188          CALL flush(nuout)
189c
190          CALL PIPE_Model_Stepi(nuout, imess, ime, imesso, ierror)
191c
192          IF (ierror.ne.0) THEN
193              WRITE (nuout,*)
194     $            'Error in exchange first informations with Oasis'
195              WRITE (nuout,*) 'STOP inicma'
196              CALL abort
197          END IF
198c
199          WRITE(nuout,*) ' '
200          WRITE(nuout,*) 'Communication test between ATM and CPL is OK'
201          WRITE(nuout,*) ' total simulation time in oasis = ', imesso(1)
202          WRITE(nuout,*) ' total number of iterations is  = ', imesso(2)
203          WRITE(nuout,*) ' value of oasis timestep  is    = ', imesso(3)
204          WRITE(nuout,*) ' process id for oasis  is       = ', imesso(4)
205          WRITE(nuout,*) ' '
206          CALL flush(nuout)
207c
208      ELSE  IF (cchan.eq.'SIPC') THEN
209c
210c debug for more information
211c
212c          CALL SVIPC_debug(1)
213
214c
215c     1.1-Define the experiment name :
216c
217          cljobnam = 'IPC'      ! as $JOBNAM in namcouple
218c
219c         3-Attach to shared memory pool used to exchange initial infos
220c
221          imrc = 0
222          CALL SIPC_Init_Model (cljobnam, clmodnam, 1, imrc)
223          IF (imrc .NE. 0) THEN
224            WRITE (nuout,*)'   '
225            WRITE (nuout,*)'WARNING: Problem with attachement to', imrc
226            WRITE (nuout,*)'         initial memory pool(s) in atmos'
227            WRITE (nuout,*)'   '
228            CALL ABORT('STOP in atmos')
229          ENDIF
230c
231c         4-Attach to pools used to exchange fields from atmos to coupler
232c
233          DO jf = 1, jpflda2o
234c
235C
236c           Pool name:
237            clpoolnam = 'P'//cl_writ(jf)
238C
239            CALL SIPC_Attach(clpoolnam, ipoolhandle)
240c     
241c           Resulting pool handle:
242            mpoolwrit(jf) = ipoolhandle 
243C
244            END DO
245C
246c         5-Attach to pools used to exchange fields from coupler to atmos
247c
248          DO jf = 1, jpfldo2a
249c
250c           Pool name:
251            clpoolnam = 'P'//cl_read(jf)
252c
253            CALL SIPC_Attach(clpoolnam, ipoolhandle)
254c
255c           Resulting pool handle:
256            mpoolread(jf) = ipoolhandle 
257c
258          END DO
259c
260c         6-Exchange of initial infos
261c
262c         Write data array isend to pool READ by Oasis
263c
264          imrc = 0
265          ipoolsize = 4*jpbyteint
266          CALL SVIPC_Write(mpoolinitr, imess, ipoolsize, imrc)
267C
268C         Find error if any
269C
270          IF (imrc .LT. 0) THEN
271              WRITE (nuout,*) '   '
272              WRITE (nuout,*) 'Problem in atmos in writing initial'
273              WRITE (nuout,*) 'infos to the shared memory segment(s)'
274              WRITE (nuout,*) '   '
275          ELSE
276              WRITE (nuout,*) '   '
277              WRITE (nuout,*) 'Initial infos written in atmos'           
278              WRITE (nuout,*) 'to the shared memory segment(s)'
279              WRITE (nuout,*) '   '
280          ENDIF
281C
282C         Read data array irecv from pool written by Oasis
283C
284          imrc = 0
285          ipoolsize = 4*jpbyteint
286          CALL SVIPC_Read(mpoolinitw, imesso, ipoolsize, imrc)
287C
288C*        Find error if any
289C
290          IF (imrc .LT. 0) THEN
291              WRITE (nuout,*) '   '
292              WRITE (nuout,*) 'Problem in atmos in reading initial'
293              WRITE (nuout,*) 'infos from the shared memory segment(s)'
294              WRITE (nuout,*) '   '
295          ELSE
296              WRITE (nuout,*) '   '
297              WRITE (nuout,*) 'Initial infos read by atmos'               
298              WRITE (nuout,*) 'from the shared memory segment(s)'
299              WRITE (nuout,*) '   '
300              WRITE(*,*) ' ntime, niter, nstep, Oasis pid:'
301              WRITE(*,*) imesso(1), imesso(2), imesso(3), imesso(4)
302          ENDIF
303C
304C         Detach from shared memory segment(s)
305C
306          imrc = 0
307          CALL SVIPC_close(mpoolinitw, 0, imrc)
308C
309C         Find error if any
310C
311          IF (imrc .LT. 0) THEN
312              WRITE (nuout,*)
313     $          'Problem in detaching from shared memory segment(s)'
314              WRITE (nuout,*)
315     $          'used by atmos to read initial infos'
316          ENDIF
317c
318c
319      ELSE IF (cchan.eq.'CLIM') THEN
320
321c
322c     1.1-Define the experiment name :
323c
324          cljobnam = 'CLI'      ! as $JOBNAM in namcouple
325
326          OPEN ( UNIT = 7, FILE = 'trace', STATUS = 'unknown',
327     $          FORM = 'formatted')
328          CALL CLIM_Init ( cljobnam, clmodnam, 3, 7,
329     *                 kastp, kexch, kstep,
330     *                 5, 3600, 3600, info )
331c
332          IF (info.ne.clim_ok) THEN
333              WRITE ( nuout, *) ' inicma : pb init clim '
334              WRITE ( nuout, *) ' error code is = ', info
335              CALL abort('STOP in inicma')
336            ELSE
337              WRITE(nuout,*) 'inicma : init clim ok '
338          ENDIF
339c
340          iparal ( clim_strategy ) = clim_serial
341          iparal ( clim_length   ) = iim*(jjm+1)
342          iparal ( clim_offset   ) = 0
343c
344c loop to define messages (CPL=ocean to atmos)
345c
346          DO jf=1, jpfldo2a
347            CALL CLIM_Define (cl_read(jf), clim_in , clim_double, iparal
348     $          , info ) 
349          END DO
350
351c
352c loop to define messages (atmos to ocean=CPL)
353c
354          DO jf=1, jpflda2o
355            CALL CLIM_Define (cl_writ(jf), clim_out , clim_double,
356     $          iparal, info )   
357          END DO
358
359          WRITE(nuout,*) 'inicma : clim_define ok '
360          CALL CLIM_Start ( imxtag, info )
361          IF (info.ne.clim_ok) THEN
362              WRITE ( nuout, *) 'inicma : pb start clim '
363              WRITE ( nuout, *) ' error code is = ', info
364              CALL abort('stop in inicma')
365            ELSE
366              WRITE ( nuout, *)  'inicma : start clim ok '
367          ENDIF
368c
369          CALL CLIM_Stepi (cloasis, istep, ifcpl, idt, info)
370          IF (info .NE. clim_ok) THEN
371              WRITE ( UNIT = nuout, FMT = *)
372     $            ' warning : problem in getting step info ',
373     $            'from oasis '
374              WRITE (UNIT = nuout, FMT = *)
375     $            ' =======   error code number = ', info
376            ELSE
377              WRITE (UNIT = nuout, FMT = *)
378     $            ' got step information from oasis '
379          ENDIF
380          WRITE ( nuout, *) ' number of tstep in oasis ', istep
381          WRITE ( nuout, *) ' exchange frequency in oasis ', ifcpl
382          WRITE ( nuout, *) ' length of tstep in oasis ', idt
383      ENDIF
384
385      RETURN
386      END
387
388      SUBROUTINE fromcpl(kt, imjm, sst, gla)
389      IMPLICIT none
390c
391c Laurent Z.X Li (Feb. 10, 1997): It reads the SST and Sea-Ice
392c provided by the coupler. Of course, it waits until it receives
393c the signal from the corresponding pipes.
394c 3 techniques:
395c  - pipes and signals (only on Cray C90 and Cray J90)
396c  - CLIM (PVM exchange messages)
397c  - SVIPC shared memory segments and semaphores
398c
399      INTEGER imjm, kt
400      REAL sst(imjm)          ! sea-surface-temperature
401      REAL gla(imjm)          ! sea-ice
402c
403      INTEGER nuout             ! listing output unit
404      PARAMETER (nuout=6)
405c
406      INTEGER nuread, ios, iflag, icpliter
407      CHARACTER*8 pipnom        ! name for the pipe
408      CHARACTER*8 fldnom        ! name for the field
409      CHARACTER*8 filnom        ! name for the data file
410
411      INTEGER info, jf
412
413c
414#include "oasis.h"
415#include "clim.h"
416c
417#include "param_cou.h"
418c
419#include "inc_sipc.h"
420#include "inc_cpl.h"
421c
422c     Addition for SIPC CASE
423      INTEGER index
424      CHARACTER*3 cmodinf       ! Header or not
425      CHARACTER*3 cljobnam_r    ! Experiment name in the field brick, if any
426      INTEGER infos(3)          ! infos in the field brick, if any
427c
428c
429      WRITE (nuout,*) ' '
430      WRITE (nuout,*) 'Fromcpl: Read fields from CPL, kt=',kt
431      WRITE (nuout,*) ' '
432      CALL flush (nuout)
433
434      IF (cchan.eq.'PIPE') THEN
435c
436c UNIT number for fields
437c
438          nuread = 99
439c
440c exchanges from ocean=CPL to atmosphere
441c
442          DO jf=1,jpfldo2a
443            CALL PIPE_Model_Recv(cl_read(jf), icpliter, nuout)
444            OPEN (nuread, FILE=cl_f_read(jf), FORM='UNFORMATTED')
445            IF (jf.eq.1)
446     $          CALL locread(cl_read(jf), sst, imjm, nuread, iflag,
447     $          nuout)
448            IF (jf.eq.2)
449     $          CALL locread(cl_read(jf), gla, imjm, nuread, iflag,
450     $          nuout)
451            CLOSE (nuread)
452          END DO
453
454c
455      ELSE IF (cchan.eq.'SIPC') THEN
456c
457c         Define IF a header must be encapsulated within the field brick :
458          cmodinf = 'NOT'                 ! as $MODINFO in namcouple 
459c
460c         reading of input field sea-surface-temperature SISUTESU
461c
462c
463c         Index of sst in total number of fields jpfldo2a:
464          index = 1
465c
466          CALL SIPC_Read_Model(index, imjm, cmodinf,
467     $              cljobnam_r,infos, sst)
468c
469c         reading of input field sea-ice SIICECOV
470c
471c
472c         Index of sea-ice in total number of fields jpfldo2a:
473          index = 2
474c
475          CALL SIPC_Read_Model(index, imjm, cmodinf,
476     $              cljobnam_r,infos, gla)
477c
478c
479      ELSE IF (cchan.eq.'CLIM') THEN
480
481c
482c exchanges from ocean=CPL to atmosphere
483c
484          DO jf=1,jpfldo2a
485            IF (jf.eq.1) CALL CLIM_Import (cl_read(jf) , kt, sst, info)
486            IF (jf.eq.2) CALL CLIM_Import (cl_read(jf) , kt, gla, info)
487            IF ( info .NE. CLIM_Ok) THEN
488                WRITE(nuout,*)'Pb in reading ', cl_read(jf), jf
489                WRITE(nuout,*)'Couplage kt is = ',kt
490                WRITE(nuout,*)'CLIM error code is = ', info
491                WRITE(nuout,*)'STOP in Fromcpl'
492                STOP 'Fromcpl'
493            ENDIF
494          END DO
495
496      ENDIF
497c
498      RETURN
499      END
500
501
502      SUBROUTINE intocpl(kt,imjm,
503     .                   fsol, fnsol,
504     .                   rain, snow, evap, ruisoce, ruisriv,
505     .                   taux, tauy, last)
506      IMPLICIT NONE
507c
508c Laurent Z.X Li (Feb. 10, 1997): It provides several fields to the
509c coupler. Of course, it sends a message to the corresponding pipes
510c after the writting.
511c 3 techniques : pipes
512c                clim
513c                svipc
514c IF last time step WRITE output files anway
515c
516#include "oasis.h"
517
518      INTEGER kt, imjm
519c
520      REAL fsol(imjm)
521      REAL fnsol(imjm)
522      REAL rain(imjm)
523      REAL snow(imjm)
524      REAL evap(imjm)
525      REAL ruisoce(imjm)
526      REAL ruisriv(imjm)
527      REAL taux(imjm)
528      REAL tauy(imjm)
529      LOGICAL last
530c
531      INTEGER nuout
532      PARAMETER (nuout = 6)
533c
534c Additions for SVIPC
535c
536      INTEGER index
537      INTEGER infos(3)
538      CHARACTER*3 cmodinf       ! Header or not
539      CHARACTER*3 cljobnam      ! experiment name
540c
541#include "clim.h"
542c
543#include "param_cou.h"
544c
545#include "inc_sipc.h"
546#include "inc_cpl.h"
547c
548C
549      INTEGER nuwrit, ios
550      CHARACTER*8 pipnom
551      CHARACTER*8 fldnom
552      CHARACTER*6 file_name(jpmaxfld)
553      INTEGER max_file
554      INTEGER file_unit_max, file_unit(jpmaxfld),
555     $    file_unit_field(jpmaxfld)
556
557      INTEGER icstep, info, jn, jf, ierror
558      LOGICAL trouve
559c
560c
561      icstep=kt
562c
563      WRITE(nuout,*) ' '
564      WRITE(nuout,*) 'Intocpl: send fields to CPL, kt= ', kt
565      WRITE(nuout,*) ' '
566
567      IF (last.or.(cchan.eq.'PIPE')) THEN
568c
569c
570c WRITE fields for coupler with pipe technique or for last time step
571c
572c         initialisation
573c
574          max_file=1
575          file_unit_max=99
576c keeps first file name
577          file_name(max_file)=cl_f_writ(max_file)
578c keeps first file unit
579          file_unit(max_file)=file_unit_max
580c decrements file unit maximum
581          file_unit_max=file_unit_max-1
582c keeps file unit for field
583          file_unit_field(1)=file_unit(max_file)
584c
585c different files names counter
586c
587         
588          DO jf= 2, jpflda2o
589            trouve=.false.
590            DO jn= 1, max_file
591              IF (.not.trouve) THEN
592                  IF (cl_f_writ(jf).EQ.file_name(jn)) THEN
593c keep file unit for field
594                      file_unit_field(jf)=file_unit(jn)
595                      trouve=.true.
596                  END IF
597              END IF
598            END DO
599            IF (.not.trouve) then
600c increment the number of different files
601                max_file=max_file+1
602c keep file name
603                file_name(max_file)=cl_f_writ(jf)
604c keep file unit for file
605                file_unit(max_file)=file_unit_max
606c keep file unit for field
607                file_unit_field(jf)=file_unit(max_file)
608c decrement unit maximum number from 99 to 98, ...
609                file_unit_max=file_unit_max-1
610            END IF
611          END DO
612         
613          DO jn=1, max_file
614            OPEN (file_unit(jn), FILE=file_name(jn), FORM='UNFORMATTED')
615          END DO
616         
617          DO jf=1, jpflda2o
618            IF (jf.eq.1)
619     $          CALL locwrite(cl_writ(jf),fnsol, imjm,
620     $          file_unit_field(jf), ierror, nuout)
621            IF (jf.eq.2)
622     $          CALL locwrite(cl_writ(jf),fsol, imjm,
623     $          file_unit_field(jf), ierror, nuout)
624            IF (jf.eq.3)
625     $          CALL locwrite(cl_writ(jf),rain, imjm,
626     $          file_unit_field(jf), ierror, nuout)
627            IF (jf.eq.4)
628     $          CALL locwrite(cl_writ(jf),evap, imjm,
629     $          file_unit_field(jf), ierror, nuout)
630            IF (jf.eq.5)
631     $          CALL locwrite(cl_writ(jf),ruisoce, imjm,
632     $          file_unit_field(jf),ierror, nuout)
633            IF (jf.eq.6)
634     $          CALL locwrite(cl_writ(jf),ruisriv, imjm,
635     $          file_unit_field(jf),ierror, nuout)
636            IF (jf.eq.7)
637     $          CALL locwrite(cl_writ(jf),taux, imjm,
638     $          file_unit_field(jf), ierror, nuout)
639            IF (jf.eq.8)
640     $          CALL locwrite(cl_writ(jf),taux, imjm,
641     $          file_unit_field(jf), ierror, nuout)
642            IF (jf.eq.9)
643     $          CALL locwrite(cl_writ(jf),tauy, imjm,
644     $          file_unit_field(jf), ierror, nuout)
645            IF (jf.eq.10)
646     $          CALL locwrite(cl_writ(jf),tauy, imjm,
647     $          file_unit_field(jf), ierror, nuout)
648          END DO
649C
650C simulate a FLUSH
651C
652          DO jn=1, max_file
653            CLOSE (file_unit(jn))
654          END DO
655c
656c
657c
658          IF(cchan.eq.'CLIM') THEN
659c
660c inform PVM daemon, I have finished
661c
662              CALL CLIM_Quit (CLIM_ContPvm, info)
663              IF (info .NE. CLIM_Ok) THEN
664                  WRITE (6, *)
665     $                'An error occured while leaving CLIM. Error = ',
666     $                info
667              ENDIF
668             
669          END IF
670         
671      END IF
672     
673c
674c IF last we have finished
675c
676      IF (last) RETURN
677     
678      IF (cchan.eq.'PIPE') THEN
679c
680c Send message to pipes for CPL=ocean
681c
682          DO jf=1, jpflda2o
683            CALL PIPE_Model_Send(cl_writ(jf), kt, nuout)
684          END DO
685c
686c
687c
688      ELSE  IF(cchan.eq.'SIPC') THEN
689c
690c         Define IF a header must be encapsulated within the field brick :
691          cmodinf = 'NOT'                 ! as $MODINFO in namcouple 
692c
693c         IF cmodinf = 'YES', define encapsulated infos to be exchanged
694c                 infos(1) = initial date
695c                 infos(2) = timestep
696c                 infos(3) = actual time
697c
698c         Writing of output field non solar heat flux CONSFTOT
699c
700c         Index of non solar heat flux in total number of fields jpflda2o:
701          index = 1
702c   
703          CALL SIPC_Write_Model(index, imjm, cmodinf,
704     $                          cljobnam,infos,fnsol)
705c
706c
707c         Writing of output field solar heat flux COSHFTOT
708c
709c         Index of solar heat flux in total number of fields jpflda2o:
710          index = 2
711c   
712          CALL SIPC_Write_Model(index, imjm, cmodinf,
713     $                          cljobnam,infos,fsol)
714c
715c         Writing of output field rain COTOPRSU
716c
717c         Index of rain in total number of fields jpflda2o:
718          index = 3
719c   
720          CALL SIPC_Write_Model(index, imjm, cmodinf,
721     $                          cljobnam,infos, rain)
722c
723c         Writing of output field evap COTFSHSU
724c
725c         Index of evap in total number of fields jpflda2o:
726          index = 4
727c   
728          CALL SIPC_Write_Model(index, imjm, cmodinf,
729     $                          cljobnam,infos, evap)
730c
731c         Writing of output field ruisoce CORUNCOA
732c
733c         Index of ruisoce in total number of fields jpflda2o:
734          index = 5
735c   
736          CALL SIPC_Write_Model(index, imjm, cmodinf,
737     $                          cljobnam,infos, ruisoce)
738c
739c
740c         Writing of output field ruisriv CORIVFLU
741c
742c         Index of ruisriv in total number of fields jpflda2o:
743          index = 6
744c   
745          CALL SIPC_Write_Model(index, imjm, cmodinf,
746     $                          cljobnam,infos, ruisriv)
747c
748c
749c         Writing of output field zonal wind stress COZOTAUX
750c
751c         Index of runoff in total number of fields jpflda2o:
752          index = 7
753c   
754          CALL SIPC_Write_Model(index, imjm, cmodinf,
755     $                          cljobnam,infos, taux)
756c
757c         Writing of output field meridional wind stress COMETAUY
758c
759c         Index of runoff in total number of fields jpflda2o:
760          index = 8
761c   
762          CALL SIPC_Write_Model(index, imjm, cmodinf,
763     $                          cljobnam,infos, taux)
764c
765c
766c         Writing of output field zonal wind stress COMETAU2 (at v point)
767c
768c         Index of runoff in total number of fields jpflda2o:
769          index = 9
770c   
771          CALL SIPC_Write_Model(index, imjm, cmodinf,
772     $                          cljobnam,infos, tauy)
773c
774c         Writing of output field meridional wind stress COMETAU2
775c
776c         Index of runoff in total number of fields jpflda2o:
777          index = 10
778c   
779          CALL SIPC_Write_Model(index, imjm, cmodinf,
780     $                          cljobnam,infos, tauy)
781c
782c
783      ELSE IF(cchan.eq.'CLIM') THEN
784         
785          DO jn=1, jpflda2o
786           
787            IF (jn.eq.1) CALL CLIM_Export(cl_writ(jn), kt, fnsol, info)
788            IF (jn.eq.2) CALL CLIM_Export(cl_writ(jn), kt, fsol, info)
789            IF (jn.eq.3) CALL CLIM_Export(cl_writ(jn), kt, rain, info)
790            IF (jn.eq.4) CALL CLIM_Export(cl_writ(jn), kt, evap, info)
791            IF (jn.eq.5) CALL CLIM_Export(cl_writ(jn), kt, ruisoce, info
792     $          )
793            IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, ruisriv, info
794     $          )
795            IF (jn.eq.7) CALL CLIM_Export(cl_writ(jn), kt, taux, info)
796            IF (jn.eq.8) CALL CLIM_Export(cl_writ(jn), kt, taux, info)
797            IF (jn.eq.9) CALL CLIM_Export(cl_writ(jn), kt, tauy, info)
798            IF (jn.eq.10) CALL CLIM_Export(cl_writ(jn), kt, tauy, info)
799           
800            IF (info .NE. CLIM_Ok) THEN
801                WRITE (nuout,*) 'STEP : Pb giving ',cl_writ(jn), ':',jn
802                WRITE (nuout,*) ' at timestep = ', icstep,'kt = ',kt
803                WRITE (nuout,*) 'Clim error code is = ',info
804                WRITE (nuout,*) 'STOP in intocpl '
805                CALL abort(' intocpl ')
806            ENDIF
807           
808          END DO
809         
810      ENDIF
811c
812      RETURN
813      END
814
815      SUBROUTINE locread
816      print *, 'Attention dans oasis.F, locread est non defini'
817      RETURN
818      END
819
820      SUBROUTINE locwrite
821      print *, 'Attention dans oasis.F, locwrite est non defini'
822      RETURN
823      END
824
825      SUBROUTINE pipe_model_define
826      print*,'Attention dans oasis.F, pipe_model_define est non defini'
827      RETURN
828      END
829
830      SUBROUTINE pipe_model_stepi
831      print*,'Attention dans oasis.F, pipe_model_stepi est non defini'
832      RETURN
833      END
834
835      SUBROUTINE pipe_model_recv
836      print *, 'Attention dans oasis.F, pipe_model_recv est non defini'
837      RETURN
838      END
839
840      SUBROUTINE pipe_model_send
841      print *, 'Attention dans oasis.F, pipe_model_send est non defini'
842      RETURN
843      END
844
845      SUBROUTINE clim_stepi
846      print *, 'Attention dans oasis.F, clim_stepi est non defini'
847      RETURN
848      END
849
850      SUBROUTINE clim_start
851      print *, 'Attention dans oasis.F, clim_start est non defini'
852      RETURN
853      END
854
855      SUBROUTINE clim_import
856      print *, 'Attention dans oasis.F, clim_import est non defini'
857      RETURN
858      END
859
860      SUBROUTINE clim_export
861      print *, 'Attention dans oasis.F, clim_export est non defini'
862      RETURN
863      END
864
865      SUBROUTINE clim_init
866      print *, 'Attention dans oasis.F, clim_init est non defini'
867      RETURN
868      END
869
870      SUBROUTINE clim_define
871      print *, 'Attention dans oasis.F, clim_define est non defini'
872      RETURN
873      END
874
875      SUBROUTINE clim_quit
876      print *, 'Attention dans oasis.F, clim_quit est non defini'
877      RETURN
878      END
879
880      SUBROUTINE svipc_write
881      print *, 'Attention dans oasis.F, svipc_write est non defini'
882      RETURN
883      END
884
885      SUBROUTINE svipc_close
886      print *, 'Attention dans oasis.F, svipc_close est non defini'
887      RETURN
888      END
889
890      SUBROUTINE svipc_read
891      print *, 'Attention dans oasis.F, svipc_read est non defini'
892      RETURN
893      END
894
895      SUBROUTINE quitcpl
896      print *, 'Attention dans oasis.F, quitcpl est non defini'
897      RETURN
898      END
899
900      SUBROUTINE sipc_write_model
901      print *, 'Attention dans oasis.F, sipc_write_model est non defini'
902      RETURN
903      END
904
905      SUBROUTINE sipc_attach
906      print *, 'Attention dans oasis.F, sipc_attach est non defini'
907      RETURN
908      END
909
910      SUBROUTINE sipc_init_model
911      print *, 'Attention dans oasis.F, sipc_init_model est non defini'
912      RETURN
913      END
914
915      SUBROUTINE sipc_read_model
916      print *, 'Attention dans oasis.F, sipc_read_model est non defini'
917      RETURN
918      END
Note: See TracBrowser for help on using the repository browser.