Changeset 13 for LMDZ.3.3/trunk/libf


Ignore:
Timestamp:
Jan 12, 2000, 3:05:47 PM (25 years ago)
Author:
lmdz
Message:

Changement de oasis.F pour passage sur Nec LF

Location:
LMDZ.3.3/trunk/libf/phylmd
Files:
4 added
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ.3.3/trunk/libf/phylmd/oasis.F

    r2 r13  
    1       SUBROUTINE inicma(kastp,kexch,kstep)
    2       IMPLICIT none
    3 c
    4       INTEGER kastp, kexch, kstep
    5 c
    6       INTEGER ime
    7       PARAMETER (ime = 1)
    81c
    92C****
    … …  
    4538C     -----------------------------------------------------------
    4639C
    47       INTEGER imess(4)
    48       INTEGER getpid, mknod ! system functions
    49       CHARACTER*80 clcmd
    50       CHARACTER*8 pipnom, fldnom
    51       INTEGER ierror
    52 C
     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
    5350#include "dimensions.h"
    5451#include "dimphy.h"
    … …  
    5653#include "clim.h"
    5754c
    58       INTEGER iparal(3)
    59       INTEGER istep, ifcpl, idt, info, imxtag
    60 c
    61       INTEGER mode, iret, isize
     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
    6270C
    6371      INTEGER nuout
    6472      PARAMETER (nuout = 6)
     73c
     74C
     75c
     76
    6577C     -----------------------------------------------------------
    6678C
    … …  
    7587      WRITE(nuout,*) ' '
    7688c
    77       IF (cchain.EQ."PIPE") THEN
    78 c
    79       WRITE(nuout,*) " "
    80       WRITE(nuout,*) "Making pipes for fields to receive from CPL"
    81       WRITE(nuout,*) " "
    82 c
    83 c zxli(le17fev97): je ne comprends pas pourquoi il faut
    84 c                  avoir 2 noms pour un seul pipe
    85 c
    86       pipnom = "SISUTESU"
    87       fldnom = "Sisutesu"
    88 #ifdef CRAY
    89       clcmd = "assign -s unblocked -a "//pipnom//" f:"//fldnom
    90       CALL assign(clcmd, ierror)
    91       ierror = mknod (pipnom, 4480, 0)
    92       WRITE(nuout,'(a80)') clcmd
    93 #else
    94       clcmd = "CALL makepipe("//pipnom//",...,...)"
    95       mode = o'010600'
    96       iret = 0
    97       CALL makepipe(pipnom, mode, iret)
    98       WRITE(nuout,'(a80)') clcmd
    99 #endif
    100 c
    101       pipnom = "SIALBEDO"
    102       fldnom = "Sialbedo"
    103 #ifdef CRAY
    104       clcmd = "assign -s unblocked -a "//pipnom//" f:"//fldnom
    105       CALL assign(clcmd, ierror)
    106       ierror = mknod (pipnom, 4480, 0)
    107       WRITE(nuout,'(a80)') clcmd
    108 #else
    109       clcmd = "CALL makepipe("//pipnom//",...,...)"
    110       mode = o'010600'
    111       iret = 0
    112       CALL makepipe(pipnom, mode, iret)
    113       WRITE(nuout,'(a80)') clcmd
    114 #endif
    115 c
    116       pipnom = "SIICECOV"
    117       fldnom = "Siicecov"
    118 #ifdef CRAY
    119       clcmd = "assign -s unblocked -a "//pipnom//" f:"//fldnom
    120       CALL assign(clcmd, ierror)
    121       ierror = mknod (pipnom, 4480, 0)
    122       WRITE(nuout,'(a80)') clcmd
    123 #else
    124       clcmd = "CALL makepipe("//pipnom//",...,...)"
    125       mode = o'010600'
    126       iret = 0
    127       CALL makepipe(pipnom, mode, iret)
    128       WRITE(nuout,'(a80)') clcmd
    129 #endif
    130 c
    131       pipnom = "SIICEALB"
    132       fldnom = "Siicealb"
    133 #ifdef CRAY
    134       clcmd = "assign -s unblocked -a "//pipnom//" f:"//fldnom
    135       CALL assign(clcmd, ierror)
    136       ierror = mknod (pipnom, 4480, 0)
    137       WRITE(nuout,'(a80)') clcmd
    138 #else
    139       clcmd = "CALL makepipe("//pipnom//",...,...)"
    140       mode = o'010600'
    141       iret = 0
    142       CALL makepipe(pipnom, mode, iret)
    143       WRITE(nuout,'(a80)') clcmd
    144 #endif
    145 c
    146       WRITE(nuout,*) " "
    147       WRITE(nuout,*) "Making pipes for fields to send to CPL"
    148       WRITE(nuout,*) " "
    149 c
    150       pipnom = "CONSFTOT"
    151       fldnom = "Consftot"
    152 #ifdef CRAY
    153       clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
    154       CALL assign(clcmd, ierror)
    155       ierror = mknod (pipnom, 4480, 0)
    156       WRITE(nuout,'(a80)') clcmd
    157 #else
    158       clcmd = "CALL makepipe("//pipnom//",...,...)"
    159       mode = o'010600'
    160       iret = 0
    161       CALL makepipe(pipnom, mode, iret)
    162       WRITE(nuout,'(a80)') clcmd
    163 #endif
    164 c
    165       pipnom = "COSSTSST"
    166       fldnom = "Cosstsst"
    167 #ifdef CRAY
    168       clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
    169       CALL assign(clcmd, ierror)
    170       ierror = mknod (pipnom, 4480, 0)
    171       WRITE(nuout,'(a80)') clcmd
    172 #else
    173       clcmd = "CALL makepipe("//pipnom//",...,...)"
    174       mode = o'010600'
    175       iret = 0
    176       CALL makepipe(pipnom, mode, iret)
    177       WRITE(nuout,'(a80)') clcmd
    178 #endif
    179 c
    180       pipnom = "CODFLXDT"
    181       fldnom = "Codflxdt"
    182 #ifdef CRAY
    183       clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
    184       CALL assign(clcmd, ierror)
    185       ierror = mknod (pipnom, 4480, 0)
    186       WRITE(nuout,'(a80)') clcmd
    187 #else
    188       clcmd = "CALL makepipe("//pipnom//",...,...)"
    189       mode = o'010600'
    190       iret = 0
    191       CALL makepipe(pipnom, mode, iret)
    192       WRITE(nuout,'(a80)') clcmd
    193 #endif
    194 c
    195       pipnom = "COSHFTOT"
    196       fldnom = "Coshftot"
    197 #ifdef CRAY
    198       clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
    199       CALL assign(clcmd, ierror)
    200       ierror = mknod (pipnom, 4480, 0)
    201       WRITE(nuout,'(a80)') clcmd
    202 #else
    203       clcmd = "CALL makepipe("//pipnom//",...,...)"
    204       mode = o'010600'
    205       iret = 0
    206       CALL makepipe(pipnom, mode, iret)
    207       WRITE(nuout,'(a80)') clcmd
    208 #endif
    209 c
    210       pipnom = "COALBSUR"
    211       fldnom = "Coalbsur"
    212 #ifdef CRAY
    213       clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
    214       CALL assign(clcmd, ierror)
    215       ierror = mknod (pipnom, 4480, 0)
    216       WRITE(nuout,'(a80)') clcmd
    217 #else
    218       clcmd = "CALL makepipe("//pipnom//",...,...)"
    219       mode = o'010600'
    220       iret = 0
    221       CALL makepipe(pipnom, mode, iret)
    222       WRITE(nuout,'(a80)') clcmd
    223 #endif
    224 c
    225       pipnom = "COTOSPSU"
    226       fldnom = "Cotospsu"
    227 #ifdef CRAY
    228       clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
    229       CALL assign(clcmd, ierror)
    230       ierror = mknod (pipnom, 4480, 0)
    231       WRITE(nuout,'(a80)') clcmd
    232 #else
    233       clcmd = "CALL makepipe("//pipnom//",...,...)"
    234       mode = o'010600'
    235       iret = 0
    236       CALL makepipe(pipnom, mode, iret)
    237       WRITE(nuout,'(a80)') clcmd
    238 #endif
    239 c
    240       pipnom = "COTOLPSU"
    241       fldnom = "Cotolpsu"
    242 #ifdef CRAY
    243       clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
    244       CALL assign(clcmd, ierror)
    245       ierror = mknod (pipnom, 4480, 0)
    246       WRITE(nuout,'(a80)') clcmd
    247 #else
    248       clcmd = "CALL makepipe("//pipnom//",...,...)"
    249       mode = o'010600'
    250       iret = 0
    251       CALL makepipe(pipnom, mode, iret)
    252       WRITE(nuout,'(a80)') clcmd
    253 #endif
    254 c
    255       pipnom = "COTFSHSU"
    256       fldnom = "Cotfshsu"
    257 #ifdef CRAY
    258       clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
    259       CALL assign(clcmd, ierror)
    260       ierror = mknod (pipnom, 4480, 0)
    261       WRITE(nuout,'(a80)') clcmd
    262 #else
    263       clcmd = "CALL makepipe("//pipnom//",...,...)"
    264       mode = o'010600'
    265       iret = 0
    266       CALL makepipe(pipnom, mode, iret)
    267       WRITE(nuout,'(a80)') clcmd
    268 #endif
    269 c
    270       pipnom = "CORUNCOA"
    271       fldnom = "Coruncoa"
    272 #ifdef CRAY
    273       clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
    274       CALL assign(clcmd, ierror)
    275       ierror = mknod (pipnom, 4480, 0)
    276       WRITE(nuout,'(a80)') clcmd
    277 #else
    278       clcmd = "CALL makepipe("//pipnom//",...,...)"
    279       mode = o'010600'
    280       iret = 0
    281       CALL makepipe(pipnom, mode, iret)
    282       WRITE(nuout,'(a80)') clcmd
    283 #endif
    284 c
    285       pipnom = "CORIVFLU"
    286       fldnom = "Corivflu"
    287 #ifdef CRAY
    288       clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
    289       CALL assign(clcmd, ierror)
    290       ierror = mknod (pipnom, 4480, 0)
    291       WRITE(nuout,'(a80)') clcmd
    292 #else
    293       clcmd = "CALL makepipe("//pipnom//",...,...)"
    294       mode = o'010600'
    295       iret = 0
    296       CALL makepipe(pipnom, mode, iret)
    297       WRITE(nuout,'(a80)') clcmd
    298 #endif
    299 c
    300       pipnom = "COZOTAUX"
    301       fldnom = "Cozotaux"
    302 #ifdef CRAY
    303       clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
    304       CALL assign(clcmd, ierror)
    305       ierror = mknod (pipnom, 4480, 0)
    306       WRITE(nuout,'(a80)') clcmd
    307 #else
    308       clcmd = "CALL makepipe("//pipnom//",...,...)"
    309       mode = o'010600'
    310       iret = 0
    311       CALL makepipe(pipnom, mode, iret)
    312       WRITE(nuout,'(a80)') clcmd
    313 #endif
    314 c
    315       pipnom = "COMETAUY"
    316       fldnom = "Cometauy"
    317 #ifdef CRAY
    318       clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
    319       CALL assign(clcmd, ierror)
    320       ierror = mknod (pipnom, 4480, 0)
    321       WRITE(nuout,'(a80)') clcmd
    322 #else
    323       clcmd = "CALL makepipe("//pipnom//",...,...)"
    324       mode = o'010600'
    325       iret = 0
    326       CALL makepipe(pipnom, mode, iret)
    327       WRITE(nuout,'(a80)') clcmd
    328 #endif
    329 c
    330       pipnom = "COZOTAU2"
    331       fldnom = "Cozotau2"
    332 #ifdef CRAY
    333       clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
    334       CALL assign(clcmd, ierror)
    335       ierror = mknod (pipnom, 4480, 0)
    336       WRITE(nuout,'(a80)') clcmd
    337 #else
    338       clcmd = "CALL makepipe("//pipnom//",...,...)"
    339       mode = o'010600'
    340       iret = 0
    341       CALL makepipe(pipnom, mode, iret)
    342       WRITE(nuout,'(a80)') clcmd
    343 #endif
    344 c
    345       pipnom = "COMETAU2"
    346       fldnom = "Cometau2"
    347 #ifdef CRAY
    348       clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
    349       CALL assign(clcmd, ierror)
    350       ierror = mknod (pipnom, 4480, 0)
    351       WRITE(nuout,'(a80)') clcmd
    352 #else
    353       clcmd = "CALL makepipe("//pipnom//",...,...)"
    354       mode = o'010600'
    355       iret = 0
    356       CALL makepipe(pipnom, mode, iret)
    357       WRITE(nuout,'(a80)') clcmd
    358 #endif
    359 c
    360       WRITE(nuout,*) " "
    361       WRITE(nuout,*) "All pipes have been made"
    362       WRITE(nuout,*) " "
    363       CALL flush(nuout)
    364 c
    365       WRITE(nuout,*) " "
    366       WRITE(nuout,*) "Communication test between ATM and CPL"
    367       WRITE(nuout,*) " "
    368 c
    369       WRITE (pipnom,'(a6,i2.2)') "Preadm", ime
    370 #ifdef CRAY
    371       clcmd = "assign -s u f:"//pipnom
    372       CALL assign(clcmd, ierror)
    373       ierror = mknod (pipnom, 4480, 0)
    374 #else
    375       clcmd = "CALL makepipe("//pipnom//",...,...)"
    376       mode = o'010600'
    377       iret = 0
    378       CALL makepipe(pipnom, mode, iret)
    379 #endif
    380       WRITE(nuout,'(a80)') clcmd
     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
    381141      imess(1) = kastp
    382142      imess(2) = kexch
    383143      imess(3) = kstep
    384144      imess(4) = getpid()
    385 #ifdef CRAY
    386       WRITE (pipnom) imess ! send message to pipe
    387 #else
    388       iret=0
    389       isize=4
    390       CALL pipwrite(pipnom, imess, isize, iret)
    391 #endif
    392       WRITE(nuout,*) "Msg sent to pipe "//pipnom
    393       CALL flush(nuout)
    394 c
    395       WRITE (pipnom,'(a6,i2.2)') "Pwritm", ime
    396 #ifdef CRAY
    397       clcmd = "assign -s unblocked f:"//pipnom
    398       CALL assign(clcmd, ierror)
    399       ierror = mknod (pipnom, 4480, 0)
    400 #else
    401       clcmd = "CALL makepipe("//pipnom//",...,...)"
    402       mode = o'010600'
    403       iret = 0
    404       CALL makepipe(pipnom, mode, iret)
    405 #endif
    406       WRITE(nuout,'(a80)') clcmd
    407 c
    408       WRITE(nuout,*) "Waiting for the pipe "//pipnom
    409       CALL flush(nuout)
    410 #ifdef CRAY
    411       READ (pipnom) imess ! read message from pipe
    412 #else
    413       isize=1
    414       iret =0
    415       CALL pipread(pipnom,imess,isize,iret)
    416 #endif
    417 c
    418       WRITE(nuout,*) " "
    419       WRITE(nuout,*) "Communication test between ATM and CPL is OK"
    420       WRITE(nuout,*) " total simulation time in oasis = ", imess(1)
    421       WRITE(nuout,*) " total number of iterations is  = ", imess(2)
    422       WRITE(nuout,*) " value of oasis timestep  is    = ", imess(3)
    423       WRITE(nuout,*) " process id for oasis  is       = ", imess(4)
    424       WRITE(nuout,*) " "
    425       CALL flush(nuout)
    426 c
    427       ELSE ! cchain.EQ."CLIM"
    428 c
    429       CALL CLIM_Init ( 'CLI', 'lmd.xx', 3, 7,
     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)
     213c 
     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,
    430329     *                 kastp, kexch, kstep,
    431      *                 5, 1200, 300, info )
    432       IF (info.EQ.CLIM_Ok) THEN
    433          WRITE(nuout,*) "inicma: CLIM_Init OK"
    434       ELSE
    435          WRITE(nuout,*) "inicma: CLIM_Init erreur:", info
    436          CALL ABORT("STOP in inicma")
    437       ENDIF
    438 c
    439       iparal ( CLIM_Strategy ) = CLIM_Serial
    440       iparal ( CLIM_Length   ) = iim*(jjm+1)
    441       iparal ( CLIM_Offset   ) = 0
    442 c
    443       CALL CLIM_Define ('SISUTESU', CLIM_In , CLIM_Double, iparal, info)
    444       CALL CLIM_Define ('SIALBEDO', CLIM_In , CLIM_Double, iparal, info)
    445       CALL CLIM_Define ('SIICECOV', CLIM_In , CLIM_Double, iparal, info)
    446       CALL CLIM_Define ('SIICEALB', CLIM_In , CLIM_Double, iparal, info)
    447 c
    448       CALL CLIM_Define ('CONSFTOT', CLIM_Out , CLIM_Double, iparal,info)
    449       CALL CLIM_Define ('COSSTSST', CLIM_Out , CLIM_Double, iparal,info)
    450       CALL CLIM_Define ('CODFLXDT', CLIM_Out , CLIM_Double, iparal,info)
    451       CALL CLIM_Define ('COSHFTOT', CLIM_Out , CLIM_Double, iparal,info)
    452       CALL CLIM_Define ('COALBSUR', CLIM_Out , CLIM_Double, iparal,info)
    453       CALL CLIM_Define ('COTOSPSU', CLIM_Out , CLIM_Double, iparal,info)
    454       CALL CLIM_Define ('COTOLPSU', CLIM_Out , CLIM_Double, iparal,info)
    455       CALL CLIM_Define ('COTFSHSU', CLIM_Out , CLIM_Double, iparal,info)
    456       CALL CLIM_Define ('CORUNCOA', CLIM_Out , CLIM_Double, iparal,info)
    457       CALL CLIM_Define ('CORIVFLU', CLIM_Out , CLIM_Double, iparal,info)
    458       CALL CLIM_Define ('COZOTAUX', CLIM_Out , CLIM_Double, iparal,info)
    459       CALL CLIM_Define ('COMETAUY', CLIM_Out , CLIM_Double, iparal,info)
    460       CALL CLIM_Define ('COZOTAU2', CLIM_Out , CLIM_Double, iparal,info)
    461       CALL CLIM_Define ('COMETAU2', CLIM_Out , CLIM_Double, iparal,info)
    462       WRITE(nuout,*) 'inicma : CLIM_Define ok '
    463 c
    464       CALL CLIM_Start ( imxtag, info )
    465       IF (info.NE.CLIM_Ok) THEN
    466           WRITE (nuout,*) "inicma: CLIM_Start pb. ", info
    467           CALL ABORT("STOP in inicma")
    468       ELSE
    469           WRITE (nuout,*)  "inicma: CLIM_Start OK"
    470       ENDIF
    471 c
    472       CALL CLIM_Stepi ("oasis", istep, ifcpl, idt, info)
    473       IF (info .NE. CLIM_Ok) THEN
    474           WRITE (nuout,*) "inicma: CLIM_Stepi pb. ", info
    475           CALL ABORT("STOP in inicma")
    476       ELSE
    477           WRITE (nuout,*) "inicma: CLIM_Stepi OK"
    478           WRITE (nuout,*) " number of tstep in oasis ", istep
    479           WRITE (nuout,*) " exchange frequency in oasis ", ifcpl
    480           WRITE (nuout,*) " length of tstep in oasis ", idt
    481       ENDIF
    482 c
    483       ENDIF
    484 c
     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
    485385      RETURN
    486386      END
    487       SUBROUTINE fromcpl(jour, imjm, sst, sic, alb_sst, alb_sic)
     387
     388      SUBROUTINE fromcpl(kt, imjm, sst, gla)
    488389      IMPLICIT none
    489390c
    490391c Laurent Z.X Li (Feb. 10, 1997): It reads the SST and Sea-Ice
    491392c provided by the coupler. Of course, it waits until it receives
    492 c the signal from the corresponding pipes in the case of utilizing
    493 c the pipe technique.
    494 c
    495       INTEGER imjm, jour
    496       REAL sst(imjm)      ! sea surface temperature
    497       REAL alb_sst(imjm)  ! open sea albedo
    498       REAL sic(imjm)      ! sea ice cover
    499       REAL alb_sic(imjm)  ! sea ice albedo
    500 c
    501       INTEGER nuout   ! listing output unit
     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
    502404      PARAMETER (nuout=6)
    503405c
    504406      INTEGER nuread, ios, iflag, icpliter
    505       CHARACTER*8 pipnom ! name for the pipe
    506       CHARACTER*8 fldnom ! name for the field
    507       CHARACTER*8 filnom ! name for the data file
     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
    508413c
    509414#include "oasis.h"
    510415#include "clim.h"
    511       INTEGER info, jktm1
    512       INTEGER iret, isize
    513 c
    514       WRITE (nuout,*) " "
    515       WRITE (nuout,*) "Fromcpl: Read fields from CPL"
    516       WRITE (nuout,*) " "
     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,*) ' '
    517432      CALL flush (nuout)
    518 c
    519       IF (cchain.EQ."PIPE") THEN
    520 c
    521 c sea-surface-temperature:
    522 c
    523       pipnom = "Sisutesu"
    524       fldnom = "SISUTESU"
    525       filnom = "atmsst"
    526       WRITE (nuout,*) "Waiting for the pipe "//pipnom
    527       CALL flush (nuout)
    528 #ifdef CRAY
    529       READ (pipnom) icpliter
    530 #else
    531       iret = 0
    532       isize = 1
    533       CALL pipread(pipnom, icpliter, isize, iret)
    534 #endif
    535       WRITE (nuout,*) "Ready to read "//fldnom//" from "//filnom
    536       CALL flush (nuout)
    537       nuread = 99
    538       OPEN(nuread, FILE=filnom, FORM='unformatted', IOSTAT=ios)
    539       IF (ios .NE. 0) THEN
    540           WRITE(nuout,*) "Error while connecting "//filnom, nuread
    541           CALL flush (nuout)
    542           CALL ABORT("STOP in Fromcpl")
    543       ENDIF
    544       REWIND (UNIT = nuread)
    545       WRITE(nuout,*) "Reading "//fldnom//" from "//filnom
    546       CALL flush (nuout)
    547       CALL locread(fldnom, sst, imjm, nuread, iflag)
    548       IF (iflag .NE. 0) THEN
    549           WRITE(nuout,*) "Pb in reading "//fldnom//" from "//filnom
    550           WRITE(nuout,*) "jour, iflag = ", jour, iflag
    551           CALL flush (nuout)
    552           CALL ABORT('STOP in Fromcpl')
    553       ENDIF
    554       CLOSE(nuread)
    555       WRITE(nuout,*) "Succesful for reading "//fldnom
    556       CALL flush (nuout)
    557 c
    558 c open sea albedo:
    559 c
    560       pipnom = "Sialbedo"
    561       fldnom = "SIALBEDO"
    562       filnom = "atmice"
    563       WRITE (nuout,*) "Waiting for the pipe "//pipnom
    564       CALL flush (nuout)
    565 #ifdef CRAY
    566       READ (pipnom) icpliter
    567 #else
    568       iret = 0
    569       isize = 1
    570       CALL pipread(pipnom, icpliter, isize, iret)
    571 #endif
    572       WRITE (nuout,*) "Ready to read "//fldnom//" from "//filnom
    573       CALL flush (nuout)
    574       nuread = 99
    575       OPEN(nuread, FILE=filnom, FORM='unformatted', IOSTAT=ios)
    576       IF (ios .NE. 0) THEN
    577           WRITE(nuout,*) "Error while connecting "//filnom, nuread
    578           CALL flush (nuout)
    579           CALL ABORT("STOP in Fromcpl")
    580       ENDIF
    581       REWIND (UNIT = nuread)
    582       WRITE(nuout,*) "Reading "//fldnom//" from "//filnom
    583       CALL flush (nuout)
    584       CALL locread(fldnom, alb_sst, imjm, nuread, iflag)
    585       IF (iflag .NE. 0) THEN
    586           WRITE(nuout,*) "Pb in reading "//fldnom//" from "//filnom
    587           WRITE(nuout,*) "jour, iflag = ", jour, iflag
    588           CALL flush (nuout)
    589           CALL ABORT('STOP in Fromcpl')
    590       ENDIF
    591       CLOSE(nuread)
    592       WRITE(nuout,*) "Succesful for reading "//fldnom
    593       CALL flush (nuout)
    594 c
    595 c sea-ice cover:
    596 c
    597       pipnom = "Siicecov"
    598       fldnom = "SIICECOV"
    599       filnom = "atmice"
    600       WRITE (nuout,*) "Waiting for the pipe "//pipnom
    601       CALL flush (nuout)
    602 #ifdef CRAY
    603       READ (pipnom) icpliter
    604 #else
    605       iret = 0
    606       isize = 1
    607       CALL pipread(pipnom, icpliter, isize, iret)
    608 #endif
    609       WRITE (nuout,*) "Ready to read "//fldnom//" from "//filnom
    610       CALL flush (nuout)
    611       nuread = 99
    612       OPEN(nuread, FILE=filnom, FORM='unformatted', IOSTAT=ios)
    613       IF (ios .NE. 0) THEN
    614           WRITE(nuout,*) "Error while connecting "//filnom, nuread
    615           CALL flush (nuout)
    616           CALL ABORT("STOP in Fromcpl")
    617       ENDIF
    618       REWIND (UNIT = nuread)
    619       WRITE(nuout,*) "Reading "//fldnom//" from "//filnom
    620       CALL flush (nuout)
    621       CALL locread(fldnom, sic, imjm, nuread, iflag)
    622       IF (iflag .NE. 0) THEN
    623           WRITE(nuout,*) "Pb in reading "//fldnom//" from "//filnom
    624           WRITE(nuout,*) "jour, iflag = ", jour, iflag
    625           CALL flush (nuout)
    626           CALL ABORT('STOP in Fromcpl')
    627       ENDIF
    628       CLOSE(nuread)
    629       WRITE(nuout,*) "Succesful for reading "//fldnom
    630       CALL flush (nuout)
    631 c
    632 c sea-ice albedo:
    633 c
    634       pipnom = "Siicealb"
    635       fldnom = "SIICEALB"
    636       filnom = "atmice"
    637       WRITE (nuout,*) "Waiting for the pipe "//pipnom
    638       CALL flush (nuout)
    639 #ifdef CRAY
    640       READ (pipnom) icpliter
    641 #else
    642       iret = 0
    643       isize = 1
    644       CALL pipread(pipnom, icpliter, isize, iret)
    645 #endif
    646       WRITE (nuout,*) "Ready to read "//fldnom//" from "//filnom
    647       CALL flush (nuout)
    648       nuread = 99
    649       OPEN(nuread, FILE=filnom, FORM='unformatted', IOSTAT=ios)
    650       IF (ios .NE. 0) THEN
    651           WRITE(nuout,*) "Error while connecting "//filnom, nuread
    652           CALL flush (nuout)
    653           CALL ABORT("STOP in Fromcpl")
    654       ENDIF
    655       REWIND (UNIT = nuread)
    656       WRITE(nuout,*) "Reading "//fldnom//" from "//filnom
    657       CALL flush (nuout)
    658       CALL locread(fldnom, alb_sic, imjm, nuread, iflag)
    659       IF (iflag .NE. 0) THEN
    660           WRITE(nuout,*) "Pb in reading "//fldnom//" from "//filnom
    661           WRITE(nuout,*) "jour, iflag = ", jour, iflag
    662           CALL flush (nuout)
    663           CALL ABORT('STOP in Fromcpl')
    664       ENDIF
    665       CLOSE(nuread)
    666       WRITE(nuout,*) "Succesful for reading "//fldnom
    667       CALL flush (nuout)
    668 c
    669       ELSE ! cchain.EQ."CLIM"
    670 c
    671       jktm1=jour-1
    672 c
    673       CALL CLIM_Import ('SISUTESU', jktm1, sst, info)
    674       IF (info .NE. CLIM_Ok) THEN
    675          WRITE(nuout,*)'Pb in reading ', 'SISUTESU'
    676          WRITE(nuout,*)'Atmosphere jour is = ',jour
    677          WRITE(nuout,*)'Couplage kt is = ',jktm1
    678          WRITE(nuout,*)'CLIM error code is = ', info
    679          WRITE(nuout,*)'STOP in Fromcpl'
    680          CALL abort
    681       ENDIF
    682 c
    683       CALL CLIM_Import ('SIALBEDO', jktm1, alb_sst, info)
    684       IF (info .NE. CLIM_Ok) THEN
    685          WRITE(nuout,*)'Pb in reading ', 'SIALBEDO'
    686          WRITE(nuout,*)'Atmosphere jour is = ',jour
    687          WRITE(nuout,*)'Couplage kt is = ',jktm1
    688          WRITE(nuout,*)'CLIM error code is = ', info
    689          WRITE(nuout,*)'STOP in Fromcpl'
    690          CALL abort
    691       ENDIF
    692 c
    693       CALL CLIM_Import ('SIICECOV', jktm1, sic, info)
    694       IF (info .NE. CLIM_Ok) THEN
    695          WRITE(nuout,*)'Pb in reading ', 'SIICECOV'
    696          WRITE(nuout,*)'Atmosphere jour is = ',jour
    697          WRITE(nuout,*)'Couplage kt is = ',jktm1
    698          WRITE(nuout,*)'CLIM error code is = ', info
    699          WRITE(nuout,*)'STOP in Fromcpl'
    700          CALL abort
    701       ENDIF
    702 c
    703       CALL CLIM_Import ('SIICEALB', jktm1, alb_sic, info)
    704       IF (info .NE. CLIM_Ok) THEN
    705          WRITE(nuout,*)'Pb in reading ', 'SIICEALB'
    706          WRITE(nuout,*)'Atmosphere jour is = ',jour
    707          WRITE(nuout,*)'Couplage kt is = ',jktm1
    708          WRITE(nuout,*)'CLIM error code is = ', info
    709          WRITE(nuout,*)'STOP in Fromcpl'
    710          CALL abort
    711       ENDIF
    712 c
    713       ENDIF ! fin de test sur cchain
     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
    714497c
    715498      RETURN
    716499      END
    717500
    718       SUBROUTINE locread (cdfldn, pfield, kdimax, knulre, kflgre)
    719       IMPLICIT none
    720       INTEGER kdimax, knulre, kflgre
    721 C****
    722 C               *****************************
    723 C               * OASIS ROUTINE  -  LEVEL 0 *
    724 C               * -------------     ------- *
    725 C               *****************************
    726 C
    727 C**** *locread*  - Read binary field on unit knulre
    728 C
    729 C     Purpose:
    730 C     -------
    731 C     Find string cdfldn on unit knulre and read array pfield
    732 C
    733 C**   Interface:
    734 C     ---------
    735 C       *CALL*  *locread (cdfldn, pfield, kdimax, knulre, kflgre)*
    736 C
    737 C     Input:
    738 C     -----
    739 C                cdfldn : character string locator
    740 C                kdimax : dimension of field to be read
    741 C                knulre : logical unit to be read
    742 C
    743 C     Output:
    744 C     ------
    745 C                pfield : field array (real 1D)
    746 C                kflgre : error status flag
    747 C
    748 C     Workspace:
    749 C     ---------
    750 C     None
    751 C
    752 C     Externals:
    753 C     ---------
    754 C     None
    755 C
    756 C     Reference:
    757 C     ---------
    758 C     See OASIS manual (1995)
    759 C
    760 C     History:
    761 C     -------
    762 C       Version   Programmer     Date      Description
    763 C       -------   ----------     ----      ----------- 
    764 C       2.0       L. Terray      95/09/01  created
    765 C
    766 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    767 C
    768 C* ---------------------------- Include files ---------------------------
    769 C
    770 C
    771 C* ---------------------------- Argument declarations -------------------
    772 C
    773       REAL pfield(kdimax)
    774       CHARACTER*8 cdfldn
    775 C
    776 C* ---------------------------- Local declarations ----------------------
    777 C
    778       CHARACTER*8 clecfl
    779       INTEGER nulou
    780 c
    781       nulou = 6
    782 C
    783 C* ---------------------------- Poema verses ----------------------------
    784 C
    785 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    786 C
    787 C*    1. Initialization
    788 C        --------------
    789 C
    790 c     WRITE (UNIT = nulou,FMT = *) ' '
    791 c     WRITE (UNIT = nulou,FMT = *) ' '
    792 c     WRITE (UNIT = nulou,FMT = *)
    793 c    $    '           ROUTINE locread  -  Level 0'
    794 c     WRITE (UNIT = nulou,FMT = *)
    795 c    $    '           ***************     *******'
    796 c     WRITE (UNIT = nulou,FMT = *) ' '
    797 c     WRITE (UNIT = nulou,FMT = 1001) knulre
    798 c     WRITE (UNIT = nulou,FMT = *) ' '
    799 C
    800 C* Formats
    801 C
    802  1001 FORMAT(5X,' Read binary file connected to unit = ',I3)
    803 C
    804 C     2. Find field in file
    805 C        ------------------
    806 C
    807       REWIND knulre
    808  200  CONTINUE
    809 C* Find string
    810       READ (UNIT = knulre, ERR = 210, END = 210) clecfl
    811       IF (clecfl .NE. cdfldn) GO TO  200
    812 C* Read associated field
    813       READ (UNIT = knulre, ERR = 210, END = 210) pfield
    814 C* Reading done and ok
    815       kflgre = 0
    816       GO TO 220
    817 C* Problem in reading
    818  210  kflgre = 1
    819  220  CONTINUE
    820 C
    821 C
    822 C*    3. End of routine
    823 C        --------------
    824 C
    825 c     WRITE (UNIT = nulou,FMT = *)
    826 c    $    '          --------- End of routine locread ---------'
    827 c     WRITE (UNIT = nulou,FMT = *) ' '
    828 c     CALL FLUSH (nulou)
    829       RETURN
    830       END
    831 
    832 
    833       SUBROUTINE intocpl(itau,imjm,
     501
     502      SUBROUTINE intocpl(kt,imjm,
    834503     .                   fsol, fnsol,
    835504     .                   rain, snow, evap, ruisoce, ruisriv,
    836      .                   tsol, fder, albe,
    837      .                   taux, tauy)
     505     .                   taux, tauy, last)
    838506      IMPLICIT NONE
    839507c
    … …  
    841509c coupler. Of course, it sends a message to the corresponding pipes
    842510c after the writting.
    843 c
    844       INTEGER itau, imjm
     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
    845519c
    846520      REAL fsol(imjm)
    … …  
    851525      REAL ruisoce(imjm)
    852526      REAL ruisriv(imjm)
    853       REAL tsol(imjm)
    854       REAL fder(imjm)
    855       REAL albe(imjm)
    856527      REAL taux(imjm)
    857528      REAL tauy(imjm)
     529      LOGICAL last
    858530c
    859531      INTEGER nuout
    860532      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
    861548C
    862549      INTEGER nuwrit, ios
    863550      CHARACTER*8 pipnom
    864551      CHARACTER*8 fldnom
    865       CHARACTER*8 filnom
    866 c
    867 c
    868 #include "oasis.h"
    869 #include "clim.h"
    870       INTEGER info
    871       INTEGER isize, iret
    872 c
    873       WRITE(nuout,*) " "
    874       WRITE(nuout,*) "Intocpl: send fields to CPL, itau= ", itau
    875       WRITE(nuout,*) " "
    876 c
    877       IF (cchain.EQ."PIPE") THEN
    878 c
    879       nuwrit = 99
    880       filnom = "atmflx"
    881       OPEN(nuwrit, FILE=filnom, FORM="unformatted", IOSTAT=ios)
    882       IF (ios .NE. 0) THEN
    883           WRITE(6,*) "Error while connecting "//filnom
    884           CALL ABORT('STOP in intocpl')
    885       ENDIF
    886       REWIND ( UNIT = nuwrit)
    887 c
    888       WRITE(nuout,*) " "
    889       WRITE(nuout,*) "Writting fields to "//filnom, nuwrit
    890       WRITE(nuout,*) " "
    891       CALL flush(nuout)
    892 C
    893 C            ecriture CONSFTOT (flux non solaire)
    894 C
    895       fldnom = "CONSFTOT"
    896       WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
    897       WRITE(UNIT = nuwrit) fnsol
    898       WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
    899 C
    900 C           ecriture COSHFTOT (solaire)
    901 C
    902       fldnom = "COSHFTOT"
    903       WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
    904       WRITE(UNIT = nuwrit) fsol
    905       WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
    906 C
    907 C           ecriture COTOLPSU (precipitation liquide)
    908 C
    909       fldnom = "COTOLPSU"
    910       WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
    911       WRITE(UNIT = nuwrit) rain
    912       WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
    913 C
    914 C           ecriture COTOSPSU (precipitation solide)
    915 C
    916       fldnom = "COTOSPSU"
    917       WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
    918       WRITE(UNIT = nuwrit) snow
    919       WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
    920 C
    921 C           ecriture COTFSHSU (evaporation)
    922 C
    923       fldnom = "COTFSHSU"
    924       WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
    925       WRITE(UNIT = nuwrit) evap
    926       WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
    927 C
    928 C           ecriture COSSTSST (temperature du sol)
    929 C
    930       fldnom = "COSSTSST"
    931       WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
    932       WRITE(UNIT = nuwrit) tsol
    933       WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
    934 C
    935 C           ecriture CODFLXDT (derivee du flux non-solaire)
    936 C
    937       fldnom = "CODFLXDT"
    938       WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
    939       WRITE(UNIT = nuwrit) fder
    940       WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
    941 C
    942 C           ecriture COALBSUR (albedo moyen)
    943 C
    944       fldnom = "COALBSUR"
    945       WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
    946       WRITE(UNIT = nuwrit) albe
    947       WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
    948 C
    949 C           ecriture CORUNCOA (runoff DIRECT)
    950 C
    951       fldnom = "CORUNCOA"
    952       WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
    953       WRITE(UNIT = nuwrit) ruisoce
    954       WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
    955 C
    956 C           ecriture river runoff 'CORIVFLU'
    957 C
    958       fldnom = "CORIVFLU"
    959       WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
    960       WRITE(UNIT = nuwrit) ruisriv
    961       WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
    962 c
    963       CLOSE(UNIT = nuwrit)
     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
    964649C
    965650C simulate a FLUSH
    966651C
    967       OPEN(nuwrit, FILE=filnom, FORM='unformatted')
    968       CLOSE(UNIT = nuwrit)
    969 C
    970 C Send message to pipes:
    971 c
    972       pipnom = 'Consftot'
    973 #ifdef CRAY
    974       WRITE(pipnom) itau
    975 #else
    976       isize=1
    977       iret=0
    978       CALL pipwrite(pipnom,itau,isize,iret)
    979 #endif
    980       WRITE(nuout,*) "Message sent to pipe "//pipnom
    981 c
    982       pipnom = 'Coshftot'
    983 #ifdef CRAY
    984       WRITE(pipnom) itau
    985 #else
    986       isize=1
    987       iret=0
    988       CALL pipwrite(pipnom,itau,isize,iret)
    989 #endif
    990       WRITE(nuout,*) "Message sent to pipe "//pipnom
    991 c
    992       pipnom = 'Cotolpsu'
    993 #ifdef CRAY
    994       WRITE(pipnom) itau
    995 #else
    996       isize=1
    997       iret=0
    998       CALL pipwrite(pipnom,itau,isize,iret)
    999 #endif
    1000       WRITE(nuout,*) "Message sent to pipe "//pipnom
    1001 c
    1002       pipnom = 'Cotospsu'
    1003 #ifdef CRAY
    1004       WRITE(pipnom) itau
    1005 #else
    1006       isize=1
    1007       iret=0
    1008       CALL pipwrite(pipnom,itau,isize,iret)
    1009 #endif
    1010       WRITE(nuout,*) "Message sent to pipe "//pipnom
    1011 c
    1012       pipnom = 'Cotfshsu'
    1013 #ifdef CRAY
    1014       WRITE(pipnom) itau
    1015 #else
    1016       isize=1
    1017       iret=0
    1018       CALL pipwrite(pipnom,itau,isize,iret)
    1019 #endif
    1020       WRITE(nuout,*) "Message sent to pipe "//pipnom
    1021 c
    1022       pipnom = 'Cosstsst'
    1023 #ifdef CRAY
    1024       WRITE(pipnom) itau
    1025 #else
    1026       isize=1
    1027       iret=0
    1028       CALL pipwrite(pipnom,itau,isize,iret)
    1029 #endif
    1030       WRITE(nuout,*) "Message sent to pipe "//pipnom
    1031 c
    1032       pipnom = 'Codflxdt'
    1033 #ifdef CRAY
    1034       WRITE(pipnom) itau
    1035 #else
    1036       isize=1
    1037       iret=0
    1038       CALL pipwrite(pipnom,itau,isize,iret)
    1039 #endif
    1040       WRITE(nuout,*) "Message sent to pipe "//pipnom
    1041 c
    1042       pipnom = 'Coalbsur'
    1043 #ifdef CRAY
    1044       WRITE(pipnom) itau
    1045 #else
    1046       isize=1
    1047       iret=0
    1048       CALL pipwrite(pipnom,itau,isize,iret)
    1049 #endif
    1050       WRITE(nuout,*) "Message sent to pipe "//pipnom
    1051 c
    1052       pipnom = 'Coruncoa'
    1053 #ifdef CRAY
    1054       WRITE(pipnom) itau
    1055 #else
    1056       isize=1
    1057       iret=0
    1058       CALL pipwrite(pipnom,itau,isize,iret)
    1059 #endif
    1060       WRITE(nuout,*) "Message sent to pipe "//pipnom
    1061 c
    1062       pipnom = 'Corivflu'
    1063 #ifdef CRAY
    1064       WRITE(pipnom) itau
    1065 #else
    1066       isize=1
    1067       iret=0
    1068       CALL pipwrite(pipnom,itau,isize,iret)
    1069 #endif
    1070       WRITE(nuout,*) "Message sent to pipe "//pipnom
    1071 C
    1072 C Send wind stresses to coupler
    1073 c
    1074       nuwrit = 99
    1075       filnom = "atmtau"
    1076       OPEN(nuwrit, FILE=filnom, FORM="unformatted", IOSTAT=ios)
    1077       IF (ios .NE. 0) THEN
    1078           WRITE(6,*) "Error while connecting "//filnom
    1079           CALL ABORT('STOP in intocpl')
    1080       ENDIF
    1081       REWIND ( UNIT = nuwrit)
    1082 c
    1083       WRITE(nuout,*) " "
    1084       WRITE(nuout,*) "Writting fields to "//filnom, nuwrit
    1085       WRITE(nuout,*) " "
    1086 C
    1087 C ecriture COZOTAUX
    1088 c
    1089       fldnom = "COZOTAUX"
    1090       WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
    1091       WRITE(UNIT = nuwrit) taux
    1092       WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
    1093 c
    1094       fldnom = "COZOTAU2"
    1095       WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
    1096       WRITE(UNIT = nuwrit) taux
    1097       WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
    1098 C
    1099 C ecriture COMETAUY
    1100 C
    1101       fldnom = "COMETAUY"
    1102       WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
    1103       WRITE(UNIT = nuwrit) tauy
    1104       WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
    1105 c
    1106       fldnom = "COMETAU2"
    1107       WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
    1108       WRITE(UNIT = nuwrit) tauy
    1109       WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
    1110 c
    1111       CLOSE(UNIT = nuwrit)
    1112 C
    1113 C simulate a FLUSH
    1114 C
    1115       OPEN(nuwrit, FILE=filnom, FORM='unformatted')
    1116       CLOSE(UNIT = nuwrit)
    1117 c
    1118 c Send message to pipes:
    1119 c
    1120       pipnom = 'Cozotaux'
    1121 #ifdef CRAY
    1122       WRITE(pipnom) itau
    1123 #else
    1124       isize=1
    1125       iret=0
    1126       CALL pipwrite(pipnom,itau,isize,iret)
    1127 #endif
    1128       WRITE(nuout,*) "Message sent to pipe "//pipnom
    1129 c
    1130       pipnom = 'Cozotau2'
    1131 #ifdef CRAY
    1132       WRITE(pipnom) itau
    1133 #else
    1134       isize=1
    1135       iret=0
    1136       CALL pipwrite(pipnom,itau,isize,iret)
    1137 #endif
    1138       WRITE(nuout,*) "Message sent to pipe "//pipnom
    1139 c
    1140       pipnom = 'Cometauy'
    1141 #ifdef CRAY
    1142       WRITE(pipnom) itau
    1143 #else
    1144       isize=1
    1145       iret=0
    1146       CALL pipwrite(pipnom,itau,isize,iret)
    1147 #endif
    1148       WRITE(nuout,*) "Message sent to pipe "//pipnom
    1149 c
    1150       pipnom = 'Cometau2'
    1151 #ifdef CRAY
    1152       WRITE(pipnom) itau
    1153 #else
    1154       isize=1
    1155       iret=0
    1156       CALL pipwrite(pipnom,itau,isize,iret)
    1157 #endif
    1158       WRITE(nuout,*) "Message sent to pipe "//pipnom
    1159 c
    1160       ELSE ! cchain.EQ."CLIM"
    1161 c
    1162       CALL CLIM_Export("CONSFTOT", itau, fnsol, info)
    1163       IF (info .NE. CLIM_Ok) THEN
    1164          WRITE (nuout,*) "intocpl: CLIM_Export fnsol pb. ", info
    1165          CALL ABORT("STOP in intocpl")
    1166       ENDIF
    1167 c
    1168       CALL CLIM_Export("COSHFTOT", itau, fsol, info)
    1169       IF (info .NE. CLIM_Ok) THEN
    1170          WRITE (nuout,*) "intocpl: CLIM_Export fsol pb. ", info
    1171          CALL ABORT("STOP in intocpl")
    1172       ENDIF
    1173 c
    1174       CALL CLIM_Export("COTOLPSU", itau, rain, info)
    1175       IF (info .NE. CLIM_Ok) THEN
    1176          WRITE (nuout,*) "intocpl: CLIM_Export rain pb. ", info
    1177          CALL ABORT("STOP in intocpl")
    1178       ENDIF
    1179 c
    1180       CALL CLIM_Export("COTOSPSU", itau, snow, info)
    1181       IF (info .NE. CLIM_Ok) THEN
    1182          WRITE (nuout,*) "intocpl: CLIM_Export snow pb. ", info
    1183          CALL ABORT("STOP in intocpl")
    1184       ENDIF
    1185 c
    1186       CALL CLIM_Export("COTFSHSU", itau, evap, info)
    1187       IF (info .NE. CLIM_Ok) THEN
    1188          WRITE (nuout,*) "intocpl: CLIM_Export evap pb. ", info
    1189          CALL ABORT("STOP in intocpl")
    1190       ENDIF
    1191 c
    1192       CALL CLIM_Export("COSSTSST", itau, tsol, info)
    1193       IF (info .NE. CLIM_Ok) THEN
    1194          WRITE (nuout,*) "intocpl: CLIM_Export tsol pb. ", info
    1195          CALL ABORT("STOP in intocpl")
    1196       ENDIF
    1197 c
    1198       CALL CLIM_Export("CODFLXDT", itau, fder, info)
    1199       IF (info .NE. CLIM_Ok) THEN
    1200          WRITE (nuout,*) "intocpl: CLIM_Export fder pb. ", info
    1201          CALL ABORT("STOP in intocpl")
    1202       ENDIF
    1203 c
    1204       CALL CLIM_Export("COALBSUR", itau, albe, info)
    1205       IF (info .NE. CLIM_Ok) THEN
    1206          WRITE (nuout,*) "intocpl: CLIM_Export fder pb. ", info
    1207          CALL ABORT("STOP in intocpl")
    1208       ENDIF
    1209 c
    1210       CALL CLIM_Export("CORUNCOA", itau, ruisoce, info)
    1211       IF (info .NE. CLIM_Ok) THEN
    1212          WRITE (nuout,*) "intocpl: CLIM_Export ruisoce pb. ", info
    1213          CALL ABORT("STOP in intocpl")
    1214       ENDIF
    1215 c
    1216       CALL CLIM_Export("CORIVFLU", itau, ruisriv, info)
    1217       IF (info .NE. CLIM_Ok) THEN
    1218          WRITE (nuout,*) "intocpl: CLIM_Export ruisriv pb. ", info
    1219          CALL ABORT("STOP in intocpl")
    1220       ENDIF
    1221 c
    1222       CALL CLIM_Export("COZOTAUX", itau, taux, info)
    1223       IF (info .NE. CLIM_Ok) THEN
    1224          WRITE (nuout,*) "intocpl: CLIM_Export taux pb. ", info
    1225          CALL ABORT("STOP in intocpl")
    1226       ENDIF
    1227 c
    1228       CALL CLIM_Export("COZOTAU2", itau, taux, info)
    1229       IF (info .NE. CLIM_Ok) THEN
    1230          WRITE (nuout,*) "intocpl: CLIM_Export taux pb. ", info
    1231          CALL ABORT("STOP in intocpl")
    1232       ENDIF
    1233 c
    1234       CALL CLIM_Export("COMETAUY", itau, tauy, info)
    1235       IF (info .NE. CLIM_Ok) THEN
    1236          WRITE (nuout,*) "intocpl: CLIM_Export tauy pb. ", info
    1237          CALL ABORT("STOP in intocpl")
    1238       ENDIF
    1239 c
    1240       CALL CLIM_Export("COMETAU2", itau, tauy, info)
    1241       IF (info .NE. CLIM_Ok) THEN
    1242          WRITE (nuout,*) "intocpl: CLIM_Export tauy pb. ", info
    1243          CALL ABORT("STOP in intocpl")
    1244       ENDIF
    1245 c
    1246       ENDIF
     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
    1247811c
    1248812      RETURN
    1249813      END
    1250       SUBROUTINE quitcpl
    1251       IMPLICIT none
    1252 c
    1253 c Sortir du coupleur
    1254 c
    1255       INTEGER nuout   ! listing output unit
    1256       PARAMETER (nuout=6)
    1257 c
    1258 #include "oasis.h"
    1259 #include "clim.h"
    1260       INTEGER info
    1261 c
    1262       IF (cchain.EQ."PIPE") THEN
    1263 c
    1264          WRITE(nuout,*)"On sort du coupleur sans rien faire"
    1265 c
    1266       ELSE ! cchain.EQ."CLIM"
    1267 c
    1268          CALL CLIM_Quit(CLIM_StopPvm,info)
    1269          IF (info.NE.CLIM_Ok) THEN
    1270             WRITE(nuout,*)"Erreur pour quiter coupleur:",info
    1271          ENDIF
    1272 c
    1273       ENDIF
    1274 c
    1275       RETURN
    1276       END
    1277 
    1278 
    1279       SUBROUTINE makepipe
    1280       PRINT*, "rien"
    1281       END
    1282       SUBROUTINE pipwrite
    1283       PRINT*, "rien"
    1284       END
    1285       SUBROUTINE pipread
    1286       PRINT*, "rien"
    1287       END
    1288       SUBROUTINE CLIM_Init
    1289       PRINT*, "rien"
    1290       END
    1291       SUBROUTINE CLIM_Define
    1292       PRINT*, "rien"
    1293       END
    1294       SUBROUTINE CLIM_Start
    1295       PRINT*, "rien"
    1296       END
    1297       SUBROUTINE CLIM_Stepi
    1298       PRINT*, "rien"
    1299       END
    1300       SUBROUTINE CLIM_Import
    1301       PRINT*, "rien"
    1302       END
    1303       SUBROUTINE CLIM_Export
    1304       PRINT*, "rien"
    1305       END
    1306       SUBROUTINE CLIM_quit
    1307       PRINT*, "rien"
    1308       END
     814

  • LMDZ.3.3/trunk/libf/phylmd/oasis.h

    r2 r13  
    22      PARAMETER (ok_oasis = .FALSE.)
    33c
    4       CHARACTER*8 cchain
    5       PARAMETER (cchain="PIPE")
    6 c      PARAMETER (cchain="CLIM")
     4      CHARACTER*4 cchan
     5      PARAMETER (cchan="PIPE")
     6c      PARAMETER (cchan="CLIM")
     7
     8      INTEGER jpmaxfld
     9      PARAMETER(jpmaxfld = 20)
Note: See TracChangeset for help on using the changeset viewer.