Changeset 5663


Ignore:
Timestamp:
2015-08-03T15:53:06+02:00 (5 years ago)
Author:
dancopsey
Message:

Merged in Alex West's GSI8 changes from eld259:/data/local/hadax/FCM_working/NEMO/Multilayers/NEMO3.6_stable/UKMO1_CICE_coupling_GSI7_GSI8

Location:
branches/UKMO/dev_r5518_CICE_coupling_GSI7_GSI8/NEMOGCM/NEMO/OPA_SRC
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_CICE_coupling_GSI7_GSI8/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90

    r5662 r5663  
    6868   REAL(wp), PUBLIC ::   rcdsn    =    0.31_wp       !: thermal conductivity of snow 
    6969   REAL(wp), PUBLIC ::   cpic     = 2067.0_wp        !: specific heat for ice  
     70#if defined key_cice 
     71   REAL(wp), PUBLIC ::   lsub     =    2.835e+6_wp   !: pure ice latent heat of sublimation                   [J/kg] 
     72#else 
    7073   REAL(wp), PUBLIC ::   lsub     =    2.834e+6_wp   !: pure ice latent heat of sublimation                   [J/kg] 
     74#endif 
    7175   REAL(wp), PUBLIC ::   lfus     =    0.334e+6_wp   !: latent heat of fusion of fresh ice                    [J/kg] 
    7276   REAL(wp), PUBLIC ::   tmut     =    0.054_wp      !: decrease of seawater meltpoint with salinity 
  • branches/UKMO/dev_r5518_CICE_coupling_GSI7_GSI8/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90

    r5662 r5663  
    101101   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr_iu              !: ice fraction at NEMO U point 
    102102   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr_iv              !: ice fraction at NEMO V point 
    103     
     103   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sstfrz             !: sea surface freezing temperature 
     104   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tsfc_ice           !: sea-ice surface skin temperature (on categories) 
     105   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   kn_ice             !: sea-ice surface layer thermal conductivity (on cats) 
     106 
    104107   ! variables used in the coupled interface 
    105108   INTEGER , PUBLIC, PARAMETER ::   jpl = ncat 
    106109   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice          ! jpi, jpj 
     110   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_p, ht_p ! Meltpond fraction and depth 
    107111#endif 
    108112    
     
    152156 
    153157#if defined key_cice 
    154       ALLOCATE( qla_ice(jpi,jpj,1)    , qlw_ice(jpi,jpj,1)    , qsr_ice(jpi,jpj,1)    , & 
     158      ALLOCATE( qla_ice(jpi,jpj,ncat) , qlw_ice(jpi,jpj,1)    , qsr_ice(jpi,jpj,1)    , & 
    155159                wndi_ice(jpi,jpj)     , tatm_ice(jpi,jpj)     , qatm_ice(jpi,jpj)     , & 
    156160                wndj_ice(jpi,jpj)     , nfrzmlt(jpi,jpj)      , ss_iou(jpi,jpj)       , & 
    157161                ss_iov(jpi,jpj)       , fr_iu(jpi,jpj)        , fr_iv(jpi,jpj)        , & 
    158162                a_i(jpi,jpj,ncat)     , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat) , & 
    159                 STAT= ierr(1) ) 
    160       IF( ln_cpl )   ALLOCATE( u_ice(jpi,jpj)        , fr1_i0(jpi,jpj)       , tn_ice (jpi,jpj,1)    , & 
     163                sstfrz(jpi,jpj)       , STAT= ierr(1) ) 
     164   ! Alex West: Allocating tn_ice with 5 categories.  When NEMO is used with CICE, this variable 
     165   ! represents top layer ice temperature, which is multi-category. 
     166      IF( ln_cpl )   ALLOCATE( u_ice(jpi,jpj)        , fr1_i0(jpi,jpj)       , tn_ice (jpi,jpj,jpl)  , & 
    161167         &                     v_ice(jpi,jpj)        , fr2_i0(jpi,jpj)       , alb_ice(jpi,jpj,1)    , & 
    162168         &                     emp_ice(jpi,jpj)      , qns_ice(jpi,jpj,1)    , dqns_ice(jpi,jpj,1)   , & 
    163          &                     STAT= ierr(2) ) 
     169         &                     a_p(jpi,jpj,jpl)      , ht_p(jpi,jpj,jpl)     , tsfc_ice(jpi,jpj,jpl) , & 
     170         &                     kn_ice(jpi,jpj,jpl) ,    STAT=ierr(2) ) 
    164171       
    165172#endif 
  • branches/UKMO/dev_r5518_CICE_coupling_GSI7_GSI8/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r5662 r5663  
    4646   USE p4zflx, ONLY : oce_co2 
    4747#endif 
    48 #if defined key_cice 
    49    USE ice_domain_size, only: ncat 
    50 #endif 
    5148#if defined key_lim3 
    5249   USE limthd_dh       ! for CALL lim_thd_snwblow 
     
    105102   INTEGER, PARAMETER ::   jpr_e3t1st = 41            ! first T level thickness  
    106103   INTEGER, PARAMETER ::   jpr_fraqsr = 42            ! fraction of solar net radiation absorbed in the first ocean level 
    107    INTEGER, PARAMETER ::   jprcv      = 42            ! total number of fields received 
     104   INTEGER, PARAMETER ::   jpr_ts_ice = 43            ! skin temperature of sea-ice (used for melt-ponds) 
     105   INTEGER, PARAMETER ::   jprcv      = 43            ! total number of fields received 
    108106 
    109107   INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction sent to the atmosphere 
     
    135133   INTEGER, PARAMETER ::   jps_e3t1st = 27            ! first level depth (vvl) 
    136134   INTEGER, PARAMETER ::   jps_fraqsr = 28            ! fraction of solar net radiation absorbed in the first ocean level 
    137    INTEGER, PARAMETER ::   jpsnd      = 28            ! total number of fields sended 
     135   INTEGER, PARAMETER ::   jps_a_p    = 29            ! meltpond fraction   
     136   INTEGER, PARAMETER ::   jps_ht_p   = 30            ! meltpond depth (m)  
     137   INTEGER, PARAMETER ::   jps_kice   = 31            ! ice surface layer thermal conductivity 
     138   INTEGER, PARAMETER ::   jps_sstfrz = 32            ! sea-surface freezing temperature 
     139   INTEGER, PARAMETER ::   jps_fice1  = 33            ! first-order ice concentration (for time-travelling ice coupling) 
     140   INTEGER, PARAMETER ::   jpsnd      = 33            ! total number of fields sended 
    138141 
    139142   !                                                         !!** namelist namsbc_cpl ** 
     
    146149   END TYPE FLD_C 
    147150   ! Send to the atmosphere                           ! 
    148    TYPE(FLD_C) ::   sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2                         
     151   TYPE(FLD_C) ::   sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2, sn_snd_cond, sn_snd_mpnd, sn_snd_sstfrz, sn_snd_thick1 
     152 
    149153   ! Received from the atmosphere                     ! 
    150154   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 
    151    TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2                         
     155   TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_ts_ice  
    152156   ! Other namelist parameters                        ! 
    153157   INTEGER     ::   nn_cplmodel            ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 
     
    217221      !! 
    218222      NAMELIST/namsbc_cpl/  sn_snd_temp, sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2,      & 
     223         &                  sn_snd_cond, sn_snd_mpnd, sn_snd_sstfrz,                                  & 
    219224         &                  sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr,      & 
    220225         &                  sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf  , sn_rcv_cal   , sn_rcv_iceflx,   & 
    221          &                  sn_rcv_co2 , nn_cplmodel , ln_usecplmask 
     226         &                  sn_rcv_co2 , sn_rcv_ts_ice, nn_cplmodel , ln_usecplmask 
    222227      !!--------------------------------------------------------------------- 
    223228      ! 
     
    269274         WRITE(numout,*)'                      - mesh          = ', sn_snd_crt%clvgrd 
    270275         WRITE(numout,*)'      oce co2 flux                    = ', TRIM(sn_snd_co2%cldes   ), ' (', TRIM(sn_snd_co2%clcat   ), ')' 
     276         WRITE(numout,*)'      ice effective conductivity      = ', TRIM(sn_snd_cond%cldes   ), ' (', TRIM(sn_snd_cond%clcat   ), ')' 
     277         WRITE(numout,*)'      meltponds fraction & depth      = ', TRIM(sn_snd_mpnd%cldes  ), ' (', TRIM(sn_snd_mpnd%clcat   ), ')' 
     278         WRITE(numout,*)'      sea surface freezing temp       = ', TRIM(sn_snd_sstfrz%cldes   ), ' (', TRIM(sn_snd_sstfrz%clcat   ), ')' 
     279 
    271280         WRITE(numout,*)'  nn_cplmodel                         = ', nn_cplmodel 
    272281         WRITE(numout,*)'  ln_usecplmask                       = ', ln_usecplmask 
     
    383392      srcv(jpr_snow)%clname = 'OTotSnow'      ! Snow = solid precipitation 
    384393      srcv(jpr_tevp)%clname = 'OTotEvap'      ! total evaporation (over oce + ice sublimation) 
    385       srcv(jpr_ievp)%clname = 'OIceEvap'      ! evaporation over ice = sublimation 
     394      srcv(jpr_ievp)%clname = 'OIceEvp'      ! evaporation over ice = sublimation 
    386395      srcv(jpr_sbpr)%clname = 'OSubMPre'      ! sublimation - liquid precipitation - solid precipitation  
    387396      srcv(jpr_semp)%clname = 'OISubMSn'      ! ice solid water budget = sublimation - solid precipitation 
     
    396405      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' ) 
    397406      END SELECT 
    398  
     407      !Set the number of categories for coupling of sublimation 
     408      IF ( TRIM( sn_rcv_emp%clcat ) == 'yes' ) srcv(jpr_ievp)%nct = jpl 
     409      ! 
    399410      !                                                      ! ------------------------- ! 
    400411      !                                                      !     Runoffs & Calving     !    
     
    483494         srcv(jpr_topm:jpr_botm)%laction = .TRUE. 
    484495      ENDIF 
     496       
     497#if defined key_cice && ! defined key_cice4 
     498      !                                                      ! ----------------------------- ! 
     499      !                                                      !  sea-ice skin temperature     !    
     500      !                                                      !  used in meltpond scheme      ! 
     501      !                                                      !  May be calculated in Atm     ! 
     502      !                                                      ! ----------------------------- ! 
     503      srcv(jpr_ts_ice)%clname = 'OTsfIce' 
     504      IF ( TRIM( sn_rcv_ts_ice%cldes ) == 'ice' ) srcv(jpr_ts_ice)%laction = .TRUE. 
     505      IF ( TRIM( sn_rcv_ts_ice%clcat ) == 'yes' ) srcv(jpr_ts_ice)%nct = jpl 
     506      !TODO: Should there be a consistency check here? 
     507#endif 
     508 
    485509      !                                                      ! ------------------------------- ! 
    486510      !                                                      !   OPA-SAS coupling - rcv by opa !    
     
    600624      !                                                      ! ------------------------- ! 
    601625      ssnd(jps_toce)%clname = 'O_SSTSST' 
    602       ssnd(jps_tice)%clname = 'O_TepIce' 
     626      ssnd(jps_tice)%clname = 'OTepIce' 
    603627      ssnd(jps_tmix)%clname = 'O_TepMix' 
    604628      SELECT CASE( TRIM( sn_snd_temp%cldes ) ) 
    605629      CASE( 'none'                                 )       ! nothing to do 
    606630      CASE( 'oce only'                             )   ;   ssnd( jps_toce )%laction = .TRUE. 
    607       CASE( 'oce and ice' , 'weighted oce and ice' ) 
     631      CASE( 'oce and ice' , 'weighted oce and ice' , 'oce and weighted ice') 
    608632         ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 
    609633         IF ( TRIM( sn_snd_temp%clcat ) == 'yes' )  ssnd(jps_tice)%nct = jpl 
     
    634658 
    635659      !                                                      ! ------------------------- ! 
    636       !                                                      !  Ice fraction & Thickness !  
     660      !                                                      !  Ice fraction & Thickness  
    637661      !                                                      ! ------------------------- ! 
    638662      ssnd(jps_fice)%clname = 'OIceFrc' 
    639663      ssnd(jps_hice)%clname = 'OIceTck' 
    640664      ssnd(jps_hsnw)%clname = 'OSnwTck' 
     665      ssnd(jps_a_p)%clname  = 'OPndFrc' 
     666      ssnd(jps_ht_p)%clname = 'OPndTck' 
     667      ssnd(jps_fice1)%clname = 'OIceFrd' 
    641668      IF( k_ice /= 0 ) THEN 
    642669         ssnd(jps_fice)%laction = .TRUE.                  ! if ice treated in the ocean (even in climato case) 
     670         ssnd(jps_fice1)%laction = .TRUE.                 ! First-order regridded ice concentration, to be used 
     671                                                     ! in producing atmos-to-ice fluxes 
    643672! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now 
    644673         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl 
     674         IF ( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = jpl 
    645675      ENDIF 
    646676       
     
    657687      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' ) 
    658688      END SELECT 
     689 
     690      !                                                      ! ------------------------- ! 
     691      !                                                      ! Ice Meltponds             ! 
     692      !                                                      ! ------------------------- ! 
     693#if defined key_cice && ! defined key_cice4 
     694      ! Meltponds only CICE5  
     695      ssnd(jps_a_p)%clname = 'OPndFrc'    
     696      ssnd(jps_ht_p)%clname = 'OPndTck'    
     697      SELECT CASE ( TRIM( sn_snd_mpnd%cldes ) ) 
     698      CASE ( 'none' ) 
     699         ssnd(jps_a_p)%laction = .FALSE. 
     700         ssnd(jps_ht_p)%laction = .FALSE. 
     701      CASE ( 'ice only' )  
     702         ssnd(jps_a_p)%laction = .TRUE. 
     703         ssnd(jps_ht_p)%laction = .TRUE. 
     704         IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 
     705            ssnd(jps_a_p)%nct = jpl 
     706            ssnd(jps_ht_p)%nct = jpl 
     707         ELSE 
     708            IF ( jpl > 1 ) THEN 
     709               CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_mpnd%cldes if not exchanging category fields' ) 
     710            ENDIF 
     711         ENDIF 
     712      CASE ( 'weighted ice' )  
     713         ssnd(jps_a_p)%laction = .TRUE. 
     714         ssnd(jps_ht_p)%laction = .TRUE. 
     715         IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 
     716            ssnd(jps_a_p)%nct = jpl  
     717            ssnd(jps_ht_p)%nct = jpl  
     718         ENDIF 
     719      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_mpnd%cldes' ) 
     720      END SELECT 
     721#else 
     722      IF( TRIM( sn_snd_mpnd%cldes /= 'none' ) THEN 
     723         CALL ctl_stop('Meltponds can only be used with CICEv5') 
     724      ENDIF 
     725#endif 
    659726 
    660727      !                                                      ! ------------------------- ! 
     
    689756      !                                                      ! ------------------------- ! 
    690757      ssnd(jps_co2)%clname = 'O_CO2FLX' ;  IF( TRIM(sn_snd_co2%cldes) == 'coupled' )    ssnd(jps_co2 )%laction = .TRUE. 
     758      ! 
     759       
     760      !                                                      ! ------------------------- ! 
     761      !                                                      ! Sea surface freezing temp ! 
     762      !                                                      ! ------------------------- ! 
     763      ssnd(jps_sstfrz)%clname = 'O_SSTFrz' ; IF( TRIM(sn_snd_sstfrz%cldes) == 'coupled' )  ssnd(jps_sstfrz)%laction = .TRUE. 
     764      ! 
     765      !                                                      ! ------------------------- ! 
     766      !                                                      !    Ice conductivity       ! 
     767      !                                                      ! ------------------------- ! 
     768      ! Note that ultimately we will move to passing an ocean effective conductivity as well so there 
     769      ! will be some changes to the parts of the code which currently relate only to ice conductivity 
     770      ssnd(jps_kice )%clname = 'OIceKn' 
     771      SELECT CASE ( TRIM( sn_snd_cond%cldes ) ) 
     772      CASE ( 'none' ) 
     773         ssnd(jps_kice)%laction = .FALSE. 
     774      CASE ( 'ice only' ) 
     775         ssnd(jps_kice)%laction = .TRUE. 
     776         IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN 
     777            ssnd(jps_kice)%nct = jpl 
     778         ELSE 
     779            IF ( jpl > 1 ) THEN 
     780               CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_cond%cldes if not exchanging category fields' ) 
     781            ENDIF 
     782         ENDIF 
     783      CASE ( 'weighted ice' ) 
     784         ssnd(jps_kice)%laction = .TRUE. 
     785         IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = jpl 
     786      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_cond%cldes' ) 
     787      END SELECT 
     788      ! 
     789       
    691790 
    692791      !                                                      ! ------------------------------- ! 
     
    843942      !! 
    844943      LOGICAL  ::   llnewtx, llnewtau      ! update wind stress components and module?? 
    845       INTEGER  ::   ji, jj, jn             ! dummy loop indices 
     944      INTEGER  ::   ji, jj, jl, jn         ! dummy loop indices 
    846945      INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdttra did not change since nit000) 
    847946      REAL(wp) ::   zcumulneg, zcumulpos   ! temporary scalars      
     
    9951094      !                                                      ! ================== ! 
    9961095      IF( srcv(jpr_co2)%laction )   atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 
     1096#endif 
     1097 
     1098#if defined key_cice && ! defined key_cice4 
     1099      !  ! Sea ice surface skin temp: 
     1100      IF( srcv(jpr_ts_ice)%laction ) THEN 
     1101        DO jl = 1, jpl 
     1102          DO jj = 1, jpj 
     1103            DO ji = 1, jpi 
     1104              IF (frcv(jpr_ts_ice)%z3(ji,jj,jl) > 0.0) THEN 
     1105                tsfc_ice(ji,jj,jl) = 0.0 
     1106              ELSE IF (frcv(jpr_ts_ice)%z3(ji,jj,jl) < -60.0) THEN 
     1107                tsfc_ice(ji,jj,jl) = -60.0 
     1108              ELSE 
     1109                tsfc_ice(ji,jj,jl) = frcv(jpr_ts_ice)%z3(ji,jj,jl) 
     1110              ENDIF 
     1111            END DO 
     1112          END DO 
     1113        END DO 
     1114      ENDIF 
    9971115#endif 
    9981116 
     
    14031521         zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1)                  ! May need to ensure positive here 
    14041522         ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:)  ! May need to ensure positive here 
    1405          zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 
     1523         zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:)          
     1524#if defined key_cice 
     1525         IF ( TRIM(sn_rcv_emp%clcat) == 'yes' ) THEN 
     1526            ! zemp_ice is the sum of frcv(jpr_ievp)%z3(:,:,1) over all layers - snow 
     1527            zemp_ice(:,:) = - frcv(jpr_snow)%z3(:,:,1) 
     1528            DO jl=1,jpl 
     1529               zemp_ice(:,:   ) = zemp_ice(:,:) + frcv(jpr_ievp)%z3(:,:,jl) 
     1530            ENDDO 
     1531            ! latent heat coupled for each category in CICE 
     1532            qla_ice(:,:,1:jpl) = - frcv(jpr_ievp)%z3(:,:,1:jpl) * lsub 
     1533         ELSE 
     1534            ! If CICE has multicategories it still expects coupling fields for 
     1535            ! each even if we treat as a single field 
     1536            ! The latent heat flux is split between the ice categories according 
     1537            ! to the fraction of the ice in each category 
     1538            zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 
     1539            WHERE ( zicefr(:,:) /= 0._wp )  
     1540               ztmp(:,:) = 1./zicefr(:,:) 
     1541            ELSEWHERE  
     1542               ztmp(:,:) = 0.e0 
     1543            END WHERE   
     1544            DO jl=1,jpl 
     1545               qla_ice(:,:,jl) = - a_i(:,:,jl) * ztmp(:,:) * frcv(jpr_ievp)%z3(:,:,1) * lsub  
     1546            END DO 
     1547            WHERE ( zicefr(:,:) == 0._wp )  qla_ice(:,:,1) = -frcv(jpr_ievp)%z3(:,:,1) * lsub  
     1548         ENDIF 
     1549#else          
    14061550         zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 
     1551#endif                   
    14071552            CALL iom_put( 'rain'         , frcv(jpr_rain)%z3(:,:,1)              )   ! liquid precipitation  
    14081553         IF( iom_use('hflx_rain_cea') )   & 
     
    17581903               CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
    17591904               END SELECT 
     1905            CASE( 'oce and weighted ice' )   ;   ztmp1(:,:) =   tsn(:,:,1,jp_tem) + rt0  
     1906               SELECT CASE( sn_snd_temp%clcat ) 
     1907               CASE( 'yes' )    
     1908           ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
     1909               CASE( 'no' ) 
     1910           ztmp3(:,:,:) = 0.0 
     1911           DO jl=1,jpl 
     1912                     ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 
     1913           ENDDO 
     1914               CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
     1915               END SELECT 
    17601916            CASE( 'mixed oce-ice'        )    
    17611917               ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:)  
     
    17991955         END SELECT 
    18001956         IF( ssnd(jps_fice)%laction )   CALL cpl_snd( jps_fice, isec, ztmp3, info ) 
     1957      ENDIF 
     1958       
     1959      ! Send ice fraction field (first order interpolation), for weighting UM fluxes to be passed to NEMO 
     1960      IF (ssnd(jps_fice1)%laction) THEN 
     1961         SELECT CASE (sn_snd_thick1%clcat) 
     1962         CASE( 'yes' )   ;   ztmp3(:,:,1:jpl) =  a_i(:,:,1:jpl) 
     1963         CASE( 'no' )    ;   ztmp3(:,:,1) = fr_i(:,:) 
     1964         CASE default    ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick1%clcat' ) 
     1965    END SELECT 
     1966         CALL cpl_snd (jps_fice1, isec, ztmp3, info) 
    18011967      ENDIF 
    18021968       
     
    18442010         IF( ssnd(jps_hsnw)%laction )   CALL cpl_snd( jps_hsnw, isec, ztmp4, info ) 
    18452011      ENDIF 
     2012      ! 
     2013      ! Send meltpond fields  
     2014      IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN 
     2015         SELECT CASE( sn_snd_mpnd%cldes)  
     2016         CASE( 'weighted ice' )  
     2017            SELECT CASE( sn_snd_mpnd%clcat )  
     2018            CASE( 'yes' )  
     2019               ztmp3(:,:,1:jpl) =  a_p(:,:,1:jpl) * a_i(:,:,1:jpl)  
     2020               ztmp4(:,:,1:jpl) =  ht_p(:,:,1:jpl) * a_i(:,:,1:jpl)  
     2021            CASE( 'no' )  
     2022               ztmp3(:,:,:) = 0.0  
     2023               ztmp4(:,:,:) = 0.0  
     2024               DO jl=1,jpl  
     2025                 ztmp3(:,:,1) = ztmp3(:,:,1) + a_p(:,:,jpl) * a_i(:,:,jpl)  
     2026                 ztmp4(:,:,1) = ztmp4(:,:,1) + ht_p(:,:,jpl) * a_i(:,:,jpl)  
     2027               ENDDO  
     2028            CASE default    ;   CALL ctl_stop( 'sbc_cpl_mpd: wrong definition of sn_snd_mpnd%clcat' )  
     2029            END SELECT  
     2030         CASE( 'ice only' )     
     2031            ztmp3(:,:,1:jpl) = a_p(:,:,1:jpl)  
     2032            ztmp4(:,:,1:jpl) = ht_p(:,:,1:jpl)  
     2033         END SELECT  
     2034         IF( ssnd(jps_a_p)%laction )   CALL cpl_snd( jps_a_p, isec, ztmp3, info )     
     2035         IF( ssnd(jps_ht_p)%laction )   CALL cpl_snd( jps_ht_p, isec, ztmp4, info )     
     2036         ! 
     2037         ! Send ice effective conductivity 
     2038         SELECT CASE( sn_snd_cond%cldes) 
     2039         CASE( 'weighted ice' )    
     2040            SELECT CASE( sn_snd_cond%clcat ) 
     2041            CASE( 'yes' )    
     2042               ztmp3(:,:,1:jpl) =  kn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
     2043            CASE( 'no' ) 
     2044               ztmp3(:,:,:) = 0.0 
     2045               DO jl=1,jpl 
     2046                 ztmp3(:,:,1) = ztmp3(:,:,1) + kn_ice(:,:,jl) * a_i(:,:,jl) 
     2047               ENDDO 
     2048            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%clcat' ) 
     2049            END SELECT 
     2050         CASE( 'ice only' )    
     2051           ztmp3(:,:,1:jpl) = kn_ice(:,:,1:jpl) 
     2052         END SELECT 
     2053         IF( ssnd(jps_kice)%laction )   CALL cpl_snd( jps_kice, isec, ztmp3, info ) 
     2054      ENDIF 
     2055      ! 
    18462056      ! 
    18472057#if defined key_cpl_carbon_cycle 
     
    20232233      IF( ssnd(jps_rnf   )%laction )  CALL cpl_snd( jps_rnf   , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info ) 
    20242234      IF( ssnd(jps_taum  )%laction )  CALL cpl_snd( jps_taum  , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info ) 
    2025  
     2235       
     2236      ztmp1(:,:) = sstfrz(:,:) + rt0 
     2237      IF( ssnd(jps_sstfrz)%laction )  CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
     2238      ! 
    20262239      CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 
    20272240      CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 ) 
  • branches/UKMO/dev_r5518_CICE_coupling_GSI7_GSI8/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r5662 r5663  
    1515   USE dom_oce         ! ocean space and time domain 
    1616   USE domvvl 
    17    USE phycst, only : rcp, rau0, r1_rau0, rhosn, rhoic 
     17   USE eosbn2, only : eos_fzp ! Function to calculate freezing point of seawater 
     18   USE phycst, only : rcp, rau0, r1_rau0, rhosn, rhoic, rt0 
    1819   USE in_out_manager  ! I/O manager 
    1920   USE iom, ONLY : iom_put,iom_use              ! I/O manager library !!Joakim edit 
     
    3738   USE ice_gather_scatter 
    3839   USE ice_calendar, only: dt 
     40# if defined key_cice4 
    3941   USE ice_state, only: aice,aicen,uvel,vvel,vsno,vsnon,vice,vicen 
    40 # if defined key_cice4 
    4142   USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow,  & 
    4243                strocnxT,strocnyT,                               &  
     
    4546                flatn_f,fsurfn_f,fcondtopn_f,                    & 
    4647                uatm,vatm,wind,fsw,flw,Tair,potT,Qa,rhoa,zlvl,   & 
    47                 swvdr,swvdf,swidr,swidf 
     48                swvdr,swvdf,swidr,swidf,Tf 
    4849   USE ice_therm_vertical, only: calc_Tsfc 
    4950#else 
     51   USE ice_state, only: aice,aicen,uvel,nt_hpnd,trcrn,vvel,vsno,& 
     52                vsnon,vice,vicen,nt_Tsfc 
    5053   USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow,  & 
    5154                strocnxT,strocnyT,                               &  
    52                 sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_ai,     & 
    53                 fresh_ai,fhocn_ai,fswthru_ai,frzmlt,          & 
     55                sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_ai,      & 
     56                fresh_ai,fhocn_ai,fswthru_ai,frzmlt,             & 
    5457                flatn_f,fsurfn_f,fcondtopn_f,                    & 
    5558                uatm,vatm,wind,fsw,flw,Tair,potT,Qa,rhoa,zlvl,   & 
    56                 swvdr,swvdf,swidr,swidf 
    57    USE ice_therm_shared, only: calc_Tsfc 
     59                swvdr,swvdf,swidr,swidf,Tf,                      & 
     60      !! When using NEMO with CICE, this change requires use of  
     61      !! one of the following two CICE branches: 
     62      !! - at CICE5.0,   hadax/r1015_GSI8_with_GSI7 
     63      !! - at CICE5.1.2, hadax/vn5.1.2_GSI8 
     64                keffn_top,Tn_top 
     65 
     66   USE ice_therm_shared, only: calc_Tsfc, heat_capacity 
     67   USE ice_shortwave, only: apeffn 
    5868#endif 
    5969   USE ice_forcing, only: frcvdr,frcvdf,frcidr,frcidf 
     
    161171      INTEGER, INTENT( in  ) ::   ksbc                ! surface forcing type 
    162172      REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 
     173      REAL(wp), DIMENSION(:,:,:), POINTER :: ztfrz3d 
    163174      REAL(wp) ::   zcoefu, zcoefv, zcoeff            ! local scalar 
    164175      INTEGER  ::   ji, jj, jl, jk                    ! dummy loop indices 
     
    173184      ji_off = INT ( (jpiglo - nx_global) / 2 ) 
    174185      jj_off = INT ( (jpjglo - ny_global) / 2 ) 
     186 
     187      ! Set freezing temperatures and ensure consistencey between NEMO and CICE 
     188      CALL wrk_alloc( jpi,jpj,jpk, ztfrz3d )  
     189      DO jk=1,jpk 
     190         ztfrz3d(:,:,jk) = eos_fzp( tsn(:,:,jk,jp_sal), fsdept_n(:,:,jk) ) 
     191      ENDDO 
     192 
     193      !Ensure that no temperature points are below freezing if not a NEMO restart 
     194      IF( .NOT. ln_rstart ) THEN 
     195         tsn(:,:,:,jp_tem) = MAX (tsn(:,:,:,jp_tem),ztfrz3d) 
     196         tsb(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) 
     197      ENDIF 
    175198 
    176199#if defined key_nemocice_decomp 
     
    202225      IF( sbc_ice_cice_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_ice_cice_alloc : unable to allocate cice arrays' ) 
    203226 
    204 ! Ensure ocean temperatures are nowhere below freezing if not a NEMO restart 
    205       IF( .NOT. ln_rstart ) THEN 
    206          tsn(:,:,:,jp_tem) = MAX (tsn(:,:,:,jp_tem),Tocnfrz) 
    207          tsb(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) 
    208       ENDIF 
     227      ! Populate the surface freezing temperature array 
     228      sstfrz(:,:)=ztfrz3d(:,:,1) 
    209229 
    210230      fr_iu(:,:)=0.0 
     
    283303  
    284304      CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 ) 
     305      CALL wrk_dealloc( jpi,jpj,jpk, ztfrz3d )  
    285306      ! 
    286307      IF( nn_timing == 1 )  CALL timing_stop('cice_sbc_init') 
     
    343364         CALL nemo2cice(ztmp,stray,'F', -1. ) 
    344365 
     366 
     367! Alex West: From configuration GSI8 onwards, when NEMO is used with CICE in 
     368! HadGEM3 the 'time-travelling ice' coupling approach is used, whereby  
     369! atmosphere-ice fluxes are passed as pseudo-local values, formed by dividing 
     370! gridbox mean fluxes in the UM by future ice concentration obtained through   
     371! OASIS.  This allows for a much more realistic apportionment of energy through 
     372! the ice - and conserves energy. 
     373! Therefore the fluxes are now divided by ice concentration in the coupled 
     374! formulation (jp_purecpl) as well as for jp_flx.  This NEMO branch should only 
     375! be used at UM10.2 onwards (unless an explicit GSI8 UM branch is included), at 
     376! which point the GSI8 UM changes were committed. 
     377 
    345378! Surface downward latent heat flux (CI_5) 
    346          IF (ksbc == jp_flx) THEN 
     379         IF (ksbc == jp_flx .OR. ksbc == jp_purecpl) THEN 
    347380            DO jl=1,ncat 
    348381               ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl) 
    349382            ENDDO 
    350383         ELSE 
    351 ! emp_ice is set in sbc_cpl_ice_flx as sublimation-snow 
    352             qla_ice(:,:,1)= - ( emp_ice(:,:)+sprecip(:,:) ) * Lsub 
    353 ! End of temporary code 
    354             DO jj=1,jpj 
    355                DO ji=1,jpi 
    356                   IF (fr_i(ji,jj).eq.0.0) THEN 
    357                      DO jl=1,ncat 
    358                         ztmpn(ji,jj,jl)=0.0 
    359                      ENDDO 
    360                      ! This will then be conserved in CICE 
    361                      ztmpn(ji,jj,1)=qla_ice(ji,jj,1) 
    362                   ELSE 
    363                      DO jl=1,ncat 
    364                         ztmpn(ji,jj,jl)=qla_ice(ji,jj,1)*a_i(ji,jj,jl)/fr_i(ji,jj) 
    365                      ENDDO 
    366                   ENDIF 
    367                ENDDO 
    368             ENDDO 
     384           !In coupled mode - qla_ice calculated in sbc_cpl for each category 
     385           ztmpn(:,:,1:ncat)=qla_ice(:,:,1:ncat) 
    369386         ENDIF 
     387 
    370388         DO jl=1,ncat 
    371389            CALL nemo2cice(ztmpn(:,:,jl),flatn_f(:,:,jl,:),'T', 1. ) 
     
    373391! GBM conductive flux through ice (CI_6) 
    374392!  Convert to GBM 
    375             IF (ksbc == jp_flx) THEN 
     393            IF (ksbc == jp_flx .OR. ksbc == jp_purecpl) THEN 
    376394               ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl) 
    377395            ELSE 
     
    382400! GBM surface heat flux (CI_7) 
    383401!  Convert to GBM 
    384             IF (ksbc == jp_flx) THEN 
     402            IF (ksbc == jp_flx .OR. ksbc == jp_purecpl) THEN 
    385403               ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl)  
    386404            ELSE 
     
    442460      CALL nemo2cice(ztmp,frain,'T', 1. )  
    443461 
     462! Recalculate freezing temperature and send to CICE  
     463      sstfrz(:,:)=eos_fzp(sss_m(:,:), fsdept_n(:,:,1))  
     464      CALL nemo2cice(sstfrz,Tf,'T', 1. ) 
     465 
    444466! Freezing/melting potential 
    445467! Calculated over NEMO leapfrog timestep (hence 2*dt) 
    446       nfrzmlt(:,:)=rau0*rcp*fse3t_m(:,:)*(Tocnfrz-sst_m(:,:))/(2.0*dt) 
    447  
    448       ztmp(:,:) = nfrzmlt(:,:) 
    449       CALL nemo2cice(ztmp,frzmlt,'T', 1. ) 
     468      nfrzmlt(:,:)=rau0*rcp*fse3t_m(:,:)*(sstfrz(:,:)-sst_m(:,:))/(2.0*dt)  
     469      CALL nemo2cice(nfrzmlt,frzmlt,'T', 1. ) 
    450470 
    451471! SST  and SSS 
     
    453473      CALL nemo2cice(sst_m,sst,'T', 1. ) 
    454474      CALL nemo2cice(sss_m,sss,'T', 1. ) 
     475 
     476! Sea ice surface skin temperature 
     477      DO jl=1,ncat 
     478        CALL nemo2cice(tsfc_ice(:,:,jl), trcrn(:,:,nt_tsfc,jl,:),'T',1.) 
     479      ENDDO  
    455480 
    456481! x comp and y comp of surface ocean current 
     
    730755         CALL cice2nemo(vicen(:,:,jl,:),ht_i(:,:,jl),'T', 1. ) 
    731756      ENDDO 
     757 
     758#if ! defined key_cice4 
     759! Meltpond fraction and depth 
     760      DO jl = 1,ncat 
     761         CALL cice2nemo(apeffn(:,:,jl,:),a_p(:,:,jl),'T', 1. ) 
     762         CALL cice2nemo(trcrn(:,:,nt_hpnd,jl,:),ht_p(:,:,jl),'T', 1. ) 
     763      ENDDO 
     764#endif 
     765 
     766 
     767! If using multilayers thermodynamics in CICE then get top layer temperature 
     768! and effective conductivity        
     769!! When using NEMO with CICE, this change requires use of  
     770!! one of the following two CICE branches: 
     771!! - at CICE5.0,   hadax/r1015_GSI8_with_GSI7 
     772!! - at CICE5.1.2, hadax/vn5.1.2_GSI8 
     773      IF (heat_capacity) THEN 
     774         DO jl = 1,ncat 
     775            CALL cice2nemo(Tn_top(:,:,jl,:),tn_ice(:,:,jl),'T', 1. ) 
     776            CALL cice2nemo(keffn_top(:,:,jl,:),kn_ice(:,:,jl),'T', 1. ) 
     777         ENDDO 
     778! Convert surface temperature to Kelvin 
     779         tn_ice(:,:,:)=tn_ice(:,:,:)+rt0 
     780      ELSE 
     781         tn_ice(:,:,:) = 0.0 
     782         kn_ice(:,:,:) = 0.0 
     783      ENDIF        
     784 
    732785      ! 
    733786      IF( nn_timing == 1 )  CALL timing_stop('cice_sbc_hadgam') 
Note: See TracChangeset for help on using the changeset viewer.