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

Changeset 4859


Ignore:
Timestamp:
2014-11-14T21:43:49+01:00 (9 years ago)
Author:
smasson
Message:

dev_4728_CNRS04_coupled_interface: cleaning of the coupling interface for OASIS3-MCT. 2

Location:
branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO
Files:
17 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90

    r4730 r4859  
    3030   USE sbc_oce          ! surface boundary condition: ocean 
    3131   USE sbccpl 
    32    USE cpl_oasis3, ONLY : lk_cpl 
    3332   USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass  
    3433   USE albedo           ! albedo parameters 
     
    183182 
    184183            !   computation the solar flux at ocean surface 
    185 #if defined key_coupled  
    186             zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 
    187 #else 
    188             zqsr = pfrld(ji,jj) * qsr(ji,jj)  + ( 1.  - pfrld(ji,jj) ) * fstric(ji,jj) 
    189 #endif             
     184            IF( lk_cpl ) THEN 
     185               zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 
     186            ELSE 
     187               zqsr = pfrld(ji,jj) * qsr(ji,jj)  + ( 1.  - pfrld(ji,jj) ) * fstric(ji,jj) 
     188            ENDIF 
    190189            !  computation the non solar heat flux at ocean surface 
    191190            zqns    =  - ( 1. - thcm(ji,jj) ) * zqsr                                              &   ! part of the solar energy used in leads 
     
    206205            ! 
    207206            ! mass flux at the ocean-atmosphere interface (open ocean fraction = leads area) 
    208 #if defined key_coupled 
    209207            !                                                  ! coupled mode:  
    210             zemp = + emp_tot(ji,jj)                            &     ! net mass flux over the grid cell (ice+ocean area) 
    211                &   - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )          ! minus the mass flux intercepted by sea-ice 
    212 #else 
    213             !                                                  ! forced  mode:  
    214             zemp = + emp(ji,jj)     *         frld(ji,jj)      &     ! mass flux over open ocean fraction  
    215                &   - tprecip(ji,jj) * ( 1. -  frld(ji,jj) )    &     ! liquid precip. over ice reaches directly the ocean 
    216                &   + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )          ! snow is intercepted by sea-ice (previous frld) 
    217 #endif             
     208            IF( lk_cpl ) THEN 
     209               zemp = + emp_tot(ji,jj)                            &     ! net mass flux over the grid cell (ice+ocean area) 
     210                  &   - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )          ! minus the mass flux intercepted by sea-ice 
     211            ELSE 
     212               !                                                  ! forced  mode:  
     213               zemp = + emp(ji,jj)     *         frld(ji,jj)      &     ! mass flux over open ocean fraction  
     214                  &   - tprecip(ji,jj) * ( 1. -  frld(ji,jj) )    &     ! liquid precip. over ice reaches directly the ocean 
     215                  &   + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )          ! snow is intercepted by sea-ice (previous frld) 
     216            ENDIF 
    218217            ! 
    219218            ! mass flux at the ocean/ice interface (sea ice fraction) 
     
    259258      !-----------------------------------------------! 
    260259 
    261 #if defined key_coupled 
    262       tn_ice(:,:,1) = sist(:,:)          ! sea-ice surface temperature        
    263       ht_i(:,:,1) = hicif(:,:) 
    264       ht_s(:,:,1) = hsnif(:,:) 
    265       a_i(:,:,1) = fr_i(:,:) 
    266       !                                  ! Computation of snow/ice and ocean albedo 
    267       CALL albedo_ice( tn_ice, ht_i, ht_s, zalbp, zalb ) 
    268       alb_ice(:,:,1) =  0.5 * ( zalbp(:,:,1) + zalb (:,:,1) )   ! Ice albedo (mean clear and overcast skys) 
    269       CALL iom_put( "icealb_cea", alb_ice(:,:,1) * fr_i(:,:) )  ! ice albedo 
    270 #endif 
     260      IF( lk_cpl) THEN 
     261         tn_ice(:,:,1) = sist(:,:)          ! sea-ice surface temperature        
     262         ht_i(:,:,1) = hicif(:,:) 
     263         ht_s(:,:,1) = hsnif(:,:) 
     264         a_i(:,:,1) = fr_i(:,:) 
     265         !                                  ! Computation of snow/ice and ocean albedo 
     266         CALL albedo_ice( tn_ice, ht_i, ht_s, zalbp, zalb ) 
     267         alb_ice(:,:,1) =  0.5 * ( zalbp(:,:,1) + zalb (:,:,1) )   ! Ice albedo (mean clear and overcast skys) 
     268         CALL iom_put( "icealb_cea", alb_ice(:,:,1) * fr_i(:,:) )  ! ice albedo 
     269      ENDIF 
    271270 
    272271      IF(ln_ctl) THEN            ! control print 
  • branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90

    r4696 r4859  
    3333   USE limtab_2 
    3434   USE prtctl           ! Print control 
    35    USE cpl_oasis3, ONLY :   lk_cpl 
    3635   USE diaar5    , ONLY :   lk_diaar5 
    3736   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
  • branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90

    r4306 r4859  
    1818   USE ice_2 
    1919   USE limistate_2 
    20    USE cpl_oasis3, ONLY : lk_cpl 
     20   USE sbc_oce, ONLY : lk_cpl 
    2121   USE in_out_manager 
    2222   USE lib_mpp          ! MPP library 
  • branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r4733 r4859  
    3232   USE sbc_oce          ! Surface boundary condition: ocean fields 
    3333   USE sbccpl 
    34    USE cpl_oasis3, ONLY : lk_cpl 
    3534   USE oce       , ONLY : iatte, oatte, sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 
    3635   USE albedo           ! albedo parameters 
  • branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r4855 r4859  
    4343   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    4444   USE timing         ! Timing 
    45    USE cpl_oasis3, ONLY : lk_cpl 
    4645   USE limcons        ! conservation tests 
    4746 
  • branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

    r4733 r4859  
    2626   USE wrk_nemo       ! work arrays 
    2727   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    28    USE cpl_oasis3, ONLY : lk_cpl 
    2928    
    3029   IMPLICIT NONE 
  • branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90

    r4733 r4859  
    2525   USE wrk_nemo       ! work arrays 
    2626   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    27    USE cpl_oasis3, ONLY : lk_cpl 
     27   USE sbc_oce, ONLY : lk_cpl 
    2828 
    2929   IMPLICIT NONE 
  • branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    r4857 r4859  
    4545   INTEGER                    ::   ncomp_id          ! id returned by oasis_init_comp 
    4646   INTEGER                    ::   nerror            ! return error code 
    47 #if defined key_oasis3 
    48    LOGICAL, PUBLIC, PARAMETER ::   lk_cpl = .TRUE.   !: coupled flag 
    49 #else 
    50    LOGICAL, PUBLIC, PARAMETER ::   lk_cpl = .FALSE.  !: coupled flag 
     47#if ! defined key_oasis3 
    5148   ! OASIS Variables not used. defined only for compilation purpose 
    5249   INTEGER                    ::   OASIS_Out         = -1 
  • branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90

    r4856 r4859  
    1414   !!---------------------------------------------------------------------- 
    1515   USE par_oce          ! ocean parameters 
     16   USE sbc_oce          ! surface boundary condition: ocean 
    1617# if defined key_lim3 
    1718   USE par_ice          ! LIM-3 parameters 
     
    5657 
    5758#if defined key_lim3 || defined key_lim2  
    58    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qns_ice            !: non solar heat flux over ice                  [W/m2] 
    59    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice            !: solar heat flux over ice                      [W/m2] 
    60    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice_mean       !: daily mean solar heat flux over ice       [W/m2] 
    61    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qla_ice            !: latent flux over ice                          [W/m2] 
    62    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqla_ice           !: latent sensibility over ice                 [W/m2/K] 
    63    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqns_ice           !: non solar heat flux over ice (LW+SEN+LA)    [W/m2/K] 
    64    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice             !: ice surface temperature                          [K] 
    65    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   alb_ice            !: ice albedo                                       [-] 
    66  
    67    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   utau_ice           !: atmos-ice u-stress. VP: I-pt ; EVP: U,V-pts   [N/m2] 
    68    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   vtau_ice           !: atmos-ice v-stress. VP: I-pt ; EVP: U,V-pts   [N/m2] 
    69    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr1_i0             !: Solar surface transmission parameter, thick ice  [-] 
    70    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr2_i0             !: Solar surface transmission parameter, thin ice   [-] 
    71    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice            !: sublimation - precip over sea ice            [kg/m2] 
    72    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qemp_ice           !: heat associated with emp over sea ice         [W/m2] 
     59   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qns_ice        !: non solar heat flux over ice                  [W/m2] 
     60   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice        !: solar heat flux over ice                      [W/m2] 
     61   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice_mean   !: daily mean solar heat flux over ice           [W/m2] 
     62   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qla_ice        !: latent flux over ice                          [W/m2] 
     63   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqla_ice       !: latent sensibility over ice                 [W/m2/K] 
     64   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqns_ice       !: non solar heat flux over ice (LW+SEN+LA)    [W/m2/K] 
     65   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice         !: ice surface temperature                          [K] 
     66   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   alb_ice        !: ice albedo                                       [-] 
     67 
     68   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   utau_ice       !: atmos-ice u-stress. VP: I-pt ; EVP: U,V-pts   [N/m2] 
     69   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   vtau_ice       !: atmos-ice v-stress. VP: I-pt ; EVP: U,V-pts   [N/m2] 
     70   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr1_i0         !: Solar surface transmission parameter, thick ice  [-] 
     71   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr2_i0         !: Solar surface transmission parameter, thin ice   [-] 
     72   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice        !: sublimation - precip over sea ice            [kg/m2] 
     73   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qemp_ice       !: heat associated with emp over sea ice         [W/m2] 
    7374 
    7475# if defined key_lim3 
    75    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tatm_ice           !: air temperature [K] 
     76   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tatm_ice       !: air temperature [K] 
    7677# endif 
    7778 
     
    99100   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt            !: category topmelt 
    100101   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   botmelt            !: category botmelt 
    101 #endif 
    102    REAL(wp), PUBLIC, SAVE                                ::   cldf_ice = 0.81    !: cloud fraction over sea ice, summer CLIO value   [-] 
     102 
     103   ! variables used in the coupled interface 
     104   INTEGER , PUBLIC, PARAMETER ::   jpl = ncat 
     105   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice,fr1_i0,fr2_i0          ! jpi, jpj 
     106   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice, alb_ice, qns_ice, dqns_ice  ! (jpi,jpj,jpl) 
     107   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice 
     108   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice 
     109#endif 
     110    
     111#if defined key_lim2 
     112   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i 
     113#endif 
     114 
     115#if ! defined key_lim3 
     116   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  ht_i, ht_s 
     117#endif 
     118 
     119#if ! defined key_cice 
     120   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  topmelt, botmelt 
     121#endif 
     122 
     123   REAL(wp), PUBLIC, SAVE ::   cldf_ice = 0.81    !: cloud fraction over sea ice, summer CLIO value   [-] 
    103124 
    104125   !!---------------------------------------------------------------------- 
     
    113134      !!                     ***  FUNCTION sbc_ice_alloc  *** 
    114135      !!---------------------------------------------------------------------- 
    115       INTEGER :: ierr(2) 
     136      INTEGER :: ierr(5) 
    116137      !!---------------------------------------------------------------------- 
    117138      ierr(:) = 0 
     
    125146         &      fr1_i0  (jpi,jpj)     , fr2_i0  (jpi,jpj)     ,     & 
    126147#if defined key_lim3 
    127          &      tatm_ice(jpi,jpj) 
     148         &      tatm_ice(jpi,jpj)                             ,     & 
    128149#endif 
    129150         &      emp_ice(jpi,jpj)      , qemp_ice(jpi,jpj)     , STAT= ierr(1) ) 
     
    133154                wndj_ice(jpi,jpj)     , nfrzmlt(jpi,jpj)      , ss_iou(jpi,jpj)       , & 
    134155                ss_iov(jpi,jpj)       , fr_iu(jpi,jpj)        , fr_iv(jpi,jpj)        , & 
    135                 a_i(jpi,jpj,ncat)     , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat), STAT= ierr(1) ) 
     156                a_i(jpi,jpj,ncat)     , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat) , & 
     157                STAT= ierr(1) ) 
     158      IF( lk_cpl )   ALLOCATE( u_ice(jpi,jpj)        , fr1_i0(jpi,jpj)       , tn_ice (jpi,jpj,1)    , & 
     159         &                     v_ice(jpi,jpj)        , fr2_i0(jpi,jpj)       , alb_ice(jpi,jpj,1)    , & 
     160         &                     emp_ice(jpi,jpj)      , qns_ice(jpi,jpj,1)    , dqns_ice(jpi,jpj,1)   , & 
     161         &                     STAT= ierr(2) ) 
     162       
    136163#endif 
    137164         ! 
    138165#if defined key_lim2 
    139       IF( ltrcdm2dc_ice )THEN 
    140          ALLOCATE( qsr_ice_mean (jpi,jpj,jpl), STAT=ierr(2) ) 
    141       ENDIF 
     166      IF( ltrcdm2dc_ice )   ALLOCATE( qsr_ice_mean (jpi,jpj,jpl), STAT=ierr(3) ) 
    142167#endif 
    143168         ! 
     169#if defined key_lim2 
     170      ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(4) ) 
     171#endif 
     172 
     173#if defined key_cice || defined key_lim2 
     174      IF( lk_cpl )   ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) ) 
     175#endif 
     176 
    144177      sbc_ice_alloc = MAXVAL( ierr ) 
    145178      IF( lk_mpp            )   CALL mpp_sum ( sbc_ice_alloc ) 
     
    151184   !!   Default option                      NO LIM 2.0 or 3.0 or CICE sea-ice model 
    152185   !!---------------------------------------------------------------------- 
     186   USE in_out_manager   ! I/O manager 
    153187   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2 ice model 
    154188   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3 ice model 
    155189   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE  ice model 
    156190   CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = '-'      !: no grid ice-velocity 
    157    REAL            , PUBLIC            ::   cldf_ice = 0.81       !: cloud fraction over sea ice, summer CLIO value   [-] 
     191   REAL            , PUBLIC, PARAMETER ::   cldf_ice = 0.81       !: cloud fraction over sea ice, summer CLIO value   [-] 
     192   INTEGER         , PUBLIC, PARAMETER ::   jpl = 1  
     193   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice,fr1_i0,fr2_i0          ! jpi, jpj 
     194   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice, alb_ice, qns_ice, dqns_ice  ! (jpi,jpj,jpl) 
     195   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i 
     196   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice 
     197   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice 
     198   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ht_i, ht_s 
     199   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt, botmelt 
    158200#endif 
    159201 
  • branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r4733 r4859  
    3535   LOGICAL , PUBLIC ::   ln_blk_core    !: CORE bulk formulation 
    3636   LOGICAL , PUBLIC ::   ln_blk_mfs     !: MFS  bulk formulation 
     37#if defined key_oasis3 
     38   LOGICAL , PUBLIC ::   lk_cpl = .TRUE.  !: coupled formulation 
     39#else 
     40   LOGICAL , PUBLIC ::   lk_cpl = .FALSE. !: coupled formulation 
     41#endif 
    3742   LOGICAL , PUBLIC ::   ln_dm2dc       !: Daily mean to Diurnal Cycle short wave (qsr) 
    3843   LOGICAL , PUBLIC ::   ln_rnf         !: runoffs / runoff mouths 
  • branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r4856 r4859  
    3939   USE prtctl          ! Print control 
    4040   USE sbcwave,ONLY :  cdn_wave !wave module  
    41    USE sbc_ice,ONLY :  cldf_ice ! Surface boundary condition: ice fields 
     41   USE sbc_ice        ! Surface boundary condition: ice fields 
    4242   USE lib_fortran     ! to use key_nosignedzero 
    4343 
  • branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r4857 r4859  
    133133   INTEGER , ALLOCATABLE, SAVE, DIMENSION(    :) ::   nrcvinfo           ! OASIS info argument 
    134134 
    135 #if ! defined key_lim2   &&   ! defined key_lim3 
    136    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice,fr1_i0,fr2_i0          ! jpi, jpj 
    137    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice, alb_ice, qns_ice, dqns_ice  ! (jpi,jpj,jpl) 
    138 #endif 
    139  
    140 #if defined key_cice 
    141    INTEGER, PARAMETER ::   jpl = ncat 
    142 #elif ! defined key_lim2   &&   ! defined key_lim3 
    143    INTEGER, PARAMETER ::   jpl = 1  
    144    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice 
    145    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice 
    146 #endif 
    147  
    148 #if ! defined key_lim3   &&  ! defined key_cice 
    149    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i 
    150 #endif 
    151  
    152 #if ! defined key_lim3 
    153    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  ht_i, ht_s 
    154 #endif 
    155  
    156 #if ! defined key_cice 
    157    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  topmelt, botmelt 
    158 #endif 
    159  
    160135   !! Substitution 
    161136#  include "vectopt_loop_substitute.h90" 
     
    172147      !!             ***  FUNCTION sbc_cpl_alloc  *** 
    173148      !!---------------------------------------------------------------------- 
    174       INTEGER :: ierr(4),jn 
     149      INTEGER :: ierr(2),jn 
    175150      !!---------------------------------------------------------------------- 
    176151      ierr(:) = 0 
    177152      ! 
    178153      ALLOCATE( albedo_oce_mix(jpi,jpj), nrcvinfo(jprcv),  STAT=ierr(1) ) 
    179       ! 
    180 #if ! defined key_lim2 && ! defined key_lim3 
    181       ! quick patch to be able to run the coupled model without sea-ice... 
    182       ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) ,     & 
    183                 v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,1),      & 
    184                 emp_ice(jpi,jpj) , qns_ice(jpi,jpj,1) , dqns_ice(jpi,jpj,1) , STAT=ierr(2) ) 
     154       
     155#if ! defined key_lim3 && ! defined key_lim2 && ! defined key_cice 
     156      ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) 
    185157#endif 
    186  
    187 #if ! defined key_lim3 && ! defined key_cice 
    188       ALLOCATE( a_i(jpi,jpj,jpl) , STAT=ierr(3) ) 
    189 #endif 
    190  
    191 #if defined key_cice || defined key_lim2 
    192       ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(4) ) 
    193 #endif 
     158      ! 
    194159      sbc_cpl_alloc = MAXVAL( ierr ) 
    195160      IF( lk_mpp            )   CALL mpp_sum ( sbc_cpl_alloc ) 
     
    904869      CALL wrk_alloc( jpi,jpj, ztx, zty ) 
    905870 
    906 !AC Pour eviter un stress nul sur la glace dans le cas mixed oce-ice 
    907       IF( srcv(jpr_itx1)%laction .AND. TRIM( sn_rcv_tau%cldes ) == 'oce and ice') THEN   ;   itx =  jpr_itx1    
     871      IF( srcv(jpr_itx1)%laction ) THEN   ;   itx =  jpr_itx1    
    908872      ELSE                                ;   itx =  jpr_otx1 
    909873      ENDIF 
     
    912876      IF(  nrcvinfo(itx) == OASIS_Rcv ) THEN 
    913877 
    914          !                                                                                              ! ======================= ! 
    915 !AC Pour eviter un stress nul sur la glace dans le cas mixes oce-ice 
    916          IF( srcv(jpr_itx1)%laction .AND. TRIM( sn_rcv_tau%cldes ) == 'oce and ice') THEN               !   ice stress received   ! 
    917             !                                                                                           ! ======================= ! 
     878         !                                                      ! ======================= ! 
     879         IF( srcv(jpr_itx1)%laction ) THEN                      !   ice stress received   ! 
     880            !                                                   ! ======================= ! 
    918881            !   
    919882            IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN            ! 2 components on the sphere 
     
    12861249      ENDIF 
    12871250 
    1288       SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) 
     1251      !                                                      ! ========================= ! 
     1252      SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) )             !          d(qns)/dt        ! 
     1253      !                                                      ! ========================= ! 
    12891254      CASE ('coupled') 
    12901255         IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 
     
    12981263      END SELECT 
    12991264 
    1300       SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) 
     1265      !                                                      ! ========================= ! 
     1266      SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) )             !    topmelt and botmelt    ! 
     1267      !                                                      ! ========================= ! 
    13011268      CASE ('coupled') 
    13021269         topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:) 
     
    13431310 
    13441311      zfr_l(:,:) = 1.- fr_i(:,:) 
    1345  
    13461312      !                                                      ! ------------------------- ! 
    13471313      !                                                      !    Surface temperature    !   in Kelvin 
     
    13721338         IF( ssnd(jps_tmix)%laction )   CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
    13731339      ENDIF 
    1374       ! 
    13751340      !                                                      ! ------------------------- ! 
    13761341      !                                                      !           Albedo          ! 
  • branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90

    r4624 r4859  
    1616   USE eosbn2         ! equation of state 
    1717   USE sbc_oce        ! surface boundary condition: ocean fields 
    18    USE sbccpl 
     18#if defined key_lim3 
     19   USE ice    , ONLY :   a_i  
     20#else 
     21   USE sbc_ice, ONLY :   a_i  
     22#endif 
    1923   USE fldread        ! read input field 
    2024   USE iom            ! I/O manager library 
     
    101105         fr_i(:,:) = tfreez( sss_m ) * tmask(:,:,1)      ! sea surface freezing temperature [Celcius] 
    102106 
    103 ! OM : probleme. a_i pas defini dans les cas lim3 et cice 
    104 #if defined key_coupled && defined key_lim2 
    105          a_i(:,:,1) = fr_i(:,:)          
    106 #endif 
     107         IF( lk_cpl )   a_i(:,:,1) = fr_i(:,:)          
    107108 
    108109         ! Flux and ice fraction computation 
  • branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r4621 r4859  
    206206           IF( ln_limdmp ) CALL lim_dmp_2      ( kt )      ! Ice damping  
    207207         END IF 
    208 #if defined key_coupled 
    209208         !                                             ! Ice surface fluxes in coupled mode  
    210209         IF( ksbc == 5 )   THEN 
     
    215214            sprecip(:,:) = - emp_ice(:,:)   ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.) 
    216215         ENDIF 
    217 #endif 
    218216                           CALL lim_thd_2      ( kt )      ! Ice thermodynamics  
    219217                           CALL lim_sbc_flx_2  ( kt )      ! update surface ocean mass, heat & salt fluxes  
  • branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r4857 r4859  
    3737   USE sbcice_cice      ! surface boundary condition: CICE    sea-ice model 
    3838   USE sbccpl           ! surface boundary condition: coupled florulation 
    39    USE cpl_oasis3, ONLY:lk_cpl      ! are we in coupled mode? 
    4039   USE sbcssr           ! surface boundary condition: sea surface restoring 
    4140   USE sbcrnf           ! surface boundary condition: runoffs 
     
    123122         WRITE(numout,*) '              CORE bulk  formulation                     ln_blk_core = ', ln_blk_core 
    124123         WRITE(numout,*) '              MFS  bulk  formulation                     ln_blk_mfs  = ', ln_blk_mfs 
     124         WRITE(numout,*) '              coupled    formulation (T if key_oasis3)   lk_cpl      = ', lk_cpl 
    125125         WRITE(numout,*) '              Multicategory heat flux formulation (LIM3) nn_limflx   = ', nn_limflx 
    126126         WRITE(numout,*) '           Misc. options of sbc : ' 
  • branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r4857 r4859  
    4242   !!---------------------------------------------------------------------- 
    4343   USE step_oce        ! module used in the ocean time stepping module 
    44    USE sbc_oce         ! surface boundary condition: ocean 
    4544   USE cla             ! cross land advection               (tra_cla routine) 
    4645   USE domcfg          ! domain configuration               (dom_cfg routine) 
  • branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r4328 r4859  
    2525   USE sbcrnf           ! surface boundary condition: runoff variables 
    2626   USE sbccpl           ! surface boundary condition: coupled formulation (call send at end of step) 
    27    USE cpl_oasis3, ONLY : lk_cpl 
     27   USE sbc_oce          ! surface boundary condition: ocean 
    2828   USE sbctide          ! Tide initialisation 
    2929 
Note: See TracChangeset for help on using the changeset viewer.