New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 1165 – NEMO

Changeset 1165


Ignore:
Timestamp:
2008-07-30T16:45:19+02:00 (16 years ago)
Author:
smasson
Message:

Arnaud Caubel contribution, see ticket #155

Location:
branches/dev_003_CPL
Files:
10 edited

Legend:

Unmodified
Added
Removed

  • branches/dev_003_CPL/CONFIG/ORCA2_LIM/EXP00/namelist

    r991 r1165  
    4646   no         =       0 
    4747   cexper     =  "ORCA2" 
    48    ln_rstart  = .false. 
    49    nrstdt     =       0 
    50    nit000     =       1 
    51    nitend     =    5475 
    52    ndate0     =  010101 
    53    nleapy     =       0 
     48   ln_rstart  =  .false. 
     49   nrstdt     =       1 
     50   nit000     =      76 
     51   nitend     =     150 
     52   ndate0     =18600106 
     53   nleapy     =      30 
    5454   ninist     =       0 
    55    nstock     =    5475 
    56    nwrite     =    5475 
     55   nstock     =      75 
     56   nwrite     =     450 
    5757   ln_dimgnnn = .false. 
    5858/ 
    … …  
    9494!             single and multiple processor runs. 
    9595&namctl 
    96    ln_ctl =  .false. 
     96   ln_ctl = .false. 
    9797   nprint =       0 
    9898   nictls =       0 
    … …  
    212212   ln_ana      = .false. 
    213213   ln_flx      = .false. 
    214    ln_blk_clio = .true. 
     214   ln_blk_clio = .false. 
    215215   ln_blk_core = .false. 
    216    ln_cpl      = .false. 
     216   ln_cpl      = .true. 
    217217   nn_ice      = 2 
    218218   nn_ico_cpl  = 0 
    … …  
    301301&namsbc_cpl 
    302302! SEND 
    303 cn_snd_temperature = 'oce only'              ! 'oce only' 'weighted oce and ice' 'mixed oce-ice' 
    304 cn_snd_albedo      = 'none'                  ! 'none' 'weighted ice' 'mixed oce-ice' 
    305 cn_snd_thickness   = 'weighted ice and snow' ! 'none' 'weighted ice and snow' 
    306 cn_snd_current(1)  = 'none'                  ! 'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice' 
    307 cn_snd_current(2)  = 'spherical'             ! 'spherical' 'cartesian' 
    308 cn_snd_current(3)  = 'eastward-northward'    ! 'eastward-northward' or 'local grid' 
    309 cn_snd_current(4)  = 'T'                     ! 'T''U,V' 
     303cn_snd_temperature= 'weighted oce and ice'  ! 'oce only' 'weighted oce and ice' 'mixed oce-ice' 
     304cn_snd_albedo     = 'weighted ice'          ! 'none' 'weighted ice' 'mixed oce-ice' 
     305cn_snd_thickness  = 'none'                  ! 'none' 'weighted ice and snow' 
     306cn_snd_current_1  = 'none'                  ! 'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice' 
     307cn_snd_current_2  = 'spherical'             ! 'spherical' 'cartesian' 
     308cn_snd_current_3  = 'eastward-northward'    ! 'eastward-northward' or 'local grid' 
     309cn_snd_current_4  = 'T'                     ! 'T''U,V' 
    310310! RECEIVE 
    311311cn_rcv_w10m       = 'coupled'               ! 'none' 'coupled' 
    312 cn_rcv_stress(1)  = 'oce and ice'           ! 'oce only' 'oce and ice' 'mixed oce-ice' 
    313 cn_rcv_stress(2)  = 'spherical'             ! 'spherical' 'cartesian' 
    314 cn_rcv_stress(3)  = 'eastward-northward'    ! 'eastward-northward' or 'local grid' 
    315 cn_rcv_stress(4)  = 'U,V,F'                 ! 'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V' 
     312cn_rcv_stress_1   = 'oce only'              ! 'oce only' 'oce and ice' 'mixed oce-ice' 
     313cn_rcv_stress_2   = 'cartesian'             ! 'spherical' 'cartesian' 
     314cn_rcv_stress_3   = 'eastward-northward'    ! 'eastward-northward' or 'local grid' 
     315cn_rcv_stress_4   = 'U,V'                   ! 'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V' 
    316316cn_rcv_dqnsdt     = 'coupled'               ! 'none' 'coupled' 
    317 cn_rcv_qsr        = 'conservative'          ! 'conservative' 'oce and ice' 'mixed oce-ice' 
    318 cn_rcv_qns        = 'conservative'          ! 'conservative' 'oce and ice' 'mixed oce-ice' 
     317cn_rcv_qsr        = 'oce and ice'           ! 'conservative' 'oce and ice' 'mixed oce-ice' 
     318cn_rcv_qns        = 'oce and ice'           ! 'conservative' 'oce and ice' 'mixed oce-ice' 
    319319cn_rcv_emp        = 'conservative'          ! 'conservative' 'oce and ice' 'mixed oce-ice' 
    320 cn_rcv_runoff     = 'climato'               ! 'coupled' 'climato' 'mixed' 
    321 cn_rcv_calving    = 'none'                  ! 'none' 'coupled' 
     320cn_rcv_rnf        = 'coupled'               ! 'coupled' 'climato' 'mixed' 
     321cn_rcv_cal        = 'coupled'               ! 'none' 'coupled' 
    322322/ 
    323323!----------------------------------------------------------------------- 

  • branches/dev_003_CPL/NEMO/LIM_SRC_2/limsbc_2.F90

    r991 r1165  
    3030   USE albedo           ! albedo parameters 
    3131   USE prtctl           ! Print control 
     32 
     33!!! >> Arnaud 
     34   USE cpl_oasis3, ONLY : lk_cpl 
     35!!! << Arnaud 
    3236 
    3337   IMPLICIT NONE 
    … …  
    8387      REAL(wp) ::   zutau , zvtau    ! lead fraction at U- & V-points 
    8488      REAL(wp) ::   zu_io , zv_io    ! 2 components of the ice-ocean velocity 
    85       REAL(wp), DIMENSION(jpi,jpj) ::   zalb     ! albedo of ice under overcast sky 
    86       REAL(wp), DIMENSION(jpi,jpj) ::   zalbp    ! albedo of ice under clear sky 
     89!!! >> Arnaud interface 2D --> 3D 
     90      REAL(wp), DIMENSION(jpi,jpj,1) ::   zalb     ! albedo of ice under overcast sky 
     91      REAL(wp), DIMENSION(jpi,jpj,1) ::   zalbp    ! albedo of ice under clear sky 
     92      REAL(wp), DIMENSION(jpi,jpj,1) ::   zsist    ! surface ice temperature (K) 
     93      REAL(wp), DIMENSION(jpi,jpj,1) ::   zhicif   ! ice thickness 
     94      REAL(wp), DIMENSION(jpi,jpj,1) ::   zhsnif   ! snow thickness 
     95!!! << Arnaud 
    8796      REAL(wp) ::   zsang, zmod, zfm 
    8897      REAL(wp), DIMENSION(jpi,jpj) ::   ztio_u, ztio_v   ! ocean stress below sea-ice 
    … …  
    218227         tn_ice(:,:) = sist(:,:)               
    219228         ! Computation of snow/ice and ocean albedo 
    220          +++ INTERFACE 3D versus 2D 
    221          CALL albedo_ice( sist, hicif, hsnif, zalbp, zalb ) 
    222          alb_ice(:,:) =  0.5 * ( zalbp(:,:) + zalb (:,:) )   ! Ice albedo (mean clear and overcast skys) 
     229!!! >> Arnaud        +++ INTERFACE 3D versus 2D 
     230         zsist (:,:,1) = sist (:,:) 
     231         zhicif(:,:,1) = hicif(:,:)   ;   zhsnif(:,:,1) = hsnif(:,:) 
     232         CALL albedo_ice( zsist, zhicif, zhsnif, zalbp, zalb ) 
     233         alb_ice(:,:) =  0.5 * ( zalbp(:,:,1) + zalb (:,:,1) )   ! Ice albedo (mean clear and overcast skys) 
     234!!! << Arnaud 
    223235      ENDIF 
    224236 

  • branches/dev_003_CPL/NEMO/LIM_SRC_2/limthd_2.F90

    r991 r1165  
    3131   USE limtab_2 
    3232   USE prtctl          ! Print control 
     33 
     34!!! >> Arnaud 
     35   USE cpl_oasis3, ONLY : lk_cpl 
     36!!! << Arnaud 
    3337       
    3438   IMPLICIT NONE 

  • branches/dev_003_CPL/NEMO/LIM_SRC_2/limthd_zdf_2.F90

    r991 r1165  
    2222   USE limistate_2 
    2323   USE in_out_manager 
     24 
     25!!! >> Arnaud 
     26   USE cpl_oasis3, ONLY : lk_cpl 
     27!!! << Arnaud 
    2428       
    2529   IMPLICIT NONE 
    … …  
    322326       DO ji = kideb, kiut 
    323327          sist_1d(ji) = MIN( ztsmlt(ji) , sist_1d(ji) ) 
     328! +++ dupliquer pour eviter le if dans la boucle 
    324329          IF ( .NOT. lk_cpl ) THEN 
    325330             qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( sist_1d(ji) - zts_old(ji) ) 
    … …  
    527532             zdhssub  = parsub * ( qla_ice_1d(ji) / ( rhosn * xsn ) ) * rdt_ice  
    528533          ELSE IF (parsub == 1) THEN  
     534! +++ a mettre dans la lecture de la namelist 
    529535             CALL ctl_stop( 'In coupled mode, use parsub = 0 or send dqla' )  
    530536          ELSE 

  • branches/dev_003_CPL/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    r991 r1165  
    3131   USE mod_prism_get_proto          ! OASIS3 prism module for receiving 
    3232   USE mod_prism_grids_writing      ! OASIS3 prism module for writing grids 
    33    USE par_oce                      ! 
     33   USE par_oce                      ! ocean parameters 
    3434   USE dom_oce                      ! ocean space and time domain 
    35    USE sbccpl 
    3635   USE in_out_manager               ! I/O manager 
    3736   USE lib_mpp 
    … …  
    4039   PRIVATE 
    4140! 
    42    LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .TRUE.   !: coupled flag 
     41   LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .TRUE.   ! coupled flag 
    4342   INTEGER, PUBLIC            :: nlocalComm        ! local MPI size 
    4443   INTEGER                    :: ncomp_id          ! id returned by prism_init_comp 
    4544   INTEGER                    :: nerror            ! return error code 
     45 
     46   INTEGER, PUBLIC :: nrcv, nsnd    ! Number of received and sent coupling fields 
     47 
     48   INTEGER, PARAMETER :: nmaxfld=30    ! Maximum number of coupling fields 
     49    
     50   TYPE, PUBLIC ::   FLD_CPL            ! Type for coupling field information 
     51      LOGICAL            ::   laction   ! To be coupled or not 
     52      CHARACTER(len = 8) ::   clname    ! Name of the coupling field    
     53      CHARACTER(len = 1) ::   clgrid    ! Grid type   
     54      REAL(wp)           ::   nsgn      ! Control of the sign change 
     55      INTEGER            ::   nid       ! Id of the field 
     56   END TYPE FLD_CPL 
     57 
     58   TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC :: srcv, ssnd   ! Coupling fields 
    4659 
    4760   REAL(wp), DIMENSION(:,:), ALLOCATABLE :: exfld  ! Temporary buffer for receiving 
    … …  
    7386      !!-------------------------------------------------------------------- 
    7487      !! 
     88     PRINT *,'debut cpl_prism_init' 
     89 
    7590      IF(lwp) WRITE(numout,*) 
     91      PRINT *,'apres debut cpl_prism_init' 
    7692      IF(lwp) WRITE(numout,*) 'cpl_prism_init : initialization in coupled ocean/atmosphere case' 
    7793      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~' 
    7894      IF(lwp) WRITE(numout,*) 
    79            
     95      PRINT *,'apres debut ' 
    8096      !------------------------------------------------------------------ 
    8197      ! 1st Initialize the PRISM system for the application 
    8298      !------------------------------------------------------------------ 
    83  
     99      PRINT *,'avant prism_init_comp ' 
    84100      CALL prism_init_comp_proto ( ncomp_id, 'oceanx', nerror ) 
     101      PRINT *,'apres prism_init_comp ' 
    85102      IF ( nerror /= PRISM_Ok ) & 
    86103         CALL prism_abort_proto (ncomp_id, 'cpl_prism_init', 'Failure in prism_init_comp_proto') 
    … …  
    91108 
    92109      CALL prism_get_localcomm_proto ( nlocalComm, nerror ) 
     110      PRINT *,'apres prism_get_local_comm' 
    93111      IF ( nerror /= PRISM_Ok ) & 
    94112         CALL prism_abort_proto (ncomp_id, 'cpl_prism_init','Failure in prism_get_localcomm_proto' ) 
    … …  
    160178      ! ... Announce send variables.  
    161179      ! 
    162       DO ji = 1, jpsnd 
    163          IF ( scpl_snd(ji)%laction ) THEN  
    164             CALL prism_def_var_proto (scpl_snd(ji)%nid, scpl_snd(ji)%cname, id_part, (/ 2, 0/),  g & 
     180      DO ji = 1, nsnd 
     181         IF ( ssnd(ji)%laction ) THEN  
     182            CALL prism_def_var_proto (ssnd(ji)%nid, ssnd(ji)%clname, id_part, (/ 2, 0/), & 
    165183               &                      PRISM_Out   , ishape   , PRISM_REAL, nerror) 
    166184            IF ( nerror /= PRISM_Ok ) THEN 
    167                WRITE(numout,*) 'Failed to define transient ', ji, TRIM(scpl_snd(ji)%cname) 
    168                CALL prism_abort_proto ( scp_rcv(ji)%nid, 'cpl_prism_define', 'Failure in prism_def_var') 
     185               WRITE(numout,*) 'Failed to define transient ', ji, TRIM(ssnd(ji)%clname) 
     186               CALL prism_abort_proto ( ssnd(ji)%nid, 'cpl_prism_define', 'Failure in prism_def_var') 
    169187            ENDIF 
    170188         ENDIF 
    … …  
    173191      ! ... Announce received variables.  
    174192      ! 
    175       DO ji = 1, jprcv 
     193      DO ji = 1, nrcv 
    176194         IF ( srcv(ji)%laction ) THEN  
    177             CALL prism_def_var_proto ( srcv(ji)%nid, srcv(ji)%name, id_part, (/ 2, 0/),   & 
     195            CALL prism_def_var_proto ( srcv(ji)%nid, srcv(ji)%clname, id_part, (/ 2, 0/),   & 
    178196               &                      PRISM_In    , ishape   , PRISM_REAL, nerror) 
    179197            IF ( nerror /= PRISM_Ok ) THEN 
    180                WRITE(numout,*) 'Failed to define transient ', ji, TRIM(srcv(ji)%name) 
     198               WRITE(numout,*) 'Failed to define transient ', ji, TRIM(srcv(ji)%clname) 
    181199               CALL prism_abort_proto ( srcv(ji)%nid, 'cpl_prism_define', 'Failure in prism_def_var') 
    182200            ENDIF 
    … …  
    199217      !!              ***  ROUTINE cpl_prism_snd  *** 
    200218      !! 
    201       !! ** Purpose : - At each coupling time-step,this routine snds fields 
     219      !! ** Purpose : - At each coupling time-step,this routine sends fields 
    202220      !!      like sst or ice cover to the coupler or remote application. 
    203221      !!---------------------------------------------------------------------- 
    … …  
    209227      REAL(wp), DIMENSION(jpi,jpj), INTENT( IN    )   :: pdata 
    210228      !! 
    211       !! * Local declarations 
    212       !! 
    213       INTEGER                :: ji 
    214229      !! 
    215230      !!-------------------------------------------------------------------- 
    … …  
    217232      ! snd data to OASIS3 
    218233      ! 
    219       IF( lk_mpp ) THEN   ;   CALL prism_put_proto ( rcv(kid)%nid, kstep, pdata(nldi:nlei, nldj:nlej), kinfo ) 
    220       ELSE                ;   CALL prism_put_proto ( rcv(kid)%nid, kstep, pdata                      , kinfo ) 
     234      IF( lk_mpp ) THEN   ;   CALL prism_put_proto ( ssnd(kid)%nid, kstep, pdata(nldi:nlei, nldj:nlej), kinfo ) 
     235      ELSE                ;   CALL prism_put_proto ( ssnd(kid)%nid, kstep, pdata                      , kinfo ) 
    221236      ENDIF 
    222237       
    … …  
    225240            & kinfo == PRISM_SentOut  .OR. kinfo == PRISM_ToRestOut ) THEN 
    226241            WRITE(numout,*) '****************' 
    227             WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%cname 
     242            WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%clname 
    228243            WRITE(numout,*) 'prism_put_proto: ivarid ', ssnd(kid)%nid 
    229244            WRITE(numout,*) 'prism_put_proto:  kstep ', kstep 
    … …  
    233248            WRITE(numout,*) '     -     Sum value is ', SUM(pdata) 
    234249            WRITE(numout,*) '****************' 
    235          ENDIF 
    236       ENDIF 
    237  
    238    END SUBROUTINE cpl_prism_snd 
     250        ENDIF 
     251     ENDIF 
     252    END SUBROUTINE cpl_prism_snd 
    239253 
    240254 
    … …  
    260274 
    261275      llaction = .false. 
    262       IF( kinfo == PRISM_Rcvd   .OR. kinfo == PRISM_FromRest .OR.   & 
    263           kinfo == PRISM_RcvOut .OR. kinfo == PRISM_FromRestOut )   llaction = .TRUE. 
     276      IF( kinfo == PRISM_Recvd   .OR. kinfo == PRISM_FromRest .OR.   & 
     277          kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut )   llaction = .TRUE. 
    264278 
    265279      IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid 
    … …  
    273287         !--- Fill the overlap areas and extra hallows (mpp) 
    274288         !--- check periodicity conditions (all cases) 
    275          CALL lbc_lnk( pdata, srcv(kid)%cgrid, srcv(kid)%nsgn )    
     289         CALL lbc_lnk( pdata, srcv(kid)%clgrid, srcv(kid)%nsgn )    
    276290          
    277291         IF ( ln_ctl ) THEN         
    278292            WRITE(numout,*) '****************' 
    279             WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%cname 
     293            WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname 
    280294            WRITE(numout,*) 'prism_get_proto: ivarid '  , srcv(kid)%nid 
    281295            WRITE(numout,*) 'prism_get_proto:   kstep', kstep 
    … …  
    285299            WRITE(numout,*) '     -     Sum value is ', SUM(pdata) 
    286300            WRITE(numout,*) '****************' 
     301            call flush(numout) 
    287302         ENDIF 
    288303       

  • branches/dev_003_CPL/NEMO/OPA_SRC/SBC/sbccpl.F90

    r991 r1165  
    3232 
    3333   IMPLICIT NONE 
     34 
     35#  include "vectopt_loop_substitute.h90" 
    3436   PRIVATE 
    3537 
    3638   PUBLIC   sbc_cpl_snd       ! routine called by step.F90 
     39   PUBLIC   sbc_cpl_rcv       ! routine called by step.F90 
    3740    
    38    TYPE ::   FLD_CPL     ! Coupling Namelist field informations 
    39       LOGICAL            ::   laction   !  
    40       CHARACTER(len = 8) ::   clname      !  
    41       CHARACTER(len = 1) ::   clgrid      ! 
    42       INTEGER            ::   nsgn      ! 
    43    END TYPE FLD_CPL 
     41   INTEGER :: jprcv_qsroce, jprcv_qsrice, jprcv_qsrmix                                           ! Index used for qsr 
     42   INTEGER :: jprcv_qnsoce, jprcv_qnsice, jprcv_qnsmix                                           ! Index used for qns 
     43   INTEGER :: jprcv_rain, jprcv_snow, jprcv_tevp, jprcv_ievp, jprcv_tpre, jprcv_spre, jprcv_oemp ! Index used for water flux 
     44   INTEGER :: jprcv_otx1, jprcv_oty1, jprcv_otz1, jprcv_otx2, jprcv_oty2, jprcv_otz2             ! Index used for wind stress on oce 
     45   INTEGER :: jprcv_itx1, jprcv_ity1, jprcv_itz1, jprcv_itx2, jprcv_ity2, jprcv_itz2             ! Index used for wind stress on ice 
     46   INTEGER :: jprcv_w10m                                                                         ! Index used for 10m wind 
     47   INTEGER :: jprcv_dqnsdt                                                                       ! Index used for dqnsdt 
     48   INTEGER :: jprcv_rnf                                                                          ! Index used for runoff 
     49   INTEGER :: jprcv_cal                                                                          ! Index used for calving 
    4450    
    45  
    46    TYPE(FLD_CPL):: sn_snd_fice 
    47  
    48  
    49  
    50  
    51  
    52  
    53    REAL(wp), DIMENSION(jpi,jpj) :: qsr_mix 
    54  
    55  
    56  
     51   INTEGER :: jpsnd_fice                                                                         ! Index used for ice fraction  
     52   INTEGER :: jpsnd_toce, jpsnd_tice, jpsnd_tmix                                                 ! Index used for temperature 
     53   INTEGER :: jpsnd_albice, jpsnd_albmix                                                         ! Index used for albedo 
     54   INTEGER :: jpsnd_tckice, jpsnd_tcksnw                                                         ! Index used for thickness 
     55   INTEGER :: jpsnd_uoce, jpsnd_voce, jpsnd_uice, jpsnd_vice, jpsnd_umix, jpsnd_vmix             ! Index used for current velocity 
     56 
     57   CHARACTER(len=100) :: cn_snd_temperature, cn_snd_albedo, cn_snd_thickness,      &             ! Description of coupled mode 
     58      cn_snd_current_1, cn_snd_current_2, cn_snd_current_3, cn_snd_current_4,      & 
     59      cn_rcv_w10m, cn_rcv_stress_1, cn_rcv_stress_2, cn_rcv_stress_3,              & 
     60      cn_rcv_stress_4,cn_rcv_dqnsdt, cn_rcv_qsr, cn_rcv_qns, cn_rcv_emp,           & 
     61      cn_rcv_rnf, cn_rcv_cal 
     62    
     63   CHARACTER(len=100), DIMENSION(4) :: cn_snd_current, cn_rcv_stress 
    5764 
    5865   !!---------------------------------------------------------------------- 
    … …  
    6269   !!---------------------------------------------------------------------- 
    6370 
    64 CONTAINS 
    65  
     71 CONTAINS 
     72   
    6673   SUBROUTINE sbc_cpl_init 
    67   
    68       NAMELIST/namsbc_cpl_rcv/ ... 
    69  
    70  
    71       !!--------------------------------------------------------------------- 
    72  
    73  
    74  
    75  
    76          REWIND( numnam )                    ! ... read in namlist namsbc_cpl_rcv 
    77          READ  ( numnam, namsbc_cpl_rcv ) 
    78           
    79          !------------------------------------- 
    80          !------------------------------------- 
    81          ! Define the receive interface 
    82          !------------------------------------- 
    83          !------------------------------------- 
    84          ! 
    85          ! Read restart of variables for coupling (needed to compute some values from the received data) 
     74 
     75!!! >> Arnaud pour lire freeze, alb_ice et tn_ice dans le restart oasis 
     76     USE netcdf 
     77 
     78     INTEGER :: ncid, varid,ierr 
     79!!! << Arnaud 
     80     
     81     CHARACTER(len=1), DIMENSION(100) :: cltmp 
     82     INTEGER :: i 
     83 
     84     NAMELIST/namsbc_cpl/ cn_snd_temperature, cn_snd_albedo, cn_snd_thickness,       &           
     85        cn_snd_current_1, cn_snd_current_2, cn_snd_current_3, cn_snd_current_4,      & 
     86        cn_rcv_w10m, cn_rcv_stress_1, cn_rcv_stress_2, cn_rcv_stress_3,              & 
     87        cn_rcv_stress_4, cn_rcv_dqnsdt, cn_rcv_qsr, cn_rcv_qns, cn_rcv_emp,          & 
     88        cn_rcv_rnf, cn_rcv_cal 
     89      
     90 
     91     !!--------------------------------------------------------------------- 
     92      
     93     
     94     REWIND( numnam )                    ! ... read in namlist namsbc_cpl_rcv 
     95     READ  ( numnam, namsbc_cpl ) 
     96     
     97     cn_snd_current(1)=cn_snd_current_1 ; cn_snd_current(2)=cn_snd_current_2 
     98     cn_snd_current(3)=cn_snd_current_3 ; cn_snd_current(4)=cn_snd_current_4 
     99     cn_rcv_stress(1)=cn_rcv_stress_1   ; cn_rcv_stress(2)=cn_rcv_stress_2 
     100     cn_rcv_stress(3)=cn_rcv_stress_3   ; cn_rcv_stress(4)=cn_rcv_stress_4 
     101      
     102     !------------------------------------- 
     103     !------------------------------------- 
     104     ! Define the receive interface 
     105     !------------------------------------- 
     106     !------------------------------------- 
     107     ! 
     108     ! Read restart of variables for coupling (needed to compute some values from the received data) 
    86109 
    87110 
    … …  
    89112!!$             quand on n'a pas de restart (a nit000) 
    90113 
    91  
    92          CALL iom_get( numror, 'freeze' , freeze  ) 
    93          IF ( TRIM(cn_rcv_qsr) == 'mixed oce-ice' ) CALL iom_get( numror, 'alb_ice', alb_ice ) 
     114!!! >> Arnaud pour lire freeze, alb_ice et tn_ice dans le restart oasis 
     115 
     116!         CALL iom_get( numror, jpdom_local_full, 'freeze' , freeze  ) 
     117 
     118     ierr = nf90_OPEN('sstoc.nc',NF90_NOWRITE,ncid) 
     119 
     120     ierr = NF90_INQ_VARID(ncid,'OIceFrac',varid) 
     121     ierr = NF90_GET_VAR(ncid,varid,freeze) 
     122 
     123     ierr = NF90_INQ_VARID(ncid,'O_AlbIce',varid) 
     124     ierr = NF90_GET_VAR(ncid,varid,alb_ice) 
     125 
     126     ierr = NF90_INQ_VARID(ncid,'O_TepIce',varid) 
     127     ierr = NF90_GET_VAR(ncid,varid,tn_ice) 
     128 
     129     ierr = NF90_close(ncid) 
     130 
     131!!! << Arnaud 
     132 
     133     IF ( TRIM(cn_rcv_qsr) == 'mixed oce-ice' ) CALL iom_get( numror, jpdom_local_full, 'alb_ice', alb_ice ) 
    94134!!!!! 
    95135!!!!! +++ ERIC tu utilises tn_ice dans le calcule de Qns, c'est bien ca??? 
    96136!!!!! 
    97          IF ( TRIM(cn_rcv_qns) == 'mixed oce-ice' ) CALL iom_get( numror, 'tn_ice' , tn_ice  ) 
    98  
    99  
    100  
    101  
    102  
    103          ! default definitions of srcv 
    104          nrcv = 0 
    105          srcv(:)%cgrid = 'T' 
    106          srcv(:)%nsgn = 1 
    107  
    108          !------------------------------------- 
    109          ! Qsr 
    110          nrcv = nrcv + 1   ;   jprcv_qsroce = nrcv   ;   srcv(nrcv)%cname = 'O_QsrOce' 
    111          nrcv = nrcv + 1   ;   jprcv_qsrice = nrcv   ;   srcv(nrcv)%cname = 'O_QsrIce' 
    112          nrcv = nrcv + 1   ;   jprcv_qsrmix = nrcv   ;   srcv(nrcv)%cname = 'O_QsrMix' 
    113          SELECT CASE (TRIM(cn_rcv_qsr)) 
    114          CASE( 'conservative'  )   ;   srcv( (/jprcv_qsrice, jprcv_qsrmix/) )%laction = .TRUE. 
    115          CASE( 'oce and ice'   )   ;   srcv( (/jprcv_qsrice, jprcv_qsroce/) )%laction = .TRUE. 
    116          CASE( 'mixed oce-ice' )   ;   srcv(                 jprcv_qsrmix   )%laction = .TRUE.  
    117          CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_qsr' ) 
    118          END SELECT 
    119  
    120          !------------------------------------- 
    121          ! Qns 
    122          nrcv = nrcv + 1   ;   jprcv_qnsoce = nrcv   ;   srcv(nrcv)%cname = 'O_QnsOce' 
    123          nrcv = nrcv + 1   ;   jprcv_qnsice = nrcv   ;   srcv(nrcv)%cname = 'O_QnsIce' 
    124          nrcv = nrcv + 1   ;   jprcv_qnsmix = nrcv   ;   srcv(nrcv)%cname = 'O_QnsMix' 
    125          SELECT CASE (TRIM(cn_rcv_qns)) 
    126          CASE( 'conservative'  )   ;   srcv( (/jprcv_qnsice, jprcv_qnsmix/) )%laction = .TRUE. 
    127          CASE( 'oce and ice'   )   ;   srcv( (/jprcv_qnsice, jprcv_qnsoce/) )%laction = .TRUE. 
    128          CASE( 'mixed oce-ice' )   ;   srcv(                 jprcv_qnsmix   )%laction = .TRUE.  
    129          CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_qns' ) 
    130          END SELECT 
    131  
    132          !------------------------------------- 
    133          ! emp, tprecip and sprecip 
    134          nrcv = nrcv + 1   ;   jprcv_rain = nrcv   ;   srcv(nrcv)%cname = 'OIceRain'   ! Rain = liquid precipitation 
    135          nrcv = nrcv + 1   ;   jprcv_snow = nrcv   ;   srcv(nrcv)%cname = 'OIceSnow'    
    136          nrcv = nrcv + 1   ;   jprcv_tevp = nrcv   ;   srcv(nrcv)%cname = 'OTotEvap'   ! total evaporation ( over oce + ice ) 
    137          nrcv = nrcv + 1   ;   jprcv_ievp = nrcv   ;   srcv(nrcv)%cname = 'OIceEvap'   ! evaporation iver ice (sublimation) 
    138          nrcv = nrcv + 1   ;   jprcv_tpre = nrcv   ;   srcv(nrcv)%cname = 'OIPr-Sub'   ! Pr = liquid + solid precipitation 
    139          nrcv = nrcv + 1   ;   jprcv_spre = nrcv   ;   srcv(nrcv)%cname = 'OISn-Sub'   ! Sub = Sublimation = Evap over ice 
    140          nrcv = nrcv + 1   ;   jprcv_oemp = nrcv   ;   srcv(nrcv)%cname = 'OOEv-OPr'   !  
    141          SELECT CASE (TRIM(cn_rcv_emp)) 
    142          CASE( 'conservative'  )   ;   srcv( (/jprcv_rain, jprcv_snow, jprcv_ievp, jprcv_tevp/) )%laction = .TRUE. 
    143          CASE( 'oce and ice'   )   ;   srcv( (/            jprcv_tpre, jprcv_spre, jprcv_oemp/) )%laction = .TRUE. 
    144          CASE( 'mixed oce-ice' )   ;   srcv( (/jprcv_rain,             jprcv_spre, jprcv_tevp/) )%laction = .TRUE.  
    145          CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_emp' ) 
    146          END SELECT 
    147  
    148          !------------------------------------- 
    149          ! wind stress : utau, vtau, utaui_ice, vtaui_ice  
    150          ! oce stress 
    151          nrcv = nrcv + 1   ;   jprcv_otx1 = nrcv   ;   srcv(nrcv)%cname = 'O_OTaux1' ! oce tau 1st component on 1st grid 
    152          nrcv = nrcv + 1   ;   jprcv_oty1 = nrcv   ;   srcv(nrcv)%cname = 'O_OTauy1' ! oce tau 2nd component on 1st grid 
    153          nrcv = nrcv + 1   ;   jprcv_otz1 = nrcv   ;   srcv(nrcv)%cname = 'O_OTauz1' ! oce tau 3rd component on 1st grid 
    154          nrcv = nrcv + 1   ;   jprcv_otx2 = nrcv   ;   srcv(nrcv)%cname = 'O_OTaux2' ! oce tau 1st component on 2nd grid 
    155          nrcv = nrcv + 1   ;   jprcv_oty2 = nrcv   ;   srcv(nrcv)%cname = 'O_OTauy2' ! oce tau 2nd component on 2nd grid 
    156          nrcv = nrcv + 1   ;   jprcv_otz2 = nrcv   ;   srcv(nrcv)%cname = 'O_OTauz2' ! oce tau 3rd component on 2nd grid 
    157          ! ice stress 
    158          nrcv = nrcv + 1   ;   jprcv_itx1 = nrcv   ;   srcv(nrcv)%cname = 'O_ITaux1' ! ice tau 1st component on 1st grid 
    159          nrcv = nrcv + 1   ;   jprcv_ity1 = nrcv   ;   srcv(nrcv)%cname = 'O_ITauy1' ! ice tau 2nd component on 1st grid 
    160          nrcv = nrcv + 1   ;   jprcv_itz1 = nrcv   ;   srcv(nrcv)%cname = 'O_ITauz1' ! ice tau 3rd component on 1st grid 
    161          nrcv = nrcv + 1   ;   jprcv_itx2 = nrcv   ;   srcv(nrcv)%cname = 'O_ITaux2' ! ice tau 1st component on 2nd grid 
    162          nrcv = nrcv + 1   ;   jprcv_ity2 = nrcv   ;   srcv(nrcv)%cname = 'O_ITauy2' ! ice tau 2nd component on 2nd grid 
    163          nrcv = nrcv + 1   ;   jprcv_itz2 = nrcv   ;   srcv(nrcv)%cname = 'O_ITauz2' ! ice tau 3rd component on 2nd grid 
    164          ! change default definition of srcv(:)%nsgn 
    165          srcv(jprcv_otx1:jprcv_itz2)%nsgn = -1 
    166          ! change default definition of srcv(:)%cgrid and srcv(:)%laction 
    167          SELECT CASE (LEN_TRIM(cn_rcv_stress(4)))   !  'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V' 
    168          CASE( 1 )   ! 'T' 
    169             srcv(jprcv_otx1:jprcv_itz2)%cgrid = cltmp(1)   ! all oce and ice components on the same unique grid 
    170             srcv(jprcv_otx1:jprcv_otz1)%laction = .TRUE.   ! oce components on 1 grid  
    171             srcv(jprcv_itx1:jprcv_itz1)%laction = .TRUE.   ! ice components on 1 grid  
    172          CASE( 3 )   ! 'U,V' 'T,F' 'T,I' 
    173             cltmp = cn_rcv_stress(4) 
    174             SELECT CASE (cltmp(1)) 
    175             CASE( 'T' )   ! 'T,F' 'T,I' 
    176                   srcv(jprcv_otx1:jprcv_otz2)%cgrid = cltmp(1)   ! oce and ice tau on 2 grids 
    177                   srcv(jprcv_itx1:jprcv_itz2)%cgrid = cltmp(3)   ! but oce(ice) components on the same grid 
    178                   srcv(jprcv_otx1:jprcv_otz1)%laction = .TRUE.   ! oce components on 1 grid 
    179                   srcv(jprcv_itx1:jprcv_itz1)%laction = .TRUE.   ! ice components on 1 grid 
    180             CASE( 'U' )   ! 'U,V' 
    181                IF ( cltmp(3) := 'V' ) THEN CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_stress(4)' ) 
    182                srcv(jprcv_otx1:jprcv_otz1)%cgrid = cltmp(1)   ! oce(ice) components on 2 grids 
    183                srcv(jprcv_otx2:jprcv_otz2)%cgrid = cltmp(3) 
    184                srcv(jprcv_itx1:jprcv_itz1)%cgrid = cltmp(1) 
    185                srcv(jprcv_itx2:jprcv_itz2)%cgrid = cltmp(3) 
    186                srcv(jprcv_otx1:jprcv_itz2)%laction = .TRUE.   ! oce(ice) components on 2 grids 
    187             CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_stress(4)' ) 
    188             END SELECT 
    189          CASE( 5 )   ! 'U,V,F' 'U,V,I' 'T,U,V' 
    190             cltmp = cn_rcv_stress(4) 
    191             SELECT CASE (cltmp(1)) 
    192             CASE( 'T' )   ! 'T,U,V' 
    193                   srcv(jprcv_otx1:jprcv_otz2)%cgrid = cltmp(1)    ! oce components on 1 grid 
    194                   srcv(jprcv_itx1:jprcv_itz1)%cgrid = cltmp(3)    ! ice components on 2 grids 
    195                   srcv(jprcv_itx2:jprcv_itz2)%cgrid = cltmp(5) 
    196                   srcv(jprcv_otx1:jprcv_otz1)%laction = .TRUE.    ! oce components on 1 grid 
    197                   srcv(jprcv_itx1:jprcv_itz2)%laction = .TRUE.    ! ice components on 2 grids 
    198             CASE( 'U' )   ! 'U,V,F' 'U,V,I'  
    199                IF ( cltmp(3) := 'V' ) THEN CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_stress(4)' ) 
    200                srcv(jprcv_otx1:jprcv_otz1)%cgrid = cltmp(1)    ! oce components on 2 grids 
    201                srcv(jprcv_otx2:jprcv_otz2)%cgrid = cltmp(3) 
    202                srcv(jprcv_itx1:jprcv_itz2)%cgrid = cltmp(5)    ! ice components on 1 grid 
    203                srcv(jprcv_otx1:jprcv_otz2)%laction = .TRUE.    ! oce components on 2 grids  
    204                srcv(jprcv_itx1:jprcv_itz1)%laction = .TRUE.    ! ice components on 1 grid  
    205             CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_stress(4)' ) 
    206             END SELECT 
     137     IF ( TRIM(cn_rcv_qns) == 'mixed oce-ice' ) CALL iom_get( numror, jpdom_local_full, 'tn_ice' , tn_ice  ) 
     138 
     139     ! default definitions of srcv 
     140     nrcv = 0 
     141     srcv(:)%laction = .FALSE. 
     142     srcv(:)%clgrid = 'T' 
     143     srcv(:)%nsgn = 1 
     144 
     145     !------------------------------------- 
     146     ! Qsr 
     147     nrcv = nrcv + 1   ;   jprcv_qsroce = nrcv   ;   srcv(nrcv)%clname = 'O_QsrOce' 
     148     nrcv = nrcv + 1   ;   jprcv_qsrice = nrcv   ;   srcv(nrcv)%clname = 'O_QsrIce' 
     149     nrcv = nrcv + 1   ;   jprcv_qsrmix = nrcv   ;   srcv(nrcv)%clname = 'O_QsrMix' 
     150     SELECT CASE (TRIM(cn_rcv_qsr)) 
     151     CASE( 'conservative'  )   ;   srcv( (/jprcv_qsrice, jprcv_qsrmix/) )%laction = .TRUE. 
     152     CASE( 'oce and ice'   )   ;   srcv( (/jprcv_qsrice, jprcv_qsroce/) )%laction = .TRUE. 
     153     CASE( 'mixed oce-ice' )   ;   srcv(                 jprcv_qsrmix   )%laction = .TRUE.  
     154     CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_qsr' ) 
     155     END SELECT 
     156 
     157     !------------------------------------- 
     158     ! Qns 
     159     nrcv = nrcv + 1   ;   jprcv_qnsoce = nrcv   ;   srcv(nrcv)%clname = 'O_QnsOce' 
     160     nrcv = nrcv + 1   ;   jprcv_qnsice = nrcv   ;   srcv(nrcv)%clname = 'O_QnsIce' 
     161     nrcv = nrcv + 1   ;   jprcv_qnsmix = nrcv   ;   srcv(nrcv)%clname = 'O_QnsMix' 
     162     SELECT CASE (TRIM(cn_rcv_qns)) 
     163     CASE( 'conservative'  )   ;   srcv( (/jprcv_qnsice, jprcv_qnsmix/) )%laction = .TRUE. 
     164     CASE( 'oce and ice'   )   ;   srcv( (/jprcv_qnsice, jprcv_qnsoce/) )%laction = .TRUE. 
     165     CASE( 'mixed oce-ice' )   ;   srcv(                 jprcv_qnsmix   )%laction = .TRUE.  
     166     CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_qns' ) 
     167     END SELECT 
     168 
     169     !------------------------------------- 
     170     ! emp, tprecip and sprecip 
     171     nrcv = nrcv + 1   ;   jprcv_rain = nrcv   ;   srcv(nrcv)%clname = 'OIceRain'   ! Rain = liquid precipitation 
     172     nrcv = nrcv + 1   ;   jprcv_snow = nrcv   ;   srcv(nrcv)%clname = 'OIceSnow'    
     173     nrcv = nrcv + 1   ;   jprcv_tevp = nrcv   ;   srcv(nrcv)%clname = 'OTotEvap'   ! total evaporation ( over oce + ice ) 
     174     nrcv = nrcv + 1   ;   jprcv_ievp = nrcv   ;   srcv(nrcv)%clname = 'OIceEvap'   ! evaporation iver ice (sublimation) 
     175     nrcv = nrcv + 1   ;   jprcv_tpre = nrcv   ;   srcv(nrcv)%clname = 'OIPr-Sub'   ! Pr = liquid + solid precipitation 
     176     nrcv = nrcv + 1   ;   jprcv_spre = nrcv   ;   srcv(nrcv)%clname = 'OISn-Sub'   ! Sub = Sublimation = Evap over ice 
     177     nrcv = nrcv + 1   ;   jprcv_oemp = nrcv   ;   srcv(nrcv)%clname = 'OOEv-OPr'   !  
     178     SELECT CASE (TRIM(cn_rcv_emp)) 
     179     CASE( 'conservative'  )   ;   srcv( (/jprcv_rain, jprcv_snow, jprcv_ievp, jprcv_tevp/) )%laction = .TRUE. 
     180     CASE( 'oce and ice'   )   ;   srcv( (/            jprcv_tpre, jprcv_spre, jprcv_oemp/) )%laction = .TRUE. 
     181     CASE( 'mixed oce-ice' )   ;   srcv( (/jprcv_rain,             jprcv_spre, jprcv_tevp/) )%laction = .TRUE.  
     182     CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_emp' ) 
     183     END SELECT 
     184 
     185 
     186     !------------------------------------- 
     187     ! wind stress : utau, vtau, utaui_ice, vtaui_ice  
     188     ! oce stress 
     189     nrcv = nrcv + 1   ;   jprcv_otx1 = nrcv   ;   srcv(nrcv)%clname = 'O_OTaux1' ! oce tau 1st component on 1st grid 
     190     nrcv = nrcv + 1   ;   jprcv_oty1 = nrcv   ;   srcv(nrcv)%clname = 'O_OTauy1' ! oce tau 2nd component on 1st grid 
     191     nrcv = nrcv + 1   ;   jprcv_otz1 = nrcv   ;   srcv(nrcv)%clname = 'O_OTauz1' ! oce tau 3rd component on 1st grid 
     192     nrcv = nrcv + 1   ;   jprcv_otx2 = nrcv   ;   srcv(nrcv)%clname = 'O_OTaux2' ! oce tau 1st component on 2nd grid 
     193     nrcv = nrcv + 1   ;   jprcv_oty2 = nrcv   ;   srcv(nrcv)%clname = 'O_OTauy2' ! oce tau 2nd component on 2nd grid 
     194     nrcv = nrcv + 1   ;   jprcv_otz2 = nrcv   ;   srcv(nrcv)%clname = 'O_OTauz2' ! oce tau 3rd component on 2nd grid 
     195     ! ice stress 
     196     nrcv = nrcv + 1   ;   jprcv_itx1 = nrcv   ;   srcv(nrcv)%clname = 'O_ITaux1' ! ice tau 1st component on 1st grid 
     197     nrcv = nrcv + 1   ;   jprcv_ity1 = nrcv   ;   srcv(nrcv)%clname = 'O_ITauy1' ! ice tau 2nd component on 1st grid 
     198     nrcv = nrcv + 1   ;   jprcv_itz1 = nrcv   ;   srcv(nrcv)%clname = 'O_ITauz1' ! ice tau 3rd component on 1st grid 
     199     nrcv = nrcv + 1   ;   jprcv_itx2 = nrcv   ;   srcv(nrcv)%clname = 'O_ITaux2' ! ice tau 1st component on 2nd grid 
     200     nrcv = nrcv + 1   ;   jprcv_ity2 = nrcv   ;   srcv(nrcv)%clname = 'O_ITauy2' ! ice tau 2nd component on 2nd grid 
     201     nrcv = nrcv + 1   ;   jprcv_itz2 = nrcv   ;   srcv(nrcv)%clname = 'O_ITauz2' ! ice tau 3rd component on 2nd grid 
     202     ! change default definition of srcv(:)%nsgn 
     203     srcv(jprcv_otx1:jprcv_itz2)%nsgn = -1 
     204     ! change default definition of srcv(:)%clgrid and srcv(:)%laction 
     205      
     206     DO i=1,5  
     207       cltmp(i)= cn_rcv_stress_4(i:i)  
     208     ENDDO 
     209      
     210     SELECT CASE (LEN_TRIM(cn_rcv_stress(4)))   !  'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V' 
     211     CASE( 1 )   ! 'T' 
     212         srcv(jprcv_otx1:jprcv_itz2)%clgrid = cltmp(1)   ! all oce and ice components on the same unique grid 
     213         srcv(jprcv_otx1:jprcv_otz1)%laction = .TRUE.   ! oce components on 1 grid  
     214         srcv(jprcv_itx1:jprcv_itz1)%laction = .TRUE.   ! ice components on 1 grid  
     215     CASE( 3 )   ! 'U,V' 'T,F' 'T,I' 
     216         SELECT CASE (cltmp(1)) 
     217         CASE( 'T' )   ! 'T,F' 'T,I' 
     218             srcv(jprcv_otx1:jprcv_otz2)%clgrid = cltmp(1)   ! oce and ice tau on 2 grids 
     219             srcv(jprcv_itx1:jprcv_itz2)%clgrid = cltmp(3)   ! but oce(ice) components on the same grid 
     220             srcv(jprcv_otx1:jprcv_otz1)%laction = .TRUE.   ! oce components on 1 grid 
     221             srcv(jprcv_itx1:jprcv_itz1)%laction = .TRUE.   ! ice components on 1 grid 
     222         CASE( 'U' )   ! 'U,V' 
     223             IF ( cltmp(3) /= 'V' ) CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_stress(4)' ) 
     224             srcv(jprcv_otx1:jprcv_otz1)%clgrid = cltmp(1)   ! oce(ice) components on 2 grids 
     225             srcv(jprcv_otx2:jprcv_otz2)%clgrid = cltmp(3) 
     226             srcv(jprcv_itx1:jprcv_itz1)%clgrid = cltmp(1) 
     227             srcv(jprcv_itx2:jprcv_itz2)%clgrid = cltmp(3) 
     228             srcv(jprcv_otx1:jprcv_itz2)%laction = .TRUE.   ! oce(ice) components on 2 grids 
    207229         CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_stress(4)' ) 
    208230         END SELECT 
    209          ! force .FALSE. to 3rd component for spherical coodinates 
    210          IF ( TRIM(cn_rcv_stress(2)) == 'spherical' ) srcv((/jprcv_otz1, jprcv_otz2, jprcv_itz1, jprcv_itz2/))%laction = .FALSE.  
    211          ! force .FALSE. to ice components if not 'oce and ice' 
    212          IF ( TRIM(cn_rcv_stress(1)) /= 'oce and ice' )   srcv(jprcv_itx1:jprcv_itz2)%laction = .FALSE.  
    213  
    214          !------------------------------------- 
    215          ! 10 m wind speed 
    216          nrcv = nrcv + 1   ;   jprcv_w10m = nrcv   ;   srcv(nrcv)%cname = 'O_Wind10' 
    217          IF ( TRIM(cn_rcv_w10m) == 'coupled' ) srcv(jprcv_w10m)%laction = .TRUE. 
    218          ! +++ ---> A brancher et a blinder dans tke  si TRIM(cn_rcv_w10m) == 'none' 
    219  
    220          !------------------------------------- 
    221          ! d(Qns)/d(T)  
    222          nrcv = nrcv + 1   ;   jprcv_dqnsdt = nrcv   ;   srcv(nrcv)%cname = 'O_dQnsdT' 
    223          IF ( TRIM(cn_rcv_dqnsdt) == 'coupled' ) srcv(jprcv_dqnsdt)%laction = .TRUE. 
    224  
    225          !------------------------------------- 
    226          ! Runoff 
    227          nrcv = nrcv + 1   ;   jprcv_rnf = nrcv   ;   srcv(nrcv)%cname = 'O_Runoff' 
    228          IF ( TRIM(cn_rcv_rnf) /= 'climato' ) srcv(jprcv_rnf)%laction = .TRUE. 
    229          ! +++ ---> A brancher   
    230  
    231          !------------------------------------- 
    232          ! Calving 
    233          nrcv = nrcv + 1   ;   jprcv_cal = nrcv   ;   srcv(nrcv)%cname = 'OCalving' 
    234          IF ( TRIM(cn_rcv_cal) == 'coupled' ) srcv(jprcv_cal)%laction = .TRUE. 
    235          ! +++ ---> A brancher   
    236  
    237          !------------------------------------- 
    238          ! fraction of net shortwave radiation which is not absorbed in the  
    239          ! thin surface layer and penetrates inside the ice cover  
    240          !  ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 
    241          ! Since cloud cover catm not transmitted from atmosphere  
    242          ! ===> defined as constant value -> definition done in sbc_cpl_init 
     231     CASE( 5 )   ! 'U,V,F' 'U,V,I' 'T,U,V' 
     232         SELECT CASE (cltmp(1)) 
     233         CASE( 'T' )   ! 'T,U,V' 
     234             srcv(jprcv_otx1:jprcv_otz2)%clgrid = cltmp(1)    ! oce components on 1 grid 
     235             srcv(jprcv_itx1:jprcv_itz1)%clgrid = cltmp(3)    ! ice components on 2 grids 
     236             srcv(jprcv_itx2:jprcv_itz2)%clgrid = cltmp(5) 
     237             srcv(jprcv_otx1:jprcv_otz1)%laction = .TRUE.    ! oce components on 1 grid 
     238             srcv(jprcv_itx1:jprcv_itz2)%laction = .TRUE.    ! ice components on 2 grids 
     239         CASE( 'U' )   ! 'U,V,F' 'U,V,I'  
     240             IF ( cltmp(3) /= 'V' ) CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_stress(4)' ) 
     241             srcv(jprcv_otx1:jprcv_otz1)%clgrid = cltmp(1)    ! oce components on 2 grids 
     242             srcv(jprcv_otx2:jprcv_otz2)%clgrid = cltmp(3) 
     243             srcv(jprcv_itx1:jprcv_itz2)%clgrid = cltmp(5)    ! ice components on 1 grid 
     244             srcv(jprcv_otx1:jprcv_otz2)%laction = .TRUE.    ! oce components on 2 grids  
     245             srcv(jprcv_itx1:jprcv_itz1)%laction = .TRUE.    ! ice components on 1 grid  
     246         CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_stress(4)' ) 
     247         END SELECT 
     248     CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_stress(4)' ) 
     249     END SELECT 
     250     ! force .FALSE. to 3rd component for spherical coodinates 
     251     IF ( TRIM(cn_rcv_stress(2)) == 'spherical' ) srcv((/jprcv_otz1, jprcv_otz2, jprcv_itz1, jprcv_itz2/))%laction = .FALSE.  
     252     ! force .FALSE. to ice components if not 'oce and ice' 
     253     IF ( TRIM(cn_rcv_stress(1)) /= 'oce and ice' )   srcv(jprcv_itx1:jprcv_itz2)%laction = .FALSE. 
     254      
     255     !------------------------------------- 
     256     ! 10 m wind speed 
     257     nrcv = nrcv + 1   ;   jprcv_w10m = nrcv   ;   srcv(nrcv)%clname = 'O_Wind10' 
     258     IF ( TRIM(cn_rcv_w10m) == 'coupled' ) srcv(jprcv_w10m)%laction = .TRUE. 
     259     ! +++ ---> A brancher et a blinder dans tke  si TRIM(cn_rcv_w10m) == 'none' 
     260      
     261     !------------------------------------- 
     262     ! d(Qns)/d(T)  
     263     nrcv = nrcv + 1   ;   jprcv_dqnsdt = nrcv   ;   srcv(nrcv)%clname = 'O_dQnsdT' 
     264     IF ( TRIM(cn_rcv_dqnsdt) == 'coupled' ) srcv(jprcv_dqnsdt)%laction = .TRUE. 
     265      
     266     !------------------------------------- 
     267     ! Runoff 
     268     nrcv = nrcv + 1   ;   jprcv_rnf = nrcv   ;   srcv(nrcv)%clname = 'O_Runoff' 
     269     IF ( TRIM(cn_rcv_rnf) /= 'climato' ) srcv(jprcv_rnf)%laction = .TRUE. 
     270     ! +++ ---> A brancher   
     271      
     272     !------------------------------------- 
     273     ! Calving 
     274     nrcv = nrcv + 1   ;   jprcv_cal = nrcv   ;   srcv(nrcv)%clname = 'OCalving' 
     275     IF ( TRIM(cn_rcv_cal) == 'coupled' ) srcv(jprcv_cal)%laction = .TRUE. 
     276     ! +++ ---> A brancher   
     277      
     278     !------------------------------------- 
     279     ! fraction of net shortwave radiation which is not absorbed in the  
     280     ! thin surface layer and penetrates inside the ice cover  
     281     !  ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 
     282     ! Since cloud cover catm not transmitted from atmosphere  
     283     ! ===> defined as constant value -> definition done in sbc_cpl_init 
    243284!!$      catm(:,:) = 0. 
    244285!!$      zcatm1(:,:) = 1.0 - catm(:,:)  !  fractional cloud cover 
    245286!!$      fr1_i0(:,:) = 0.18 * zcatm1(:,:) + 0.35 * catm(:,:)  
    246287!!$      fr2_i0(:,:) = 0.82 * zcatm1(:,:) + 0.65 * catm(:,:) 
    247          fr1_i0(:,:) = 0.18 
    248          fr2_i0(:,:) = 0.82 
    249  
    250          ! 
    251          !------------------------------------- 
    252          !------------------------------------- 
    253          ! Define the send interface 
    254          !------------------------------------- 
    255          !------------------------------------- 
    256          ! 
    257          ! default definitions of nsnd 
    258          nsnd = 0 
    259          ssnd(:)%cgrid = 'T' 
    260          ssnd(:)%nsgn = 1 
     288     fr1_i0(:,:) = 0.18 
     289     fr2_i0(:,:) = 0.82 
     290      
     291     ! 
     292     !------------------------------------- 
     293     !------------------------------------- 
     294     ! Define the send interface 
     295     !------------------------------------- 
     296     !------------------------------------- 
     297     ! 
     298     ! default definitions of nsnd 
     299     nsnd = 0 
     300     ssnd(:)%laction = .FALSE. 
     301     ssnd(:)%clgrid = 'T' 
     302     ssnd(:)%nsgn = 1 
    261303          
    262          !------------------------------------- 
    263          ! Ice fraction 
    264          nsnd = nsnd + 1   ;   jpsnd_fice = nsnd   ;   ssnd(nsnd)%cname = 'OIceFrac' 
    265          ssnd(jpsnd_fice)%laction = .TRUE. 
     304     !------------------------------------- 
     305     ! Ice fraction 
     306     nsnd = nsnd + 1   ;   jpsnd_fice = nsnd   ;   ssnd(nsnd)%clname = 'OIceFrac' 
     307     ssnd(jpsnd_fice)%laction = .TRUE. 
     308      
     309     !------------------------------------- 
     310     ! T surf 
     311     nsnd = nsnd + 1   ;   jpsnd_toce = nsnd   ;   ssnd(nsnd)%clname = 'O_SSTSST' 
     312     nsnd = nsnd + 1   ;   jpsnd_tice = nsnd   ;   ssnd(nsnd)%clname = 'O_TepIce' 
     313     nsnd = nsnd + 1   ;   jpsnd_tmix = nsnd   ;   ssnd(nsnd)%clname = 'O_TepMix' 
     314     SELECT CASE (TRIM(cn_snd_temperature)) 
     315     CASE( 'oce only'             )   ;   ssnd(   jpsnd_toce               )%laction = .TRUE. 
     316     CASE( 'weighted oce and ice' )   ;   ssnd( (/jpsnd_toce, jpsnd_tice/) )%laction = .TRUE. 
     317     CASE( 'mixed oce-ice'        )   ;   ssnd(   jpsnd_tmix               )%laction = .TRUE. 
     318     END SELECT 
     319 
     320     !------------------------------------- 
     321     ! Albedo 
     322     nsnd = nsnd + 1   ;  jpsnd_albice = nsnd  ; ssnd(nsnd)%clname = 'O_AlbIce'  
     323     nsnd = nsnd + 1   ;   jpsnd_albmix = nsnd   ;   ssnd(nsnd)%clname = 'O_AlbMix' 
     324     SELECT CASE (TRIM(cn_snd_albedo)) 
     325     CASE( 'none'          )       ! nothing to do 
     326     CASE( 'weighted ice'  )   ;   ssnd(jpsnd_albice)%laction = .TRUE. 
     327     CASE( 'mixed oce-ice' )   ;   ssnd(jpsnd_albmix)%laction = .TRUE. 
     328     END SELECT 
    266329          
    267          !------------------------------------- 
    268          ! T surf 
    269          nsnd = nsnd + 1   ;   jpsnd_toce = nsnd   ;   ssnd(nsnd)%cname = 'O_SSTSST' 
    270          nsnd = nsnd + 1   ;   jpsnd_tice = nsnd   ;   ssnd(nsnd)%cname = 'O_TepIce' 
    271          nsnd = nsnd + 1   ;   jpsnd_tmix = nsnd   ;   ssnd(nsnd)%cname = 'O_TepMix' 
    272          SELECT CASE (TRIM(cn_snd_temperature)) 
    273          CASE( 'oce only'             )   ;   ssnd(   jpsnd_toce               )%laction = .TRUE. 
    274          CASE( 'weighted oce and ice' )   ;   ssnd( (/jpsnd_toce, jpsnd_tice/) )%laction = .TRUE. 
    275          CASE( 'mixed oce-ice'        )   ;   ssnd(   jpsnd_tmix               )%laction = .TRUE. 
    276          END SELECT 
    277  
    278          !------------------------------------- 
    279          ! Albedo 
    280          nsnd = nsnd + 1   ;   jpsnd_albice = nsnd   ;   ssnd(nsnd)%cname = 'O_AlbIce' 
    281          nsnd = nsnd + 1   ;   jpsnd_albmix = nsnd   ;   ssnd(nsnd)%cname = 'O_AlbMix' 
    282          SELECT CASE (TRIM(cn_snd_albedo)) 
    283          CASE( 'none'          )       ! nothing to do 
    284          CASE( 'weighted ice'  )   ;   ssnd(jpsnd_albice)%laction = .TRUE. 
    285          CASE( 'mixed oce-ice' )   ;   ssnd(jpsnd_albmix)%laction = .TRUE. 
    286          END SELECT 
     330     !------------------------------------- 
     331     ! Thickness 
     332     nsnd = nsnd + 1   ;   jpsnd_tckice = nsnd   ;   ssnd(nsnd)%clname = 'O_IceTck' 
     333     nsnd = nsnd + 1   ;   jpsnd_tcksnw = nsnd   ;   ssnd(nsnd)%clname = 'O_SnwTck' 
     334     IF ( TRIM(cn_snd_thickness) == 'weighted ice and snow' ) ssnd( (/jpsnd_tckice, jpsnd_tcksnw/) )%laction = .TRUE. 
    287335          
    288          !------------------------------------- 
    289          ! Thickness 
    290          nsnd = nsnd + 1   ;   jpsnd_tckice = nsnd   ;   ssnd(nsnd)%cname = 'O_IceTck' 
    291          nsnd = nsnd + 1   ;   jpsnd_tcksnw = nsnd   ;   ssnd(nsnd)%cname = 'O_SnwTck' 
    292          IF ( TRIM(cn_snd_thickness) == 'weighted ice and snow' ) ssnd( (/jpsnd_tckice, jpsnd_tcksnw/) )%laction = .TRUE. 
    293           
    294          !------------------------------------- 
    295          ! Surface current 
    296          nsnd = nsnd + 1   ;   jpsnd_uoce = nsnd   ;   ssnd(nsnd)%cname = 'O_UN_Oce' 
    297          nsnd = nsnd + 1   ;   jpsnd_voce = nsnd   ;   ssnd(nsnd)%cname = 'O_VN_OcE' 
    298          nsnd = nsnd + 1   ;   jpsnd_uice = nsnd   ;   ssnd(nsnd)%cname = 'O_UN_Ice' 
    299          nsnd = nsnd + 1   ;   jpsnd_vice = nsnd   ;   ssnd(nsnd)%cname = 'O_VN_IcE' 
    300          nsnd = nsnd + 1   ;   jpsnd_umix = nsnd   ;   ssnd(nsnd)%cname = 'O_UN_Mix' 
    301          nsnd = nsnd + 1   ;   jpsnd_vmix = nsnd   ;   ssnd(nsnd)%cname = 'O_VN_Mix' 
    302          ssnd(jpsnd_uoce:jpsnd_vmix)%nsgn = -1 
    303          SELECT CASE (TRIM(cn_snd_current(1))) 
    304          CASE( 'none'                 )       ! nothing to do 
    305          CASE( 'oce only'             )   ;   ssnd( (/jpsnd_uoce, jpsnd_voce                        /) )%laction = .TRUE. 
    306          CASE( 'weighted oce and ice' )   ;   ssnd( (/jpsnd_uoce, jpsnd_voce, jpsnd_uice, jpsnd_vice/) )%laction = .TRUE. 
    307          CASE( 'mixed oce-ice'        )   ;   ssnd( (/jpsnd_umix, jpsnd_vmix                        /) )%laction = .TRUE. 
    308          END SELECT 
    309           
    310          ! 
    311          !------------------------------------- 
    312          !------------------------------------- 
    313          CALL cpl_prism_define 
    314          !------------------------------------- 
    315          !------------------------------------- 
    316          ! 
     336     !------------------------------------- 
     337     ! Surface current 
     338     nsnd = nsnd + 1   ;   jpsnd_uoce = nsnd   ;   ssnd(nsnd)%clname = 'O_UN_Oce' 
     339     nsnd = nsnd + 1   ;   jpsnd_voce = nsnd   ;   ssnd(nsnd)%clname = 'O_VN_OcE' 
     340     nsnd = nsnd + 1   ;   jpsnd_uice = nsnd   ;   ssnd(nsnd)%clname = 'O_UN_Ice' 
     341     nsnd = nsnd + 1   ;   jpsnd_vice = nsnd   ;   ssnd(nsnd)%clname = 'O_VN_IcE' 
     342     nsnd = nsnd + 1   ;   jpsnd_umix = nsnd   ;   ssnd(nsnd)%clname = 'O_UN_Mix' 
     343     nsnd = nsnd + 1   ;   jpsnd_vmix = nsnd   ;   ssnd(nsnd)%clname = 'O_VN_Mix' 
     344     ssnd(jpsnd_uoce:jpsnd_vmix)%nsgn = -1 
     345     SELECT CASE (TRIM(cn_snd_current(1))) 
     346     CASE( 'none'                 )       ! nothing to do 
     347     CASE( 'oce only'             )   ;   ssnd( (/jpsnd_uoce, jpsnd_voce                        /) )%laction = .TRUE. 
     348     CASE( 'weighted oce and ice' )   ;   ssnd( (/jpsnd_uoce, jpsnd_voce, jpsnd_uice, jpsnd_vice/) )%laction = .TRUE. 
     349     CASE( 'mixed oce-ice'        )   ;   ssnd( (/jpsnd_umix, jpsnd_vmix                        /) )%laction = .TRUE. 
     350     END SELECT 
     351     ! 
     352     !------------------------------------- 
     353     !------------------------------------- 
     354     CALL cpl_prism_define 
     355     !------------------------------------- 
     356     !------------------------------------- 
     357     ! 
    317358 
    318359   END SUBROUTINE sbc_cpl_init 
    319360 
    320  
    321  
    322361   SUBROUTINE sbc_cpl_rcv( kt ) 
    323  
    324       IF( kt == nit000 )   CALL sbc_cpl_init 
    325  
    326       isec = ( kt - nit000 ) * NINT(rdttra(1))        ! date of exchanges 
    327  
    328       !------------------------------------- 
    329       ! Qsr : we must get qsr and qsr_ice 
    330       IF ( srcv(jprcv_qsroce)%laction ) CALL cpl_prism_rcv( jprcv_qsroce, isec, qsr    , info )  
    331       IF ( srcv(jprcv_qsrice)%laction ) CALL cpl_prism_rcv( jprcv_qsrice, isec, qsr_ice, info )  
    332       IF ( srcv(jprcv_qsrmix)%laction ) CALL cpl_prism_rcv( jprcv_qsrmix, isec, qsr_mix, info )         
    333       SELECT CASE (TRIM(cn_rcv_qsr)) 
    334       CASE( 'conservative' ) 
    335          qsr(:,:) = ( qsr_mix(:,:) - freeze(:,:) * qsr_ice(:,:) ) / (1. - freeze(:,:)) 
    336       CASE( 'oce and ice' ) 
    337          ! nothing to do 
    338       CASE( 'mixed oce-ice' ) 
    339          ztmp(:,:) = qsr_mix(:,:) / (1. - ( 0.065*(1. - freeze(:,:)) + freeze(:,:)*alb_ice(:,:)) ) 
     362      
     363     INTEGER :: kt, isec, info, ji, jj 
     364 
     365     !------------------------------------- 
     366     ! Temporary buffers for receiving 
     367 
     368     REAL(wp), DIMENSION(jpi,jpj) :: ztmp 
     369     REAL(wp), DIMENSION(jpi,jpj), SAVE :: qns_mix, qns_tmp, qns_ice_tmp  
     370     REAL(wp), DIMENSION(jpi,jpj), SAVE :: qsr_mix, qsr_tmp, qsr_ice_tmp 
     371     REAL(wp), DIMENSION(jpi,jpj), SAVE :: zsnow, zrain, ztevp, zievp, tprecip_tmp, sprecip_tmp, emp_tmp 
     372     REAL(wp), DIMENSION(jpi,jpj), SAVE :: zotx1, zoty1, zotz1, zotx2, zoty2, zotz2  
     373     REAL(wp), DIMENSION(jpi,jpj), SAVE :: zitx1, zity1, zitz1, zitx2, zity2, zitz2  
     374     REAL(wp), DIMENSION(jpi,jpj) :: ztmpx1, ztmpx2, ztmpy1, ztmpy2 
     375     REAL(wp), DIMENSION(jpi,jpj), SAVE :: wind10_tmp, dqns_ice_tmp, rnfcpl_tmp, ocalving_tmp 
     376 
     377     IF( kt == nit000 )   CALL sbc_cpl_init 
     378      
     379     isec = ( kt - nit000 ) * NINT(rdttra(1))        ! date of exchanges 
     380 
     381     !------------------------------------- 
     382     ! Qsr : we must get qsr and qsr_ice 
     383     IF ( srcv(jprcv_qsroce)%laction ) CALL cpl_prism_rcv( jprcv_qsroce, isec, qsr_tmp    , info )  
     384     IF ( srcv(jprcv_qsrice)%laction ) CALL cpl_prism_rcv( jprcv_qsrice, isec, qsr_ice_tmp, info )  
     385     IF ( srcv(jprcv_qsrmix)%laction ) CALL cpl_prism_rcv( jprcv_qsrmix, isec, qsr_mix, info ) 
     386 
     387 
     388!!! Peut etre utiliser  
     389!!!      IF ( srcv(jprcv_qsrmix)%laction ) qsr(:,:) = ( qsr_mix(:,:) - freeze(:,:) * qsr_ice(:,:) ) / (1. - freeze(:,:)) 
     390!!!      IF (( srcv(jprcv_qsroce)%laction ) .and. ( srcv(jprcv_qsrice)%laction )) then 
     391!!!            ztmp(:,:) = qsr_mix(:,:) / (1. - ( 0.065*(1. - freeze(:,:)) + freeze(:,:)*alb_ice(:,:))) 
     392!!!            qsr_ice(:,:) = ztmp(:,:) * (1. - alb_ice(:,:)) 
     393!!!            qsr    (:,:) = ztmp(:,:) * (1. - 0.065) 
     394!!!        endif 
     395 
     396     SELECT CASE (TRIM(cn_rcv_qsr)) 
     397     CASE( 'conservative' ) 
     398         qsr(:,:) = ( qsr_mix(:,:) - freeze(:,:) * qsr_ice_tmp(:,:) ) / (1. - freeze(:,:)) 
     399         qsr_ice(:,:) = qsr_ice_tmp(:,:) 
     400     CASE( 'oce and ice' ) 
     401         qsr(:,:) =  qsr_tmp(:,:) 
     402         qsr_ice(:,:) =  qsr_ice_tmp(:,:) 
     403     CASE( 'mixed oce-ice' ) 
     404         ztmp(:,:) = qsr_mix(:,:) / (1. - ( 0.065*(1. - freeze(:,:)) + freeze(:,:)*alb_ice(:,:))) 
    340405         qsr_ice(:,:) = ztmp(:,:) * (1. - alb_ice(:,:)) 
    341406         qsr    (:,:) = ztmp(:,:) * (1. - 0.065) 
    342       END SELECT 
    343  
    344       !------------------------------------- 
    345       ! Qns : we must get qns and qns_ice 
    346       IF ( srcv(jprcv_qnsoce)%laction ) CALL cpl_prism_rcv( jprcv_qnsoce, isec, qns    , info )  
    347       IF ( srcv(jprcv_qnsice)%laction ) CALL cpl_prism_rcv( jprcv_qnsice, isec, qns_ice, info )  
    348       IF ( srcv(jprcv_qnsmix)%laction ) CALL cpl_prism_rcv( jprcv_qnsmix, isec, qns_mix, info )         
    349       SELECT CASE (TRIM(cn_rcv_qns)) 
    350       CASE( 'conservative' ) 
    351          qns(:,:) = ( qns_mix(:,:) - freeze(:,:) * qns_ice(:,:) ) / (1. - freeze(:,:)) 
    352       CASE( 'oce and ice' ) 
    353          ! nothing to do 
    354       CASE( 'mixed oce-ice' ) 
     407     END SELECT 
     408 
     409     !------------------------------------- 
     410     ! Qns : we must get qns and qns_ice 
     411     IF ( srcv(jprcv_qnsoce)%laction ) CALL cpl_prism_rcv( jprcv_qnsoce, isec, qns_tmp    , info )  
     412     IF ( srcv(jprcv_qnsice)%laction ) CALL cpl_prism_rcv( jprcv_qnsice, isec, qns_ice_tmp, info )  
     413     IF ( srcv(jprcv_qnsmix)%laction ) CALL cpl_prism_rcv( jprcv_qnsmix, isec, qns_mix, info )         
     414     SELECT CASE (TRIM(cn_rcv_qns)) 
     415     CASE( 'conservative' ) 
     416         qns(:,:) = ( qns_mix(:,:) - freeze(:,:) * qns_ice_tmp(:,:) ) / (1. - freeze(:,:)) 
     417         qns_ice(:,:) = qns_ice_tmp(:,:) 
     418     CASE( 'oce and ice' ) 
     419         qns(:,:) =  qns_tmp(:,:) 
     420         qns_ice(:,:) =  qns_ice_tmp(:,:) 
     421     CASE( 'mixed oce-ice' ) 
    355422!!!!! 
    356423!!!!! +++ ERIC il faut que tu mettes les bonnes formules... 
    … …  
    358425!!$         qns_ice(:,:) = ... 
    359426!!$         qns    (:,:) = ... 
    360       END SELECT 
    361  
    362       !------------------------------------- 
    363       ! Precipitations and Evaporation: we must get emp tprecip and sprecip 
    364       ! sprecip = snow_ice - evap_ice 
    365       ! tprecip = ( rain_ice + snow_ice ) - evap_ice 
    366       ! emp     = emp_oce = evap_oce - ( rain_oce + snow_oce ) ... runoff??? ... calving??? 
    367       IF ( srcv(jprcv_snow)%laction )   CALL cpl_prism_rcv( jprcv_snow, isec, zsnow  , info ) ! snow 
    368       IF ( srcv(jprcv_rain)%laction )   CALL cpl_prism_rcv( jprcv_rain, isec, zrain  , info ) ! Rain = liquid precipitation 
    369       IF ( srcv(jprcv_tevp)%laction )   CALL cpl_prism_rcv( jprcv_tevp, isec, ztevp  , info ) ! total evaporation (over oce + ice) 
    370       IF ( srcv(jprcv_ievp)%laction )   CALL cpl_prism_rcv( jprcv_ievp, isec, zievp  , info ) ! evaporation over ice (sublimation) 
    371       IF ( srcv(jprcv_tpre)%laction )   CALL cpl_prism_rcv( jprcv_tpre, isec, tprecip, info ) ! see above 
    372       IF ( srcv(jprcv_spre)%laction )   CALL cpl_prism_rcv( jprcv_spre, isec, sprecip, info ) ! see above 
    373       IF ( srcv(jprcv_oemp)%laction )   CALL cpl_prism_rcv( jprcv_oemp, isec, emp    , info ) ! see above 
    374       SELECT CASE (TRIM(cn_rcv_emp)) 
    375       CASE( 'conservative' ) 
     427     END SELECT 
     428 
     429     !------------------------------------- 
     430     ! Precipitations and Evaporation: we must get emp tprecip and sprecip 
     431     ! sprecip = snow_ice - evap_ice 
     432     ! tprecip = ( rain_ice + snow_ice ) - evap_ice 
     433     ! emp     = emp_oce = evap_oce - ( rain_oce + snow_oce ) ... runoff??? ... calving??? 
     434     IF ( srcv(jprcv_snow)%laction )   CALL cpl_prism_rcv( jprcv_snow, isec, zsnow  , info ) ! snow 
     435     IF ( srcv(jprcv_rain)%laction )   CALL cpl_prism_rcv( jprcv_rain, isec, zrain  , info ) ! Rain = liquid precipitation 
     436     IF ( srcv(jprcv_tevp)%laction )   CALL cpl_prism_rcv( jprcv_tevp, isec, ztevp  , info ) ! total evaporation (over oce + ice) 
     437     IF ( srcv(jprcv_ievp)%laction )   CALL cpl_prism_rcv( jprcv_ievp, isec, zievp  , info ) ! evaporation over ice (sublimation) 
     438     IF ( srcv(jprcv_tpre)%laction )   CALL cpl_prism_rcv( jprcv_tpre, isec, tprecip_tmp, info ) ! see above 
     439     IF ( srcv(jprcv_spre)%laction )   CALL cpl_prism_rcv( jprcv_spre, isec, sprecip_tmp, info ) ! see above 
     440     IF ( srcv(jprcv_oemp)%laction )   CALL cpl_prism_rcv( jprcv_oemp, isec, emp_tmp    , info ) ! see above 
     441     SELECT CASE (TRIM(cn_rcv_emp)) 
     442     CASE( 'conservative' ) 
    376443         sprecip(:,:) = zsnow(:,:) - zievp(:,:) 
    377          tprecip(:,:) = zrain(:,:) + sprecip(,:) 
    378          emp(:,:) = ( ztevp(:,:) - zievp(:,:)*(1. - freeze(:,:)) )/freeze(:,:) - tprecip(:,:) 
    379       CASE( 'oce and ice' ) 
    380          ! nothing to do 
    381       CASE( 'mixed oce-ice' ) 
    382444         tprecip(:,:) = zrain(:,:) + sprecip(:,:) 
    383          emp(:,:) = ztevp(:,:) - ( tprecip(:,:) + sprecip(:,:) ) 
    384       END SELECT 
    385        
    386       !------------------------------------- 
    387       ! wind stress : we must get utau, vtau, utaui_ice, vtaui_ice  
    388       ! oce stress 
    389       IF ( srcv(jprcv_otx1)%laction )   CALL cpl_prism_rcv( jprcv_otx1, isec, zotx1, info ) ! oce tau 1st component on 1st grid 
    390       IF ( srcv(jprcv_oty1)%laction )   CALL cpl_prism_rcv( jprcv_oty1, isec, zoty1, info ) ! oce tau 2nd component on 1st grid 
    391       IF ( srcv(jprcv_otz1)%laction )   CALL cpl_prism_rcv( jprcv_otz1, isec, zotz1, info ) ! oce tau 3rd component on 1st grid 
    392       IF ( srcv(jprcv_otx2)%laction )   CALL cpl_prism_rcv( jprcv_otx2, isec, zotx2, info ) ! oce tau 1st component on 2nd grid 
    393       IF ( srcv(jprcv_oty2)%laction )   CALL cpl_prism_rcv( jprcv_oty2, isec, zoty2, info ) ! oce tau 2nd component on 2nd grid 
    394       IF ( srcv(jprcv_otz2)%laction )   CALL cpl_prism_rcv( jprcv_otz2, isec, zotz2, info ) ! oce tau 3rd component on 2nd grid 
    395       ! ice stress 
    396       IF ( srcv(jprcv_itx1)%laction )   CALL cpl_prism_rcv( jprcv_itx1, isec, zitx1, info ) ! ice tau 1st component on 1st grid 
    397       IF ( srcv(jprcv_ity1)%laction )   CALL cpl_prism_rcv( jprcv_ity1, isec, zity1, info ) ! ice tau 2nd component on 1st grid 
    398       IF ( srcv(jprcv_itz1)%laction )   CALL cpl_prism_rcv( jprcv_itz1, isec, zitz1, info ) ! ice tau 3rd component on 1st grid 
    399       IF ( srcv(jprcv_itx2)%laction )   CALL cpl_prism_rcv( jprcv_itx2, isec, zitx2, info ) ! ice tau 1st component on 2nd grid 
    400       IF ( srcv(jprcv_ity2)%laction )   CALL cpl_prism_rcv( jprcv_ity2, isec, zity2, info ) ! ice tau 2nd component on 2nd grid 
    401       IF ( srcv(jprcv_itz2)%laction )   CALL cpl_prism_rcv( jprcv_itz2, isec, zitz2, info ) ! ice tau 3rd component on 2nd grid 
    402       ! cartesian to spherical coordinates -> 3 components to 2 components 
    403       IF ( TRIM(cn_rcv_stress(2)) == 'cartesian' ) THEN  
     445!!! >> Arnaud pour seb et eric :  il me semble qu il y a une erreur  emp(:,:) = ( ztevp(:,:) - zievp(:,:)*(1. - freeze(:,:)) )/freeze(:,:) - tprecip(:,:) 
     446         emp(:,:) = ( ztevp(:,:) - zievp(:,:)*freeze(:,:))/(1. - freeze(:,:)) - tprecip(:,:) 
     447!!! << Arnaud 
     448     CASE( 'oce and ice' ) 
     449         tprecip(:,:) = tprecip_tmp(:,:) 
     450         sprecip(:,:) = sprecip_tmp(:,:) 
     451         emp(:,:) = emp_tmp(:,:) 
     452     CASE( 'mixed oce-ice' ) 
     453         tprecip(:,:) = zrain(:,:) + sprecip_tmp(:,:) 
     454         emp(:,:) = ztevp(:,:) - ( tprecip(:,:) + sprecip_tmp(:,:) ) 
     455     END SELECT 
     456      
     457     !------------------------------------- 
     458     ! wind stress : we must get utau, vtau, utaui_ice, vtaui_ice  
     459     ! oce stress 
     460     IF ( srcv(jprcv_otx1)%laction )   CALL cpl_prism_rcv( jprcv_otx1, isec, zotx1, info ) ! oce tau 1st component on 1st grid 
     461     IF ( srcv(jprcv_oty1)%laction )   CALL cpl_prism_rcv( jprcv_oty1, isec, zoty1, info ) ! oce tau 2nd component on 1st grid 
     462     IF ( srcv(jprcv_otz1)%laction )   CALL cpl_prism_rcv( jprcv_otz1, isec, zotz1, info ) ! oce tau 3rd component on 1st grid 
     463     IF ( srcv(jprcv_otx2)%laction )   CALL cpl_prism_rcv( jprcv_otx2, isec, zotx2, info ) ! oce tau 1st component on 2nd grid 
     464     IF ( srcv(jprcv_oty2)%laction )   CALL cpl_prism_rcv( jprcv_oty2, isec, zoty2, info ) ! oce tau 2nd component on 2nd grid 
     465     IF ( srcv(jprcv_otz2)%laction )   CALL cpl_prism_rcv( jprcv_otz2, isec, zotz2, info ) ! oce tau 3rd component on 2nd grid 
     466     ! ice stress 
     467     IF ( srcv(jprcv_itx1)%laction )   CALL cpl_prism_rcv( jprcv_itx1, isec, zitx1, info ) ! ice tau 1st component on 1st grid 
     468     IF ( srcv(jprcv_ity1)%laction )   CALL cpl_prism_rcv( jprcv_ity1, isec, zity1, info ) ! ice tau 2nd component on 1st grid 
     469     IF ( srcv(jprcv_itz1)%laction )   CALL cpl_prism_rcv( jprcv_itz1, isec, zitz1, info ) ! ice tau 3rd component on 1st grid 
     470     IF ( srcv(jprcv_itx2)%laction )   CALL cpl_prism_rcv( jprcv_itx2, isec, zitx2, info ) ! ice tau 1st component on 2nd grid 
     471     IF ( srcv(jprcv_ity2)%laction )   CALL cpl_prism_rcv( jprcv_ity2, isec, zity2, info ) ! ice tau 2nd component on 2nd grid 
     472     IF ( srcv(jprcv_itz2)%laction )   CALL cpl_prism_rcv( jprcv_itz2, isec, zitz2, info ) ! ice tau 3rd component on 2nd grid 
     473     ! cartesian to spherical coordinates -> 3 components to 2 components 
     474     IF ( TRIM(cn_rcv_stress(2)) == 'cartesian' ) THEN 
    404475         ! wind stress over ocean 
    405          SELECT CASE (srcv(jprcv_otx1)%cgrid)  
     476         SELECT CASE (srcv(jprcv_otx1)%clgrid)  
    406477         CASE( 'T' )  
    407             CALL geo2oce ( zotx1, zoty1, zotz1, 'T', glamt, gphit, ztmpx1, ztmpy1 ) ! 1st and 2nd components on the same grid 
     478             CALL geo2oce ( zotx1, zoty1, zotz1, 't', glamt, gphit, ztmpx1, ztmpy1 ) ! 1st and 2nd components on the same grid 
    408479         CASE( 'F' ) 
    409             CALL geo2oce ( zotx1, zoty1, zotz1, 'F', glamf, gphif, ztmpx1, ztmpy1 ) ! 1st and 2nd components on the same grid 
     480             CALL geo2oce ( zotx1, zoty1, zotz1, 'f', glamf, gphif, ztmpx1, ztmpy1 ) ! 1st and 2nd components on the same grid 
    410481         CASE( 'U' ) 
    411             CALL geo2oce ( zotx1, zoty1, zotz1, 'U', glamu, gphiu, ztmpx1, ztmpy1 ) ! 1st and 2nd components on the 1st grid 
    412             CALL geo2oce ( zotx2, zoty2, zotz2, 'V', glamv, gphiv, ztmpx2, ztmpy2 ) ! 1st and 2nd components on the 2nd grid 
    413             zotx2(:,:) = ztmpx2(:,:)   ! overwrite 1st component on the 2nd grid 
    414             zoty2(:,:) = ztmpy2(:,:)   ! overwrite 2nd component on the 2nd grid 
     482             CALL geo2oce ( zotx1, zoty1, zotz1, 'u', glamu, gphiu, ztmpx1, ztmpy1 ) ! 1st and 2nd components on the 1st grid 
     483             CALL geo2oce ( zotx2, zoty2, zotz2, 'v', glamv, gphiv, ztmpx2, ztmpy2 ) ! 1st and 2nd components on the 2nd grid 
     484             zotx2(:,:) = ztmpx2(:,:)   ! overwrite 1st component on the 2nd grid 
     485             zoty2(:,:) = ztmpy2(:,:)   ! overwrite 2nd component on the 2nd grid 
    415486         END SELECT 
    416487         zotx1(:,:) = ztmpx1(:,:)   ! overwrite 1st component on the 1st grid 
    … …  
    418489         ! wind stress over ice 
    419490         IF ( srcv(jprcv_itx1)%laction ) THEN  
    420             SELECT CASE (srcv(jprcv_itx1)%cgrid)  
    421             CASE( 'T' )  
    422                CALL geo2oce ( zitx1, zity1, zitz1, 'T', glamt, gphit, ztmpx1, ztmpy1 ) ! 1st and 2nd comp. on the same grid 
    423             CASE( 'F' ) 
    424                CALL geo2oce ( zitx1, zity1, zitz1, 'F', glamf, gphif, ztmpx1, ztmpy1 ) ! 1st and 2nd comp. on the same grid 
    425             CASE( 'U' ) 
    426                CALL geo2oce ( zitx1, zity1, zitz1, 'U', glamu, gphiu, ztmpx1, ztmpy1 ) ! 1st and 2nd comp. on the 1st grid 
    427                CALL geo2oce ( zitx2, zity2, zitz2, 'V', glamv, gphiv, ztmpx2, ztmpy2 ) ! 1st and 2nd comp. on the 2nd grid 
    428                zitx2(:,:) = ztmpx2(:,:)   ! overwrite 1st comp. on the 2nd grid 
    429                zity2(:,:) = ztmpy2(:,:)   ! overwrite 2nd comp. on the 2nd grid 
    430             END SELECT 
    431             zitx1(:,:) = ztmpx1(:,:)   ! overwrite 1st comp. on the 1st grid 
    432             zity1(:,:) = ztmpy1(:,:)   ! overwrite 2nd comp. on the 2nd grid 
     491             SELECT CASE (srcv(jprcv_itx1)%clgrid)  
     492             CASE( 'T' )  
     493                 CALL geo2oce ( zitx1, zity1, zitz1, 't', glamt, gphit, ztmpx1, ztmpy1 ) ! 1st and 2nd comp. on the same grid 
     494             CASE( 'F' ) 
     495                 CALL geo2oce ( zitx1, zity1, zitz1, 'f', glamf, gphif, ztmpx1, ztmpy1 ) ! 1st and 2nd comp. on the same grid 
     496             CASE( 'U' ) 
     497                 CALL geo2oce ( zitx1, zity1, zitz1, 'u', glamu, gphiu, ztmpx1, ztmpy1 ) ! 1st and 2nd comp. on the 1st grid 
     498                 CALL geo2oce ( zitx2, zity2, zitz2, 'v', glamv, gphiv, ztmpx2, ztmpy2 ) ! 1st and 2nd comp. on the 2nd grid 
     499                 zitx2(:,:) = ztmpx2(:,:)   ! overwrite 1st comp. on the 2nd grid 
     500                 zity2(:,:) = ztmpy2(:,:)   ! overwrite 2nd comp. on the 2nd grid 
     501             END SELECT 
     502             zitx1(:,:) = ztmpx1(:,:)   ! overwrite 1st comp. on the 1st grid 
     503             zity1(:,:) = ztmpy1(:,:)   ! overwrite 2nd comp. on the 2nd grid 
    433504         ENDIF 
    434       ENDIF 
    435  
    436       ! 'eastward-northward' to 'local grid' axes -> totate the components 
    437       IF ( TRIM(cn_rcv_stress(3)) == 'eastward-northward' ) THEN                        ! Oce component 
    438          call rot_rep( zotx1, zoty1, srcv(jprcv_otx1)%cgrid, 'en->i', ztmpx1 )      ! 1st component on the 1st grid 
     505     ENDIF 
     506      
     507     ! 'eastward-northward' to 'local grid' axes -> totate the components 
     508     IF ( TRIM(cn_rcv_stress(3)) == 'eastward-northward' ) THEN                        ! Oce component 
     509         CALL rot_rep( zotx1, zoty1, srcv(jprcv_otx1)%clgrid, 'en->i', ztmpx1 )      ! 1st component on the 1st grid 
    439510         zotx1(:,:) = ztmpx1(:,:)      ! overwrite 1st component on the 1st grid 
    440          IF ( srcv(jprcv_otx2)%laction ) then  
    441             call rot_rep( zotx2, zoty2, srcv(jprcv_otx2)%cgrid, 'en->j', ztmpy2 )   ! 2nd component on the 2nd grid 
    442             zoty2(:,:) = ztmpy2(:,:)   ! overwrite 2nd component on the 2nd grid 
     511         IF ( srcv(jprcv_otx2)%laction ) THEN  
     512             CALL rot_rep( zotx2, zoty2, srcv(jprcv_otx2)%clgrid, 'en->j', ztmpy2 )   ! 2nd component on the 2nd grid 
     513             zoty2(:,:) = ztmpy2(:,:)   ! overwrite 2nd component on the 2nd grid 
    443514         ELSE 
    444             call rot_rep( zotx1, zoty1, srcv(jprcv_otx1)%cgrid, 'en->j', ztmpy1 )   ! 2nd component on the 1st grid 
    445             zoty1(:,:) = ztmpy1(:,:)   ! overwrite 2nd component on the 1st grid 
     515             CALL rot_rep( zotx1, zoty1, srcv(jprcv_otx1)%clgrid, 'en->j', ztmpy1 )   ! 2nd component on the 1st grid 
     516             zoty1(:,:) = ztmpy1(:,:)   ! overwrite 2nd component on the 1st grid 
    446517         ENDIF 
    447518         IF ( srcv(jprcv_itx1)%laction ) THEN                                            ! Ice component 
    448             call rot_rep( zitx1, zity1, srcv(jprcv_itx1)%cgrid, 'en->i', ztmpx1 )      ! 1st component on the 1st grid 
    449             zitx1(:,:) = ztmpx1(:,:)      ! overwrite 1st component on the 1st grid 
    450             IF ( srcv(jprcv_itx2)%laction ) THEN 
    451                call rot_rep( zitx2, zity2, srcv(jprcv_itx2)%cgrid, 'en->j', ztmpy2 )   ! 2nd component on the 2nd grid 
    452                zity2(:,:) = ztmpy2(:,:)   ! overwrite 2nd component on the 2nd grid 
    453             ELSE 
    454                call rot_rep( zitx1, zity1, srcv(jprcv_itx1)%cgrid, 'en->j', ztmpy1 )   ! 2nd component on the 1st grid 
    455                zity1(:,:) = ztmpy1(:,:)   ! overwrite 2nd component on the 1st grid 
    456             ENDIF 
     519             CALL rot_rep( zitx1, zity1, srcv(jprcv_itx1)%clgrid, 'en->i', ztmpx1 )      ! 1st component on the 1st grid 
     520             zitx1(:,:) = ztmpx1(:,:)      ! overwrite 1st component on the 1st grid 
     521             IF ( srcv(jprcv_itx2)%laction ) THEN 
     522                 CALL rot_rep( zitx2, zity2, srcv(jprcv_itx2)%clgrid, 'en->j', ztmpy2 )   ! 2nd component on the 2nd grid 
     523                 zity2(:,:) = ztmpy2(:,:)   ! overwrite 2nd component on the 2nd grid 
     524             ELSE 
     525                 CALL rot_rep( zitx1, zity1, srcv(jprcv_itx1)%clgrid, 'en->j', ztmpy1 )   ! 2nd component on the 1st grid 
     526                 zity1(:,:) = ztmpy1(:,:)   ! overwrite 2nd component on the 1st grid 
     527             ENDIF 
    457528         ENDIF 
    458       ENDIF 
    459  
    460       ! oce stress must be on U,V grids 
    461       IF ( srcv(jprcv_otx1)%cgrid == 'T' ) THEN 
     529     ENDIF 
     530      
     531     ! oce stress must be on U,V grids 
     532     IF ( srcv(jprcv_otx1)%clgrid == 'T' ) THEN 
    462533         DO jj = 2, jpjm1 
    463             DO ji = fs_2, fs_jpim1   ! vector opt. 
    464               utau(ji,jj) = 0.5 * ( zotx1(ji,jj) + zotx1(ji+1,jj  ) ) ! T -> U grid 
    465               vtau(ji,jj) = 0.5 * ( zoty1(ji,jj) + zoty1(ji  ,jj+1) ) ! T -> V grid 
    466             END DO 
     534           DO ji = fs_2, fs_jpim1   ! vector opt. 
     535             utau(ji,jj) = 0.5 * ( zotx1(ji,jj) + zotx1(ji+1,jj  ) ) ! T -> U grid 
     536             vtau(ji,jj) = 0.5 * ( zoty1(ji,jj) + zoty1(ji  ,jj+1) ) ! T -> V grid 
     537           END DO 
    467538         END DO 
    468539         CALL lbc_lnk( utau, 'U',  -1. )   ;   CALL lbc_lnk( vtau, 'V',  -1. ) 
    469       ELSE 
     540     ELSE 
    470541         utau(:,:) = zotx1(:,:) 
    471542         vtau(:,:) = zoty2(:,:) 
    472       ENDIF 
    473  
    474       ! make sure we have stress over ice 
    475       IF ( TRIM(cn_rcv_stress(1)) /= 'oce and ice' ) THEN  
     543     ENDIF 
     544      
     545     ! make sure we have stress over ice 
     546     IF ( TRIM(cn_rcv_stress(1)) /= 'oce and ice' ) THEN  
    476547         zitx1(:,:) = zotx1(:,:)                                                ! 1st component on the 1st grid 
    477548         IF ( srcv(jprcv_otx2)%laction ) THEN   ;   zity2(:,:) = zoty2(:,:)   ! 2nd component on the 2nd grid 
    478549         ELSE                                     ;   zity1(:,:) = zoty1(:,:)   ! 2nd component on the 1st grid 
    479550         ENDIF 
    480          srcv(jprcv_itx1)%cgrid = srcv(jprcv_otx1)%cgrid   ! update grid of the ice component 
    481       ENDIF 
    482        
    483       ! ice stress must be on I grid 
    484       SELECT CASE ( srcv(jprcv_itx1)%cgrid ) 
    485       CASE( 'U' ) 
     551         srcv(jprcv_itx1)%clgrid = srcv(jprcv_otx1)%clgrid   ! update grid of the ice component 
     552     ENDIF 
     553      
     554     ! ice stress must be on I grid 
     555     SELECT CASE ( srcv(jprcv_itx1)%clgrid ) 
     556     CASE( 'U' ) 
    486557         DO jj = 2, jpjm1 
    487             DO ji = fs_2, fs_jpim1   ! vector opt. 
    488                utaui_ice(ji,jj) = 0.5 * ( zitx1(ji-1,jj  ) + zitx1(ji-1,jj-1) ) ! U -> I grid 
    489                vtaui_ice(ji,jj) = 0.5 * ( zity2(ji  ,jj-1) + zity2(ji-1,jj-1) ) ! V -> I grid 
    490             END DO 
     558           DO ji = fs_2, fs_jpim1   ! vector opt. 
     559             utaui_ice(ji,jj) = 0.5 * ( zitx1(ji-1,jj  ) + zitx1(ji-1,jj-1) ) ! U -> I grid 
     560             vtaui_ice(ji,jj) = 0.5 * ( zity2(ji  ,jj-1) + zity2(ji-1,jj-1) ) ! V -> I grid 
     561           END DO 
    491562         END DO 
    492563         CALL lbc_lnk( utaui_ice, 'I',  -1. )   ;   CALL lbc_lnk( vtaui_ice, 'I',  -1. ) 
    493       CASE( 'F' ) 
     564     CASE( 'F' ) 
    494565         DO jj = 2, jpjm1 
    495             DO ji = fs_2, fs_jpim1   ! vector opt. 
    496                utaui_ice(ji,jj) = zitx1(ji-1,jj-1) ! F -> I grid 
    497                vtaui_ice(ji,jj) = zity1(ji-1,jj-1) ! F -> I grid 
    498             END DO 
     566           DO ji = fs_2, fs_jpim1   ! vector opt. 
     567             utaui_ice(ji,jj) = zitx1(ji-1,jj-1) ! F -> I grid 
     568             vtaui_ice(ji,jj) = zity1(ji-1,jj-1) ! F -> I grid 
     569           END DO 
    499570         END DO 
    500571         CALL lbc_lnk( utaui_ice, 'I',  -1. )   ;   CALL lbc_lnk( vtaui_ice, 'I',  -1. ) 
    501       CASE( 'T' ) 
     572     CASE( 'T' ) 
    502573         DO jj = 2, jpjm1 
    503             DO ji = fs_2, fs_jpim1   ! vector opt. 
    504                utaui_ice(ji,jj) = 0.25 * ( zitx1(ji,jj) + zitx1(ji-1,jj) + zitx1(ji,jj-1) + zitx1(ji-1,jj-1) ) ! T -> I grid 
    505                vtaui_ice(ji,jj) = 0.25 * ( zity1(ji,jj) + zity1(ji-1,jj) + zity1(ji,jj-1) + zity1(ji-1,jj-1) ) ! T -> I grid 
    506             END DO 
     574           DO ji = fs_2, fs_jpim1   ! vector opt. 
     575             utaui_ice(ji,jj) = 0.25 * ( zitx1(ji,jj) + zitx1(ji-1,jj) + zitx1(ji,jj-1) + zitx1(ji-1,jj-1) ) ! T -> I grid 
     576             vtaui_ice(ji,jj) = 0.25 * ( zity1(ji,jj) + zity1(ji-1,jj) + zity1(ji,jj-1) + zity1(ji-1,jj-1) ) ! T -> I grid 
     577           END DO 
    507578         END DO 
    508579         CALL lbc_lnk( utaui_ice, 'I',  -1. )   ;   CALL lbc_lnk( vtaui_ice, 'I',  -1. ) 
    509       CASE( 'I' ) 
     580     CASE( 'I' ) 
    510581         utaui_ice(:,:) = zitx1(:,:) 
    511582         vtaui_ice(:,:) = zity1(:,:) 
    512       END SELECT 
    513        
    514       !------------------------------------- 
    515       ! 10 m wind speed 
    516       ! +++ ---> blinder dans tke  si TRIM(cn_rcv_w10m) == 'none' 
    517 !!$     +++ IF ( srcv(jprcv_w10m  )%laction )   CALL cpl_prism_rcv( jprcv_dqnsdt, isec, wind10, info ) 
    518        
    519       !------------------------------------- 
    520       ! d(Qns)/d(T)  
    521       IF ( srcv(jprcv_dqnsdt)%laction )   CALL cpl_prism_rcv( jprcv_dqnsdt, isec, dqns_ice, info ) 
    522        
    523       !------------------------------------- 
    524       ! Runoff 
    525       IF ( srcv(jprcv_rnf   )%laction )   CALL cpl_prism_rcv( jprcv_rnf   , isec, rnfcpl, info ) 
    526        
    527       !------------------------------------- 
    528       ! Calving 
    529       IF ( srcv(jprcv_cal   )%laction )   CALL cpl_prism_rcv( jprcv_cal   , isec, ocalving, info ) 
    530        
    531       !  fraction of net shortwave radiation which is not absorbed in the  
    532       !  thin surface layer and penetrates inside the ice cover  
    533       !  ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 
    534       !------------------------------------------------------------------ 
    535       ! Since cloud cover catm not transmitted from atmosphere 
    536       ! ===> defined as constant value -> definition done in sbc_cpl_init 
    537  
     583     END SELECT 
     584      
     585      
     586     !------------------------------------- 
     587     ! 10 m wind speed 
     588     ! +++ ---> blinder dans tke  si TRIM(cn_rcv_w10m) == 'none' 
     589     IF ( srcv(jprcv_w10m  )%laction )   CALL cpl_prism_rcv( jprcv_w10m, isec, wind10_tmp, info ) 
     590!!!     wind10m(:,:) = wind10_tmp(:,:) 
     591      
     592     !------------------------------------- 
     593     ! d(Qns)/d(T)  
     594     IF ( srcv(jprcv_dqnsdt)%laction )   CALL cpl_prism_rcv( jprcv_dqnsdt, isec, dqns_ice_tmp, info ) 
     595     dqns_ice(:,:) = dqns_ice_tmp(:,:) 
     596      
     597     !------------------------------------- 
     598     ! Runoff 
     599     IF ( srcv(jprcv_rnf   )%laction )   CALL cpl_prism_rcv( jprcv_rnf   , isec, rnfcpl_tmp, info ) 
     600     rnfcpl(:,:) = rnfcpl_tmp(:,:) 
     601      
     602     !------------------------------------- 
     603     ! Calving 
     604     IF ( srcv(jprcv_cal   )%laction )   CALL cpl_prism_rcv( jprcv_cal   , isec, ocalving_tmp, info ) 
     605     ocalving(:,:) = ocalving_tmp(:,:) 
     606      
     607     !  fraction of net shortwave radiation which is not absorbed in the  
     608     !  thin surface layer and penetrates inside the ice cover  
     609     !  ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 
     610     !------------------------------------------------------------------ 
     611     ! Since cloud cover catm not transmitted from atmosphere 
     612     ! ===> defined as constant value -> definition done in sbc_cpl_init 
     613      
    538614   END SUBROUTINE sbc_cpl_rcv 
    539615    
    540616   SUBROUTINE sbc_cpl_snd( kt ) 
    541        
    542       isec = ( kt - nit000 ) * NINT(rdttra(1))        ! date of exxhanges 
    543  
    544       !------------------------------------- 
    545       ! Ice fraction 
    546       IF ( ssnd(jpsnd_fice)%laction ) CALL cpl_prism_snd( jpsnd_fice, isec, freeze, info ) 
    547  
    548       !------------------------------------- 
    549       ! T surf 
    550       ztmp(:,:) = tn(:,:,1) + rt0 
    551       SELECT CASE (TRIM(cn_snd_temperature)) 
    552       CASE( 'oce only'             )       ! nothing to do 
    553       CASE( 'weighted oce and ice' )   ;   ztmp = ztmp(:,:) * (1. - freeze(:,:)) 
    554       CASE( 'mixed oce-ice'        )   ;   ztmp = ztmp(:,:) * (1. - freeze(:,:)) + tn_ice(:,:)*freeze(:,:) 
    555       END SELECT 
    556       IF ( ssnd(jpsnd_toce)%laction ) CALL cpl_prism_snd( jpsnd_toce, isec, ztmp, info ) 
    557       IF ( ssnd(jpsnd_tice)%laction ) CALL cpl_prism_snd( jpsnd_tice, isec, tn_ice(:,:) * freeze(:,:), info ) 
    558       IF ( ssnd(jpsnd_tmix)%laction ) CALL cpl_prism_snd( jpsnd_tmix, isec, ztmp, info ) 
    559        
    560       !------------------------------------- 
    561       ! Albedo 
    562       IF ( ssnd(jpsnd_albice)%laction ) CALL cpl_prism_snd( jpsnd_albice, isec, alb_ice(:,:) * freeze(:,:), info ) 
    563       IF ( ssnd(jpsnd_albmix)%laction ) THEN  
     617      
     618     USE oce, ONLY : tn 
     619     USE phycst, ONLY : rt0 
     620      
     621     INTEGER :: kt, isec, info 
     622     REAL(wp), DIMENSION(jpi,jpj) :: ztmp             
     623      
     624     isec = ( kt - nit000 ) * NINT(rdttra(1))        ! date of exchanges 
     625      
     626     !------------------------------------- 
     627     ! Ice fraction 
     628     IF ( ssnd(jpsnd_fice)%laction ) CALL cpl_prism_snd( jpsnd_fice, isec, freeze, info ) 
     629 
     630     !------------------------------------- 
     631     ! T surf 
     632     ztmp(:,:) = tn(:,:,1) + rt0 
     633     SELECT CASE (TRIM(cn_snd_temperature)) 
     634     CASE( 'oce only'             )       ! nothing to do 
     635     CASE( 'weighted oce and ice' )   ;   ztmp = ztmp(:,:) * (1. - freeze(:,:)) 
     636     CASE( 'mixed oce-ice'        )   ;   ztmp = ztmp(:,:) * (1. - freeze(:,:)) + tn_ice(:,:)*freeze(:,:) 
     637     END SELECT 
     638     IF ( ssnd(jpsnd_toce)%laction ) CALL cpl_prism_snd( jpsnd_toce, isec, ztmp, info ) 
     639     IF ( ssnd(jpsnd_tice)%laction ) CALL cpl_prism_snd( jpsnd_tice, isec, tn_ice(:,:) * freeze(:,:), info ) 
     640     IF ( ssnd(jpsnd_tmix)%laction ) CALL cpl_prism_snd( jpsnd_tmix, isec, ztmp, info ) 
     641      
     642     !------------------------------------- 
     643     ! Albedo 
     644     IF ( ssnd(jpsnd_albice)%laction ) CALL cpl_prism_snd( jpsnd_albice, isec, alb_ice(:,:) * freeze(:,:), info ) 
     645     IF ( ssnd(jpsnd_albmix)%laction ) THEN  
    564646!!!!! +++ ERIC   ztmp(:,:) = albedo de l'ocean a definir... 
    565647         CALL cpl_prism_snd( jpsnd_albmix, isec, ztmp(:,:) * (1. - freeze(:,:)) + alb_ice(:,:) * freeze(:,:), info ) 
    566       ENDIF 
     648     ENDIF 
    567649       
    568       !------------------------------------- 
    569       ! Thickness 
    570       IF ( ssnd(jpsnd_tckice)%laction ) CALL cpl_prism_snd( jpsnd_tckice, isec, tckice(:,:) * freeze(:,:), info ) 
    571       IF ( ssnd(jpsnd_tcksnw)%laction ) CALL cpl_prism_snd( jpsnd_tcksnw, isec, tcksnw(:,:) * freeze(:,:), info ) 
    572  
    573  
     650     !------------------------------------- 
     651     ! Thickness 
     652     IF ( ssnd(jpsnd_tckice)%laction ) CALL cpl_prism_snd( jpsnd_tckice, isec, tckice(:,:) * freeze(:,:), info ) 
     653     IF ( ssnd(jpsnd_tcksnw)%laction ) CALL cpl_prism_snd( jpsnd_tcksnw, isec, tcksnw(:,:) * freeze(:,:), info ) 
    574654       
    575       !------------------------------------- 
    576       ! Surface current 
    577  
    578       +++ seb ecriture des restarts... 
    579  
     655     !------------------------------------- 
     656     ! Surface current 
     657      
     658!!!      +++ seb ecriture des restarts... 
    580659 
    581660   END SUBROUTINE sbc_cpl_snd 
    582661    
    583  
    584  
    585  
    586  
    587662#else 
    588663      !!---------------------------------------------------------------------- 
    … …  
    596671 
    597672      !!====================================================================== 
    598    END MODULE sbccpl 
     673END MODULE sbccpl 

  • branches/dev_003_CPL/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r991 r1165  
    128128 
    129129         ! ... ice albedo 
     130!!! >> Arnaud 
     131#ifndef key_coupled 
    130132          
    131133         IF ( nsbc /= 5 ) THEN 
    132 +++ INTERFACE 2D/3D suprimer les tableaux intermediaires 
    133 +++ les mettre sous cle cpp 
    134 +++ il faudrait utiliser les variables de transfert pour tn_ice, ice/snow thickness, albedo... 
     134!!!+++ INTERFACE 2D/3D suprimer les tableaux intermediaires 
     135!!!+++ les mettre sous cle cpp 
     136!!!+++ il faudrait utiliser les variables de transfert pour tn_ice, ice/snow thickness, albedo... 
    135137 
    136138            zsist (:,:,1) = sist (:,:) 
    … …  
    169171         qla_ice(:,:) = zqla_ice(:,:,1)   ;   dqla_ice(:,:) = zdqla_ice(:,:,1) 
    170172 
    171          ENDIF 
     173     ENDIF 
     174 
     175#endif 
     176!!! << Arnaud 
    172177         IF(ln_ctl) THEN         ! print mean trends (used for debugging) 
    173178            CALL prt_ctl_info( 'Ice Forcings ' ) 

  • branches/dev_003_CPL/NEMO/OPA_SRC/SBC/sbcmod.F90

    r991 r1165  
    145145      IF( MOD( rday, nn_fsbc*rdt ) /= 0 )   CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' ) 
    146146 
    147       IF( nn_ice == 2 .AND. .NOT.( ln_blk_clio .OR. ln_blk_core ) )   & 
    148          &   CALL ctl_stop( 'sbc_init: sea-ice model requires a bulk formulation' ) 
     147!! Arnaud     IF( nn_ice == 2 .AND. .NOT.( ln_blk_clio .OR. ln_blk_core ) )   & 
     148!!         &   CALL ctl_stop( 'sbc_init: sea-ice model requires a bulk formulation' ) 
    149149       
    150150      ! Choice of the Surface Boudary Condition (set nsbc) 
    … …  
    217217      CASE(  3 )   ;   CALL sbc_blk_clio( kt )      ! bulk formulation : CLIO for the ocean 
    218218      CASE(  4 )   ;   CALL sbc_blk_core( kt )      ! bulk formulation : CORE for the ocean 
    219       CASE(  5 )   ;   CALL sbc_cpl    ( kt )      ! coupled formulation 
     219      CASE(  5 )   ;   CALL sbc_cpl_rcv ( kt )      ! coupled formulation 
    220220      CASE( -1 )                                 
    221221         ;             CALL sbc_ana     ( kt )      ! ESOPA, test ALL the formulations 
    … …  
    224224         ;             CALL sbc_blk_clio( kt ) 
    225225         ;             CALL sbc_blk_core( kt ) 
    226          ;             CALL sbc_cpl    ( kt ) 
     226         ;             CALL sbc_cpl_rcv ( kt ) 
    227227      END SELECT 
    228228 

  • branches/dev_003_CPL/NEMO/OPA_SRC/ocfzpt.F90

    r991 r1165  
    1818   !! * Shared module variables    
    1919   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !: 
    20       fzptb, fzptn        !: before and now freezing point 
     20      fzptb, fzptn ,  &       !: before and now freezing point 
     21!!! >> Arnaud 
     22      freezn                  !: now ice mask (0 or 1)  
     23!!! << Arnaud 
    2124   !!---------------------------------------------------------------------- 
    2225   !! OPA 9.0 , LOCEAN-IPSL (2005)  

  • branches/dev_003_CPL/NEMO/OPA_SRC/step.F90

    r991 r1165  
    117117   USE domvvl          ! variable volume                  (dom_vvl routine) 
    118118 
     119!!! >> Arnaud 
     120    USE sbccpl          ! surface boundary condition: coupled florulation 
     121!!! << Arnaud 
    119122#if defined key_agrif 
    120123   USE agrif_opa_sponge ! Momemtum and tracers sponges 
    … …  
    365368 
    366369      IF( lk_cpl    )   CALL sbc_cpl_snd( kstp )                 ! coupled mode : field exchanges 
    367 #endif 
     370!!!!!  Arnaud #endif 
    368371      ! 
    369372   END SUBROUTINE stp 
Note: See TracChangeset for help on using the changeset viewer.