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 9500 for branches/UKMO – NEMO

Changeset 9500 for branches/UKMO


Ignore:
Timestamp:
2018-04-23T16:40:35+02:00 (6 years ago)
Author:
davestorkey
Message:

branches/UKMO/dev_merge_2017_CICE_interface : recommit science changes.

Location:
branches/UKMO/dev_merge_2017_CICE_interface/NEMOGCM/NEMO/OPA_SRC
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_merge_2017_CICE_interface/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90

    r9499 r9500  
    3030   USE ioipsl         ! I/O IPSL library 
    3131   USE in_out_manager ! I/O Manager 
     32#if defined key_nemocice_decomp 
     33   USE ice_domain_size, only: nx_global, ny_global 
     34#endif 
    3235 
    3336   IMPLICIT NONE 
  • branches/UKMO/dev_merge_2017_CICE_interface/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90

    r9499 r9500  
    8888   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr_iu              !: ice fraction at NEMO U point 
    8989   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr_iv              !: ice fraction at NEMO V point 
    90     
     90   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sstfrz             !: sea surface freezing temperature 
     91   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tsfc_ice           !: sea-ice surface skin temperature (on categories) 
     92   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   kn_ice             !: sea-ice surface layer thermal conductivity (on cats) 
     93 
    9194   ! variables used in the coupled interface 
    9295   INTEGER , PUBLIC, PARAMETER ::   jpl = ncat 
    9396   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice          ! jpi, jpj 
     97   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_p, ht_p ! Meltpond fraction and depth 
     98    
     99   ! 
     100    
     101   ! 
     102#if defined key_asminc 
     103   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ndaice_da          !: NEMO fresh water flux to ocean due to data assim 
     104   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nfresh_da          !: NEMO salt flux to ocean due to data assim 
     105   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nfsalt_da          !: NEMO ice concentration change/second from data assim 
     106#endif 
     107       
    94108    
    95109   ! already defined in ice.F90 for LIM3 
  • branches/UKMO/dev_merge_2017_CICE_interface/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r9499 r9500  
    1313   USE dom_oce         ! ocean space and time domain 
    1414   USE domvvl 
    15    USE phycst, only : rcp, rau0, r1_rau0, rhosn, rhoic 
     15   USE eosbn2, only : eos_fzp ! Function to calculate freezing point of seawater 
     16   USE phycst, only : rcp, rau0, r1_rau0, rhosn, rhoic, rt0 
    1617   USE in_out_manager  ! I/O manager 
    1718   USE iom, ONLY : iom_put,iom_use              ! I/O manager library !!Joakim edit 
     
    3334   USE ice_gather_scatter 
    3435   USE ice_calendar, only: dt 
     36# if defined key_cice4 
    3537   USE ice_state, only: aice,aicen,uvel,vvel,vsno,vsnon,vice,vicen 
    36 # if defined key_cice4 
    3738   USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow,  & 
    3839                strocnxT,strocnyT,                               &  
     
    4142                flatn_f,fsurfn_f,fcondtopn_f,                    & 
    4243                uatm,vatm,wind,fsw,flw,Tair,potT,Qa,rhoa,zlvl,   & 
    43                 swvdr,swvdf,swidr,swidf 
     44                swvdr,swvdf,swidr,swidf,Tf 
    4445   USE ice_therm_vertical, only: calc_Tsfc 
    4546#else 
     47   USE ice_state, only: aice,aicen,uvel,nt_hpnd,trcrn,vvel,vsno,& 
     48                vsnon,vice,vicen,nt_Tsfc 
    4649   USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow,  & 
    4750                strocnxT,strocnyT,                               &  
    48                 sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_ai,     & 
    49                 fresh_ai,fhocn_ai,fswthru_ai,frzmlt,          & 
     51                sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_ai,      & 
     52                fresh_ai,fhocn_ai,fswthru_ai,frzmlt,             & 
    5053                flatn_f,fsurfn_f,fcondtopn_f,                    & 
     54#ifdef key_asminc 
     55                daice_da,fresh_da,fsalt_da,                    & 
     56#endif 
    5157                uatm,vatm,wind,fsw,flw,Tair,potT,Qa,rhoa,zlvl,   & 
    52                 swvdr,swvdf,swidr,swidf 
    53    USE ice_therm_shared, only: calc_Tsfc 
     58                swvdr,swvdf,swidr,swidf,Tf,                      & 
     59      !! When using NEMO with CICE, this change requires use of  
     60      !! one of the following two CICE branches: 
     61      !! - at CICE5.0,   hadax/r1015_GSI8_with_GSI7 
     62      !! - at CICE5.1.2, hadax/vn5.1.2_GSI8 
     63                keffn_top,Tn_top 
     64 
     65   USE ice_therm_shared, only: calc_Tsfc, heat_capacity 
     66   USE ice_shortwave, only: apeffn 
    5467#endif 
    5568   USE ice_forcing, only: frcvdr,frcvdf,frcidr,frcidf 
     
    155168      INTEGER, INTENT( in  ) ::   ksbc                ! surface forcing type 
    156169      REAL(wp), DIMENSION(jpi,jpj) :: ztmp1, ztmp2 
    157       REAL(wp) ::   zcoefu, zcoefv, zcoeff            ! local scalar 
     170      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztfrz3d 
    158171      INTEGER  ::   ji, jj, jl, jk                    ! dummy loop indices 
    159172      !!--------------------------------------------------------------------- 
     
    164177      jj_off = INT ( (jpjglo - ny_global) / 2 ) 
    165178 
    166 #if defined key_nemocice_decomp 
    167       ! Pass initial SST from NEMO to CICE so ice is initialised correctly if 
    168       ! there is no restart file. 
    169       ! Values from a CICE restart file would overwrite this 
    170       IF ( .NOT. ln_rstart ) THEN     
    171          CALL nemo2cice( tsn(:,:,1,jp_tem) , sst , 'T' , 1.)  
    172       ENDIF   
    173 #endif 
    174  
    175 ! Initialize CICE 
     179      ! Initialize CICE 
    176180      CALL CICE_Initialize 
    177181 
    178 ! Do some CICE consistency checks 
     182      ! Do some CICE consistency checks 
    179183      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 
    180184         IF ( calc_strair .OR. calc_Tsfc ) THEN 
     
    188192 
    189193 
    190 ! allocate sbc_ice and sbc_cice arrays 
    191       IF( sbc_ice_alloc()      /= 0 )   CALL ctl_stop( 'STOP', 'sbc_ice_cice_alloc : unable to allocate arrays' ) 
     194      ! allocate sbc_ice and sbc_cice arrays 
     195      IF( sbc_ice_alloc()      /= 0 )   CALL ctl_stop( 'STOP', 'sbc_ice_alloc : unable to allocate arrays' ) 
    192196      IF( sbc_ice_cice_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_ice_cice_alloc : unable to allocate cice arrays' ) 
    193197 
    194 ! Ensure ocean temperatures are nowhere below freezing if not a NEMO restart 
     198      ! Ensure that no temperature points are below freezing if not a NEMO restart 
    195199      IF( .NOT. ln_rstart ) THEN 
    196          tsn(:,:,:,jp_tem) = MAX (tsn(:,:,:,jp_tem),Tocnfrz) 
     200 
     201         DO jk=1,jpk 
     202             CALL eos_fzp( tsn(:,:,jk,jp_sal), ztfrz3d(:,:,jk), gdept_n(:,:,jk) ) 
     203         ENDDO 
     204         tsn(:,:,:,jp_tem) = MAX( tsn(:,:,:,jp_tem), ztfrz3d ) 
    197205         tsb(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) 
    198       ENDIF 
    199  
    200       fr_iu(:,:)=0.0 
    201       fr_iv(:,:)=0.0 
     206 
     207#if defined key_nemocice_decomp 
     208         ! Pass initial SST from NEMO to CICE so ice is initialised correctly if 
     209         ! there is no restart file. 
     210         ! Values from a CICE restart file would overwrite this 
     211         CALL nemo2cice( tsn(:,:,1,jp_tem) , sst , 'T' , 1.)  
     212#endif 
     213 
     214      ENDIF   
     215 
     216      ! calculate surface freezing temperature and send to CICE 
     217      CALL  eos_fzp(sss_m(:,:), sstfrz(:,:), gdept_n(:,:,1))  
     218      CALL nemo2cice(sstfrz,Tf, 'T', 1. ) 
    202219 
    203220      CALL cice2nemo(aice,fr_i, 'T', 1. ) 
     
    210227! T point to U point 
    211228! T point to V point 
     229      fr_iu(:,:)=0.0 
     230      fr_iv(:,:)=0.0 
    212231      DO jj=1,jpjm1 
    213232         DO ji=1,jpim1 
     
    268287         ENDIF 
    269288      ENDIF 
    270       ! 
     289 
     290#if defined key_asminc 
     291      ! Initialize fresh water and salt fluxes from data assim    
     292      !  and data assimilation index to cice  
     293      nfresh_da(:,:) = 0.0    
     294      nfsalt_da(:,:) = 0.0    
     295      ndaice_da(:,:) = 0.0          
     296#endif 
     297      ! 
     298      ! In coupled mode get extra fields from CICE for passing back to atmosphere 
     299  
     300      IF ( ksbc == jp_purecpl ) CALL cice_sbc_hadgam(nit000) 
     301      !  
    271302   END SUBROUTINE cice_sbc_init 
    272303 
     
    321352         CALL nemo2cice(ztmp,stray,'F', -1. ) 
    322353 
     354 
     355! Alex West: From configuration GSI8 onwards, when NEMO is used with CICE in 
     356! HadGEM3 the 'time-travelling ice' coupling approach is used, whereby  
     357! atmosphere-ice fluxes are passed as pseudo-local values, formed by dividing 
     358! gridbox mean fluxes in the UM by future ice concentration obtained through   
     359! OASIS.  This allows for a much more realistic apportionment of energy through 
     360! the ice - and conserves energy. 
     361! Therefore the fluxes are now divided by ice concentration in the coupled 
     362! formulation (jp_purecpl) as well as for jp_flx.  This NEMO branch should only 
     363! be used at UM10.2 onwards (unless an explicit GSI8 UM branch is included), at 
     364! which point the GSI8 UM changes were committed. 
     365 
    323366! Surface downward latent heat flux (CI_5) 
    324367         IF (ksbc == jp_flx) THEN 
     
    326369               ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl) 
    327370            ENDDO 
    328          ELSE 
    329 ! emp_ice is set in sbc_cpl_ice_flx as sublimation-snow 
    330             qla_ice(:,:,1)= - ( emp_ice(:,:)+sprecip(:,:) ) * Lsub 
    331 ! End of temporary code 
    332             DO jj=1,jpj 
    333                DO ji=1,jpi 
    334                   IF (fr_i(ji,jj).eq.0.0) THEN 
    335                      DO jl=1,ncat 
    336                         ztmpn(ji,jj,jl)=0.0 
    337                      ENDDO 
    338                      ! This will then be conserved in CICE 
    339                      ztmpn(ji,jj,1)=qla_ice(ji,jj,1) 
    340                   ELSE 
    341                      DO jl=1,ncat 
    342                         ztmpn(ji,jj,jl)=qla_ice(ji,jj,1)*a_i(ji,jj,jl)/fr_i(ji,jj) 
    343                      ENDDO 
    344                   ENDIF 
    345                ENDDO 
     371         ELSE IF (ksbc == jp_purecpl) THEN 
     372            DO jl=1,ncat 
     373               ztmpn(:,:,jl)=qla_ice(:,:,jl)*a_i(:,:,jl) 
    346374            ENDDO 
     375    ELSE 
     376           !In coupled mode - qla_ice calculated in sbc_cpl for each category 
     377           ztmpn(:,:,1:ncat)=qla_ice(:,:,1:ncat) 
    347378         ENDIF 
     379 
    348380         DO jl=1,ncat 
    349381            CALL nemo2cice(ztmpn(:,:,jl),flatn_f(:,:,jl,:),'T', 1. ) 
     
    351383! GBM conductive flux through ice (CI_6) 
    352384!  Convert to GBM 
    353             IF (ksbc == jp_flx) THEN 
     385            IF (ksbc == jp_flx .OR. ksbc == jp_purecpl) THEN 
    354386               ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl) 
    355387            ELSE 
     
    360392! GBM surface heat flux (CI_7) 
    361393!  Convert to GBM 
    362             IF (ksbc == jp_flx) THEN 
     394            IF (ksbc == jp_flx .OR. ksbc == jp_purecpl) THEN 
    363395               ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl)  
    364396            ELSE 
     
    409441      ENDIF 
    410442 
     443#if defined key_asminc 
     444!Ice concentration change (from assimilation) 
     445      ztmp(:,:)=ndaice_da(:,:)*tmask(:,:,1) 
     446      Call nemo2cice(ztmp,daice_da,'T', 1. ) 
     447#endif  
     448 
    411449! Snowfall 
    412450! Ensure fsnow is positive (as in CICE routine prepare_forcing) 
     
    420458      CALL nemo2cice(ztmp,frain,'T', 1. )  
    421459 
     460! Recalculate freezing temperature and send to CICE  
     461      CALL eos_fzp(sss_m(:,:), sstfrz(:,:), gdept_n(:,:,1))  
     462      CALL nemo2cice(sstfrz,Tf,'T', 1. ) 
     463 
    422464! Freezing/melting potential 
    423465! Calculated over NEMO leapfrog timestep (hence 2*dt) 
    424       nfrzmlt(:,:) = rau0 * rcp * e3t_m(:,:) * ( Tocnfrz-sst_m(:,:) ) / ( 2.0*dt ) 
    425  
    426       ztmp(:,:) = nfrzmlt(:,:) 
    427       CALL nemo2cice(ztmp,frzmlt,'T', 1. ) 
     466      nfrzmlt(:,:)=rau0*rcp*e3t_m(:,:)*(sstfrz(:,:)-sst_m(:,:))/(2.0*dt)  
     467      CALL nemo2cice(nfrzmlt,frzmlt,'T', 1. ) 
    428468 
    429469! SST  and SSS 
     
    431471      CALL nemo2cice(sst_m,sst,'T', 1. ) 
    432472      CALL nemo2cice(sss_m,sss,'T', 1. ) 
     473 
     474      IF( ksbc == jp_purecpl ) THEN 
     475! Sea ice surface skin temperature 
     476         DO jl=1,ncat 
     477           CALL nemo2cice(tsfc_ice(:,:,jl), trcrn(:,:,nt_tsfc,jl,:),'T',1.) 
     478         ENDDO  
     479      ENDIF 
    433480 
    434481! x comp and y comp of surface ocean current 
     
    663710      INTEGER  ::   ierror 
    664711      !!--------------------------------------------------------------------- 
    665       ! 
    666       IF( kt == nit000 )  THEN 
    667          IF(lwp) WRITE(numout,*)'cice_sbc_hadgam' 
    668          IF( sbc_cpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 
    669       ENDIF 
    670  
     712#if defined key_asminc 
     713! Import fresh water and salt flux due to seaice da 
     714      CALL cice2nemo(fresh_da, nfresh_da,'T',1.0) 
     715      CALL cice2nemo(fsalt_da, nfsalt_da,'T',1.0) 
     716#endif 
     717 
     718      ! 
    671719      !                                         ! =========================== ! 
    672720      !                                         !   Prepare Coupling fields   ! 
     
    686734         CALL cice2nemo( vicen(:,:,jl,:), h_i(:,:,jl),'T', 1. ) 
    687735      END DO 
     736 
     737#if ! defined key_cice4 
     738! Meltpond fraction and depth 
     739      DO jl = 1,ncat 
     740         CALL cice2nemo(apeffn(:,:,jl,:),a_p(:,:,jl),'T', 1. ) 
     741         CALL cice2nemo(trcrn(:,:,nt_hpnd,jl,:),ht_p(:,:,jl),'T', 1. ) 
     742      ENDDO 
     743#endif 
     744 
     745 
     746! If using multilayers thermodynamics in CICE then get top layer temperature 
     747! and effective conductivity        
     748!! When using NEMO with CICE, this change requires use of  
     749!! one of the following two CICE branches: 
     750!! - at CICE5.0,   hadax/r1015_GSI8_with_GSI7 
     751!! - at CICE5.1.2, hadax/vn5.1.2_GSI8 
     752      IF (heat_capacity) THEN 
     753         DO jl = 1,ncat 
     754            CALL cice2nemo(Tn_top(:,:,jl,:),tn_ice(:,:,jl),'T', 1. ) 
     755            CALL cice2nemo(keffn_top(:,:,jl,:),kn_ice(:,:,jl),'T', 1. ) 
     756         ENDDO 
     757! Convert surface temperature to Kelvin 
     758         tn_ice(:,:,:)=tn_ice(:,:,:)+rt0 
     759      ELSE 
     760         tn_ice(:,:,:) = 0.0 
     761         kn_ice(:,:,:) = 0.0 
     762      ENDIF        
     763 
    688764      ! 
    689765   END SUBROUTINE cice_sbc_hadgam 
Note: See TracChangeset for help on using the changeset viewer.