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

Changeset 3508


Ignore:
Timestamp:
2012-10-17T13:40:14+02:00 (12 years ago)
Author:
charris
Message:

First attempt at changes for CICE embedded sea ice. The nn_ice_embd=0 option has been prevented (as for LIM3). Changes to sbcice_cice include some other fixes
and cosmetic changes as in dev_3352_UKMO8_CICE (care will be required merging with this branch).

Location:
branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/OPA_SRC
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90

    r3488 r3508  
    1818   USE oce             ! dynamics and tracers 
    1919   USE dom_oce         ! ocean space and time domain 
     20   USE phycst 
    2021   USE in_out_manager  ! I/O manager 
    2122   USE sbc_oce         ! ocean surface boundary conditions 

  • branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90

    r3396 r3508  
    187187         WRITE(numout,*) '          fresh ice specific heat                   = ', cpic    , ' J/kg/K' 
    188188         WRITE(numout,*) '          latent heat of fusion of fresh ice / snow = ', lfus    , ' J/kg' 
    189 #if defined key_lim3 
     189#if defined key_lim3 || defined key_cice 
    190190         WRITE(numout,*) '          latent heat of subl.  of fresh ice / snow = ', lsub    , ' J/kg' 
    191191#else 

  • branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r3488 r3508  
    1515   USE dom_oce         ! ocean space and time domain 
    1616   USE domvvl 
    17    USE phycst, only : rcp, rau0 
     17   USE phycst, only : rcp, rau0, r1_rau0, rhosn, rhoic 
    1818   USE in_out_manager  ! I/O manager 
    1919   USE lib_mpp         ! distributed memory computing library 
    … …  
    3737   USE ice_gather_scatter 
    3838   USE ice_calendar, only: dt 
    39    USE ice_state, only: aice,aicen,uvel,vvel,vsnon,vicen 
     39   USE ice_state, only: aice,aicen,uvel,vvel,vsno,vsnon,vice,vicen 
    4040   USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow,  & 
    4141                sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_gbm,     & 
    … …  
    5959   PUBLIC cice_sbc_final  ! routine called by sbc_final 
    6060   PUBLIC sbc_ice_cice    ! routine called by sbc 
     61 
     62   INTEGER , PARAMETER ::   ji_off = INT ( (jpiglo - nx_global) / 2 ) 
     63   INTEGER , PARAMETER ::   jj_off = INT ( (jpjglo - ny_global) / 2 ) 
    6164 
    6265   INTEGER , PARAMETER ::   jpfld   = 13   ! maximum number of files to read  
    … …  
    107110      !! ** Action  : - time evolution of the CICE sea-ice model 
    108111      !!              - update all sbc variables below sea-ice: 
    109       !!                utau, vtau, qns , qsr, emp , sfx  
     112      !!                utau, vtau, qns , qsr, emp , sfx 
    110113      !!--------------------------------------------------------------------- 
    111114      INTEGER, INTENT(in) ::   kt      ! ocean time step 
    … …  
    138141   END SUBROUTINE sbc_ice_cice 
    139142 
    140  
    141143   SUBROUTINE cice_sbc_init (nsbc) 
    142144      !!--------------------------------------------------------------------- 
    … …  
    144146      !! ** Purpose: Initialise ice related fields for NEMO and coupling 
    145147      !! 
    146       INTEGER, INTENT( in  ) ::   nsbc ! surface forcing type 
    147       !!--------------------------------------------------------------------- 
    148  
    149       INTEGER  ::   ji, jj, jpl                        ! dummy loop indices 
     148      INTEGER, INTENT( in  ) ::   nsbc                ! surface forcing type 
     149      REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 
     150      REAL(wp) ::   zcoefu, zcoefv, zcoeff            ! local scalar 
     151      INTEGER  ::   ji, jj, jl                        ! dummy loop indices 
     152      !!--------------------------------------------------------------------- 
    150153 
    151154      IF( nn_timing == 1 )  CALL timing_start('cice_sbc_init') 
     155      ! 
     156      CALL wrk_alloc( jpi,jpj, ztmp1, ztmp2 ) 
    152157      ! 
    153158      IF(lwp) WRITE(numout,*)'cice_sbc_init' 
    … …  
    183188      CALL cice2nemo(aice,fr_i, 'T', 1. ) 
    184189      IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN 
    185          DO jpl=1,ncat 
    186             CALL cice2nemo(aicen(:,:,jpl,:),a_i(:,:,jpl), 'T', 1. ) 
     190         DO jl=1,ncat 
     191            CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 
    187192         ENDDO 
    188193      ENDIF 
    … …  
    199204      CALL lbc_lnk ( fr_iu , 'U', 1. ) 
    200205      CALL lbc_lnk ( fr_iv , 'V', 1. ) 
     206 
     207      !                                      ! embedded sea ice 
     208      IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 
     209         CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. ) 
     210         CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. ) 
     211         snwice_mass  (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:)  ) 
     212         snwice_mass_b(:,:) = snwice_mass(:,:) 
     213      ELSE 
     214         snwice_mass  (:,:) = 0.0_wp         ! no mass exchanges 
     215         snwice_mass_b(:,:) = 0.0_wp         ! no mass exchanges 
     216      ENDIF 
     217      IF( nn_ice_embd == 2 .AND.          &  ! full embedment (case 2) & no restart :  
     218         &   .NOT.ln_rstart ) THEN           ! deplete the initial ssh belew sea-ice area 
     219         sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 
     220         sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 
     221         ! 
     222         ! Note: Changed the initial values of sshb and sshn=>  need to recompute ssh[u,v,f]_[b,n]  
     223         !       which were previously set in domvvl 
     224         IF ( lk_vvl ) THEN            ! Is this necessary? embd 2 should be restricted to vvl only??? 
     225            DO jj = 1, jpjm1 
     226               DO ji = 1, jpim1                    ! caution: use of Vector Opt. not possible 
     227                  zcoefu = 0.5  * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) ) 
     228                  zcoefv = 0.5  * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) ) 
     229                  zcoeff = 0.25 * umask(ji,jj,1) * umask(ji,jj+1,1) 
     230                  sshu_b(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshb(ji  ,jj)     & 
     231                     &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshb(ji+1,jj) ) 
     232                  sshv_b(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshb(ji,jj  )     & 
     233                     &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshb(ji,jj+1) ) 
     234                  sshu_n(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshn(ji  ,jj)     & 
     235                     &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshn(ji+1,jj) ) 
     236                  sshv_n(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshn(ji,jj  )     & 
     237                     &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshn(ji,jj+1) ) 
     238               END DO 
     239            END DO 
     240            CALL lbc_lnk( sshu_b, 'U', 1. )   ;   CALL lbc_lnk( sshu_n, 'U', 1. ) 
     241            CALL lbc_lnk( sshv_b, 'V', 1. )   ;   CALL lbc_lnk( sshv_n, 'V', 1. ) 
     242            DO jj = 1, jpjm1 
     243               DO ji = 1, jpim1      ! NO Vector Opt. 
     244                  sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                   & 
     245                       &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     & 
     246                       &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     & 
     247                       &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 
     248               END DO 
     249            END DO 
     250            CALL lbc_lnk( sshf_n, 'F', 1. ) 
     251          ENDIF 
     252      ENDIF 
     253  
     254      CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 ) 
    201255      ! 
    202256      IF( nn_timing == 1 )  CALL timing_stop('cice_sbc_init') 
    … …  
    213267      INTEGER, INTENT(in   ) ::   nsbc ! surface forcing type 
    214268 
    215       INTEGER  ::   ji, jj, jpl                   ! dummy loop indices       
    216       REAL(wp), DIMENSION(:,:), POINTER :: ztmp 
     269      INTEGER  ::   ji, jj, jl                   ! dummy loop indices       
     270      REAL(wp), DIMENSION(:,:), POINTER :: ztmp, zpice 
    217271      REAL(wp), DIMENSION(:,:,:), POINTER :: ztmpn 
     272      REAL(wp) ::   zintb, zintn  ! dummy argument 
    218273      !!--------------------------------------------------------------------- 
    219274 
    220275      IF( nn_timing == 1 )  CALL timing_start('cice_sbc_in') 
    221276      ! 
    222       CALL wrk_alloc( jpi,jpj, ztmp ) 
     277      CALL wrk_alloc( jpi,jpj, ztmp, zpice ) 
    223278      CALL wrk_alloc( jpi,jpj,ncat, ztmpn ) 
    224279 
    … …  
    260315! Surface downward latent heat flux (CI_5) 
    261316         IF (nsbc == 2) THEN 
    262             DO jpl=1,ncat 
    263                ztmpn(:,:,jpl)=qla_ice(:,:,1)*a_i(:,:,jpl) 
     317            DO jl=1,ncat 
     318               ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl) 
    264319            ENDDO 
    265320         ELSE 
    … …  
    270325               DO ji=1,jpi 
    271326                  IF (fr_i(ji,jj).eq.0.0) THEN 
    272                      DO jpl=1,ncat 
    273                         ztmpn(ji,jj,jpl)=0.0 
     327                     DO jl=1,ncat 
     328                        ztmpn(ji,jj,jl)=0.0 
    274329                     ENDDO 
    275330                     ! This will then be conserved in CICE 
    276331                     ztmpn(ji,jj,1)=qla_ice(ji,jj,1) 
    277332                  ELSE 
    278                      DO jpl=1,ncat 
    279                         ztmpn(ji,jj,jpl)=qla_ice(ji,jj,1)*a_i(ji,jj,jpl)/fr_i(ji,jj) 
     333                     DO jl=1,ncat 
     334                        ztmpn(ji,jj,jl)=qla_ice(ji,jj,1)*a_i(ji,jj,jl)/fr_i(ji,jj) 
    280335                     ENDDO 
    281336                  ENDIF 
    … …  
    283338            ENDDO 
    284339         ENDIF 
    285          DO jpl=1,ncat 
    286             CALL nemo2cice(ztmpn(:,:,jpl),flatn_f(:,:,jpl,:),'T', 1. ) 
     340         DO jl=1,ncat 
     341            CALL nemo2cice(ztmpn(:,:,jl),flatn_f(:,:,jl,:),'T', 1. ) 
    287342 
    288343! GBM conductive flux through ice (CI_6) 
    289344!  Convert to GBM 
    290345            IF (nsbc == 2) THEN 
    291                ztmp(:,:) = botmelt(:,:,jpl)*a_i(:,:,jpl) 
     346               ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl) 
    292347            ELSE 
    293                ztmp(:,:) = botmelt(:,:,jpl) 
     348               ztmp(:,:) = botmelt(:,:,jl) 
    294349            ENDIF 
    295             CALL nemo2cice(ztmp,fcondtopn_f(:,:,jpl,:),'T', 1. ) 
     350            CALL nemo2cice(ztmp,fcondtopn_f(:,:,jl,:),'T', 1. ) 
    296351 
    297352! GBM surface heat flux (CI_7) 
    298353!  Convert to GBM 
    299354            IF (nsbc == 2) THEN 
    300                ztmp(:,:) = (topmelt(:,:,jpl)+botmelt(:,:,jpl))*a_i(:,:,jpl)  
     355               ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl)  
    301356            ELSE 
    302                ztmp(:,:) = (topmelt(:,:,jpl)+botmelt(:,:,jpl)) 
     357               ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl)) 
    303358            ENDIF 
    304             CALL nemo2cice(ztmp,fsurfn_f(:,:,jpl,:),'T', 1. ) 
     359            CALL nemo2cice(ztmp,fsurfn_f(:,:,jl,:),'T', 1. ) 
    305360         ENDDO 
    306361 
    … …  
    384439      CALL nemo2cice(ztmp,vocn,'F', -1. ) 
    385440 
     441      IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: compute representative ice top surface ==! 
     442          ! 
     443          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1} 
     444          !                                               = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1} 
     445         zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp 
     446          ! 
     447          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1} 
     448          !                                               = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1}) 
     449         zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 
     450          ! 
     451         zpice(:,:) = ssh_m(:,:) + (  zintn * snwice_mass(:,:) +  zintb * snwice_mass_b(:,:)  ) * r1_rau0 
     452          ! 
     453         ! 
     454      ELSE                                    !== non-embedded sea ice: use ocean surface for slope calculation ==! 
     455         zpice(:,:) = ssh_m(:,:) 
     456      ENDIF 
     457 
    386458! x comp and y comp of sea surface slope (on F points) 
    387459! T point to F point 
    388460      DO jj=1,jpjm1 
    389461         DO ji=1,jpim1 
    390             ztmp(ji,jj)=0.5 * (  (ssh_m(ji+1,jj  )-ssh_m(ji,jj  ))/e1u(ji,jj  )   & 
    391                                + (ssh_m(ji+1,jj+1)-ssh_m(ji,jj+1))/e1u(ji,jj+1) ) &  
     462            ztmp(ji,jj)=0.5 * (  (zpice(ji+1,jj  )-zpice(ji,jj  ))/e1u(ji,jj  )   & 
     463                               + (zpice(ji+1,jj+1)-zpice(ji,jj+1))/e1u(ji,jj+1) ) &  
    392464                            *  fmask(ji,jj,1) 
    393465         ENDDO 
    … …  
    398470      DO jj=1,jpjm1 
    399471         DO ji=1,jpim1 
    400             ztmp(ji,jj)=0.5 * (  (ssh_m(ji  ,jj+1)-ssh_m(ji  ,jj))/e2v(ji  ,jj)   & 
    401                                + (ssh_m(ji+1,jj+1)-ssh_m(ji+1,jj))/e2v(ji+1,jj) ) & 
     472            ztmp(ji,jj)=0.5 * (  (zpice(ji  ,jj+1)-zpice(ji  ,jj))/e2v(ji  ,jj)   & 
     473                               + (zpice(ji+1,jj+1)-zpice(ji+1,jj))/e2v(ji+1,jj) ) & 
    402474                            *  fmask(ji,jj,1) 
    403475         ENDDO 
    … …  
    421493      INTEGER, INTENT( in  ) ::   nsbc ! surface forcing type 
    422494       
    423       INTEGER  ::   ji, jj, jpl                 ! dummy loop indices 
    424       REAL(wp), DIMENSION(:,:), POINTER :: ztmp 
     495      INTEGER  ::   ji, jj, jl                 ! dummy loop indices 
     496      REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 
    425497      !!--------------------------------------------------------------------- 
    426498 
    427499      IF( nn_timing == 1 )  CALL timing_start('cice_sbc_out') 
    428500      ! 
    429       CALL wrk_alloc( jpi,jpj, ztmp ) 
     501      CALL wrk_alloc( jpi,jpj, ztmp1, ztmp2 ) 
    430502       
    431503      IF( kt == nit000 )  THEN 
    … …  
    434506       
    435507! x comp of ocean-ice stress  
    436       CALL cice2nemo(strocnx,ztmp,'F', -1. ) 
     508      CALL cice2nemo(strocnx,ztmp1,'F', -1. ) 
    437509      ss_iou(:,:)=0.0 
    438510! F point to U point 
    439511      DO jj=2,jpjm1 
    440512         DO ji=2,jpim1 
    441             ss_iou(ji,jj) = 0.5 * ( ztmp(ji,jj-1) + ztmp(ji,jj) ) * umask(ji,jj,1) 
     513            ss_iou(ji,jj) = 0.5 * ( ztmp1(ji,jj-1) + ztmp1(ji,jj) ) * umask(ji,jj,1) 
    442514         ENDDO 
    443515      ENDDO 
    … …  
    445517 
    446518! y comp of ocean-ice stress  
    447       CALL cice2nemo(strocny,ztmp,'F', -1. ) 
     519      CALL cice2nemo(strocny,ztmp1,'F', -1. ) 
    448520      ss_iov(:,:)=0.0 
    449521! F point to V point 
    … …  
    451523      DO jj=1,jpjm1 
    452524         DO ji=2,jpim1 
    453             ss_iov(ji,jj) = 0.5 * ( ztmp(ji-1,jj) + ztmp(ji,jj) ) * vmask(ji,jj,1) 
     525            ss_iov(ji,jj) = 0.5 * ( ztmp1(ji-1,jj) + ztmp1(ji,jj) ) * vmask(ji,jj,1) 
    454526         ENDDO 
    455527      ENDDO 
    … …  
    474546         emp(:,:)  = (1.0-fr_i(:,:))*emp(:,:)         
    475547      ELSE IF (nsbc ==5) THEN 
    476 ! emp_tot is set in sbc_cpl_ice_flx (call from cice_sbc_in above)  
     548! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above)  
     549! This is currently as required with the coupling fields from the UM atmosphere 
    477550         emp(:,:) = emp_tot(:,:)+tprecip(:,:)*fr_i(:,:)  
    478551      ENDIF 
    479552 
    480 !! ACC this block needs attention. sfx has replaced emps but its meaning is now 
    481 !! different. Need the equivalent of this block: 
    482 !     SELECT CASE( nn_ice_embd )                 ! levitating or embedded sea-ice option 
    483 !       CASE( 0    )   ;   zswitch = 1           ! (0) standard levitating sea-ice : salt exchange only 
    484 !       CASE( 1, 2 )   ;   zswitch = 0           ! (1) levitating sea-ice: salt and volume exchange but no pressure effect 
    485 !                                                ! (2) embedded sea-ice : salt and volume fluxes and pressure 
    486 !     END SELECT 
    487 ! 
    488 !     sfx (ji,jj) = zfsalt +                  zswitch  * zcd   ! salt flux (+ C/D if no ice/ocean mass exchange) 
    489 !     emp (ji,jj) = zemp   + zemp_snw + ( 1.- zswitch) * zfmm  ! mass flux (- F/M mass flux if no ice/ocean mass exchange) 
    490 ! 
    491 ! Here zfsalt is salt flux between ice and ocean due to freezing and melting (PSU/m2/s) 
    492 !      zcd    is the virtual salt flux that appears in the standard levitating case only (0 otherwise) 
    493 !             it generates a change in SSS equivalent to that which would occur if a true mass exchange happened 
    494 !      zemp   is:  
    495 !              in coupled mode:  net mass flux over the grid cell (ice+ocean area) minus the mass flux intercepted by sea-ice 
    496 !              in forced  mode:  mass flux budget (emp) over open ocean fraction minus liquid precip. over the ice  
    497 !                                (assumed to instantaneous drain into the ocean). 
    498 !    zemp_snw is the snow melt that enters the ocean as pure water (no associated salt flux)  
    499 !    zfmm     is freezing minus melting 
    500 ! 
    501 ! with zswitch = 1 ( nn_ice_embd = 0 ) the results should be equivalent to the original CICE code.  
    502  
    503 !! 
    504 ! Subtract fluxes from CICE to get freshwater equivalent flux used in  
    505 ! salinity calculation 
    506       CALL cice2nemo(fresh_gbm,ztmp,'T', 1. ) 
    507       sfx (:,:)=emp(:,:)-ztmp(:,:) 
    508 ! Note the 1000.0 is to convert from kg salt to g salt (needed for PSU) 
    509       CALL cice2nemo(fsalt_gbm,ztmp,'T', 1. ) 
    510       DO jj=1,jpj 
    511          DO ji=1,jpi 
    512             IF (sss_m(ji,jj).gt.0.0) THEN 
    513                sfx (ji,jj)=sfx (ji,jj)+ztmp(ji,jj)*1000.0/sss_m(ji,jj) 
    514             ENDIF 
    515          ENDDO 
    516       ENDDO 
    517  
    518 ! No longer remove precip over ice from free surface calculation on basis that the 
    519 ! weight of the precip will affect the free surface even if it falls on the ice 
    520 ! (same to the argument that freezing / melting of ice doesn't change the free surface)  
    521 ! Sublimation from the ice is treated in a similar way (included in emp but not sfx )   
    522 ! 
    523 ! This should not be done in the variable volume case 
    524  
    525  
    526       IF (.NOT. lk_vvl) THEN 
    527  
    528          emp(:,:)  = emp(:,:) - tprecip(:,:)*fr_i(:,:) 
    529  
    530 ! Take sublimation into account 
    531          IF (nsbc == 5 ) THEN  
    532             emp(:,:) = emp(:,:) + ( emp_ice(:,:) + sprecip(:,:) ) 
    533          ELSE IF (nsbc == 2 ) THEN 
    534             emp(:,:) = emp(:,:) - qla_ice(:,:,1) / Lsub 
    535          ENDIF 
    536  
    537       ENDIF 
    538 !! ACC end of questionable code 
    539  
     553      CALL cice2nemo(fresh_gbm,ztmp1,'T', 1. ) 
     554      CALL cice2nemo(fsalt_gbm,ztmp2,'T', 1. ) 
     555 
     556! Check to avoid unphysical expression when ice is forming (ztmp1 negative) 
     557! Otherwise we are effectively allowing ice of higher salinity than the ocean to form 
     558! which has to be compensated for by the ocean salinity potentially going negative 
     559! This check breaks conservation but seems reasonable until we have prognostic ice salinity 
     560! Note the 1000.0 below is to convert from kg salt to g salt (needed for PSU) 
     561      WHERE (ztmp1(:,:).lt.0.0) ztmp2(:,:)=MAX(ztmp2(:,:),ztmp1(:,:)*sss_m(:,:)/1000.0) 
     562      sfx(:,:)=ztmp2(:,:)*1000.0 
     563      emp(:,:)=emp(:,:)-ztmp1(:,:) 
     564  
    540565      CALL lbc_lnk( emp , 'T', 1. ) 
    541       CALL lbc_lnk( sfx  , 'T', 1. ) 
    542  
    543 !! ACC Now the latent heat for snow melting is already accounted for in the bulk formulea and coupled interfaces. 
    544 !!     For the non-solar heat flux, in LIM2, code changes were needed to account for the heat content of the mass exchanged  
    545 !      between ice and ocean. It was not necessary to make changes for LIM3 since all mass exchanges are referenced to  
    546 !      zero degrees; this is most likely to be the case in CICE too?? 
    547 !!  
     566      CALL lbc_lnk( sfx , 'T', 1. ) 
     567 
    548568! Solar penetrative radiation and non solar surface heat flux 
    549569 
    … …  
    564584! Now add in ice / snow related terms 
    565585! [fswthru will be zero unless running with calc_Tsfc=T in CICE] 
    566       CALL cice2nemo(fswthru_gbm,ztmp,'T', 1. ) 
    567       qsr(:,:)=qsr(:,:)+ztmp(:,:) 
     586      CALL cice2nemo(fswthru_gbm,ztmp1,'T', 1. ) 
     587      qsr(:,:)=qsr(:,:)+ztmp1(:,:) 
    568588      CALL lbc_lnk( qsr , 'T', 1. ) 
    569589 
    … …  
    574594      ENDDO 
    575595 
    576       CALL cice2nemo(fhocn_gbm,ztmp,'T', 1. ) 
    577       qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp(:,:) 
     596      CALL cice2nemo(fhocn_gbm,ztmp1,'T', 1. ) 
     597      qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp1(:,:) 
    578598 
    579599      CALL lbc_lnk( qns , 'T', 1. ) 
    … …  
    583603      CALL cice2nemo(aice,fr_i,'T', 1. ) 
    584604      IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN 
    585          DO jpl=1,ncat 
    586             CALL cice2nemo(aicen(:,:,jpl,:),a_i(:,:,jpl), 'T', 1. ) 
     605         DO jl=1,ncat 
     606            CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 
    587607         ENDDO 
    588608      ENDIF 
    … …  
    600620      CALL lbc_lnk ( fr_iv , 'V', 1. ) 
    601621 
     622      !                                      ! embedded sea ice 
     623      IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 
     624         CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. ) 
     625         CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. ) 
     626         snwice_mass  (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:)  ) 
     627         snwice_mass_b(:,:) = snwice_mass(:,:) 
     628         snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) / dt 
     629      ENDIF 
     630 
    602631! Release work space 
    603632 
    604       CALL wrk_dealloc( jpi,jpj, ztmp ) 
     633      CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 ) 
    605634      ! 
    606635      IF( nn_timing == 1 )  CALL timing_stop('cice_sbc_out') 
    … …  
    619648      !!--------------------------------------------------------------------- 
    620649 
    621       INTEGER  ::   jpl                        ! dummy loop index 
     650      INTEGER  ::   jl                        ! dummy loop index 
    622651      INTEGER  ::   ierror 
    623652 
    … …  
    642671! Snow and ice thicknesses (CO_2 and CO_3) 
    643672 
    644       DO jpl = 1,ncat 
    645          CALL cice2nemo(vsnon(:,:,jpl,:),ht_s(:,:,jpl),'T', 1. ) 
    646          CALL cice2nemo(vicen(:,:,jpl,:),ht_i(:,:,jpl),'T', 1. ) 
     673      DO jl = 1,ncat 
     674         CALL cice2nemo(vsnon(:,:,jl,:),ht_s(:,:,jl),'T', 1. ) 
     675         CALL cice2nemo(vicen(:,:,jl,:),ht_i(:,:,jl),'T', 1. ) 
    647676      ENDDO 
    648677      ! 
    … …  
    812841      REAL(wp), DIMENSION(jpi,jpj) :: pn 
    813842#if !defined key_nemocice_decomp 
     843      REAL(wp), DIMENSION(jpiglo,jpjglo) :: png2 
    814844      REAL (kind=dbl_kind), dimension(nx_global,ny_global) :: pcg 
    815845#endif 
    … …  
    830860      ! Copy local domain data from NEMO to CICE field 
    831861      pc(:,:,1)=0.0 
    832       DO jj=2,ny_block 
    833          DO ji=2,nx_block 
    834             pc(ji,jj,1)=pn(ji,jj-1) 
     862      DO jj=2,ny_block-1 
     863         DO ji=2,nx_block-1 
     864            pc(ji,jj,1)=pn(ji-1+ji_off,jj-1+jj_off) 
    835865         ENDDO 
    836866      ENDDO 
    … …  
    856886!        pcg(:,:)=0.0 
    857887         DO jn=1,jpnij 
    858             DO jj=1,nlcjt(jn)-1 
    859                DO ji=2,nlcit(jn)-1 
    860                   pcg(ji+nimppt(jn)-2,jj+njmppt(jn)-1)=png(ji,jj,jn)        
     888            DO jj=nldjt(jn),nlejt(jn) 
     889               DO ji=nldit(jn),nleit(jn) 
     890                  png2(ji+nimppt(jn)-1,jj+njmppt(jn)-1)=png(ji,jj,jn) 
    861891               ENDDO 
     892            ENDDO 
     893         ENDDO 
     894         DO jj=1,ny_global 
     895            DO ji=1,nx_global 
     896               pcg(ji,jj)=png2(ji+ji_off,jj+jj_off) 
    862897            ENDDO 
    863898         ENDDO 
    … …  
    954989      DO jj=1,jpjm1 
    955990         DO ji=1,jpim1 
    956             pn(ji,jj)=pc(ji,jj+1,1) 
     991            pn(ji,jj)=pc(ji+1-ji_off,jj+1-jj_off,1) 
    957992         ENDDO 
    958993      ENDDO 
    … …  
    9681003! Need to make sure this is robust to changes in NEMO halo rows.... 
    9691004! (may be OK but not spent much time thinking about it) 
     1005! Note that non-existent pcg elements may be used below, but 
     1006! the lbclnk call on pn will replace these with sensible values 
    9701007 
    9711008      IF (nproc==0) THEN 
    9721009         png(:,:,:)=0.0 
    9731010         DO jn=1,jpnij 
    974             DO jj=1,nlcjt(jn)-1 
    975                DO ji=2,nlcit(jn)-1 
    976                   png(ji,jj,jn)=pcg(ji+nimppt(jn)-2,jj+njmppt(jn)-1)       
     1011            DO jj=nldjt(jn),nlejt(jn) 
     1012               DO ji=nldit(jn),nleit(jn) 
     1013                  png(ji,jj,jn)=pcg(ji+nimppt(jn)-1-ji_off,jj+njmppt(jn)-1-jj_off) 
    9771014               ENDDO 
    9781015            ENDDO 

  • branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r3488 r3508  
    163163      IF( nn_ice == 4 .AND. ( .NOT. ( cp_cfg == 'orca' ) .OR. lk_agrif ) )   & 
    164164         &   CALL ctl_stop( 'CICE sea-ice model currently only available in a global ORCA configuration without AGRIF' ) 
    165       IF( nn_ice == 3 .AND. nn_ice_embd == 0 )   & 
    166          &   CALL ctl_stop( 'LIM3 sea-ice model requires nn_ice_embd = 2 or 3' ) 
     165      IF( ( nn_ice == 3 .OR. nn_ice == 4 ) .AND. nn_ice_embd == 0 )   & 
     166         &   CALL ctl_stop( 'LIM3 and CICE sea-ice models require nn_ice_embd = 2 or 3' ) 
    167167       
    168168      IF( ln_dm2dc )   nday_qsr = -1   ! initialisation flag 
Note: See TracChangeset for help on using the changeset viewer.