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 991 – NEMO

Changeset 991


Ignore:
Timestamp:
2008-05-23T17:55:55+02:00 (16 years ago)
Author:
smasson
Message:

dev_003_CPL: preliminary draft (not working), see ticket #155

Location:
branches/dev_003_CPL
Files:
29 edited

Legend:

Unmodified
Added
Removed

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

    r990 r991  
    300300!----------------------------------------------------------------------- 
    301301&namsbc_cpl 
     302! SEND 
     303cn_snd_temperature = 'oce only'              ! 'oce only' 'weighted oce and ice' 'mixed oce-ice' 
     304cn_snd_albedo      = 'none'                  ! 'none' 'weighted ice' 'mixed oce-ice' 
     305cn_snd_thickness   = 'weighted ice and snow' ! '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' 
     310! RECEIVE 
     311cn_rcv_w10m       = 'coupled'               ! 'none' 'coupled' 
     312cn_rcv_stress(1)  = 'oce and ice'           ! 'oce only' 'oce and ice' 'mixed oce-ice' 
     313cn_rcv_stress(2)  = 'spherical'             ! 'spherical' 'cartesian' 
     314cn_rcv_stress(3)  = 'eastward-northward'    ! 'eastward-northward' or 'local grid' 
     315cn_rcv_stress(4)  = 'U,V,F'                 ! 'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V' 
     316cn_rcv_dqnsdt     = 'coupled'               ! 'none' 'coupled' 
     317cn_rcv_qsr        = 'conservative'          ! 'conservative' 'oce and ice' 'mixed oce-ice' 
     318cn_rcv_qns        = 'conservative'          ! 'conservative' 'oce and ice' 'mixed oce-ice' 
     319cn_rcv_emp        = 'conservative'          ! 'conservative' 'oce and ice' 'mixed oce-ice' 
     320cn_rcv_runoff     = 'climato'               ! 'coupled' 'climato' 'mixed' 
     321cn_rcv_calving    = 'none'                  ! 'none' 'coupled' 
    302322/ 
    303323!----------------------------------------------------------------------- 

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

    r888 r991  
    8080   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qfvbq         !: Array used to store energy in case of toral lateral ablation (?) 
    8181   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   dmgwi         !: Variation of the mass of snow ice 
    82  
    83    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   albege        !: Albedo of the snow or ice (only for outputs) 
    84    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   albecn        !: Albedo of the ocean (only for outputs) 
    8582   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tauc          !: Cloud optical depth 
    86  
    8783   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ui_ice, vi_ice   !: two components of the ice   velocity at I-point (m/s) 
    8884   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ui_oce, vi_oce   !: two components of the ocean velocity at I-point (m/s) 

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

    r990 r991  
    7373         CALL lim_rst_read_2          ! start from a restart file 
    7474      ENDIF 
    75        
    76       tn_ice(:,:) = sist(:,:)         ! initialisation of ice temperature    
    77       freeze(:,:) = 1.0 - frld(:,:)   ! initialisation of sea/ice cover     
    78 # if defined key_coupled 
    79       alb_ice(:,:) = albege(:,:)      ! sea-ice albedo 
    80 # endif 
    8175      ! 
    8276   END SUBROUTINE ice_init_2 

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

    r888 r991  
    113113      ui_ice(:,:)   = 0.e0 
    114114      vi_ice(:,:)   = 0.e0 
    115 # if defined key_coupled 
    116       albege(:,:)   = 0.8 * tms(:,:) 
    117 # endif 
    118115 
    119116      !---  Moments for advection.              

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

    r888 r991  
    112112      CALL iom_rstput( iter, nitrst, numriw, 'frld'  , frld  (:,:)   ) 
    113113      CALL iom_rstput( iter, nitrst, numriw, 'sist'  , sist  (:,:)   ) 
    114 # if defined key_coupled 
    115       CALL iom_rstput( iter, nitrst, numriw, 'albege', albege(:,:) ) 
    116 # endif 
    117114      CALL iom_rstput( iter, nitrst, numriw, 'tbif1' , tbif  (:,:,1) ) 
    118115      CALL iom_rstput( iter, nitrst, numriw, 'tbif2' , tbif  (:,:,2) ) 
    … …  
    198195      CALL iom_get( numrir, jpdom_autoglo, 'frld'  , frld   )     
    199196      CALL iom_get( numrir, jpdom_autoglo, 'sist'  , sist   )     
    200 # if defined key_coupled  
    201       CALL iom_get( numrir, jpdom_autoglo, 'albege', albege )     
    202 # endif 
    203197      CALL iom_get( numrir, jpdom_autoglo, 'tbif1' , tbif(:,:,1) )     
    204198      CALL iom_get( numrir, jpdom_autoglo, 'tbif2' , tbif(:,:,2) )     

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

    r888 r991  
    8383      REAL(wp) ::   zutau , zvtau    ! lead fraction at U- & V-points 
    8484      REAL(wp) ::   zu_io , zv_io    ! 2 components of the ice-ocean velocity 
    85 #if defined key_coupled     
    8685      REAL(wp), DIMENSION(jpi,jpj) ::   zalb     ! albedo of ice under overcast sky 
    8786      REAL(wp), DIMENSION(jpi,jpj) ::   zalbp    ! albedo of ice under clear sky 
    88 #endif 
    8987      REAL(wp) ::   zsang, zmod, zfm 
    9088      REAL(wp), DIMENSION(jpi,jpj) ::   ztio_u, ztio_v   ! ocean stress below sea-ice 
    … …  
    215213 
    216214      freeze(:,:) = 1.0 - frld(:,:)       ! Sea ice cover             
    217       tn_ice(:,:) = sist(:,:)             ! Ice surface temperature                       
    218  
    219 #if defined key_coupled             
    220       !------------------------------------------------! 
    221       !    Computation of snow/ice and ocean albedo    ! 
    222       !------------------------------------------------! 
    223       zalb  (:,:) = 0.e0 
    224       zalbp (:,:) = 0.e0 
    225  
    226       CALL albedo_ice( sist, hicif, hsnif, zalbp, zalb ) 
    227  
    228       alb_ice(:,:) =  0.5 * zalbp(:,:) + 0.5 * zalb (:,:)   ! Ice albedo (mean clear and overcast skys) 
    229 #endif 
     215              
     216      IF ( lk_cpl ) THEN            
     217         ! Ice surface temperature  
     218         tn_ice(:,:) = sist(:,:)               
     219         ! 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) 
     223      ENDIF 
    230224 
    231225      IF(ln_ctl) THEN 

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

    r888 r991  
    257257         CALL tab_2d_1d_2( nbpb, fr2_i0_1d  (1:nbpb)     , fr2_i0     , jpi, jpj, npb(1:nbpb) ) 
    258258         CALL tab_2d_1d_2( nbpb, qns_ice_1d (1:nbpb)     , qns_ice    , jpi, jpj, npb(1:nbpb) ) 
    259 #if ! defined key_coupled 
    260          CALL tab_2d_1d_2( nbpb, qla_ice_1d (1:nbpb)     , qla_ice    , jpi, jpj, npb(1:nbpb) ) 
    261          CALL tab_2d_1d_2( nbpb, dqla_ice_1d(1:nbpb)     , dqla_ice   , jpi, jpj, npb(1:nbpb) ) 
    262 #endif 
     259         IF ( lk_cpl ) THEN  
     260            CALL tab_2d_1d_2( nbpb, qla_ice_1d (1:nbpb)     , qla_ice    , jpi, jpj, npb(1:nbpb) ) 
     261            CALL tab_2d_1d_2( nbpb, dqla_ice_1d(1:nbpb)     , dqla_ice   , jpi, jpj, npb(1:nbpb) ) 
     262         ENDIF 
    263263         CALL tab_2d_1d_2( nbpb, dqns_ice_1d(1:nbpb)     , dqns_ice   , jpi, jpj, npb(1:nbpb) ) 
    264264         CALL tab_2d_1d_2( nbpb, tfu_1d     (1:nbpb)     , tfu        , jpi, jpj, npb(1:nbpb) ) 

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

    r888 r991  
    213213          zghe     = ( 1.0 - zihe ) * zheshth * ( 2.0 - zheshth )   & 
    214214             &     +         zihe   * 0.5 * ( 1.5 + LOG( 2.0 * zheshth ) ) 
    215 #if defined key_lim_cp3 
    216           zghe = 1.0 
    217 #endif  
    218215 
    219216          !---effective conductivities  
    … …  
    297294       DO ji = kideb, kiut 
    298295          !---computation of the derivative of energy balance function  
    299 #if defined key_coupled 
    300 #   if defined key_lim_cp2 
    301           zdfts   =   zksndh(ji)   & ! contribution of the conductive heat flux 
    302              &      + zrcpdt(ji)   & ! contribution of hsu * rcp / dt 
    303              &      - dqns_ice_1d(ji)      ! contribution of the total non solar radiation  
    304 #   else 
    305           zdfts   =   zksndh(ji)   & ! contribution of the conductive heat flux 
    306              &      + zrcpdt(ji)    ! contribution of hsu * rcp / dt 
    307 #   endif 
    308  
    309 #else 
    310296          zdfts    =  zksndh(ji)   & ! contribution of the conductive heat flux 
    311297             &      + zrcpdt(ji)   & ! contribution of hsu * rcp / dt 
    312298             &      - dqns_ice_1d (ji)     ! contribution of the total non solar radiation  
    313 #endif 
    314299          !---computation of the energy balance function  
    315300          zfts    = - z1mi0 (ji) * qsr_ice_1d(ji)   & ! net absorbed solar radiation 
    … …  
    318303          !---computation of surface temperature increment   
    319304          zdts    = -zfts / zdfts 
    320 #if defined key_lim_cp3 
    321           zdts = zdts / 3.0 
    322 #endif 
    323305          !---computation of the new surface temperature  
    324306          sist_1d(ji) = sist_1d(ji) + zdts 
    … …  
    340322       DO ji = kideb, kiut 
    341323          sist_1d(ji) = MIN( ztsmlt(ji) , sist_1d(ji) ) 
    342 #if ! defined key_coupled 
    343           qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( sist_1d(ji) - zts_old(ji) ) 
    344           qla_ice_1d (ji) = qla_ice_1d (ji) + dqla_ice_1d(ji) * ( sist_1d(ji) - zts_old(ji) ) 
    345 #endif 
     324          IF ( .NOT. lk_cpl ) THEN 
     325             qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( sist_1d(ji) - zts_old(ji) ) 
     326             qla_ice_1d(ji) = qla_ice_1d(ji) + dqla_ice_1d(ji) * ( sist_1d(ji) - zts_old(ji) ) 
     327          ENDIF 
    346328          zfcsu(ji)  = zksndh(ji) * ( ztbif(ji) - sist_1d(ji) ) 
    347329       END DO 
    … …  
    542524          !----------------------------------------------------------------------- 
    543525          !----change in snow and ice thicknesses due to sublimation or evaporation 
    544           zdhssub  = parsub * ( qla_ice_1d(ji) / ( rhosn * xsn ) ) * rdt_ice  
     526          IF ( .NOT. lk_cpl ) THEN  
     527             zdhssub  = parsub * ( qla_ice_1d(ji) / ( rhosn * xsn ) ) * rdt_ice  
     528          ELSE IF (parsub == 1) THEN  
     529             CALL ctl_stop( 'In coupled mode, use parsub = 0 or send dqla' )  
     530          ELSE 
     531             zdhssub  = 0.0 
     532          ENDIF 
    545533          zhsn     = h_snow_1d(ji) - zdhssub 
    546534          zdhisub  = MAX( zzero , -zhsn ) * rhosn/rhoic 

  • branches/dev_003_CPL/NEMO/LIM_SRC_3/ice.F90

    r990 r991  
    330330 
    331331   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::       &  !: 
    332       albege ,   &  !: Albedo of the snow or ice (only for outputs) 
    333       albecn ,   &  !: Albedo of the ocean (only for outputs) 
    334332      tauc          !: Cloud optical depth 
    335333 

  • branches/dev_003_CPL/NEMO/LIM_SRC_3/iceini.F90

    r990 r991  
    5757      !!   3.0  !  08-03  (M. Vancop) ITD, salinity, EVP-C 
    5858      !!---------------------------------------------------------------------- 
    59  
     59      INTEGER ::   jl 
    6060      ! Open the namelist file  
    6161      CALL ctlopn(numnam_ice,'namelist_ice','OLD', 'FORMATTED', 'SEQUENTIAL', 1,numout,.FALSE.,1) 
    … …  
    9292         CALL lim_var_glo2eqv         ! convert global var in equivalent variables 
    9393      ENDIF 
    94  
    95       freeze(:,:) = at_i(:,:)   ! initialisation of sea/ice cover     
    96 # if defined key_coupled 
    97       Must be adpated to LIM3  
    98       alb_ice(:,:,:) = albege(:,:)      ! sea-ice albedo 
    99 # endif 
    10094 
    10195      nstart = numit  + nn_fsbc       
    … …  
    255249      END DO 
    256250 
    257       tn_ice(:,:,:) = t_su(:,:,:) 
    258  
    259251   END SUBROUTINE lim_itd_ini 
    260252 

  • branches/dev_003_CPL/NEMO/LIM_SRC_3/limistate.F90

    r990 r991  
    469469      stress2_i(:,:)  = 0.0 
    470470      stress12_i(:,:) = 0.0 
    471  
    472 # if defined key_coupled 
    473       albege(:,:)   = 0.8 * tms(:,:) 
    474 # endif 
    475471 
    476472      !-------------------------------------------------------------------- 

  • branches/dev_003_CPL/NEMO/LIM_SRC_3/limrst.F90

    r990 r991  
    138138         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    139139      END DO 
    140 # if defined key_coupled 
    141       CALL iom_rstput( iter, nitrst, numriw, 'albege', albege(:,:) ) 
    142 # endif 
    143140      DO jl = 1, jpl  
    144141         WRITE(zchar,'(I1)') jl 
    … …  
    498495      ENDIF 
    499496 
    500 # if defined key_coupled  
    501       CALL iom_get( numrir, jpdom_autoglo, 'albege'   , albege ) 
    502 # endif 
    503497      DO jl = 1, jpl  
    504498         WRITE(zchar,'(I1)') jl 

  • branches/dev_003_CPL/NEMO/LIM_SRC_3/limsbc.F90

    r990 r991  
    242242      REAL(wp) ::   zpme             ! freshwater exchanges at the ice/ocean interface 
    243243      REAL(wp), DIMENSION(jpi,jpj) ::   zfcm1 , zfcm2    ! solar/non solar heat fluxes 
    244 #if defined key_coupled     
    245244      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zalb     ! albedo of ice under overcast sky 
    246245      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zalbp    ! albedo of ice under clear sky 
    247 #endif 
    248246      !!--------------------------------------------------------------------- 
    249247 
    … …  
    422420      !-----------------------------------------------! 
    423421 
    424       freeze(:,:)   = at_i(:,:)             ! Sea ice cover             
    425       tn_ice(:,:,:) = t_su(:,:,:)           ! Ice surface temperature                       
    426  
    427 #if defined key_coupled             
    428       !------------------------------------------------! 
    429       !    Computation of snow/ice and ocean albedo    ! 
    430       !------------------------------------------------! 
    431       zalb  (:,:,:) = 0.e0 
    432       zalbp (:,:,:) = 0.e0 
    433  
    434       CALL albedo_ice( t_su, ht_i, ht_s, zalbp, zalb ) 
    435  
    436       alb_ice(:,:,:) =  0.5 * zalbp(:,:,:) + 0.5 * zalb (:,:,:)   ! Ice albedo (mean clear and overcast skys) 
    437 #endif 
    438  
     422      freeze(:,:)   = at_i(:,:)             ! Sea ice cover   
     423 
     424      IF ( lk_cpl ) THEN                 
     425         ! Ice surface temperature 
     426         tn_ice(:,:,:) = t_su(:,:,:)            
     427         ! Computation of snow/ice and ocean albedo 
     428         CALL albedo_ice( t_su, ht_i, ht_s, zalbp, zalb ) 
     429         alb_ice(:,:,:) =  0.5 * ( zalbp(:,:,:) + zalb (:,:,:) )   ! Ice albedo (mean clear and overcast skys) 
     430      ENDIF 
     431          
    439432      IF(ln_ctl) THEN 
    440433         CALL prt_ctl( tab2d_1=qsr   , clinfo1=' lim_sbc: qsr    : ', tab2d_2=qns , clinfo2=' qns     : ' ) 

  • branches/dev_003_CPL/NEMO/LIM_SRC_3/limthd.F90

    r990 r991  
    314314            CALL tab_2d_1d( nbpb, fr2_i0_1d  (1:nbpb)     , fr2_i0     , jpi, jpj, npb(1:nbpb) ) 
    315315            CALL tab_2d_1d( nbpb, qnsr_ice_1d(1:nbpb)     , qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    316  
    317 #if ! defined key_coupled 
    318             CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb)     , qla_ice(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    319             CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb)     , dqla_ice(:,:,jl)   , jpi, jpj, npb(1:nbpb) ) 
    320 #endif 
    321  
     316            IF ( lk_cpl ) THEN 
     317               CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb)     , qla_ice(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
     318               CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb)     , dqla_ice(:,:,jl)   , jpi, jpj, npb(1:nbpb) ) 
     319            ENDIF 
    322320            CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb)     , dqns_ice(:,:,jl)   , jpi, jpj, npb(1:nbpb) ) 
    323321            CALL tab_2d_1d( nbpb, t_bo_b     (1:nbpb)     , t_bo       , jpi, jpj, npb(1:nbpb) ) 

  • branches/dev_003_CPL/NEMO/LIM_SRC_3/limthd_dh.F90

    r990 r991  
    384384         ! if qla is positive (upwards), heat goes to the atmosphere, therefore 
    385385         ! snow sublimates, if qla is negative (downwards), snow condensates 
    386          zdh_s_sub(ji)   =  - parsub * qla_ice_1d(ji) / ( rhosn * lsub ) * rdt_ice 
     386          
     387         IF ( .NOT. lk_cpl ) THEN  
     388            zdh_s_sub(ji) = - parsub * qla_ice_1d(ji) / ( rhosn * lsub ) * rdt_ice 
     389         ELSE IF (parsub == 1) THEN  
     390            CALL ctl_stop( 'In coupled mode, use parsub = 0 or send dqla' )  
     391         ELSE 
     392            zdh_s_sub(ji)  = 0.0 
     393         ENDIF 
    387394         dh_s_tot(ji)    =  dh_s_tot(ji) + zdh_s_sub(ji) 
    388395         zdhcf           =  ht_s_b(ji) + zdh_s_sub(ji)  

  • branches/dev_003_CPL/NEMO/OPA_SRC/DIA/diafwb.F90

    r888 r991  
    88   !!            9.0  !  05-11  (V. Garnier) Surface pressure gradient organization 
    99   !!---------------------------------------------------------------------- 
    10 #if ( defined key_orca_r2 || defined  key_orca_r4 ) && ! defined key_dynspg_rl && ! defined key_coupled 
     10#if ( defined key_orca_r2 || defined  key_orca_r4 ) && ! defined key_dynspg_rl && ! defined key_oasis3 && ! defined key_oasis4  
    1111   !!---------------------------------------------------------------------- 
    1212   !!   NOT "key_dynspg_rl" and "key_orca_r2 or 4" 

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

    r888 r991  
    2121   !!   cpl_prism_init     : initialization of coupled mode communication 
    2222   !!   cpl_prism_define   : definition of grid and fields 
    23    !!   cpl_prism_send     : send out fields in coupled mode 
    24    !!   cpl_prism_recv     : receive fields in coupled mode 
     23   !!   cpl_prism_snd     : snd out fields in coupled mode 
     24   !!   cpl_prism_rcv     : receive fields in coupled mode 
    2525   !!   cpl_prism_finalize : finalize the coupled mode communication 
    2626   !!---------------------------------------------------------------------- 
    27    !! * Modules used 
    28 !##################### WARNING coupled mode ############################### 
    29 !##################### WARNING coupled mode ############################### 
    30 !   Following lines must be enabled if coupling with OASIS 
     27   USE mod_prism_proto              ! OASIS3 prism module 
     28   USE mod_prism_def_partition_proto! OASIS3 prism module for partitioning 
     29   USE mod_prism_grids_writing      ! OASIS3 prism module for writing grid files 
     30   USE mod_prism_put_proto          ! OASIS3 prism module for snding 
     31   USE mod_prism_get_proto          ! OASIS3 prism module for receiving 
     32   USE mod_prism_grids_writing      ! OASIS3 prism module for writing grids 
     33   USE par_oce                      ! 
     34   USE dom_oce                      ! ocean space and time domain 
     35   USE sbccpl 
     36   USE in_out_manager               ! I/O manager 
     37   USE lib_mpp 
     38   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     39   IMPLICIT NONE 
     40   PRIVATE 
    3141! 
    32 !   USE mod_prism_proto              ! OASIS3 prism module 
    33 !   USE mod_prism_def_partition_proto! OASIS3 prism module for partitioning 
    34 !   USE mod_prism_grids_writing      ! OASIS3 prism module for writing grid files 
    35 !   USE mod_prism_put_proto          ! OASIS3 prism module for sending 
    36 !   USE mod_prism_get_proto          ! OASIS3 prism module for receiving 
    37 !   USE mod_prism_grids_writing      ! OASIS3 prism module for writing grids 
    38 !##################### WARNING coupled mode ############################### 
    39 !##################### WARNING coupled mode ############################### 
    40 #if defined key_mpp_mpi 
    41    USE lib_mpp, only : mppsize, mpprank ! message passing 
    42    USE lib_mpp, only : mppsend          ! message passing 
    43    USE lib_mpp, only : mpprecv          ! message passing 
    44 #endif 
    45    USE daymod                       ! date and time info 
    46    USE dom_oce                      ! ocean space and time domain 
    47    USE sbc_ice                      ! surface boundary condition: ice 
    48    USE in_out_manager               ! I/O manager 
    49    USE par_oce                      ! 
    50    USE phycst, only : rt0           ! freezing point of sea water 
    51  
    52    USE oce, only: tn, un, vn 
    53 #if defined key_lim2 
    54    USE ice_2, only: frld, hicif, hsnif 
    55 #endif 
    56  
    57    IMPLICIT NONE 
    58 ! 
    59 ! Exchange parameters for coupling ORCA-LIM with ECHAM5 
    60 ! 
    61 #if defined key_cpl_ocevel 
    62    INTEGER, PARAMETER         :: nsend =  6 
    63 #else 
    64    INTEGER, PARAMETER         :: nsend =  4 
    65 #endif 
    66  
    67 #if defined key_cpl_discharge 
    68    INTEGER, PARAMETER         :: nrecv = 20 
    69 #else 
    70    INTEGER, PARAMETER         :: nrecv = 17 
    71 #endif 
    72  
    73    INTEGER, DIMENSION(nsend)  :: send_id 
    74    INTEGER, DIMENSION(nrecv)  :: recv_id 
    75  
    76    CHARACTER(len=32)          :: cpl_send (nsend) 
    77    CHARACTER(len=32)          :: cpl_recv (nrecv) 
    78  
    79    PRIVATE 
    80  
    81    INTEGER                    :: localRank      ! local MPI rank 
    82    INTEGER                    :: comp_id        ! id returned by prism_init_comp 
    83  
    84    INTEGER                    :: range(5) 
    85  
    86    INTEGER, PARAMETER         :: localRoot  = 0 
    87    INTEGER                    :: localSize      ! local MPI size 
    88    INTEGER                    :: localComm      ! local MPI size 
    89    LOGICAL                    :: commRank       ! true for ranks doing OASIS communication 
    90  
    91    LOGICAL, SAVE              :: prism_was_initialized 
    92    LOGICAL, SAVE              :: prism_was_terminated 
    93    INTEGER, SAVE              :: write_grid 
    94  
    95    INTEGER                    :: ierror         ! return error code 
     42   LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .TRUE.   !: coupled flag 
     43   INTEGER, PUBLIC            :: nlocalComm        ! local MPI size 
     44   INTEGER                    :: ncomp_id          ! id returned by prism_init_comp 
     45   INTEGER                    :: nerror            ! return error code 
    9646 
    9747   REAL(wp), DIMENSION(:,:), ALLOCATABLE :: exfld  ! Temporary buffer for receiving 
    98  
    99 #ifdef key_cpl_rootexchg 
    100    LOGICAL                               :: rootexchg =.true.     ! logical switch  
    101 #else 
    102    LOGICAL                               :: rootexchg =.false.    ! logical switch 
    103 #endif 
    104  
    105    REAL(wp), DIMENSION(:),   ALLOCATABLE :: buffer ! Temporary buffer for exchange 
    106    INTEGER, DIMENSION(:,:),  ALLOCATABLE :: ranges ! Temporary buffer for exchange 
    10748 
    10849   !! Routine accessibility 
    10950   PUBLIC cpl_prism_init 
    11051   PUBLIC cpl_prism_define 
    111    PUBLIC cpl_prism_send 
    112    PUBLIC cpl_prism_recv 
     52   PUBLIC cpl_prism_snd 
     53   PUBLIC cpl_prism_rcv 
    11354   PUBLIC cpl_prism_finalize 
    11455 
    115    PUBLIC send_id, recv_id 
    116  
    11756   !!---------------------------------------------------------------------- 
    11857   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
    119    !! $Id$ 
     58   !! $Header$  
    12059   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    12160   !!---------------------------------------------------------------------- 
    … …  
    12362CONTAINS 
    12463 
    125    SUBROUTINE cpl_prism_init( localCommunicator ) 
    126  
    127       IMPLICIT NONE 
     64   SUBROUTINE cpl_prism_init 
    12865 
    12966      !!------------------------------------------------------------------- 
    … …  
    13471      !! 
    13572      !! ** Method  :   OASIS3 MPI communication  
    136       !!-------------------------------------------------------------------- 
    137       !! * Arguments 
    138       !! 
    139       INTEGER, INTENT(OUT)       :: localCommunicator 
    140       !! 
    141       !! * Local declarations 
    142       !! 
    143       CHARACTER(len=4)           :: comp_name      ! name of this PRISM component 
    144       !! 
    14573      !!-------------------------------------------------------------------- 
    14674      !! 
    … …  
    14977      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~' 
    15078      IF(lwp) WRITE(numout,*) 
    151       
    152 #if defined key_flx_bulk_monthly || defined key_flx_bulk_daily || defined key_flx_forced_daily 
    153       IF(lwp)WRITE(numout,cform_err) 
    154       IF(lwp)WRITE(numout,*) ' key_coupled and key_flx_bulk_* key_flx_forced_daily are incompatible' 
    155       nstop = nstop + 1 
    156 #endif 
    157  
    158       comp_name = 'opa9' 
    159  
     79           
    16080      !------------------------------------------------------------------ 
    16181      ! 1st Initialize the PRISM system for the application 
    16282      !------------------------------------------------------------------ 
    16383 
    164       CALL prism_init_comp_proto ( comp_id, comp_name, ierror ) 
    165       IF ( ierror /= PRISM_Ok ) & 
    166          CALL prism_abort_proto (comp_id, 'cpl_prism_init', 'Failure in prism_init_comp_proto') 
    167       prism_was_initialized = .true. 
     84      CALL prism_init_comp_proto ( ncomp_id, 'oceanx', nerror ) 
     85      IF ( nerror /= PRISM_Ok ) & 
     86         CALL prism_abort_proto (ncomp_id, 'cpl_prism_init', 'Failure in prism_init_comp_proto') 
    16887 
    16988      !------------------------------------------------------------------ 
    … …  
    17190      !------------------------------------------------------------------ 
    17291 
    173       CALL prism_get_localcomm_proto ( localComm, ierror ) 
    174       IF ( ierror /= PRISM_Ok ) & 
    175          CALL prism_abort_proto (comp_id, 'cpl_prism_init','Failure in prism_get_localcomm_proto' ) 
    176  
    177       localCommunicator = localComm 
     92      CALL prism_get_localcomm_proto ( nlocalComm, nerror ) 
     93      IF ( nerror /= PRISM_Ok ) & 
     94         CALL prism_abort_proto (ncomp_id, 'cpl_prism_init','Failure in prism_get_localcomm_proto' ) 
    17895 
    17996   END SUBROUTINE cpl_prism_init 
    … …  
    18198 
    18299   SUBROUTINE cpl_prism_define () 
    183  
    184       IMPLICIT NONE 
    185100 
    186101      !!------------------------------------------------------------------- 
    … …  
    196111      !! * Local declarations 
    197112      !! 
    198       INTEGER                    :: grid_id(2)     ! id returned by prism_def_grid 
    199       INTEGER                    :: part_id 
    200  
     113      INTEGER                    :: id_part 
    201114      INTEGER                    :: paral(5)       ! OASIS3 box partition 
    202  
    203       INTEGER                    :: shape(2,3)     ! shape of arrays passed to PSMILe 
    204       INTEGER                    :: nodim(2) 
    205       INTEGER                    :: data_type      ! data type of transients 
    206  
    207       INTEGER                    :: ji, jj         ! local loop indicees 
    208       INTEGER                    :: nx, ny, nc     ! local variables 
    209       INTEGER                    :: im1, ip1 
    210       INTEGER                    :: jm1, jp1 
    211       INTEGER                    :: i_grid         ! loop index 
    212       INTEGER                    :: info 
    213       INTEGER                    :: maxlen 
    214       INTEGER                    :: mask(jpi,jpj) 
    215       REAL(kind=wp)              :: area(jpi,jpj) 
    216  
    217       CHARACTER(len=4)           :: point_name     ! name of the grid points 
    218  
    219       REAL(kind=wp)              :: rclam(jpi,jpj,4) 
    220       REAL(kind=wp)              :: rcphi(jpi,jpj,4) 
    221  
    222       REAL(kind=wp)              :: glam_b(jpi,jpj) ! buffer for orca2 grid correction 
    223       REAL(kind=wp)              :: gphi_b(jpi,jpj) ! buffer for orca2 grid correction 
    224       !! 
    225       !!-------------------------------------------------------------------- 
    226       
     115      INTEGER                    :: ishape(2,2)    ! shape of arrays passed to PSMILe 
     116      INTEGER                    :: ji             ! local loop indicees 
     117      !! 
     118      !!-------------------------------------------------------------------- 
     119 
    227120      IF(lwp) WRITE(numout,*) 
    228121      IF(lwp) WRITE(numout,*) 'cpl_prism_define : initialization in coupled ocean/atmosphere case' 
    229122      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~' 
    230123      IF(lwp) WRITE(numout,*) 
    231       
    232 #if defined key_flx_bulk_monthly || defined key_flx_bulk_daily || defined key_flx_forced_daily 
    233       IF(lwp)WRITE(numout,cform_err) 
    234       IF(lwp)WRITE(numout,*) ' key_coupled and key_flx_bulk_... are incompatible' 
    235       nstop = nstop + 1 
    236 #endif 
    237  
    238       ! ----------------------------------------------------------------- 
    239       ! ... Some initialisation 
    240       ! ----------------------------------------------------------------- 
    241  
    242       send_id = 0 
    243       recv_id = 0 
    244  
    245 #if defined key_mpp_mpi 
    246  
    247       ! ----------------------------------------------------------------- 
    248       ! ... Some MPI stuff relevant for optional exchange via root only 
    249       ! ----------------------------------------------------------------- 
    250  
    251       commRank = .false. 
    252  
    253       localRank = mpprank ! from lib_mpp 
    254       localSize = mppsize ! from lib_mpp 
    255  
    256       IF ( rootexchg ) THEN 
    257          IF ( localRank == localRoot ) commRank = .true. 
    258       ELSE 
    259          commRank = .true. 
    260       ENDIF 
    261  
    262       IF ( rootexchg .and. localRank == localRoot ) THEN 
    263          ALLOCATE(ranges(5,0:localSize-1), stat = ierror) 
    264          IF (ierror > 0) THEN 
    265             CALL prism_abort_proto ( comp_id, 'cpl_prism_define', 'Failure in allocating Integer') 
    266             RETURN 
    267          ENDIF 
    268       ENDIF 
    269  
    270 #else 
    271       ! 
    272       ! For non-parallel configurations the one and only process ("localRoot") 
    273       ! takes part in the communication 
    274       !  
    275       localRank = localRoot 
    276       commRank = .true. 
    277  
    278 #endif 
    279  
    280       ! ----------------------------------------------------------------- 
    281       ! ... If necessary the root process writes the global grid info 
    282       ! ----------------------------------------------------------------- 
    283  
    284       IF ( localRank == localRoot ) THEN 
    285  
    286          WRITE(numout,*)'Opening file SSTOCEAN, unit= 199' 
    287  
    288          OPEN (199,STATUS='NEW',FILE="sstocean",FORM='UNFORMATTED',err=310) 
    289  
    290          ! In case the sstocean of OASIS3 from a previous run exists 
    291          ! the programs jumps to the end of the if-block 
    292 !     
    293 !*    2.0    Write exchange fields to OASIS data file. 
    294 !            ----------------------------------------- 
    295  
    296          WHERE (tmask(:,:,1) > 0.5 ) 
    297             mask(:,:) = 0 
    298          ELSE WHERE 
    299             mask(:,:) = 1 
    300          END WHERE 
    301  
    302 ! Initialise ice mask at the very first start only 
    303          frld = 1. 
    304  
    305          WRITE(199) 'SSTOCEAN' 
    306          WRITE(199) (tn(:,:,1)*mask(:,:))+rt0 
    307  
    308          WRITE(199) 'SICOCEAN' 
    309          WRITE(199) (1.-frld(:,:))*mask(:,:) 
    310  
    311 #if defined key_cpl_albedo 
    312 # if defined key_lim3 
    313          Must be adapted for LIM3 
    314 # endif 
    315          tn_ice  = 271.285 
    316     alb_ice =   0.75 
    317  
    318          WRITE(199) 'STIOCEAN' 
    319          WRITE(199) tn_ice(:,:) 
    320  
    321          WRITE(199) 'SAIOCEAN' 
    322          WRITE(199) alb_ice(:,:) 
    323 #else 
    324          hicit = 0. 
    325          hsnit = 0. 
    326          WRITE(199) 'SITOCEAN' 
    327          WRITE(199) hicif(:,:)*mask(:,:) 
    328  
    329          WRITE(199) 'SNTOCEAN' 
    330          WRITE(199) hsnif(:,:)*mask(:,:) 
    331 #endif 
    332  
    333 #if defined key_cpl_ocevel 
    334          un(:,:,1) = 0. 
    335          vn(:,:,1) = 0. 
    336  
    337          WHERE (umask(:,:,1) > 0.5 ) 
    338             mask(:,:) = 0 
    339          ELSE WHERE 
    340             mask(:,:) = 1 
    341          END WHERE 
    342  
    343          WRITE(199) 'SUNOCEAN' 
    344          WRITE(199) un(:,:,1)*mask(:,:) 
    345  
    346          WHERE (vmask(:,:,1) > 0.5 ) 
    347             mask(:,:) = 0 
    348          ELSE WHERE 
    349             mask(:,:) = 1 
    350          END WHERE 
    351  
    352          WRITE(199) 'SVNOCEAN' 
    353          WRITE(199) vn(:,:,1)*mask(:,:) 
    354 #endif 
    355  
    356          WRITE(numout,*) 
    357          WRITE(numout,*)' sstocean written' 
    358          WRITE(numout,*)' ***************' 
    359  
    360          CLOSE(199) 
    361  
    362  310     CONTINUE 
    363  
    364          CALL prism_start_grids_writing ( write_grid ) 
    365  
    366       ENDIF  ! localRank == localRoot 
    367  
    368       IF ( localRank == localRoot .and. write_grid == 1 ) THEN 
    369  
    370          !------------------------------------------------------------------ 
    371          ! 1st write global grid information (ORCA tripolar) characteristics 
    372          !     for surface coupling into a OASIS3 specific grid file. For 
    373          !     surface coupling it is sufficient to specify only one vertical 
    374          !     z-level. 
    375          !------------------------------------------------------------------ 
    376          ! 
    377          ! ... Treat corners in the horizontal plane 
    378          ! 
    379          nx = jpi 
    380          ny = jpj 
    381          nc = 4 
    382  
    383          DO i_grid = 1, 3 
    384  
    385             IF ( i_grid == 1 ) THEN 
    386  
    387                ! -------------------------------------------------------- 
    388                ! ... Write the grid info for T points 
    389                ! -------------------------------------------------------- 
    390  
    391                point_name = 'opat' 
    392  
    393                glam_b = glamt 
    394                gphi_b = gphit 
    395  
    396                DO ji = 1, jpi 
    397                   DO jj = 1, jpj 
    398  
    399                      im1 = ji-1 
    400                      jm1 = jj-1 
    401                      IF (ji == 1) im1 = jpi-2 
    402                      IF (jj == 1) jm1 = jj 
    403  
    404                      rclam(ji,jj,1) = glamf(ji,jj) 
    405                      rclam(ji,jj,2) = glamf(im1,jj) 
    406                      rclam(ji,jj,3) = glamf(im1,jm1) 
    407                      rclam(ji,jj,4) = glamf(ji,jm1) 
    408  
    409                      rcphi(ji,jj,1) = gphif(ji,jj) 
    410                      rcphi(ji,jj,2) = gphif(im1,jj) 
    411                      rcphi(ji,jj,3) = gphif(im1,jm1) 
    412                      rcphi(ji,jj,4) = gphif(ji,jm1) 
    413  
    414                   END DO 
    415                END DO 
    416  
    417                ! Correction of one (land) grid cell of the orca2 grid. 
    418                ! It was causing problems with the SCRIP interpolation. 
    419  
    420                IF (jpiglo == 182 .AND. jpjglo == 149) THEN 
    421                   rclam(145,106,2) = -1.0 
    422                   rcphi(145,106,2) = 41.0 
    423                ENDIF 
    424  
    425                WHERE (tmask(:,:,1) > 0.5 ) 
    426                   mask(:,:) = 0 
    427                ELSE WHERE 
    428                   mask(:,:) = 1 
    429                END WHERE 
    430  
    431                area = e1t * e2t 
    432  
    433             ELSE IF ( i_grid == 2 ) THEN 
    434  
    435                ! -------------------------------------------------------- 
    436                ! ... Write the grid info for u points 
    437                ! -------------------------------------------------------- 
    438  
    439                point_name = 'opau' 
    440  
    441                glam_b = glamu 
    442                gphi_b = gphiu 
    443  
    444                DO ji = 1, jpi 
    445                   DO jj = 1, jpj 
    446  
    447                      ip1 = ji+1 
    448                      jm1 = jj-1 
    449  
    450                      IF (ji == jpiglo) ip1 = 3 
    451                      IF (jj == 1) jm1 = jj 
    452  
    453                      rclam(ji,jj,1) = glamv(ip1,jj) 
    454                      rclam(ji,jj,2) = glamv(ji,jj) 
    455                      rclam(ji,jj,3) = glamv(ji,jm1) 
    456                      rclam(ji,jj,4) = glamv(ip1,jm1) 
    457  
    458                      rcphi(ji,jj,1) = gphiv(ip1,jj) 
    459                      rcphi(ji,jj,2) = gphiv(ji,jj) 
    460                      rcphi(ji,jj,3) = gphiv(ji,jm1) 
    461                      rcphi(ji,jj,4) = gphiv(ip1,jm1) 
    462  
    463                   END DO 
    464                END DO 
    465  
    466                ! Correction of three (land) grid cell of the orca2 grid. 
    467                ! It was causing problems with the SCRIP interpolation. 
    468  
    469                IF (jpiglo == 182 .AND. jpjglo == 149) THEN 
    470                   glam_b(144,106)   = -1.0 
    471                   gphi_b(144,106)   = 40.5 
    472                   rclam (144,106,2) = -1.5   
    473                   rcphi (144,106,2) = 41.0 
    474  
    475                   glam_b(144,107)   = -1.0 
    476                   gphi_b(144,107)   = 41.5 
    477                   rclam (144,107,2) = -1.5   
    478                   rcphi (144,107,2) = 42.0 
    479                   rclam (144,107,3) = -1.5   
    480                   rcphi (144,107,3) = 41.0 
    481  
    482                   glam_b(144,108)   = -1.0 
    483                   gphi_b(144,108)   = 42.5 
    484                   rclam (144,108,2) = -1.5   
    485                   rcphi (144,108,2) = 43.0 
    486                   rclam (144,108,3) = -1.5   
    487                   rcphi (144,108,3) = 42.0 
    488                ENDIF 
    489  
    490                WHERE (umask(:,:,1) > 0.5 ) 
    491                   mask(:,:) = 0 
    492                ELSE WHERE 
    493                   mask(:,:) = 1 
    494                END WHERE 
    495  
    496                area = e1u * e2u 
    497  
    498             ELSE IF ( i_grid == 3 ) THEN 
    499  
    500                ! -------------------------------------------------------- 
    501                ! ... Write the grid info for v points 
    502                ! -------------------------------------------------------- 
    503  
    504                point_name = 'opav' 
    505  
    506                glam_b = glamv 
    507                gphi_b = gphiv 
    508  
    509                DO ji = 1, jpi 
    510                   DO jj = 1, jpj 
    511  
    512                      im1 = ji-1 
    513                      jp1 = jj+1 
    514                      IF (ji == 1) im1 = jpiglo-2 
    515                      IF (jj == jpjglo) jp1 = jj 
    516  
    517                      rclam(ji,jj,1) = glamu(ji,jp1) 
    518                      rclam(ji,jj,2) = glamu(im1,jp1) 
    519                      rclam(ji,jj,3) = glamu(im1,jj) 
    520                      rclam(ji,jj,4) = glamu(ji,jj) 
    521  
    522                      rcphi(ji,jj,1) = gphiu(ji,jp1) 
    523                      rcphi(ji,jj,2) = gphiu(im1,jp1) 
    524                      rcphi(ji,jj,3) = gphiu(im1,jj) 
    525                      rcphi(ji,jj,4) = gphiu(ji,jj) 
    526  
    527                   END DO 
    528                END DO 
    529  
    530                ! Correction of one (land) grid cell of the orca2 grid. 
    531                ! It was causing problems with the SCRIP interpolation. 
    532  
    533                IF (jpiglo == 182 .AND. jpjglo == 149) THEN 
    534                   rclam(145,105,2) = -1.0   
    535                   rcphi(145,105,2) = 40.5 
    536                ENDIF 
    537  
    538                WHERE (vmask(:,:,1) > 0.5 ) 
    539                   mask(:,:) = 0 
    540                ELSE WHERE 
    541                   mask(:,:) = 1 
    542                END WHERE 
    543  
    544                area = e1v * e2v 
    545  
    546             ENDIF ! i_grid 
    547  
    548             WHERE (glam_b(:,:) < 0.) 
    549                glam_b(:,:) = glam_b(:,:) + 360. 
    550             END WHERE 
    551             WHERE (glam_b(:,:) > 360.) 
    552                glam_b(:,:) = glam_b(:,:) - 360. 
    553             END WHERE 
    554  
    555             WHERE (rclam(:,:,:) < 0.) 
    556                rclam(:,:,:) = rclam(:,:,:) + 360. 
    557             END WHERE 
    558             WHERE (rclam(:,:,:) > 360.) 
    559                rclam(:,:,:) = rclam(:,:,:) - 360. 
    560             END WHERE 
    561  
    562             mask(:,jpjglo)=1 
    563  
    564             CALL prism_write_grid   ( point_name, nx, ny, glam_b, gphi_b )  
    565             CALL prism_write_corner ( point_name, nx, ny, nc, rclam, rcphi ) 
    566             CALL prism_write_mask   ( point_name, nx, ny, mask ) 
    567             CALL prism_write_area   ( point_name, nx, ny, area ) 
    568  
    569          END DO ! i_grid 
    570  
    571          CALL prism_terminate_grids_writing () 
    572  
    573       ENDIF ! localRank == localRoot .and. write_grid == 1 
    574  
     124 
     125      ! 
     126      ! ... Define the shape for the area that excludes the halo 
     127      !     For serial configuration (key_mpp_mpi not being active) 
     128      !     nl* is set to the global values 1 and jp*glo. 
     129      ! 
     130      ishape(:,1) = (/ 1, nlei-nldi+1 /) 
     131      ishape(:,2) = (/ 1, nlej-nldj+1 /) 
     132      ! 
     133      ! ... Allocate memory for data exchange 
     134      ! 
     135      ALLOCATE(exfld(nlei-nldi+1, nlej-nldj+1), stat = nerror) 
     136      IF (nerror > 0) THEN 
     137         CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in allocating exfld') 
     138         RETURN 
     139      ENDIF 
     140      ! 
    575141      ! ----------------------------------------------------------------- 
    576142      ! ... Define the partition  
    577143      ! ----------------------------------------------------------------- 
    578  
    579       IF ( rootexchg ) THEN 
    580  
    581          paral(1) = 2              ! box partitioning 
    582          paral(2) = 0              ! NEMO lower left corner global offset     
    583          paral(3) = jpiglo         ! local extent in i  
    584          paral(4) = jpjglo         ! local extent in j 
    585          paral(5) = jpiglo         ! global extent in x 
    586  
    587          range(1) = nimpp-1+nldi   ! global start in i 
    588          range(2) = nlei-nldi+1    ! local size in i of valid region 
    589          range(3) = njmpp-1+nldj   ! global start in j 
    590          range(4) = nlej-nldj+1    ! local size in j of valid region 
    591          range(5) = range(2) & 
    592                   * range(4)       ! local horizontal size 
    593  
    594          IF(ln_ctl) THEN 
    595          write(numout,*) ' rootexchg: range(1:5)', range 
    596          ENDIF 
    597  
    598          ! 
    599          ! Collect ranges from all NEMO procs on the local root process 
    600          ! 
    601          CALL mpi_gather(range,  5, MPI_INTEGER, & 
    602                          ranges, 5, MPI_INTEGER, localRoot, localComm, ierror) 
    603  
    604          IF ( localRank == localRoot ) THEN 
    605  
    606             maxlen = maxval(ranges(5,:)) 
    607              
    608             ALLOCATE(buffer(1:maxlen), stat = ierror) 
    609             IF (ierror > 0) THEN 
    610                CALL prism_abort_proto ( comp_id, 'cpl_prism_define', 'Failure in allocating buffer') 
    611                RETURN 
     144       
     145      paral(1) = 2                                              ! box partitioning 
     146      paral(2) = jpiglo * (nldj-1+njmpp-1) + (nldi-1+nimpp-1)   ! NEMO lower left corner global offset     
     147      paral(3) = nlei-nldi+1                                    ! local extent in i  
     148      paral(4) = nlej-nldj+1                                    ! local extent in j 
     149      paral(5) = jpiglo                                         ! global extent in x 
     150       
     151      IF( ln_ctl ) THEN 
     152         WRITE(numout,*) ' multiexchg: paral (1:5)', paral 
     153         WRITE(numout,*) ' multiexchg: jpi, jpj =', jpi, jpj 
     154         WRITE(numout,*) ' multiexchg: nldi, nlei, nimpp =', nldi, nlei, nimpp 
     155         WRITE(numout,*) ' multiexchg: nldj, nlej, njmpp =', nldj, nlej, njmpp 
     156      ENDIF 
     157       
     158      CALL prism_def_partition_proto ( id_part, paral, nerror ) 
     159      ! 
     160      ! ... Announce send variables.  
     161      ! 
     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 & 
     165               &                      PRISM_Out   , ishape   , PRISM_REAL, nerror) 
     166            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') 
    612169            ENDIF 
    613  
    614           ENDIF 
    615  
    616       ELSE 
    617  
    618          paral(1) = 2                  ! box partitioning 
    619 !2dtest         paral(2) = jpiglo           & 
    620 !2dtest                  * (nldj-1+njmpp-1) & 
    621 !2dtest                  + (nldi-1+nimpp-1)   ! NEMO lower left corner global offset     
    622          paral(2) = jpiglo & 
    623                   * (nldj-1+njmpp-1)   ! NEMO lower left corner global offset     
    624          paral(3) = nlei-nldi+1        ! local extent in i  
    625          paral(4) = nlej-nldj+1        ! local extent in j 
    626          paral(5) = jpiglo             ! global extent in x 
    627  
    628          IF(ln_ctl) THEN 
    629             print*, ' multiexchg: paral (1:5)', paral 
    630             print*, ' multiexchg: jpi, jpj =', jpi, jpj 
    631             print*, ' multiexchg: nldi, nlei, nimpp =', nldi, nlei, nimpp 
    632             print*, ' multiexchg: nldj, nlej, njmpp =', nldj, nlej, njmpp 
    633          ENDIF 
    634  
    635          IF ( paral(3) /= nlei-nldi+1 ) THEN 
    636               print*, 'WARNING!!! in cpl_oasis3 - cpl_prism_define' 
    637               print*, 'cpl_prism_define: local extend in i is ', paral(3), ' should equal ', nlei-nldi+1 
    638          ENDIF 
    639          IF ( paral(4) /= nlej-nldj+1 ) THEN 
    640               print*, 'WARNING!!! in cpl_oasis3 - cpl_prism_define' 
    641               print*, 'cpl_prism_define: local extend in j is ', paral(4), ' should equal ', nlej-nldj+1 
    642          ENDIF 
    643  
    644       ENDIF 
    645  
    646       IF ( commRank ) & 
    647       CALL prism_def_partition_proto ( part_id, paral, ierror ) 
    648  
    649       grid_id(1)= part_id 
    650  
    651       !------------------------------------------------------------------ 
    652       ! 3rd Declare the transient variables 
    653       !------------------------------------------------------------------ 
    654       ! 
    655       ! ... Define symbolic names for the transient fields send by the ocean 
    656       !     These must be identical to the names specified in the SMIOC file. 
    657       ! 
    658       cpl_send( 1)='SSTOCEAN' ! sea surface temperature              -> sst_io 
    659       cpl_send( 2)='SICOCEAN' ! sea ice area fraction                -> 1.-frld 
    660 #if defined key_cpl_albedo 
    661       cpl_send( 3)='STIOCEAN' ! surface temperature over sea ice     -> tn_ice 
    662       cpl_send( 4)='SAIOCEAN' ! albedo over sea ice                  -> alb_ice 
    663 #else 
    664       cpl_send( 3)='SITOCEAN' ! sea ice thickness                    -> hicif (only 1 layer available!) 
    665       cpl_send( 4)='SNTOCEAN' ! surface snow thickness over sea ice  -> hsnif 
    666 #endif 
    667 #if defined key_cpl_ocevel 
    668       cpl_send( 5)='SUNOCEAN' ! U-velocity                           -> un 
    669       cpl_send( 6)='SVNOCEAN' ! V-velocity                           -> vn 
    670 #endif 
    671       ! 
    672       ! ...  Define symbolic names for transient fields received by the ocean. 
    673       !      These must be identical to the names specified in the SMIOC file. 
    674       ! 
    675       ! ...  a) U-Grid fields 
    676       ! 
    677       cpl_recv( 1)='TXWOCEWU' ! weighted surface downward eastward stress 
    678       cpl_recv( 2)='TYWOCEWU' ! weighted surface downward northward stress 
    679       cpl_recv( 3)='TXIOCEWU' ! weighted surface downward eastward stress over ice 
    680       cpl_recv( 4)='TYIOCEWU' ! weighted surface downward northward stress over ice 
    681       ! 
    682       ! ...  a) V-Grid fields 
    683       ! 
    684       cpl_recv( 5)='TXWOCEWV' ! weighted surface downward eastward stress 
    685       cpl_recv( 6)='TYWOCEWV' ! weighted surface downward northward stress 
    686       cpl_recv( 7)='TXIOCEWV' ! weighted surface downward eastward stress over ice 
    687       cpl_recv( 8)='TYIOCEWV' ! weighted surface downward northward stress over ice 
    688       ! 
    689       ! ...  a) T-Grid fields 
    690       ! 
    691       cpl_recv( 9)='FRWOCEPE' ! P-E over water                               -> zpew 
    692       cpl_recv(10)='FRIOCEPE' ! P-E over ice                                 -> zpei 
    693       cpl_recv(11)='FRROCESN' ! surface downward snow fall                   -> zpsol 
    694       cpl_recv(12)='FRIOCEEV' ! surface upward snow flux where sea ice       -> zevice 
    695  
    696       cpl_recv(13)='QSWOCESR' ! surface net downward shortwave flux          -> qsr_oce 
    697       cpl_recv(14)='QSWOCENS' ! surface downward non-solar heat flux in air  -> qnsr_oce 
    698       cpl_recv(15)='QSIOCESR' ! solar heat flux on sea ice                   -> qsr_ice 
    699       cpl_recv(16)='QSIOCENS' ! non-solar heat flux on sea ice               -> qnsr_ice 
    700       cpl_recv(17)='QSIOCEDQ' ! non-solar heat flux derivative               -> dqns_ice 
    701  
    702 #ifdef key_cpl_discharge 
    703       cpl_recv(18)='FRWOCEIS' ! ice discharge into ocean                     -> calving 
    704       cpl_recv(19)='FRWOCERD' ! river discharge into ocean                   -> zrunriv 
    705       cpl_recv(20)='FRWOCECD' ! continental discharge into ocean             -> zruncot 
    706 #endif 
    707       ! 
    708       ! data_type has to be PRISM_REAL as PRISM_DOUBLE is not supported. 
    709       ! For exchange of double precision fields the OASIS3 has to be compiled 
    710       ! with use_realtype_single. (see OASIS3 User Guide prism_2-4, 5th Ed., 
    711       ! p. 13 and p. 53 for further explanation.) 
    712       ! 
    713       data_type = PRISM_REAL 
    714  
    715       nodim(1) = 3 ! check 
    716       nodim(2) = 0 
    717  
    718       ! 
    719       ! ... Define the shape for the area that excludes the halo 
    720       !     For serial configuration (key_mpp_mpi not being active) 
    721       !     nl* is set to the global values 1 and jp*glo. 
    722       ! 
    723       IF ( rootexchg ) THEN 
    724          shape(1,1) = 1 
    725          shape(2,1) = jpiglo 
    726          shape(1,2) = 1 
    727          shape(2,2) = jpjglo 
    728          shape(1,3) = 1 
    729          shape(2,3) = 1 
    730        ELSE 
    731          shape(1,1) = 1 
    732          shape(2,1) = nlei-nldi+1 ! jpi 
    733          shape(1,2) = 1 
    734          shape(2,2) = nlej-nldj+1 ! jpj 
    735          shape(1,3) = 1 
    736          shape(2,3) = 1 
    737       ENDIF 
    738       ! 
    739       ! ----------------------------------------------------------------- 
    740       ! ... Allocate memory for data exchange 
    741       ! ----------------------------------------------------------------- 
    742       ! 
    743       ALLOCATE(exfld(shape(1,1):shape(2,1),shape(1,2):shape(2,2)), stat = ierror) 
    744       IF (ierror > 0) THEN 
    745          CALL prism_abort_proto ( comp_id, 'cpl_prism_define', 'Failure in allocating exfld') 
    746          RETURN 
    747       ENDIF 
    748       ! 
    749       ! ... Announce send variables, all on T points.  
    750       ! 
    751       info = PRISM_Out 
    752       ! 
    753  
    754       IF ( commRank ) THEN 
    755  
    756          DO ji = 1, nsend 
    757             !        if ( ji == 2 ) ; then ; nodim(2) = 2 ; else ; nodim(2) = 0 ; endif 
    758             CALL prism_def_var_proto (send_id(ji), cpl_send(ji), grid_id(1), & 
    759                  nodim, info, shape, data_type, ierror) 
    760             IF ( ierror /= PRISM_Ok ) THEN 
    761                PRINT *, 'Failed to define transient ', ji, TRIM(cpl_send(ji)) 
    762                CALL prism_abort_proto ( comp_id, 'cpl_prism_define', 'Failure in prism_def_var') 
     170         ENDIF 
     171      END DO 
     172      ! 
     173      ! ... Announce received variables.  
     174      ! 
     175      DO ji = 1, jprcv 
     176         IF ( srcv(ji)%laction ) THEN  
     177            CALL prism_def_var_proto ( srcv(ji)%nid, srcv(ji)%name, id_part, (/ 2, 0/),   & 
     178               &                      PRISM_In    , ishape   , PRISM_REAL, nerror) 
     179            IF ( nerror /= PRISM_Ok ) THEN 
     180               WRITE(numout,*) 'Failed to define transient ', ji, TRIM(srcv(ji)%name) 
     181               CALL prism_abort_proto ( srcv(ji)%nid, 'cpl_prism_define', 'Failure in prism_def_var') 
    763182            ENDIF 
    764          ENDDO 
    765          ! 
    766          nodim(1) = 3 ! check 
    767          nodim(2) = 0 
    768          ! 
    769          ! ... Announce recv variables.  
    770          ! 
    771          info = PRISM_In 
    772          ! 
    773          ! ... a) on U points 
    774          ! 
    775          DO ji = 1, 4 
    776             CALL prism_def_var_proto (recv_id(ji), cpl_recv(ji), grid_id(1), & 
    777                  nodim, info, shape, data_type, ierror) 
    778             IF ( ierror /= PRISM_Ok ) THEN 
    779                PRINT *, 'Failed to define transient ', ji, TRIM(cpl_recv(ji)) 
    780                CALL prism_abort_proto ( comp_id, 'cpl_prism_define', 'Failure in prism_def_var') 
    781             ENDIF 
    782          ENDDO 
    783          ! 
    784          ! ... b) on V points 
    785          ! 
    786          DO ji = 5, 8 
    787             CALL prism_def_var_proto (recv_id(ji), cpl_recv(ji), grid_id(1), & 
    788                  nodim, info, shape, data_type, ierror) 
    789             IF ( ierror /= PRISM_Ok ) THEN 
    790                PRINT *, 'Failed to define transient ', TRIM(cpl_recv(ji)) 
    791                CALL prism_abort_proto ( comp_id, 'cpl_prism_define', 'Failure in prism_def_var') 
    792             ENDIF 
    793          ENDDO 
    794          ! 
    795          ! ... c) on T points 
    796          ! 
    797          DO ji = 9, nrecv 
    798             CALL prism_def_var_proto (recv_id(ji), cpl_recv(ji), grid_id(1), & 
    799                  nodim, info, shape, data_type, ierror) 
    800             IF ( ierror /= PRISM_Ok ) THEN 
    801                PRINT *, 'Failed to define transient ', TRIM(cpl_recv(ji)) 
    802                CALL prism_abort_proto ( comp_id, 'cpl_prism_define', 'Failure in prism_def_var') 
    803             ENDIF 
    804          ENDDO 
    805  
    806       ENDIF ! commRank 
    807  
    808       !------------------------------------------------------------------ 
    809       ! 4th End of definition phase 
    810       !------------------------------------------------------------------ 
    811  
    812       IF ( commRank ) THEN 
    813          CALL prism_enddef_proto(ierror) 
    814          IF ( ierror /= PRISM_Ok ) & 
    815               CALL prism_abort_proto ( comp_id, 'cpl_prism_define', 'Failure in prism_enddef') 
    816       ENDIF 
    817  
     183         ENDIF 
     184      END DO 
     185       
     186      !------------------------------------------------------------------ 
     187      ! End of definition phase 
     188      !------------------------------------------------------------------ 
     189       
     190      CALL prism_enddef_proto(nerror) 
     191      IF ( nerror /= PRISM_Ok )   CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in prism_enddef') 
     192       
    818193   END SUBROUTINE cpl_prism_define 
    819  
    820  
    821  
    822    SUBROUTINE cpl_prism_send( var_id, date, data_array, info ) 
    823  
    824       IMPLICIT NONE 
     194    
     195    
     196   SUBROUTINE cpl_prism_snd( kid, kstep, pdata, kinfo ) 
    825197 
    826198      !!--------------------------------------------------------------------- 
    827       !!              ***  ROUTINE cpl_prism_send  *** 
    828       !! 
    829       !! ** Purpose : - At each coupling time-step,this routine sends fields 
     199      !!              ***  ROUTINE cpl_prism_snd  *** 
     200      !! 
     201      !! ** Purpose : - At each coupling time-step,this routine snds fields 
    830202      !!      like sst or ice cover to the coupler or remote application. 
    831203      !!---------------------------------------------------------------------- 
    832204      !! * Arguments 
    833205      !! 
    834       INTEGER, INTENT( IN )  :: var_id    ! variable Id 
    835       INTEGER, INTENT( OUT ) :: info      ! OASIS3 info argument 
    836       INTEGER, INTENT( IN )  :: date      ! ocean time-step in seconds 
    837       REAL(wp)               :: data_array(:,:) 
     206      INTEGER,                      INTENT( IN    )   :: kid       ! variable intex in the array 
     207      INTEGER,                      INTENT(   OUT )   :: kinfo     ! OASIS3 info argument 
     208      INTEGER,                      INTENT( IN    )   :: kstep     ! ocean time-step in seconds 
     209      REAL(wp), DIMENSION(jpi,jpj), INTENT( IN    )   :: pdata 
    838210      !! 
    839211      !! * Local declarations 
    840212      !! 
    841 #if defined key_mpp_mpi 
    842       REAL(wp)               :: global_array(jpiglo,jpjglo) 
    843       ! 
    844 !mpi  INTEGER                :: status(MPI_STATUS_SIZE) 
    845 !mpi  INTEGER                :: type       ! MPI data type 
    846       INTEGER                :: request    ! MPI isend request 
    847       INTEGER                :: ji, jj, jn ! local loop indicees 
    848 #else 
    849213      INTEGER                :: ji 
    850 #endif 
    851       !! 
    852       !!-------------------------------------------------------------------- 
    853       !! 
    854  
    855 #if defined key_mpp_mpi 
    856  
    857       request = 0 
    858  
    859       IF ( rootexchg ) THEN 
    860          ! 
    861 !mpi     IF ( wp == 4 ) type = MPI_REAL 
    862 !mpi     IF ( wp == 8 ) type = MPI_DOUBLE_PRECISION 
    863          ! 
    864          ! collect data on the local root process 
    865          ! 
    866  
    867          if ( var_id == 1 .and. localRank == localRoot .and. ln_ctl )  then 
    868              do ji = 0, localSize-1 
    869                 WRITE(numout,*) ' rootexchg: ranges for rank ', ji, ' are ', ranges(:,ji)  
    870              enddo 
    871          endif 
    872  
    873          IF ( localRank /= localRoot ) THEN 
    874  
    875             DO jj = nldj, nlej 
    876                DO ji = nldi, nlei 
    877                   exfld(ji-nldi+1,jj-nldj+1)=data_array(ji,jj) 
    878                ENDDO 
    879             ENDDO 
    880  
    881 !mpi        CALL mpi_send(exfld, range(5), type, localRoot, localRank, localComm, ierror) 
    882             CALL mppsend (localRank, exfld, range(5), localRoot, request)   
    883  
    884             if ( var_id == 1 .and. ln_ctl )  then 
    885                WRITE(numout,*) ' rootexchg: This is process       ', localRank 
    886                WRITE(numout,*) ' rootexchg: We have a range of    ', range  
    887 !               WRITE(numout,*) ' rootexchg: We got SST to process ', data_array  
    888             endif 
    889  
    890          ENDIF 
    891  
    892          IF ( localRank == localRoot ) THEN 
    893  
    894             DO jj = ranges(3,localRoot), ranges(3,localRoot)+ranges(4,localRoot)-1 
    895                DO ji = ranges(1,localRoot), ranges(1,localRoot)+ranges(2,localRoot)-1 
    896                   global_array(ji,jj) = data_array(ji,jj) ! workaround 
    897                ENDDO 
    898             ENDDO 
    899  
    900             DO jn = 1, localSize-1 
    901  
    902 !mpi           CALL mpi_recv(buffer, ranges(5,jn), type, localRoot, jn, localComm, status, ierror) 
    903                CALL mpprecv(jn, buffer, ranges(5,jn)) 
    904  
    905                if ( var_id == 1 .and. ln_ctl )  then 
    906                    WRITE(numout,*) ' rootexchg: Handling data from process ', jn 
    907 !                   WRITE(numout,*) ' rootexchg: We got SST to process      ', buffer 
    908                endif 
    909  
    910  
    911                DO jj = ranges(3,jn), ranges(3,jn)+ranges(4,jn)-1 
    912                   DO ji = ranges(1,jn), ranges(1,jn)+ranges(2,jn)-1 
    913                      global_array(ji,jj) = buffer((jj-ranges(3,jn))*ranges(2,jn) + ji-ranges(1,jn)+1) 
    914                   ENDDO 
    915                ENDDO 
    916  
    917             ENDDO 
    918  
    919             CALL prism_put_proto ( var_id, date, global_array, info ) 
    920  
    921          ENDIF 
    922  
    923       ELSE 
    924  
    925          DO jj = nldj, nlej 
    926             DO ji = nldi, nlei 
    927                exfld(ji-nldi+1,jj-nldj+1)=data_array(ji,jj) 
    928             ENDDO 
    929          ENDDO 
    930  
    931          CALL prism_put_proto ( var_id, date, exfld, info ) 
    932  
    933       ENDIF 
    934  
    935 #else 
    936  
    937       ! 
    938       ! send local data from every process to OASIS3 
    939       ! 
    940       IF ( commRank ) & 
    941       CALL prism_put_proto ( var_id, date, data_array, info ) 
    942  
    943 #endif 
    944  
    945       IF ( commRank ) THEN 
    946  
    947          IF (ln_ctl .and. lwp) THEN         
    948  
    949             IF ( info == PRISM_Sent     .OR. & 
    950                  info == PRISM_ToRest   .OR. & 
    951                  info == PRISM_SentOut  .OR. & 
    952                  info == PRISM_ToRestOut       ) THEN 
    953                WRITE(numout,*) '****************' 
    954                DO ji = 1, nsend 
    955                   IF (var_id == send_id(ji) ) THEN 
    956                      WRITE(numout,*) 'prism_put_proto: Outgoing ', cpl_send(ji) 
    957                      EXIT 
    958                   ENDIF 
    959                ENDDO 
    960                WRITE(numout,*) 'prism_put_proto: var_id ', var_id 
    961                WRITE(numout,*) 'prism_put_proto:   date ', date 
    962                WRITE(numout,*) 'prism_put_proto:   info ', info 
    963                WRITE(numout,*) '     - Minimum value is ', MINVAL(data_array) 
    964                WRITE(numout,*) '     - Maximum value is ', MAXVAL(data_array) 
    965                WRITE(numout,*) '     -     Sum value is ', SUM(data_array) 
    966                WRITE(numout,*) '****************' 
    967             ENDIF 
    968  
    969          ENDIF 
    970  
    971       ENDIF 
    972  
    973    END SUBROUTINE cpl_prism_send 
    974  
    975  
    976  
    977    SUBROUTINE cpl_prism_recv( var_id, date, data_array, info ) 
    978  
    979       IMPLICIT NONE 
     214      !! 
     215      !!-------------------------------------------------------------------- 
     216      ! 
     217      ! snd data to OASIS3 
     218      ! 
     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 ) 
     221      ENDIF 
     222       
     223      IF ( ln_ctl ) THEN         
     224         IF ( kinfo == PRISM_Sent     .OR. kinfo == PRISM_ToRest .OR.   & 
     225            & kinfo == PRISM_SentOut  .OR. kinfo == PRISM_ToRestOut ) THEN 
     226            WRITE(numout,*) '****************' 
     227            WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%cname 
     228            WRITE(numout,*) 'prism_put_proto: ivarid ', ssnd(kid)%nid 
     229            WRITE(numout,*) 'prism_put_proto:  kstep ', kstep 
     230            WRITE(numout,*) 'prism_put_proto:   info ', kinfo 
     231            WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata) 
     232            WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata) 
     233            WRITE(numout,*) '     -     Sum value is ', SUM(pdata) 
     234            WRITE(numout,*) '****************' 
     235         ENDIF 
     236      ENDIF 
     237 
     238   END SUBROUTINE cpl_prism_snd 
     239 
     240 
     241   SUBROUTINE cpl_prism_rcv( kid, kstep, pdata, kinfo ) 
    980242 
    981243      !!--------------------------------------------------------------------- 
    982       !!              ***  ROUTINE cpl_prism_recv  *** 
     244      !!              ***  ROUTINE cpl_prism_rcv  *** 
    983245      !! 
    984246      !! ** Purpose : - At each coupling time-step,this routine receives fields 
    985247      !!      like stresses and fluxes from the coupler or remote application. 
    986248      !!---------------------------------------------------------------------- 
    987       !! * Arguments 
    988       !! 
    989       INTEGER, INTENT( IN )  :: var_id    ! variable Id 
    990       INTEGER, INTENT( OUT ) :: info      ! variable Id 
    991       INTEGER, INTENT( IN )  :: date      ! ocean time-step in seconds 
    992       REAL(wp),INTENT( OUT ) :: data_array(:,:) 
    993       !! 
    994       !! * Local declarations 
    995       !! 
    996 #if defined key_mpp_mpi 
    997       REAL(wp)               :: global_array(jpiglo,jpjglo) 
    998       ! 
    999 !      LOGICAL                :: action = .false. 
    1000       LOGICAL                :: action 
    1001 !mpi  INTEGER                :: status(MPI_STATUS_SIZE) 
    1002 !mpi  INTEGER                :: type       ! MPI data type 
    1003       INTEGER                :: request    ! MPI isend request 
    1004       INTEGER                :: ji, jj, jn ! local loop indices 
    1005 #else 
    1006       INTEGER                :: ji 
    1007 #endif 
    1008       !! 
    1009       !!-------------------------------------------------------------------- 
    1010       !! 
    1011 #ifdef key_mpp_mpi 
    1012       action = .false. 
    1013       request = 0 
    1014  
    1015       IF ( rootexchg ) THEN 
    1016          ! 
    1017          ! receive data from OASIS3 on local root 
    1018          ! 
    1019          IF ( commRank ) & 
    1020               CALL prism_get_proto ( var_id, date, global_array, info ) 
    1021  
    1022          CALL MPI_BCAST ( info, 1, MPI_INTEGER, localRoot, localComm, ierror ) 
    1023  
    1024       ELSE 
    1025          ! 
    1026          ! receive local data from OASIS3 on every process 
    1027          ! 
    1028          CALL prism_get_proto ( var_id, date, exfld, info ) 
    1029  
    1030       ENDIF 
    1031  
    1032       IF ( info == PRISM_Recvd        .OR. & 
    1033            info == PRISM_FromRest     .OR. & 
    1034            info == PRISM_RecvOut      .OR. & 
    1035            info == PRISM_FromRestOut ) action = .true. 
    1036  
    1037       IF (ln_ctl .and. lwp) THEN         
    1038          WRITE(numout,*) "info", info, var_id 
    1039          WRITE(numout,*) "date", date, var_id 
    1040          WRITE(numout,*) "action", action, var_id 
    1041       ENDIF 
    1042  
    1043       IF ( rootexchg .and. action ) THEN 
    1044          ! 
    1045 !mpi     IF ( wp == 4 ) type = MPI_REAL 
    1046 !mpi     IF ( wp == 8 ) type = MPI_DOUBLE_PRECISION 
    1047          ! 
    1048          ! distribute data to processes 
    1049          ! 
    1050          IF ( localRank == localRoot ) THEN 
    1051  
    1052             DO jj = ranges(3,localRoot), ranges(3,localRoot)+ranges(4,localRoot)-1 
    1053                DO ji = ranges(1,localRoot), ranges(1,localRoot)+ranges(2,localRoot)-1 
    1054                   exfld(ji-ranges(1,localRoot)+1,jj-ranges(3,localRoot)+1) = global_array(ji,jj) 
    1055                ENDDO 
    1056             ENDDO 
    1057  
    1058             DO jn = 1, localSize-1 
    1059  
    1060                DO jj = ranges(3,jn), ranges(3,jn)+ranges(4,jn)-1 
    1061                   DO ji = ranges(1,jn), ranges(1,jn)+ranges(2,jn)-1 
    1062                      buffer((jj-ranges(3,jn))*ranges(2,jn) + ji-ranges(1,jn)+1) = global_array(ji,jj) 
    1063                   ENDDO 
    1064                ENDDO 
    1065  
    1066 !mpi           CALL mpi_send(buffer, ranges(5,jn), type, jn, jn, localComm, ierror) 
    1067                CALL mppsend (jn, buffer, ranges(5,jn), jn, request)   
    1068  
    1069             ENDDO 
    1070  
    1071          ENDIF 
    1072  
    1073          IF ( localRank /= localRoot ) THEN 
    1074 !mpi         CALL mpi_recv(exfld, range(5), type, localRoot, localRank, localComm, status, ierror) 
    1075              CALL mpprecv(localRank, exfld, range(5)) 
    1076          ENDIF 
    1077  
    1078       ENDIF 
    1079  
    1080       IF ( action ) THEN 
    1081  
    1082          data_array = 0.0 
    1083  
    1084          DO jj = nldj, nlej 
    1085             DO ji = nldi, nlei 
    1086                data_array(ji,jj)=exfld(ji-nldi+1,jj-nldj+1) 
    1087             ENDDO 
    1088          ENDDO 
    1089  
    1090          IF (ln_ctl .and. lwp) THEN         
     249      INTEGER,                      INTENT( IN    )   :: kid       ! variable intex in the array 
     250      INTEGER,                      INTENT( IN    )   :: kstep     ! ocean time-step in seconds 
     251      REAL(wp), DIMENSION(jpi,jpj), INTENT( INOUT )   :: pdata     ! IN to keep the value if nothing is done 
     252      INTEGER,                      INTENT(   OUT )   :: kinfo     ! OASIS3 info argument 
     253      !! 
     254      LOGICAL                :: llaction 
     255      !!-------------------------------------------------------------------- 
     256      ! 
     257      ! receive local data from OASIS3 on every process 
     258      ! 
     259      CALL prism_get_proto ( srcv(kid)%nid, kstep, exfld, kinfo )          
     260 
     261      llaction = .false. 
     262      IF( kinfo == PRISM_Rcvd   .OR. kinfo == PRISM_FromRest .OR.   & 
     263          kinfo == PRISM_RcvOut .OR. kinfo == PRISM_FromRestOut )   llaction = .TRUE. 
     264 
     265      IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid 
     266 
     267      IF ( llaction ) THEN 
     268 
     269         IF( lk_mpp ) THEN   ;   pdata(nldi:nlei, nldj:nlej) = exfld(:,:) 
     270         ELSE                ;   pdata(    :    ,     :    ) = exfld(:,:) 
     271         ENDIF 
     272          
     273         !--- Fill the overlap areas and extra hallows (mpp) 
     274         !--- check periodicity conditions (all cases) 
     275         CALL lbc_lnk( pdata, srcv(kid)%cgrid, srcv(kid)%nsgn )    
     276          
     277         IF ( ln_ctl ) THEN         
    1091278            WRITE(numout,*) '****************' 
    1092             DO ji = 1, nrecv 
    1093                IF (var_id == recv_id(ji) ) THEN 
    1094                   WRITE(numout,*) 'prism_get_proto: Incoming ', cpl_recv(ji) 
    1095                   EXIT 
    1096                ENDIF 
    1097             ENDDO 
    1098             WRITE(numout,*) 'prism_get_proto: var_id ', var_id 
    1099             WRITE(numout,*) 'prism_get_proto:   date ', date 
    1100             WRITE(numout,*) 'prism_get_proto:   info ', info 
    1101             WRITE(numout,*) '     - Minimum value is ', MINVAL(data_array) 
    1102             WRITE(numout,*) '     - Maximum value is ', MAXVAL(data_array) 
    1103             WRITE(numout,*) '     -     Sum value is ', SUM(data_array) 
     279            WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%cname 
     280            WRITE(numout,*) 'prism_get_proto: ivarid '  , srcv(kid)%nid 
     281            WRITE(numout,*) 'prism_get_proto:   kstep', kstep 
     282            WRITE(numout,*) 'prism_get_proto:   info ', kinfo 
     283            WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata) 
     284            WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata) 
     285            WRITE(numout,*) '     -     Sum value is ', SUM(pdata) 
    1104286            WRITE(numout,*) '****************' 
    1105287         ENDIF 
    1106  
    1107       ENDIF 
    1108 #else 
    1109       CALL prism_get_proto ( var_id, date, exfld, info) 
    1110        
    1111       IF (info == PRISM_Recvd        .OR. & 
    1112           info == PRISM_FromRest     .OR. & 
    1113           info == PRISM_RecvOut      .OR. & 
    1114           info == PRISM_FromRestOut )      THEN 
    1115              data_array = exfld 
    1116  
    1117          IF (ln_ctl .and. lwp ) THEN         
    1118             WRITE(numout,*) '****************' 
    1119             DO ji = 1, nrecv 
    1120                IF (var_id == recv_id(ji) ) THEN 
    1121                   WRITE(numout,*) 'prism_get_proto: Incoming ', cpl_recv(ji) 
    1122                   EXIT 
    1123                ENDIF 
    1124             ENDDO 
    1125             WRITE(numout,*) 'prism_get_proto: var_id ', var_id 
    1126             WRITE(numout,*) 'prism_get_proto:   date ', date 
    1127             WRITE(numout,*) 'prism_get_proto:   info ', info 
    1128             WRITE(numout,*) '     - Minimum value is ', MINVAL(data_array) 
    1129             WRITE(numout,*) '     - Maximum value is ', MAXVAL(data_array) 
    1130             WRITE(numout,*) '     -     Sum value is ', SUM(data_array) 
    1131             WRITE(numout,*) '****************' 
    1132          ENDIF 
    1133  
    1134        ENDIF 
    1135 #endif 
    1136  
    1137    END SUBROUTINE cpl_prism_recv 
    1138  
     288       
     289      ENDIF 
     290 
     291   END SUBROUTINE cpl_prism_rcv 
    1139292 
    1140293 
    1141294   SUBROUTINE cpl_prism_finalize 
    1142  
    1143       IMPLICIT NONE 
    1144295 
    1145296      !!--------------------------------------------------------------------- 
    … …  
    1152303 
    1153304      DEALLOCATE(exfld) 
    1154  
    1155       if ( prism_was_initialized ) then 
    1156  
    1157          if ( prism_was_terminated ) then 
    1158             print *, 'prism has already been terminated.' 
    1159          else 
    1160             call prism_terminate_proto ( ierror ) 
    1161             prism_was_terminated = .true. 
    1162          endif 
    1163  
    1164       else 
    1165  
    1166          print *, 'Initialize prism before terminating it.' 
    1167  
    1168       endif 
    1169  
     305      CALL prism_terminate_proto ( nerror )          
    1170306 
    1171307   END SUBROUTINE cpl_prism_finalize 
    1172308 
     309#else 
     310 
     311   !!---------------------------------------------------------------------- 
     312   !!   Default case                                Forced Ocean/Atmosphere 
     313   !!---------------------------------------------------------------------- 
     314   !!   Empty module 
     315   !!---------------------------------------------------------------------- 
     316   USE in_out_manager               ! I/O manager 
     317   LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .FALSE.   !: coupled flag 
     318   PUBLIC cpl_prism_init 
     319   PUBLIC cpl_prism_finalize 
     320 
     321CONTAINS 
     322 
     323   SUBROUTINE cpl_prism_init 
     324      WRITE(numout,*) 'cpl_prism_init: Error you sould not be there...' 
     325   END SUBROUTINE cpl_prism_init 
     326 
     327   SUBROUTINE cpl_prism_finalize 
     328      WRITE(numout,*) 'cpl_prism_finalize: Error you sould not be there...' 
     329   END SUBROUTINE cpl_prism_finalize 
     330 
    1173331#endif 
    1174332 

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

    r888 r991  
    1717   IMPLICIT NONE 
    1818   PRIVATE 
    19  
     19! variables used in forced and coupled mode 
    2020#if defined key_lim3  
    2121   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   qns_ice     !: non solar heat flux over ice  [W/m2] 
    2222   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   qsr_ice     !: solar heat flux over ice      [W/m2] 
    2323   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   dqns_ice    !: non solar heat flux sensibility over ice (LW+SEN+LA) [W/m2/K] 
    24    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   tn_ice      !: ice surface temperature       [K] 
     24   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   alb_ice     !: albedo of ice 
    2525#else 
    2626   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qns_ice     !: non solar heat flux over ice  [W/m2] 
    2727   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qsr_ice     !: solar heat flux over ice      [W/m2] 
    2828   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   dqns_ice    !: non solar heat flux sensibility over ice (LW+SEN+LA) [W/m2/K] 
    29    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tn_ice      !: ice surface temperature       [K] 
     29   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   alb_ice     !: albedo of ice 
    3030#endif 
    3131 
    32    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tprecip     !: total precipitation           [Kg/m2/s] 
    33    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sprecip     !: solid precipitation           [Kg/m2/s] 
    34    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   utaui_ice   !: u-stress over ice (I-point)   [N/m2] 
    35    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   vtaui_ice   !: v-stress over ice (I-point)   [N/m2] 
    36    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fr1_i0      !: 1st fraction of sol. rad.  which penetrate inside the ice cover 
    37    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fr2_i0      !: 2nd fraction of sol. rad.  which penetrate inside the ice cover 
    38  
    39 #if ! defined key_coupled 
    40  
     32! Variables used only in forced mode 
    4133# if defined key_lim3  
    4234   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   qla_ice   !: latent flux over ice 
    … …  
    4739# endif 
    4840 
     41! Variables used only in coupled mode 
     42#if defined key_lim3  
     43   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   tn_ice      !: ice surface temperature       [K] 
     44   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   tckice      !: ice thickness 
     45   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   tcksnw      !: oce thickness 
    4946#else 
     47   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tn_ice      !: ice surface temperature       [K] 
     48   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tckice      !: ice thickness 
     49   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tcksnw      !: oce thickness 
     50#endif 
     51   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   freeze      !: ice fraction 
     52   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tprecip     !: total precipitation for ice   [Kg/m2/s] 
     53   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sprecip     !: solid precipitation ( - sublimation in coupled mode )          [Kg/m2/s] 
     54   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   utaui_ice   !: u-stress over ice (I-point)   [N/m2] 
     55   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   vtaui_ice   !: v-stress over ice (I-point)   [N/m2] 
     56   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fr1_i0      !: 1st fraction of sol. rad.  which penetrate inside the ice cover 
     57   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fr2_i0      !: 2nd fraction of sol. rad.  which penetrate inside the ice cover 
    5058 
    51 # if defined key_lim3  
    52    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   alb_ice   !: albedo of ice 
    53 # else 
    54    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   alb_ice       !: albedo of ice 
    55 # endif 
    56    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rrunoff       !: runoff 
    57    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   calving       !: calving 
    58  
    59 #endif 
     59   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rnfcpl       !: runoff 
     60   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ocalving     !: calving into the ocean 
    6061 
    6162#else 

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

    r990 r991  
    212212      !!      fields read in sbc_read 
    213213      !!  
    214       !! ** Outputs : - utau    : i-component of the stress at U-point  (N/m2) 
    215       !!              - vtau    : j-component of the stress at V-point  (N/m2) 
    216       !!              - qsr     : Solar heat flux over the ocean        (W/m2) 
    217       !!              - qns     : Non Solar heat flux over the ocean    (W/m2) 
    218       !!              - evap    : Evaporation over the ocean            (kg/m2/s) 
    219       !!              - tprecip : Total precipitation                   (Kg/m2/s) 
    220       !!              - sprecip : Solid precipitation                   (Kg/m2/s) 
     214      !! ** Action  :   defined at each time-step at the air-sea interface 
     215      !!              - utau  &  vtau   : stress components in geographical ref. 
     216      !!              - qns   &  qsr    : non solar and solar heat fluxes 
     217      !!              - emp             : evap - precip (volume flux) 
     218      !!              - emps            : evap - precip (concentration/dillution) 
    221219      !!--------------------------------------------------------------------- 
    222220      REAL(wp), INTENT(in), DIMENSION(jpi,jpj) ::   pst   ! surface temperature                      [Celcius] 

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

    r888 r991  
    88   !!            9.0   !  06-07  (G. Madec)  surface module 
    99   !!---------------------------------------------------------------------- 
    10 #if defined key_sbc_cpl 
    11    !!---------------------------------------------------------------------- 
    12    !!   'key_sbc_cpl'                   Coupled Ocean/Atmosphere formulation 
     10#if defined key_oasis3 || defined key_oasis4 
     11   !!---------------------------------------------------------------------- 
     12   !!   'key_oasis3' or 'key_oasis4'   Coupled Ocean/Atmosphere formulation 
    1313   !!---------------------------------------------------------------------- 
    1414   !!---------------------------------------------------------------------- 
    … …  
    1616   !!   sbc_cpl      : coupled formulation for the ocean surface boundary condition 
    1717   !!---------------------------------------------------------------------- 
    18    USE oce             ! ocean dynamics and tracers 
     18 
    1919   USE dom_oce         ! ocean space and time domain 
    20    USE phycst          ! physical constants 
     20   USE sbc_oce         ! Surface boundary condition: ocean fields 
     21   USE sbc_ice         ! Surface boundary condition: ice fields 
     22#if defined key_lim3 
     23   USE par_ice          ! ice parameters 
     24#endif 
     25   USE cpl_oasis3      ! OASIS3 coupling (to ECHAM5) 
     26   USE geo2ocean 
     27   USE restart 
    2128   USE in_out_manager  ! I/O manager 
     29   USE iom             ! NetCDF library 
    2230   USE lib_mpp         ! distribued memory computing library 
    2331   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    24    USE daymod          ! calendar 
    25  
    26    USE cpl_oasis3      ! OASIS3 coupling (to ECHAM5) 
    27    USE cpl_oasis4      ! OASIS4 coupling (to ECHAM5) 
    28    USE geo2ocean, ONLY : repere, repcmo 
    29    USE ice_2, only     : frld       ! : leads fraction = 1-a/totalarea 
    30  
    31    USE sbc_oce         ! Surface boundary condition: ocean fields 
    32  
    33    USE iom             ! NetCDF library 
    3432 
    3533   IMPLICIT NONE 
    3634   PRIVATE 
    3735 
    38    PUBLIC   sbc_cpl       ! routine called by step.F90 
    39  
    40    LOGICAL, PUBLIC ::   lk_sbc_cpl = .TRUE.   !: coupled formulation flag 
    41  
    42    INTEGER , PARAMETER                 ::   jpfld   = 5    ! maximum number of files to read  
    43    INTEGER , PARAMETER                 ::   jp_taux = 1    ! index of wind stress (i-component) file 
    44    INTEGER , PARAMETER                 ::   jp_tauy = 2    ! index of wind stress (j-component) file 
    45    INTEGER , PARAMETER                 ::   jp_qtot = 3    ! index of total (non solar+solar) heat file 
    46    INTEGER , PARAMETER                 ::   jp_qsr  = 4    ! index of solar heat file 
    47    INTEGER , PARAMETER                 ::   jp_emp  = 5    ! index of evaporation-precipation file 
     36   PUBLIC   sbc_cpl_snd       ! routine called by step.F90 
    4837    
    49 !!wonsun          
    50    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   & 
    51       taux, tauy       &  !: surface stress components in (i,j) referential 
    52  
    53  
    54    USE sbc_ice, only : dqns_ice , & ! : derivative of non solar heat flux on sea ice 
    55                        qsr_ice  , & ! : solar flux over ice 
    56                        qns_ice  , & ! : total non solar heat flux (Longwave downward radiation) over ice 
    57                        tn_ice   , & ! : ice surface temperature 
    58                        alb_ice  , & ! : albedo of ice 
    59                        sprecip  , & ! : solid (snow) precipitation over water (!) what about ice? 
    60                        tprecip  , & ! : total precipitation ( or liquid precip minus evaporation in coupled mode) 
    61                        calving  , & ! : calving 
    62                        rrunoff  , & ! : monthly runoff (kg/m2/s) 
    63                        fr1_i0   , & ! : 1st part of the fraction of sol.rad. which penetrate inside the ice cover 
    64                        fr2_i0       ! : 2nd part of the fraction of sol.rad. which penetrate inside the ice cover 
    65  
    66    USE ice_2, only  : hicif ,     & ! : ice thickness 
    67                       frld  ,     & ! : leads fraction = 1-a/totalarea 
    68                       hsnif  ,    & ! : snow thickness 
    69                       u_ice , v_ice ! : ice velocity 
    70  
    71    USE sbc_oce, only : sst_m        ! : sea surface temperature 
    72  
    73    REAL(wp), PUBLIC ::            & !!! surface fluxes namelist (namflx) 
    74       q0    = 0.e0,               &  ! net heat flux 
    75       qsr0  = 0.e0,               &  ! solar heat flux 
    76       emp0  = 0.e0,               &  ! net freshwater flux 
    77       dqdt0 = -40.,               &  ! coefficient for SST damping (W/m2/K) 
    78       deds0 = 27.7                   ! coefficient for SSS damping (mm/day) 
     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 
    7944    
    80     REAL(wp), DIMENSION(jpi,jpj) ::   qsr_oce_recv , qsr_ice_recv  
    81     REAL(wp), DIMENSION(jpi,jpj) ::   qns_oce_recv, qns_ice_recv 
    82     REAL(wp), DIMENSION(jpi,jpj) ::   dqns_ice_recv 
    83     REAL(wp), DIMENSION(jpi,jpj) ::   tprecip_recv , precip_recv 
    84     REAL(wp), DIMENSION(jpi,jpj) ::   fr1_i0_recv  , fr2_i0_recv      
    85     REAL(wp), DIMENSION(jpi,jpj) ::   rrunoff_recv , calving_recv    
    86 #if defined key_cpl_ocevel 
    87     REAL(wp), DIMENSION(jpi,jpj) :: un_weighted, vn_weighted 
    88     REAL(wp), DIMENSION(jpi,jpj) :: un_send    , vn_send  
    89 #endif 
    90     REAL(wp), DIMENSION(jpi,jpj) :: zrunriv   ! river discharge into ocean 
    91     REAL(wp), DIMENSION(jpi,jpj) :: zruncot   ! continental discharge into ocean 
    92  
    93     REAL(wp), DIMENSION(jpi,jpj) :: zpew      ! P-E over water 
    94     REAL(wp), DIMENSION(jpi,jpj) :: zpei      ! P-E over ice 
    95     REAL(wp), DIMENSION(jpi,jpj) :: zpsol     ! surface downward snow fall 
    96     REAL(wp), DIMENSION(jpi,jpj) :: zevice    ! surface upward snow flux where sea ice 
    97 !!wonsun          
    98  
    99    !! * Substitutions 
    100 #  include "domzgr_substitute.h90" 
     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 
     57 
    10158   !!---------------------------------------------------------------------- 
    10259   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
    … …  
    10764CONTAINS 
    10865 
    109    SUBROUTINE sbc_cpl( kt ) 
     66   SUBROUTINE sbc_cpl_init 
     67  
     68      NAMELIST/namsbc_cpl_rcv/ ... 
     69 
     70 
    11071      !!--------------------------------------------------------------------- 
    111       !!                    ***  ROUTINE sbc_cpl  *** 
    112       !!                    
    113       !! ** Purpose :   provide at each time step the surface ocean fluxes 
    114       !!                (momentum, heat, freshwater and runoff) in coupled mode 
    115       !! 
    116       !! ** Method  : - Recieve from a Atmospheric model via OASIS coupler : 
    117       !!                   i-component of the stress              taux  (N/m2) 
    118       !!                   j-component of the stress              tauy  (N/m2) 
    119       !!                   net downward heat flux                 qtot  (watt/m2) 
    120       !!                   net downward radiative flux            qsr   (watt/m2) 
    121       !!                   net upward freshwater (evapo - precip) emp   (kg/m2/s) 
    122       !!              - send to the Atmospheric model via OASIS coupler : 
    123       !! 
    124       !! ** Action  :   update at each time-step the two components of the  
    125       !!                surface stress in both (i,j) and geographical ref. 
    126       !! 
    127       !! 
    128       !!      CAUTION :  - never mask the surface stress fields 
    129       !! 
    130       !! ** Action  :   update at each time-step 
    131       !!              - taux  & tauy    : stress components in (i,j) referential 
    132       !!              - qns             : non solar heat flux 
    133       !!              - qsr             : solar heat flux 
    134       !!              - emp             : evap - precip (volume flux) 
    135       !!              - emps            : evap - precip (concentration/dillution) 
    136       !! 
    137       !! References : The OASIS User Guide, Version 3.0 and 4.0 
     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) 
     86 
     87 
     88!!$   Probleme: definir comment on initialise freeze, alb_ice et tn_ice  
     89!!$             quand on n'a pas de restart (a nit000) 
     90 
     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 ) 
     94!!!!! 
     95!!!!! +++ ERIC tu utilises tn_ice dans le calcule de Qns, c'est bien ca??? 
     96!!!!! 
     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 
     207         CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of cn_rcv_stress(4)' ) 
     208         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 
     243!!$      catm(:,:) = 0. 
     244!!$      zcatm1(:,:) = 1.0 - catm(:,:)  !  fractional cloud cover 
     245!!$      fr1_i0(:,:) = 0.18 * zcatm1(:,:) + 0.35 * catm(:,:)  
     246!!$      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 
     261          
     262         !------------------------------------- 
     263         ! Ice fraction 
     264         nsnd = nsnd + 1   ;   jpsnd_fice = nsnd   ;   ssnd(nsnd)%cname = 'OIceFrac' 
     265         ssnd(jpsnd_fice)%laction = .TRUE. 
     266          
     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 
     287          
     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         ! 
     317 
     318   END SUBROUTINE sbc_cpl_init 
     319 
     320 
     321 
     322   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(:,:)) ) 
     340         qsr_ice(:,:) = ztmp(:,:) * (1. - alb_ice(:,:)) 
     341         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' ) 
     355!!!!! 
     356!!!!! +++ ERIC il faut que tu mettes les bonnes formules... 
     357!!!!! 
     358!!$         qns_ice(:,:) = ... 
     359!!$         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' ) 
     376         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' ) 
     382         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  
     404         ! wind stress over ocean 
     405         SELECT CASE (srcv(jprcv_otx1)%cgrid)  
     406         CASE( 'T' )  
     407            CALL geo2oce ( zotx1, zoty1, zotz1, 'T', glamt, gphit, ztmpx1, ztmpy1 ) ! 1st and 2nd components on the same grid 
     408         CASE( 'F' ) 
     409            CALL geo2oce ( zotx1, zoty1, zotz1, 'F', glamf, gphif, ztmpx1, ztmpy1 ) ! 1st and 2nd components on the same grid 
     410         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 
     415         END SELECT 
     416         zotx1(:,:) = ztmpx1(:,:)   ! overwrite 1st component on the 1st grid 
     417         zoty1(:,:) = ztmpy1(:,:)   ! overwrite 2nd component on the 1st grid 
     418         ! wind stress over ice 
     419         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 
     433         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 
     439         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 
     443         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 
     446         ENDIF 
     447         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 
     457         ENDIF 
     458      ENDIF 
     459 
     460      ! oce stress must be on U,V grids 
     461      IF ( srcv(jprcv_otx1)%cgrid == 'T' ) THEN 
     462         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 
     467         END DO 
     468         CALL lbc_lnk( utau, 'U',  -1. )   ;   CALL lbc_lnk( vtau, 'V',  -1. ) 
     469      ELSE 
     470         utau(:,:) = zotx1(:,:) 
     471         vtau(:,:) = zoty2(:,:) 
     472      ENDIF 
     473 
     474      ! make sure we have stress over ice 
     475      IF ( TRIM(cn_rcv_stress(1)) /= 'oce and ice' ) THEN  
     476         zitx1(:,:) = zotx1(:,:)                                                ! 1st component on the 1st grid 
     477         IF ( srcv(jprcv_otx2)%laction ) THEN   ;   zity2(:,:) = zoty2(:,:)   ! 2nd component on the 2nd grid 
     478         ELSE                                     ;   zity1(:,:) = zoty1(:,:)   ! 2nd component on the 1st grid 
     479         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' ) 
     486         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 
     491         END DO 
     492         CALL lbc_lnk( utaui_ice, 'I',  -1. )   ;   CALL lbc_lnk( vtaui_ice, 'I',  -1. ) 
     493      CASE( 'F' ) 
     494         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 
     499         END DO 
     500         CALL lbc_lnk( utaui_ice, 'I',  -1. )   ;   CALL lbc_lnk( vtaui_ice, 'I',  -1. ) 
     501      CASE( 'T' ) 
     502         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 
     507         END DO 
     508         CALL lbc_lnk( utaui_ice, 'I',  -1. )   ;   CALL lbc_lnk( vtaui_ice, 'I',  -1. ) 
     509      CASE( 'I' ) 
     510         utaui_ice(:,:) = zitx1(:,:) 
     511         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 
     538   END SUBROUTINE sbc_cpl_rcv 
     539    
     540   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  
     564!!!!! +++ ERIC   ztmp(:,:) = albedo de l'ocean a definir... 
     565         CALL cpl_prism_snd( jpsnd_albmix, isec, ztmp(:,:) * (1. - freeze(:,:)) + alb_ice(:,:) * freeze(:,:), info ) 
     566      ENDIF 
     567       
     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 
     574       
     575      !------------------------------------- 
     576      ! Surface current 
     577 
     578      +++ seb ecriture des restarts... 
     579 
     580 
     581   END SUBROUTINE sbc_cpl_snd 
     582    
     583 
     584 
     585 
     586 
     587#else 
    138588      !!---------------------------------------------------------------------- 
    139       INTEGER, INTENT(in) ::   kt   ! ocean time step 
    140       !! 
    141       INTEGER  ::   ji, jj      ! dummy loop indices 
    142 #if defined key_cpl_ocevel 
    143       INTEGER  ::   ikchoix  
     589      !!   Dummy routine                              NO coupling 
     590      !!---------------------------------------------------------------------- 
     591 
     592+++ a verifier ... 
     593 
     594 
    144595#endif 
    145       INTEGER  ::   var_id, info 
    146       INTEGER  ::   date          !????  !!gm bug  this is a real !!! 
    147       REAL(wp) ::   zfacflx, zfacwat, zfact 
    148  
    149       REAL(wp), DIMENSION(jpi,jpj) ::   ztaueuw, ztauevw   ! eastward  wind stress over water at U and V-points 
    150       REAL(wp), DIMENSION(jpi,jpj) ::   ztaunuw, ztaunvw   ! northward wind stress over water at U and V-points 
    151       REAL(wp), DIMENSION(jpi,jpj) ::   ztaueui, ztauevi   ! eastward  wind stress over ice   at U and V-points 
    152       REAL(wp), DIMENSION(jpi,jpj) ::   ztaunui, ztaunvi   ! northward wind stress over ice   at U and V-points 
    153       REAL(wp), DIMENSION(jpi,jpj) ::   ztaueu , ztauev    ! eastward wind stress combined 
    154       REAL(wp), DIMENSION(jpi,jpj) ::   ztaunu , ztaunv    ! northward wind stress combined  
    155       !!--------------------------------------------------------------------- 
    156  
    157       date = ( kt - nit000 ) * rdttra(1)        ! date of exxhanges 
    158       !                                         ! Conversion factor (ocean units are W/m2 and Kg/m2/s] 
    159       zfacflx = 1.e0  ! no conversion    [W/m2]         ! W/m2 heat fluxes are send by the Atmosphere  
    160       zfacwat = 1.e3  ! convert [m/s] to [kg/m2/s]      ! m/s freshwater fluxes are send by the atmosphere 
    161  
    162  
    163       !                                         ! =========================== ! 
    164       !                                         !     Send Coupling fields    ! 
    165       !                                         ! =========================== ! 
    166       !  
    167 !!gm bug ?  here send instantaneous SST, not mean over the coupling period.... 
    168       var_id = send_id(1)   ;   CALL cpl_prism_send( var_id, date, tn(:,:,1)+rt0, info )   ! ocean surface temperature [K] 
    169       var_id = send_id(2)   ;   CALL cpl_prism_send( var_id, date, 1.0-frld     , info )   ! fraction of ice-cover 
    170 #if defined key_cpl_albedo 
    171       DO jj = 1, jpj 
    172          DO ji = 1, jpi 
    173             IF( ( tn_ice(ji,jj) < 50 .OR. tn_ice(ji,jj) > 400 ) .AND. frld(ji,jj) < 1. ) THEN 
    174               WRITE(numout,*) ' tn_ice, ERROR ', ji, jj, ' = ', tn_ice(ji,jj),   & 
    175                  &            ' qns_ice_recv=', qns_ice_recv(ji,jj), ' dqns_ice_recv=', dqns_ice_recv(ji,jj) 
    176             ENDIF 
    177          END DO 
    178       END DO 
    179       var_id = send_id(3)   ;   CALL cpl_prism_send( var_id, date, tn_ice      , info )    ! ice surface temperature [K]   
    180       var_id = send_id(4)   ;   CALL cpl_prism_send( var_id, date, alb_ice     , info )    ! ice albedo [%] 
    181 #else 
    182       var_id = send_id(3)   ;   CALL cpl_prism_send( var_id, date, hicif       , info )    ! ice  thickness [m] 
    183       var_id = send_id(4)   ;   CALL cpl_prism_send( var_id, date, hsnif       , info )    ! snow thickness [m] 
    184 #endif 
    185 #if defined key_cpl_ocevel 
    186 !!gm bug???  I have to check the grid point position... 
    187 !!           a priori there is a error here as un, vn are not at the same grid point.... 
    188 !!           there should be a averaged to set u and v at T-point.... with caution for sea-ice velocity at I-point.... 
    189       un_weighted = un(:,:,1) * frld + u_ice * ( 1. - frld ) 
    190       vn_weighted = vn(:,:,1) * frld + v_ice * ( 1. - frld ) 
    191       ikchoix = - 1         ! converte from (i,j) to geographic referential 
    192       CALL repere( un_weighted, vn_weighted, un_send, vn_send, ikchoix ) 
    193 !!gm bug : at lbc_lnk is to be added on un_send and vn_send   
    194       var_id = send_id(5)   ;   CALL cpl_prism_send( var_id, date, un_send    , info )        ! surface current [m/s] 
    195       var_id = send_id(6)   ;   CALL cpl_prism_send( var_id, date, vn_send    , info )        ! surface current [m/s] 
    196 #endif 
    197  
    198       !                                         ! =========================== ! 
    199       !                                         !   Recieve Momentum fluxes   ! 
    200       !                                         ! =========================== ! 
    201       !  
    202       ! ... Receive wind stress fields in geographic component over water and ice 
    203       var_id = recv_id(1)   ;   CALL cpl_prism_recv( var_id, date, ztaueuw, info )           ! ??? 
    204       var_id = recv_id(2)   ;   CALL cpl_prism_recv( var_id, date, ztaunuw, info ) 
    205       var_id = recv_id(3)   ;   CALL cpl_prism_recv( var_id, date, ztaueui, info ) 
    206       var_id = recv_id(4)   ;   CALL cpl_prism_recv( var_id, date, ztaunui, info ) 
    207       var_id = recv_id(5)   ;   CALL cpl_prism_recv( var_id, date, ztauevw, info ) 
    208       var_id = recv_id(6)   ;   CALL cpl_prism_recv( var_id, date, ztaunvw, info ) 
    209       var_id = recv_id(7)   ;   CALL cpl_prism_recv( var_id, date, ztauevi, info ) 
    210       var_id = recv_id(8)   ;   CALL cpl_prism_recv( var_id, date, ztaunvi, info ) 
    211       ! 
    212 !!gm bug : keep separate ice and ocean stress ! 
    213       ! ... combine water / ice stresses 
    214       ztaueu(:,:) = ztaueuw(:,:) * frld(:,:) + ztaueui(:,:) * ( 1.0 - frld(:,:) ) 
    215       ztaunu(:,:) = ztaunuw(:,:) * frld(:,:) + ztaunui(:,:) * ( 1.0 - frld(:,:) ) 
    216       ztauev(:,:) = ztauevw(:,:) * frld(:,:) + ztauevi(:,:) * ( 1.0 - frld(:,:) ) 
    217       ztaunv(:,:) = ztaunvw(:,:) * frld(:,:) + ztaunvi(:,:) * ( 1.0 - frld(:,:) ) 
    218       ! 
    219       ! ... rotate vector components from geographic to (i,j) referential 
    220       CALL repcmo ( ztaueu, ztaunu, ztauev, ztaunv, utau, vtau, kt ) 
    221       ! 
    222 !!gm bug??  not sure but put that for security 
    223       CALL lbc_lnk( utau , 'U', -1. ) 
    224       CALL lbc_lnk( vtau , 'V', -1. ) 
    225 !!gm end bug?? 
    226       ! 
    227       !                                         ! =========================== ! 
    228       !                                         !     Recieve heat fluxes     ! 
    229       !                                         ! =========================== ! 
    230       ! 
    231       var_id = recv_id(13)   ;   CALL cpl_prism_recv( var_id, date, qsr_oce_recv , info )   ! ocean surface net downward shortwave flux 
    232       var_id = recv_id(14)   ;   CALL cpl_prism_recv( var_id, date, qns_oce_recv , info )   ! ocean surface downward non-solar heat flux 
    233       var_id = recv_id(15)   ;   CALL cpl_prism_recv( var_id, date, qsr_ice_recv , info )   ! ice solar heat flux 
    234       var_id = recv_id(16)   ;   CALL cpl_prism_recv( var_id, date, qns_ice_recv , info )   ! ice non-solar heat flux 
    235       var_id = recv_id(17)   ;   CALL cpl_prism_recv( var_id, date, dqns_ice_recv, info )   ! ice non-solar heat flux sensitivity 
    236  
    237       qsr_oce_recv (:,:) = qsr_oce_recv (:,:) * tmask(:,:,1) * zfacflx 
    238       qns_oce_recv (:,:) = qns_oce_recv (:,:) * tmask(:,:,1) * zfacflx 
    239       qsr_ice_recv (:,:) = qsr_ice_recv (:,:) * tmask(:,:,1) * zfacflx 
    240       qns_ice_recv (:,:) = qns_ice_recv (:,:) * tmask(:,:,1) * zfacflx 
    241       dqns_ice_recv(:,:) = dqns_ice_recv(:,:) * tmask(:,:,1) * zfacflx 
    242  
    243       IF( kt == nit000 ) THEN                   ! set once for all qsr penetration in sea-ice 
    244          !                                      ! Since cloud cover catm not transmitted from atmosphere, it is set to 0.  
    245          !                                      ! i.e. constant penetration fractions of 0.18 and 0.82 
    246          !  fraction of net shortwave radiation which is not absorbed in the thin surface layer and penetrates 
    247          !  inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 
    248          fr1_i0_recv(:,:) = 0.18  
    249          fr2_i0_recv(:,:) = 0.82 
    250       ENDIF 
    251       ! 
    252       !                                         ! =========================== ! 
    253       !                                         !  Recieve freshwater fluxes  ! 
    254       !                                         ! =========================== ! 
    255       ! 
    256       var_id = recv_id( 9)   ;   CALL cpl_prism_recv( var_id, date, zpew  , info )      ! P-E over water 
    257       var_id = recv_id(10)   ;   CALL cpl_prism_recv( var_id, date, zpei  , info )      ! P-E over ice 
    258       var_id = recv_id(11)   ;   CALL cpl_prism_recv( var_id, date, zpsol , info )      ! Snow fall over water and ice 
    259       var_id = recv_id(12)   ;   CALL cpl_prism_recv( var_id, date, zevice, info )      ! Evaporation over ice (sublimination) 
    260       ! 
    261       ! ... calculate water flux (P-E over open ocean and ice) and solid precipitation  (positive upward) 
    262       tprecip_recv(:,:) = ( zpew (:,:) + zpei  (:,:) ) * tmask(:,:,1) * zfacwat 
    263       sprecip_recv(:,:) = ( zpsol(:,:) + zevice(:,:) ) * tmask(:,:,1) * zfacwat 
    264        
    265       ! ... Control print & check 
    266       IF(ln_ctl) THEN 
    267          WRITE(numout,*) ' flx:tprecip_recv    - Minimum value is ', MINVAL( tprecip_recv ) 
    268          WRITE(numout,*) ' flx:tprecip_recv    - Maximum value is ', MAXVAL( tprecip_recv ) 
    269          WRITE(numout,*) ' flx:tprecip_recv    -     Sum value is ', SUM   ( tprecip_recv ) 
    270       ENDIF 
    271 !!gm bug in mpp SUM require a mmp_sum call 
    272 !!gm further more this test is quite expensive ...  only needed at the first time-step??? 
    273       IF( SUM( zpew*e1t*e2t ) /= SUM( zpew*e1t*e2t*tmask(:,:,1) ) ) THEN 
    274          WRITE(numout,*) ' flx: Forcing values outside Orca mask' 
    275          WRITE(numout,*) ' flx: Losses in water conservation' 
    276          WRITE(numout,*) ' flx:   Masked ', SUM(zpew*e1t*e2t*tmask(:,:,1)) 
    277          WRITE(numout,*) ' flx: Unmasked ', SUM(zpew*e1t*e2t) 
    278          WRITE(numout,*) ' flx: Simulation STOP' 
    279          CALL FLUSH(numout) 
    280          STOP 
    281       END IF 
    282       ! 
    283 #if defined key_cpl_discharge 
    284       ! Runoffs 
    285       var_id = recv_id(18)   ;   CALL cpl_prism_recv ( var_id, date, calving_recv, info )   ! ice discharge into ocean 
    286       var_id = recv_id(19)   ;   CALL cpl_prism_recv ( var_id, date, zrunriv     , info )   ! river discharge into ocean 
    287       var_id = recv_id(20)   ;   CALL cpl_prism_recv ( var_id, date, zruncot     , info )   ! continental discharge into ocean 
    288  
    289       DO jj = 1, jpj 
    290          DO ji = 1, jpi 
    291             zfact = zfacwat * tmask(ji,jj,1)  
    292             calving_recv(ji,jj) =               calving_recv(ji,jj)   * zfact 
    293             rrunoff_recv(ji,jj) = ( zrunriv(ji,jj) + zruncot(ji,jj) ) * zfact 
    294          END DO 
    295       END DO 
    296 #else 
    297       calving_recv(:,:) = 0. 
    298       rrunoff_recv(:,:) = 0. 
    299 #endif 
    300  
    301 !!gm  bug  :  this is not valid in mpp 
    302 !!gm          and I presum this is not required at all as a lbc_lnk is applied to all the fields at the end of the routine 
    303       ! Oasis mask shift and update lateral boundary conditions (E. Maisonnave) 
    304       ! not tested when mpp is used, W. Park 
    305 !WSPTEST 
    306       qsr_oce_recv (jpi-1,:) = qsr_oce_recv (1,:) 
    307       qsr_ice_recv (jpi-1,:) = qsr_ice_recv (1,:) 
    308       qns_oce_recv (jpi-1,:) = qns_oce_recv (1,:) 
    309       qns_ice_recv (jpi-1,:) = qns_ice_recv (1,:) 
    310       dqns_ice_recv(jpi-1,:) = dqns_ice_recv(1,:) 
    311       tprecip_recv (jpi-1,:) = tprecip_recv (1,:) 
    312       sprecip_recv (jpi-1,:) = sprecip_recv (1,:) 
    313       fr1_i0_recv  (jpi-1,:) = fr1_i0_recv  (1,:) 
    314       fr2_i0_recv  (jpi-1,:) = fr2_i0_recv  (1,:) 
    315       rrunoff_recv (jpi-1,:) = rrunoff_recv (1,:) 
    316       calving_recv (jpi-1,:) = calving_recv (1,:) 
    317 !!gm end bug 
    318  
    319       qsr     (:,:) = qsr_oce_recv (:,:)      ! ocean surface boundary condition 
    320       qns     (:,:) = qns_oce_recv (:,:) 
    321       emp     (:,:) = zpew         (:,:) 
    322       emps    (:,:) = zpew         (:,:) 
    323        
    324       qsr_ice (:,:) = qsr_ice_recv (:,:)      ! ice forcing fields 
    325       qns_ice (:,:) = qns_ice_recv (:,:) 
    326       dqns_ice(:,:) = dqns_ice_recv(:,:) 
    327       tprecip (:,:) = tprecip_recv (:,:) 
    328       sprecip (:,:) = sprecip_recv (:,:) 
    329       fr1_i0  (:,:) = fr1_i0_recv  (:,:) 
    330       fr2_i0  (:,:) = fr2_i0_recv  (:,:) 
    331        
    332 !WSP    rrunoff = rrunoff_recv  
    333 !WSP    calving = calving_recv 
    334       rrunoff (:,:) = 0.e0   !WSP runoff and calving included in tprecip 
    335       calving (:,:) = 0.e0   !WSP 
    336   
    337       IF(ln_ctl) THEN 
    338          WRITE(numout,*) 'flx:qsr_oce     - Minimum value is ', MINVAL( qsr_oce ) 
    339          WRITE(numout,*) 'flx:qsr_oce     - Maximum value is ', MAXVAL( qsr_oce ) 
    340          WRITE(numout,*) 'flx:qsr_oce     -     Sum value is ', SUM   ( qsr_oce ) 
    341          ! 
    342          WRITE(numout,*) 'flx:tprecip     - Minimum value is ', MINVAL( tprecip ) 
    343          WRITE(numout,*) 'flx:tprecip     - Maximum value is ', MAXVAL( tprecip ) 
    344          WRITE(numout,*) 'flx:tprecip     -     Sum value is ', SUM   ( tprecip ) 
    345       ENDIF 
    346  
    347       CALL lbc_lnk( qsr_oce , 'T', 1. ) 
    348       CALL lbc_lnk( qsr_ice , 'T', 1. ) 
    349       CALL lbc_lnk( qns_oce , 'T', 1. ) 
    350       CALL lbc_lnk( qns_ice , 'T', 1. ) 
    351       CALL lbc_lnk( tprecip , 'T', 1. ) 
    352       CALL lbc_lnk( sprecip , 'T', 1. ) 
    353       CALL lbc_lnk( rrunoff , 'T', 1. ) 
    354       CALL lbc_lnk( dqns_ice, 'T', 1. ) 
    355       CALL lbc_lnk( calving , 'T', 1. ) 
    356       CALL lbc_lnk( fr1_i0  , 'T', 1. ) 
    357       CALL lbc_lnk( fr2_i0  , 'T', 1. ) 
    358  
    359       IF(ln_ctl) THEN 
    360          WRITE(numout,*) 'flx(af lbc_lnk):qsr_oce     - Minimum value is ', MINVAL( qsr_oce ) 
    361          WRITE(numout,*) 'flx(af lbc_lnk):qsr_oce     - Maximum value is ', MAXVAL( qsr_oce ) 
    362          WRITE(numout,*) 'flx(af lbc_lnk):qsr_oce     -     Sum value is ', SUM   ( qsr_oce ) 
    363          ! 
    364          WRITE(numout,*) 'flx(af lbc_lnk):tprecip     - Minimum value is ', MINVAL( tprecip ) 
    365          WRITE(numout,*) 'flx(af lbc_lnk):tprecip     - Maximum value is ', MAXVAL( tprecip ) 
    366          WRITE(numout,*) 'flx(af lbc_lnk):tprecip     -     Sum value is ', SUM   ( tprecip ) 
    367       ENDIF 
    368       ! 
    369    END SUBROUTINE sbc_cpl 
    370  
    371 #else 
    372    !!---------------------------------------------------------------------- 
    373    !!   Dummy routine                              NO sea surface restoring 
    374    !!---------------------------------------------------------------------- 
    375    LOGICAL, PUBLIC ::   lk_sbc_cpl = .FALSE.   !: coupled formulation flag 
    376 CONTAINS 
    377    SUBROUTINE sbc_cpl( kt )         ! Dummy routine 
    378       WRITE(*,*) 'sbc_cpl: you should not have seen that print! error?', kt 
    379    END SUBROUTINE sbc_cpl 
    380 #endif 
    381  
    382    !!====================================================================== 
    383 END MODULE sbccpl 
     596 
     597      !!====================================================================== 
     598   END MODULE sbccpl 

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

    r990 r991  
    1212   !!   'key_lim2' :                                  LIM 2.0 sea-ice model 
    1313   !!---------------------------------------------------------------------- 
     14   !!---------------------------------------------------------------------- 
    1415   !!   sbc_ice_lim_2  : sea-ice model time-stepping and 
    1516   !!                    update ocean sbc over ice-covered area 
    1617   !!---------------------------------------------------------------------- 
    1718   USE oce             ! ocean dynamics and tracers 
    18    USE c1d             ! 1d configuration 
    1919   USE dom_oce         ! ocean space and time domain 
    2020   USE ice_2 
    … …  
    4646   USE in_out_manager  ! I/O manager 
    4747   USE prtctl          ! Print control 
    48    USE ocfzpt          ! ocean freezing point 
    4948 
    5049   IMPLICIT NONE 
    … …  
    5958#  include "vectopt_loop_substitute.h90" 
    6059   !!---------------------------------------------------------------------- 
    61    !! NEMO/SBC  3.0 , LOCEAN-IPSL (2008)  
    62    !! $Id: $ 
     60   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
     61   !! $ Id: $ 
    6362   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    6463   !!---------------------------------------------------------------------- 
    … …  
    9089      !! 
    9190      INTEGER  ::   ji, jj   ! dummy loop indices 
    92       REAL(wp) ::   zinda     
    9391      REAL(wp), DIMENSION(jpi,jpj,1) ::   alb_ice_os   ! albedo of the ice under overcast sky 
    9492      REAL(wp), DIMENSION(jpi,jpj,1) ::   alb_ice_cs   ! albedo of ice under clear sky 
    … …  
    126124 
    127125         ! ... masked sea surface freezing temperature [Kelvin] (set to rt0 over land) 
    128          tfu(:,:) = tfreez( sss_m ) +  rt0  
    129  
    130          zsist (:,:,1) = sist (:,:) 
    131          zhicif(:,:,1) = hicif(:,:)   ;   zhsnif(:,:,1) = hsnif(:,:) 
     126         tfu(:,:) = tfreez( sss_m ) + rt0  
     127 
    132128 
    133129         ! ... ice albedo 
    134          CALL albedo_ice( zsist, zhicif, zhsnif, alb_ice_cs, alb_ice_os ) 
    135  
     130          
     131         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... 
     135 
     136            zsist (:,:,1) = sist (:,:) 
     137            zhicif(:,:,1) = hicif(:,:)   ;   zhsnif(:,:,1) = hsnif(:,:) 
     138            CALL albedo_ice( zsist, zhicif, zhsnif, alb_ice_cs, alb_ice_os ) 
    136139         ! ... Sea-ice surface boundary conditions output from bulk formulae : 
    137140         !     - utaui_ice  ! surface ice stress i-component (I-point)   [N/m2] 
    … …  
    154157               &                               tprecip   , sprecip    ,                          & 
    155158               &                               fr1_i0    , fr2_i0     , cl_grid  ) 
    156  
    157             ! CAUTION: ocean shortwave radiation sets to zero if more than 50% of sea-ice !!gm to be removed 
    158             DO jj = 1, jpj 
    159                DO ji = 1, jpi 
    160                   zinda    = MAX(  0.e0, SIGN(  1.e0, -( -1.5 - freeze(ji,jj) )  )  ) 
    161                   qsr(ji,jj) = zinda * qsr(ji,jj) 
    162                END DO 
    163             END DO 
    164  
    165159         CASE( 4 )           ! CORE bulk formulation 
    166160            CALL blk_ice_core( zsist , ui_ice , vi_ice   , alb_ice_cs ,                         & 
    … …  
    175169         qla_ice(:,:) = zqla_ice(:,:,1)   ;   dqla_ice(:,:) = zdqla_ice(:,:,1) 
    176170 
     171         ENDIF 
    177172         IF(ln_ctl) THEN         ! print mean trends (used for debugging) 
    178173            CALL prt_ctl_info( 'Ice Forcings ' ) 
    … …  
    188183         !  Ice model step  ! 
    189184         ! ---------------- ! 
    190                                         CALL lim_rst_opn_2  ( kt )      ! Open Ice restart file 
    191          IF( .NOT. lk_c1d ) THEN                                        ! Ice dynamics & transport (not in 1D case) 
    192                                         CALL lim_dyn_2      ( kt )           ! Ice dynamics    ( rheology/dynamics ) 
    193                                         CALL lim_trp_2      ( kt )           ! Ice transport   ( Advection/diffusion ) 
    194             IF( ln_limdmp )             CALL lim_dmp_2      ( kt )           ! Ice damping  
    195          ENDIF 
    196                                         CALL lim_thd_2      ( kt )      ! Ice thermodynamics  
    197                                         CALL lim_sbc_2      ( kt )      ! Ice/Ocean Mass & Heat fluxes  
     185         ;                              CALL lim_rst_opn_2  ( kt )      ! Open Ice restart file 
     186         ;                              CALL lim_dyn_2      ( kt )      ! Ice dynamics    ( rheology/dynamics ) 
     187         ;                              CALL lim_trp_2      ( kt )      ! Ice transport   ( Advection/diffusion ) 
     188         IF( ln_limdmp )                CALL lim_dmp_2      ( kt )      ! Ice damping  
     189         ;                              CALL lim_thd_2      ( kt )      ! Ice thermodynamics  
     190         ;                              CALL lim_sbc_2      ( kt )      ! Ice/Ocean Mass & Heat fluxes  
    198191         IF( MOD( kt+nn_fsbc-1, ninfo ) == 0 .OR.   & 
    199192            &  ntmoy == 1 )             CALL lim_dia_2      ( kt )      ! Ice Diagnostics  
    200                                         CALL lim_wri_2      ( kt )      ! Ice outputs  
     193         ;                              CALL lim_wri_2      ( kt )      ! Ice outputs  
    201194         IF( lrst_ice )                 CALL lim_rst_write_2( kt )      ! Ice restart file  
    202195         ! 

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

    r990 r991  
    4949   LOGICAL , PUBLIC ::   ln_blk_clio = .FALSE.   !: CLIO bulk formulation 
    5050   LOGICAL , PUBLIC ::   ln_blk_core = .FALSE.   !: CORE bulk formulation 
    51    LOGICAL , PUBLIC ::   ln_cpl      = .FALSE.   !: coupled   formulation (overwritten by key_sbc_coupled ) 
     51   LOGICAL , PUBLIC ::   ln_cpl      = .FALSE.   !: coupled   formulation (overwritten by key_oasis3/4 ) 
    5252   LOGICAL , PUBLIC ::   ln_dm2dc    = .FALSE.   !: Daily mean to Diurnal Cycle short wave (qsr) 
    5353   LOGICAL , PUBLIC ::   ln_rnf      = .FALSE.   !: runoffs / runoff mouths 

  • branches/dev_003_CPL/NEMO/OPA_SRC/SBC/sbcrnf_ORCA_R05.h90

    r888 r991  
    8484      INTEGER, INTENT( in  ) ::   kt ! ocean time step 
    8585 
    86 #if defined key_coupled 
    87       runoff(:,:) = 0.0e0 
    88 #else 
    8986      !!---------------------------------------------------------------------- 
    9087      !!  ORCA_R05 
    … …  
    15321529         ENDIF 
    15331530      ENDIF 
    1534      
    1535 #endif 
    15361531 
    15371532   END SUBROUTINE flx_rnf 

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

    r719 r991  
    329329 
    330330   SUBROUTINE geo2oce ( pxx , pyy , pzz, cgrid,     & 
    331                         plon, plat, pte, ptn  , ptv ) 
     331                        plon, plat, pte, ptn ) 
    332332      !!---------------------------------------------------------------------- 
    333333      !!                    ***  ROUTINE geo2oce  *** 
    … …  
    346346      !!---------------------------------------------------------------------- 
    347347      !! * Local declarations 
    348       REAL(wp), INTENT( in ), DIMENSION(jpi,jpj) ::   & 
    349          pxx, pyy, pzz 
    350       CHARACTER (len=1), INTENT( in) ::   & 
    351          cgrid 
    352       REAL(wp), INTENT( in ), DIMENSION(jpi,jpj) ::   & 
    353          plon, plat 
    354       REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::    & 
    355          pte, ptn, ptv 
     348      REAL(wp), DIMENSION(jpi,jpj), INTENT( IN    ) ::  pxx, pyy, pzz 
     349      CHARACTER(len=1)            , INTENT( IN    ) ::  cgrid 
     350      REAL(wp), DIMENSION(jpi,jpj), INTENT( IN    ) ::  plon, plat 
     351      REAL(wp), DIMENSION(jpi,jpj), INTENT(   OUT ) ::  pte, ptn 
     352      ! 
    356353      REAL(wp), PARAMETER :: rpi = 3.141592653E0 
    357354      REAL(wp), PARAMETER :: rad = rpi / 180.e0 
    358  
    359       !! * Local variables 
    360355      INTEGER ::   ig     ! 
    361  
    362356      !! * Local save 
    363       REAL(wp), SAVE, DIMENSION(jpi,jpj,4) ::   & 
    364          zsinlon, zcoslon,   & 
    365          zsinlat, zcoslat 
    366       LOGICAL, SAVE, DIMENSION (4) ::   & 
    367          linit = .FALSE. 
     357      REAL(wp), SAVE, DIMENSION(jpi,jpj,4) ::   zsinlon, zcoslon, zsinlat, zcoslat 
     358      LOGICAL , SAVE, DIMENSION(4)         ::   linit = .FALSE. 
    368359      !!---------------------------------------------------------------------- 
    369360 
    … …  
    392383            - zsinlon (:,:,ig) * zsinlat (:,:,ig) * pyy    & 
    393384            + zcoslat (:,:,ig) * pzz 
    394       ptv =   zcoslon (:,:,ig) * zcoslat (:,:,ig) * pxx    & 
    395             + zsinlon (:,:,ig) * zcoslat (:,:,ig) * pyy    & 
    396             + zsinlat (:,:,ig) * pzz 
     385!!$      ptv =   zcoslon (:,:,ig) * zcoslat (:,:,ig) * pxx    & 
     386!!$            + zsinlon (:,:,ig) * zcoslat (:,:,ig) * pyy    & 
     387!!$            + zsinlat (:,:,ig) * pzz 
    397388 
    398389   END SUBROUTINE geo2oce 

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

    r888 r991  
    3333   !! ice-ocean common variables 
    3434   !!---------------------------------------------------------------------- 
    35 # if defined key_coupled 
    36    REAL(wp), PUBLIC, DIMENSION(jpiglo,jpjglo) ::   &  !: cumulated fields 
    37       fqsr_oce ,      &   !: Net short wave heat flux on free ocean  
    38       fqsr_ice ,      &   !: Net short wave heat flux on sea ice  
    39       fqnsr_oce,      &   !: Net longwave heat flux on free ocean 
    40       fqnsr_ice,      &   !: Net longwave heat flux on sea ice 
    41       fdqns_ice,      &   !: Derivative of non solar heat flux on sea ice 
    42       ftprecip ,      &   !: Water flux (liquid precipitation - evaporation)  
    43       fsprecip ,      &   !: Solid (snow) precipitation 
    44       frunoff  ,      &   !: runoff 
    45       fcalving            !: Iceberg calving  
    46 # endif 
    4735 
    4836# if defined key_lim3 
    … …  
    5139      tatm_ice       , &  !: air temperature 
    5240      icethi              !: icethickness 
    53 # endif 
    54     
     41# endif    
    5542   REAL(wp), PUBLIC ::   &  !: 
    5643      rdt_ice,           &  !: ice time step 
    5744      dtsd2                 !: ice time step divide by 2 
     45#else 
    5846 
    59 #else 
    6047   !!---------------------------------------------------------------------- 
    6148   !!   Default option                      NO LIM 2.0 or 3.0 sea-ice model 

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

    r990 r991  
    6161   PUBLIC  mpp_lbc_north_e, mpp_minloc, mpp_maxloc, mpp_lnk_3d, mpp_lnk_2d, mpp_lnk_3d_gather, mpp_lnk_2d_e, mpplnks 
    6262   PUBLIC  mpprecv, mppsend, mppscatter, mppgather, mppobc, mpp_ini_north, mppstop, mppsync, mpp_ini_ice, mpp_comm_free 
    63 #if defined key_oasis3 || defined key_oasis4 
    64    PUBLIC  mppsize, mpprank 
    65 #endif 
    6663 
    6764   !! * Interfaces 

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

    r719 r991  
    1818   !! * Shared module variables    
    1919   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !: 
    20       freeze, freezn,  &  !: after and now ice mask (0 or 1) 
    2120      fzptb, fzptn        !: before and now freezing point 
    2221   !!---------------------------------------------------------------------- 

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

    r990 r991  
    3838   !! * Modules used 
    3939   USE oce             ! dynamics and tracers variables 
    40    USE cpl_oce         ! ocean-atmosphere-sea ice coupled exchanges 
    4140   USE dom_oce         ! ocean space domain variables 
    4241   USE sbc_oce         ! surface boundary condition: ocean 
    … …  
    7069 
    7170   USE step            ! OPA time-stepping                  (stp     routine) 
    72 #if defined key_oasis3 
    73    USE cpl_oasis3      ! OASIS3 coupling (to ECHAM5) 
    74 #elif defined key_oasis4 
    75    USE cpl_oasis4      ! OASIS4 coupling (to ECHAM5) 
    76 #endif 
     71   USE cpl_oasis3      ! OASIS3 coupling 
    7772   USE dynspg_oce      ! Control choice of surface pressure gradient schemes 
    7873   USE prtctl          ! Print control                 (prt_ctl_init routine) 
    … …  
    159154 
    160155      CALL opa_closefile 
    161 #if defined key_oasis3 || defined key_oasis4 
    162       call cpl_prism_finalize 
    163 #else 
    164       IF( lk_mpp )   CALL mppstop                          ! Close all files (mpp) 
    165 #endif 
    166       ! 
     156      IF      ( lk_cpl ) THEN   ;   CALL cpl_prism_finalize 
     157      ELSE IF ( lk_mpp ) THEN   ;   CALL mppstop                ! Close all files (mpp) 
     158      ENDIF 
     159                           
    167160   END SUBROUTINE opa_model 
    168161 
    … …  
    175168      !! 
    176169      !!---------------------------------------------------------------------- 
    177 #if defined key_coupled 
    178       INTEGER ::   itro, istp0        ! ??? 
    179 #endif 
    180 #if defined key_oasis3 || defined key_oasis4 
    181170      INTEGER :: localComm 
    182 #endif 
    183171      CHARACTER (len=20) ::   namelistname 
    184172      CHARACTER (len=28) ::   file_out 
    … …  
    212200      READ  ( numnam, namctl ) 
    213201 
    214 #if defined key_oasis3 || defined key_oasis4 
    215       call cpl_prism_init(localComm) 
    216       ! Nodes selection 
    217       narea = mynode(localComm) 
    218 #else 
    219       ! Nodes selection 
    220       narea = mynode() 
    221 #endif 
     202      IF ( lk_cpl ) THEN 
     203         CALL cpl_prism_init() 
     204         narea = mynode(nlocalComm) 
     205      ELSE  
     206         narea = mynode() 
     207      ENDIF 
     208           
    222209      narea = narea + 1    ! mynode return the rank of proc (0 --> jpnij -1 ) 
    223210      lwp   = narea == 1 
    … …  
    290277      CALL trd_mod_init                         ! Mixed-layer/Vorticity/Integral constraints trends 
    291278 
    292  
    293279#if defined key_top 
    294280      CALL ini_trc                           ! Passive tracers 
    295 #endif 
    296  
    297 #if defined key_coupled && ! defined key_oasis3 && ! defined key_oasis4 
    298       itro  = nitend - nit000 + 1           ! Coupled 
    299       istp0 = NINT( rdt ) 
    300       CALL cpl_init( itro, nexco, istp0 )   ! Signal processing and process id exchange 
    301 #endif 
    302  
    303 #if defined key_oasis3 || defined key_oasis4 
    304       CALL cpl_prism_define 
    305281#endif 
    306282 

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

    r990 r991  
    364364      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    365365 
    366 #if defined key_oasis3 
    367       IF( lk_cpl    )   CALL cpl_stp( kstp )                 ! coupled mode : field exchanges 
     366      IF( lk_cpl    )   CALL sbc_cpl_snd( kstp )                 ! coupled mode : field exchanges 
    368367#endif 
    369368      ! 
Note: See TracChangeset for help on using the changeset viewer.