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 5260 for branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 – NEMO

Ignore:
Timestamp:
2015-05-12T12:37:15+02:00 (9 years ago)
Author:
deazer
Message:

Merged branch with Trunk at revision 5253.
Checked with SETTE, passes modified iodef.xml for AMM12 experiment

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r4624 r5260  
    99   !!            3.4  ! 2011_11  (C. Harris) more flexibility + multi-category fields 
    1010   !!---------------------------------------------------------------------- 
    11 #if defined key_oasis3 || defined key_oasis4 
    12    !!---------------------------------------------------------------------- 
    13    !!   'key_oasis3' or 'key_oasis4'   Coupled Ocean/Atmosphere formulation 
    1411   !!---------------------------------------------------------------------- 
    1512   !!   namsbc_cpl      : coupled formulation namlist 
     
    2724   USE phycst          ! physical constants 
    2825#if defined key_lim3 
    29    USE par_ice         ! ice parameters 
    3026   USE ice             ! ice variables 
    3127#endif 
     
    3430   USE ice_2           ! ice variables 
    3531#endif 
    36 #if defined key_oasis3 
    3732   USE cpl_oasis3      ! OASIS3 coupling 
    38 #endif 
    39 #if defined key_oasis4 
    40    USE cpl_oasis4      ! OASIS4 coupling 
    41 #endif 
    4233   USE geo2ocean       !  
    4334   USE oce   , ONLY : tsn, un, vn 
     
    5243   USE p4zflx, ONLY : oce_co2 
    5344#endif 
    54    USE diaar5, ONLY :   lk_diaar5 
    5545#if defined key_cice 
    5646   USE ice_domain_size, only: ncat 
     
    5848   IMPLICIT NONE 
    5949   PRIVATE 
    60  
     50!EM XIOS-OASIS-MCT compliance 
     51   PUBLIC   sbc_cpl_init       ! routine called by sbcmod.F90 
    6152   PUBLIC   sbc_cpl_rcv        ! routine called by sbc_ice_lim(_2).F90 
    6253   PUBLIC   sbc_cpl_snd        ! routine called by step.F90 
    6354   PUBLIC   sbc_cpl_ice_tau    ! routine called by sbc_ice_lim(_2).F90 
    6455   PUBLIC   sbc_cpl_ice_flx    ! routine called by sbc_ice_lim(_2).F90 
     56   PUBLIC   sbc_cpl_alloc      ! routine called in sbcice_cice.F90 
    6557 
    6658   INTEGER, PARAMETER ::   jpr_otx1   =  1            ! 3 atmosphere-ocean stress components on grid 1 
     
    129121   TYPE(FLD_C) ::   sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf 
    130122   TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2                         
     123   ! Other namelist parameters                        ! 
     124   INTEGER     ::   nn_cplmodel            ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 
     125   LOGICAL     ::   ln_usecplmask          !  use a coupling mask file to merge data received from several models 
     126                                           !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
     127 
     128   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: xcplmask 
    131129 
    132130   TYPE ::   DYNARR      
     
    139137 
    140138   INTEGER , ALLOCATABLE, SAVE, DIMENSION(    :) ::   nrcvinfo           ! OASIS info argument 
    141  
    142 #if ! defined key_lim2   &&   ! defined key_lim3 
    143    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice,fr1_i0,fr2_i0          ! jpi, jpj 
    144    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice, alb_ice, qns_ice, dqns_ice  ! (jpi,jpj,jpl) 
    145 #endif 
    146  
    147 #if defined key_cice 
    148    INTEGER, PARAMETER ::   jpl = ncat 
    149 #elif ! defined key_lim2   &&   ! defined key_lim3 
    150    INTEGER, PARAMETER ::   jpl = 1  
    151    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice 
    152    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice 
    153 #endif 
    154  
    155 #if ! defined key_lim3   &&  ! defined key_cice 
    156    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i 
    157 #endif 
    158  
    159 #if ! defined key_lim3 
    160    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  ht_i, ht_s 
    161 #endif 
    162  
    163 #if ! defined key_cice 
    164    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  topmelt, botmelt 
    165 #endif 
    166139 
    167140   !! Substitution 
     
    179152      !!             ***  FUNCTION sbc_cpl_alloc  *** 
    180153      !!---------------------------------------------------------------------- 
    181       INTEGER :: ierr(4),jn 
     154      INTEGER :: ierr(3) 
    182155      !!---------------------------------------------------------------------- 
    183156      ierr(:) = 0 
    184157      ! 
    185158      ALLOCATE( albedo_oce_mix(jpi,jpj), nrcvinfo(jprcv),  STAT=ierr(1) ) 
    186       ! 
    187 #if ! defined key_lim2 && ! defined key_lim3 
    188       ! quick patch to be able to run the coupled model without sea-ice... 
    189       ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) ,     & 
    190                 v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,1),      & 
    191                 emp_ice(jpi,jpj) , qns_ice(jpi,jpj,1) , dqns_ice(jpi,jpj,1) , STAT=ierr(2) ) 
     159       
     160#if ! defined key_lim3 && ! defined key_lim2 && ! defined key_cice 
     161      ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) )  ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 
    192162#endif 
    193  
    194 #if ! defined key_lim3 && ! defined key_cice 
    195       ALLOCATE( a_i(jpi,jpj,jpl) , STAT=ierr(3) ) 
    196 #endif 
    197  
    198 #if defined key_cice || defined key_lim2 
    199       ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(4) ) 
    200 #endif 
     163      ALLOCATE( xcplmask(jpi,jpj,nn_cplmodel) , STAT=ierr(3) ) 
     164      ! 
    201165      sbc_cpl_alloc = MAXVAL( ierr ) 
    202166      IF( lk_mpp            )   CALL mpp_sum ( sbc_cpl_alloc ) 
     
    210174      !!             ***  ROUTINE sbc_cpl_init  *** 
    211175      !! 
    212       !! ** Purpose :   Initialisation of send and recieved information from 
     176      !! ** Purpose :   Initialisation of send and received information from 
    213177      !!                the atmospheric component 
    214178      !! 
     
    222186      INTEGER ::   jn   ! dummy loop index 
    223187      INTEGER ::   ios  ! Local integer output status for namelist read 
     188      INTEGER ::   inum  
    224189      REAL(wp), POINTER, DIMENSION(:,:) ::   zacs, zaos 
    225190      !! 
    226       NAMELIST/namsbc_cpl/  sn_snd_temp, sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2,   & 
    227          &                  sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr,   & 
    228          &                  sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf  , sn_rcv_cal   , sn_rcv_iceflx  , sn_rcv_co2 
     191      NAMELIST/namsbc_cpl/  sn_snd_temp, sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2,      & 
     192         &                  sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr,      & 
     193         &                  sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf  , sn_rcv_cal   , sn_rcv_iceflx,   & 
     194         &                  sn_rcv_co2 , nn_cplmodel  , ln_usecplmask 
    229195      !!--------------------------------------------------------------------- 
    230196      ! 
     
    274240         WRITE(numout,*)'                      - mesh          = ', sn_snd_crt%clvgrd 
    275241         WRITE(numout,*)'      oce co2 flux                    = ', TRIM(sn_snd_co2%cldes   ), ' (', TRIM(sn_snd_co2%clcat   ), ')' 
     242         WRITE(numout,*)'  nn_cplmodel                         = ', nn_cplmodel 
     243         WRITE(numout,*)'  ln_usecplmask                       = ', ln_usecplmask 
    276244      ENDIF 
    277245 
     
    485453      END DO 
    486454      ! Allocate taum part of frcv which is used even when not received as coupling field 
    487       IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jn)%nct) ) 
     455      IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 
    488456      ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 
    489457      IF( k_ice /= 0 ) THEN 
    490          IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jn)%nct) ) 
    491          IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jn)%nct) ) 
     458         IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 
     459         IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 
    492460      END IF 
    493461 
     
    604572      ! ================================ ! 
    605573 
    606       CALL cpl_prism_define(jprcv, jpsnd)             
    607       ! 
    608       IF( ln_dm2dc .AND. ( cpl_prism_freq( jpr_qsroce ) + cpl_prism_freq( jpr_qsrmix ) /= 86400 ) )   & 
     574      CALL cpl_define(jprcv, jpsnd,nn_cplmodel)             
     575      IF (ln_usecplmask) THEN  
     576         xcplmask(:,:,:) = 0. 
     577         CALL iom_open( 'cplmask', inum ) 
     578         CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1:nlci,1:nlcj,1:nn_cplmodel),   & 
     579            &          kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,nn_cplmodel /) ) 
     580         CALL iom_close( inum ) 
     581      ELSE 
     582         xcplmask(:,:,:) = 1. 
     583      ENDIF 
     584      ! 
     585      IF( ln_dm2dc .AND. ( cpl_freq( jpr_qsroce ) + cpl_freq( jpr_qsrmix ) /= 86400 ) )   & 
    609586         &   CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 
    610587 
     
    654631      !! 
    655632      !! ** Action  :   update  utau, vtau   ocean stress at U,V grid  
    656       !!                        taum, wndm   wind stres and wind speed module at T-point 
     633      !!                        taum         wind stress module at T-point 
     634      !!                        wndm         wind speed  module at T-point over free ocean or leads in presence of sea-ice 
    657635      !!                        qns          non solar heat fluxes including emp heat content    (ocean only case) 
    658636      !!                                     and the latent heat flux of solid precip. melting 
     
    678656      ! 
    679657      CALL wrk_alloc( jpi,jpj, ztx, zty ) 
    680  
    681       IF( kt == nit000 )   CALL sbc_cpl_init( k_ice )          ! initialisation 
    682  
    683658      !                                                 ! Receive all the atmos. fields (including ice information) 
    684659      isec = ( kt - nit000 ) * NINT( rdttra(1) )             ! date of exchanges 
    685660      DO jn = 1, jprcv                                       ! received fields sent by the atmosphere 
    686          IF( srcv(jn)%laction )   CALL cpl_prism_rcv( jn, isec, frcv(jn)%z3, nrcvinfo(jn) ) 
     661         IF( srcv(jn)%laction )   CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask, nrcvinfo(jn) ) 
    687662      END DO 
    688663 
     
    848823         IF( srcv(jpr_qnsoce)%laction )   qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 
    849824         IF( srcv(jpr_qnsmix)%laction )   qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
    850          ! add the latent heat of solid precip. melting 
    851          IF( srcv(jpr_snow  )%laction )   THEN                         ! update qns over the free ocean with: 
    852               qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus  & ! energy for melting solid precipitation over the free ocean 
    853            &           - emp(:,:) * sst_m(:,:) * rcp                   ! remove heat content due to mass flux (assumed to be at SST) 
     825         ! update qns over the free ocean with: 
     826         qns(:,:) =  qns(:,:) - emp(:,:) * sst_m(:,:) * rcp            ! remove heat content due to mass flux (assumed to be at SST) 
     827         IF( srcv(jpr_snow  )%laction )   THEN 
     828              qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus    ! energy for melting solid precipitation over the free ocean 
    854829         ENDIF 
    855830 
     
    914889      CALL wrk_alloc( jpi,jpj, ztx, zty ) 
    915890 
    916 !AC Pour eviter un stress nul sur la glace dans le cas mixed oce-ice 
    917       IF( srcv(jpr_itx1)%laction .AND. TRIM( sn_rcv_tau%cldes ) == 'oce and ice') THEN   ;   itx =  jpr_itx1    
     891      IF( srcv(jpr_itx1)%laction ) THEN   ;   itx =  jpr_itx1    
    918892      ELSE                                ;   itx =  jpr_otx1 
    919893      ENDIF 
     
    922896      IF(  nrcvinfo(itx) == OASIS_Rcv ) THEN 
    923897 
    924          !                                                                                              ! ======================= ! 
    925 !AC Pour eviter un stress nul sur la glace dans le cas mixes oce-ice 
    926          IF( srcv(jpr_itx1)%laction .AND. TRIM( sn_rcv_tau%cldes ) == 'oce and ice') THEN               !   ice stress received   ! 
    927             !                                                                                           ! ======================= ! 
     898         !                                                      ! ======================= ! 
     899         IF( srcv(jpr_itx1)%laction ) THEN                      !   ice stress received   ! 
     900            !                                                   ! ======================= ! 
    928901            !   
    929902            IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN            ! 2 components on the sphere 
     
    11251098      REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   p_frld     ! lead fraction                [0 to 1] 
    11261099      ! optional arguments, used only in 'mixed oce-ice' case 
    1127       REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! ice albedo  
    1128       REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature     [Celcius] 
     1100      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! all skies ice albedo  
     1101      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature     [Celsius] 
    11291102      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature     [Kelvin] 
    11301103      ! 
     
    11531126         emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - tprecip(:,:) 
    11541127         emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 
    1155                            CALL iom_put( 'rain'         , frcv(jpr_rain)%z3(:,:,1)              )   ! liquid precipitation  
    1156          IF( lk_diaar5 )   CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from liq. precip.  
    1157          ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 
    1158                            CALL iom_put( 'evap_ao_cea'  , ztmp                            )   ! ice-free oce evap (cell average) 
    1159          IF( lk_diaar5 )   CALL iom_put( 'hflx_evap_cea', ztmp(:,:         ) * zcptn(:,:) )   ! heat flux from from evap (cell ave) 
     1128            CALL iom_put( 'rain'         , frcv(jpr_rain)%z3(:,:,1)              )   ! liquid precipitation  
     1129         IF( iom_use('hflx_rain_cea') )   & 
     1130            CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from liq. precip.  
     1131         IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') )   & 
     1132            ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 
     1133         IF( iom_use('evap_ao_cea'  ) )   & 
     1134            CALL iom_put( 'evap_ao_cea'  , ztmp                   )   ! ice-free oce evap (cell average) 
     1135         IF( iom_use('hflx_evap_cea') )   & 
     1136            CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) )   ! heat flux from from evap (cell average) 
    11601137      CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 
    11611138         emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 
     
    11641141      END SELECT 
    11651142 
    1166       CALL iom_put( 'snowpre'    , sprecip                                )   ! Snow 
    1167       CALL iom_put( 'snow_ao_cea', sprecip(:,:         ) * p_frld(:,:)    )   ! Snow        over ice-free ocean  (cell average) 
    1168       CALL iom_put( 'snow_ai_cea', sprecip(:,:         ) * zicefr(:,:)    )   ! Snow        over sea-ice         (cell average) 
    1169       CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )   ! Sublimation over sea-ice         (cell average) 
     1143         CALL iom_put( 'snowpre'    , sprecip                                )   ! Snow 
     1144      IF( iom_use('snow_ao_cea') )   & 
     1145         CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:)             )   ! Snow        over ice-free ocean  (cell average) 
     1146      IF( iom_use('snow_ai_cea') )   & 
     1147         CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:)             )   ! Snow        over sea-ice         (cell average) 
     1148      IF( iom_use('subl_ai_cea') )   & 
     1149         CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )   ! Sublimation over sea-ice         (cell average) 
    11701150      !    
    11711151      !                                                           ! runoffs and calving (put in emp_tot) 
    11721152      IF( srcv(jpr_rnf)%laction ) THEN  
    11731153         emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) 
    1174                            CALL iom_put( 'runoffs'      , frcv(jpr_rnf)%z3(:,:,1)              )   ! rivers 
    1175          IF( lk_diaar5 )   CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from rivers 
     1154            CALL iom_put( 'runoffs'      , frcv(jpr_rnf)%z3(:,:,1)              )   ! rivers 
     1155         IF( iom_use('hflx_rnf_cea') )   & 
     1156            CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from rivers 
    11761157      ENDIF 
    11771158      IF( srcv(jpr_cal)%laction ) THEN  
     
    12181199            ENDDO 
    12191200         ELSE 
     1201            qns_tot(:,:   ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
    12201202            DO jl=1,jpl 
    1221                qns_tot(:,:   ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
    12221203               qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
    12231204            ENDDO 
     
    12351216         &          - (  emp_tot(:,:)                     &            ! remove the heat content of mass flux (assumed to be at SST) 
    12361217         &             - emp_ice(:,:) * zicefr(:,:)  ) * zcptn(:,:)  
    1237       IF( lk_diaar5 )   CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average) 
     1218      IF( iom_use('hflx_snow_cea') )   & 
     1219         CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average) 
    12381220!!gm 
    12391221!!    currently it is taken into account in leads budget but not in the qns_tot, and thus not in  
     
    12471229         ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus               ! add the latent heat of iceberg melting  
    12481230         qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:) 
    1249          IF( lk_diaar5 )   CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from calving 
     1231         IF( iom_use('hflx_cal_cea') )   & 
     1232            CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from calving 
    12501233      ENDIF 
    12511234 
     
    12751258            ENDDO 
    12761259         ELSE 
     1260            qsr_tot(:,:   ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
    12771261            DO jl=1,jpl 
    1278                qsr_tot(:,:   ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
    12791262               qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
    12801263            ENDDO 
     
    12961279      ENDIF 
    12971280 
    1298       SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) 
     1281      !                                                      ! ========================= ! 
     1282      SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) )             !          d(qns)/dt        ! 
     1283      !                                                      ! ========================= ! 
    12991284      CASE ('coupled') 
    13001285         IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 
     
    13081293      END SELECT 
    13091294 
    1310       SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) 
     1295      !                                                      ! ========================= ! 
     1296      SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) )             !    topmelt and botmelt    ! 
     1297      !                                                      ! ========================= ! 
    13111298      CASE ('coupled') 
    13121299         topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:) 
     
    13141301      END SELECT 
    13151302 
    1316       !    Ice Qsr penetration used (only?)in lim2 or lim3  
    1317       ! fraction of net shortwave radiation which is not absorbed in the thin surface layer  
    1318       ! and penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 
     1303      ! Surface transimission parameter io (Maykut Untersteiner , 1971 ; Ebert and Curry, 1993 ) 
     1304      ! Used for LIM2 and LIM3 
    13191305      ! Coupled case: since cloud cover is not received from atmosphere  
    1320       !               ===> defined as constant value -> definition done in sbc_cpl_init 
    1321       fr1_i0(:,:) = 0.18 
    1322       fr2_i0(:,:) = 0.82 
    1323  
     1306      !               ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 
     1307      fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 
     1308      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 
    13241309 
    13251310      CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr ) 
     
    13361321      !! ** Purpose :   provide the ocean-ice informations to the atmosphere 
    13371322      !! 
    1338       !! ** Method  :   send to the atmosphere through a call to cpl_prism_snd 
     1323      !! ** Method  :   send to the atmosphere through a call to cpl_snd 
    13391324      !!              all the needed fields (as defined in sbc_cpl_init) 
    13401325      !!---------------------------------------------------------------------- 
     
    13551340 
    13561341      zfr_l(:,:) = 1.- fr_i(:,:) 
    1357  
    13581342      !                                                      ! ------------------------- ! 
    13591343      !                                                      !    Surface temperature    !   in Kelvin 
     
    13741358            END SELECT 
    13751359         CASE( 'mixed oce-ice'        )    
    1376             ztmp1(:,:) = ( tsn(:,:,1,1) + rt0 ) * zfr_l(:,:)  
     1360            ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:)  
    13771361            DO jl=1,jpl 
    13781362               ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 
     
    13801364         CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 
    13811365         END SELECT 
    1382          IF( ssnd(jps_toce)%laction )   CALL cpl_prism_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
    1383          IF( ssnd(jps_tice)%laction )   CALL cpl_prism_snd( jps_tice, isec, ztmp3, info ) 
    1384          IF( ssnd(jps_tmix)%laction )   CALL cpl_prism_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
    1385       ENDIF 
    1386       ! 
     1366         IF( ssnd(jps_toce)%laction )   CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
     1367         IF( ssnd(jps_tice)%laction )   CALL cpl_snd( jps_tice, isec, ztmp3, info ) 
     1368         IF( ssnd(jps_tmix)%laction )   CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
     1369      ENDIF 
    13871370      !                                                      ! ------------------------- ! 
    13881371      !                                                      !           Albedo          ! 
     
    13901373      IF( ssnd(jps_albice)%laction ) THEN                         ! ice  
    13911374         ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
    1392          CALL cpl_prism_snd( jps_albice, isec, ztmp3, info ) 
     1375         CALL cpl_snd( jps_albice, isec, ztmp3, info ) 
    13931376      ENDIF 
    13941377      IF( ssnd(jps_albmix)%laction ) THEN                         ! mixed ice-ocean 
     
    13971380            ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl) 
    13981381         ENDDO 
    1399          CALL cpl_prism_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
     1382         CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
    14001383      ENDIF 
    14011384      !                                                      ! ------------------------- ! 
     
    14091392         CASE default    ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 
    14101393         END SELECT 
    1411          CALL cpl_prism_snd( jps_fice, isec, ztmp3, info ) 
     1394         CALL cpl_snd( jps_fice, isec, ztmp3, info ) 
    14121395      ENDIF 
    14131396 
     
    14341417         CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' ) 
    14351418         END SELECT 
    1436          IF( ssnd(jps_hice)%laction )   CALL cpl_prism_snd( jps_hice, isec, ztmp3, info ) 
    1437          IF( ssnd(jps_hsnw)%laction )   CALL cpl_prism_snd( jps_hsnw, isec, ztmp4, info ) 
     1419         IF( ssnd(jps_hice)%laction )   CALL cpl_snd( jps_hice, isec, ztmp3, info ) 
     1420         IF( ssnd(jps_hsnw)%laction )   CALL cpl_snd( jps_hsnw, isec, ztmp4, info ) 
    14381421      ENDIF 
    14391422      ! 
     
    14421425      !                                                      !  CO2 flux from PISCES     !  
    14431426      !                                                      ! ------------------------- ! 
    1444       IF( ssnd(jps_co2)%laction )   CALL cpl_prism_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info ) 
     1427      IF( ssnd(jps_co2)%laction )   CALL cpl_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info ) 
    14451428      ! 
    14461429#endif 
     
    15651548         ENDIF 
    15661549         ! 
    1567          IF( ssnd(jps_ocx1)%laction )   CALL cpl_prism_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info )   ! ocean x current 1st grid 
    1568          IF( ssnd(jps_ocy1)%laction )   CALL cpl_prism_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info )   ! ocean y current 1st grid 
    1569          IF( ssnd(jps_ocz1)%laction )   CALL cpl_prism_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info )   ! ocean z current 1st grid 
     1550         IF( ssnd(jps_ocx1)%laction )   CALL cpl_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info )   ! ocean x current 1st grid 
     1551         IF( ssnd(jps_ocy1)%laction )   CALL cpl_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info )   ! ocean y current 1st grid 
     1552         IF( ssnd(jps_ocz1)%laction )   CALL cpl_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info )   ! ocean z current 1st grid 
    15701553         ! 
    1571          IF( ssnd(jps_ivx1)%laction )   CALL cpl_prism_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info )   ! ice   x current 1st grid 
    1572          IF( ssnd(jps_ivy1)%laction )   CALL cpl_prism_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info )   ! ice   y current 1st grid 
    1573          IF( ssnd(jps_ivz1)%laction )   CALL cpl_prism_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info )   ! ice   z current 1st grid 
     1554         IF( ssnd(jps_ivx1)%laction )   CALL cpl_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info )   ! ice   x current 1st grid 
     1555         IF( ssnd(jps_ivy1)%laction )   CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info )   ! ice   y current 1st grid 
     1556         IF( ssnd(jps_ivz1)%laction )   CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info )   ! ice   z current 1st grid 
    15741557         !  
    15751558      ENDIF 
     
    15821565   END SUBROUTINE sbc_cpl_snd 
    15831566    
    1584 #else 
    1585    !!---------------------------------------------------------------------- 
    1586    !!   Dummy module                                            NO coupling 
    1587    !!---------------------------------------------------------------------- 
    1588    USE par_kind        ! kind definition 
    1589 CONTAINS 
    1590    SUBROUTINE sbc_cpl_snd( kt ) 
    1591       WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', kt 
    1592    END SUBROUTINE sbc_cpl_snd 
    1593    ! 
    1594    SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice )      
    1595       WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', kt, k_fsbc, k_ice 
    1596    END SUBROUTINE sbc_cpl_rcv 
    1597    ! 
    1598    SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj )      
    1599       REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_taui   ! i- & j-components of atmos-ice stress [N/m2] 
    1600       REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_tauj   ! at I-point (B-grid) or U & V-point (C-grid) 
    1601       p_taui(:,:) = 0.   ;   p_tauj(:,:) = 0. ! stupid definition to avoid warning message when compiling... 
    1602       WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?' 
    1603    END SUBROUTINE sbc_cpl_ice_tau 
    1604    ! 
    1605    SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi   , psst    , pist  ) 
    1606       REAL(wp), INTENT(in   ), DIMENSION(:,:  ) ::   p_frld     ! lead fraction                [0 to 1] 
    1607       REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! ice albedo 
    1608       REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature      [Celcius] 
    1609       REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature      [Kelvin] 
    1610       WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', p_frld(1,1), palbi(1,1,1), psst(1,1), pist(1,1,1)  
    1611    END SUBROUTINE sbc_cpl_ice_flx 
    1612     
    1613 #endif 
    1614  
    16151567   !!====================================================================== 
    16161568END MODULE sbccpl 
Note: See TracChangeset for help on using the changeset viewer.