Ignore:
Timestamp:
2017-09-01T15:49:35+02:00 (3 years ago)
Author:
clem
Message:

changes in style - part1 - (now the code looks better txs to Gurvan's comments)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/iceupdate.F90

    r8426 r8486  
    22   !!====================================================================== 
    33   !!                       ***  MODULE iceupdate   *** 
    4    !!           computation of the flux at the sea ice/ocean interface 
     4   !!  Sea-ice :   computation of the flux at the sea ice/ocean interface 
    55   !!====================================================================== 
    66   !! History :   -   ! 2006-07 (M. Vancoppelle)  LIM3 original code 
     
    2727   USE phycst         ! physical constants 
    2828   USE dom_oce        ! ocean domain 
    29    USE ice            ! LIM sea-ice variables 
    30    USE sbc_ice , ONLY : emp_oce, qns_oce, qsr_oce, qemp_oce, emp_ice, qsr_ice, qemp_ice, qevap_ice, alb_ice, tn_ice, cldf_ice,  & 
     29   USE ice            ! sea-ice: variables 
     30!!gm  It should be probably better to pass these variable in argument of the routine,  
     31!!gm  rather than having this long list in USE. This will also highlight what is updated, and what is just use. 
     32   USE sbc_ice , ONLY : emp_oce, qns_oce, qsr_oce , qemp_oce ,                             & 
     33      &                 emp_ice, qsr_ice, qemp_ice, qevap_ice, alb_ice, tn_ice, cldf_ice,  & 
    3134      &                 snwice_mass, snwice_mass_b, snwice_fmass 
    3235   USE sbc_oce , ONLY : nn_fsbc, ln_ice_embd, sfx, fr_i, qsr_tot, qns, qsr, fmmflx, emp, taum, utau, vtau 
     36!!gm end 
    3337   USE sbccpl         ! Surface boundary condition: coupled interface 
    3438   USE icealb         ! albedo parameters 
    3539   USE traqsr         ! add penetration of solar flux in the calculation of heat budget 
    3640   USE domvvl         ! Variable volume 
    37    USE icectl         ! 
    38    USE bdy_oce  , ONLY: ln_bdy 
     41   USE icectl         ! ??? 
     42   USE bdy_oce , ONLY : ln_bdy 
    3943   ! 
    4044   USE in_out_manager ! I/O manager 
     
    5963#  include "vectopt_loop_substitute.h90" 
    6064   !!---------------------------------------------------------------------- 
    61    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     65   !! NEMO/ICE 4.0 , NEMO Consortium (2017) 
    6266   !! $Id: iceupdate.F90 8411 2017-08-07 16:09:12Z clem $ 
    6367   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    7276         &      sice_0(jpi,jpj) , vtau_oce(jpi,jpj) , tmod_io(jpi,jpj), STAT=ice_update_alloc) 
    7377         ! 
    74       IF( lk_mpp             )   CALL mpp_sum( ice_update_alloc ) 
     78      IF( lk_mpp                )   CALL mpp_sum( ice_update_alloc ) 
    7579      IF( ice_update_alloc /= 0 )   CALL ctl_warn('ice_update_alloc: failed to allocate arrays') 
    7680   END FUNCTION ice_update_alloc 
     
    138142               zqsr = zqsr - a_i_b(ji,jj,jl) * (  qsr_ice(ji,jj,jl) - ftr_ice(ji,jj,jl) )  
    139143            END DO 
     144!!gm  why not like almost everywhere else : 
     145!!gm        zqsr = qsr_tot(ji,jj) - SUM( a_i_b(ji,jj,:) * (  qsr_ice(ji,jj,:) - ftr_ice(ji,jj,:) ) 
    140146 
    141147            ! Total heat flux reaching the ocean = hfx_out (W.m-2)  
     
    170176            ! mass flux from ice/ocean 
    171177            wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   & 
    172                            + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj)  
     178               &           + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj)  
    173179 
    174180            IF ( ln_pnd_fw )   wfx_ice(ji,jj) = wfx_ice(ji,jj) + wfx_pnd(ji,jj) 
     
    189195            ! Mass of snow and ice per unit area    
    190196            !---------------------------------------- 
    191             ! save mass from the previous ice time step 
    192             snwice_mass_b(ji,jj) = snwice_mass(ji,jj)                   
    193             ! new mass per unit area 
     197            snwice_mass_b(ji,jj) = snwice_mass(ji,jj)       ! save mass from the previous ice time step 
     198            !                                               ! new mass per unit area 
    194199            snwice_mass  (ji,jj) = tmask(ji,jj,1) * ( rhosn * vt_s(ji,jj) + rhoic * vt_i(ji,jj)  )  
    195             ! time evolution of snow+ice mass 
     200            !                                               ! time evolution of snow+ice mass 
    196201            snwice_fmass (ji,jj) = ( snwice_mass(ji,jj) - snwice_mass_b(ji,jj) ) * r1_rdtice 
    197202             
     
    209214      !------------------------------------------------------------------------! 
    210215      CALL ice_alb( t_su, ht_i, ht_s, a_ip_frac, h_ip, ln_pnd_rad, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 
    211  
    212       alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
    213  
    214       ! conservation test 
    215       IF( ln_limdiachk .AND. .NOT. ln_bdy)  CALL ice_cons_final( 'iceupdate' ) 
    216  
    217       ! control prints 
     216      ! 
     217      alb_ice(:,:,:) = ( 1._wp - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
     218 
     219      !                    ! conservation test 
     220      IF( ln_limdiachk .AND. .NOT. ln_bdy)   CALL ice_cons_final( 'iceupdate' ) 
     221      !                    ! control prints 
    218222      IF( ln_limctl )   CALL ice_prt( kt, iiceprt, jiceprt, 3, ' - Final state ice_update - ' ) 
    219       IF( ln_ctl )      CALL ice_prt3D( 'iceupdate' ) 
    220  
    221       IF( nn_timing == 1 )  CALL timing_stop('ice_update_flx') 
    222  
     223      IF( ln_ctl    )   CALL ice_prt3D( 'iceupdate' ) 
     224      ! 
     225      IF( nn_timing == 1 )   CALL timing_stop('ice_update_flx') 
     226      ! 
    223227   END SUBROUTINE ice_update_flx 
    224228 
    225229 
    226    SUBROUTINE ice_update_tau( kt , pu_oce, pv_oce ) 
     230   SUBROUTINE ice_update_tau( kt, pu_oce, pv_oce ) 
    227231      !!------------------------------------------------------------------- 
    228232      !!                ***  ROUTINE ice_update_tau *** 
     
    312316      !!                  ***  ROUTINE ice_update_init  *** 
    313317      !!              
    314       !! ** Purpose : Preparation of the file ice_evolu for the output of 
    315       !!      the temporal evolution of key variables 
     318      !! ** Purpose :   ??? 
    316319      !! 
    317       !! ** input   : Namelist namicedia 
    318320      !!------------------------------------------------------------------- 
    319321      INTEGER  ::   ji, jj, jk               ! dummy loop indices 
     
    322324      ! 
    323325      IF(lwp) WRITE(numout,*) 
    324       IF(lwp) WRITE(numout,*) 'ice_update_init : LIM-3 sea-ice - surface boundary condition' 
     326      IF(lwp) WRITE(numout,*) 'ice_update_init :   sea-ice   ????' 
    325327      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~   ' 
    326328 
     
    328330      IF( ice_update_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'ice_update_init : unable to allocate standard arrays' ) 
    329331      ! 
    330       soce_0(:,:) = soce                     ! constant SSS and ice salinity used in levitating sea-ice case 
     332      soce_0(:,:) = soce                     ! constant SSS and ice salinity used in levitating case 0 (i.e. virtual salt flux) 
    331333      sice_0(:,:) = sice 
    332       !                                      ! decrease ocean & ice reference salinities in the Baltic Sea area 
    333       WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.   & 
     334      WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.   &   ! reduced values in the Baltic Sea area 
    334335         &   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp         )  
    335336         soce_0(:,:) = 4._wp 
     
    337338      END WHERE 
    338339      ! 
    339       IF( .NOT. ln_rstart ) THEN 
     340      IF( .NOT.ln_rstart ) THEN              ! set  
    340341         ! 
    341342         snwice_mass  (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  )   ! snow+ice mass 
     
    350351            IF( .NOT.ln_linssh ) THEN 
    351352               DO jk = 1,jpkm1                     ! adjust initial vertical scale factors 
    352                   e3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
    353                   e3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
     353                  e3t_n(:,:,jk) = e3t_0(:,:,jk) * (  1._wp + sshn(:,:)*tmask(:,:,1) / (ht_0(:,:) + 1._wp - tmask(:,:,1) ) ) 
     354                  e3t_b(:,:,jk) = e3t_0(:,:,jk) * (  1._wp + sshb(:,:)*tmask(:,:,1) / (ht_0(:,:) + 1._wp - tmask(:,:,1) ) ) 
    354355               END DO 
    355356               e3t_a(:,:,:) = e3t_b(:,:,:) 
     357!!gm  we are in no-restart case, so sshn=sshb   ==>> faster calculation: 
     358!!    REAL(wp) ::   ze3t   ! local scalar 
     359!!    REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace 
     360!! 
     361!!             WHERE( ht_0(:,:) > 0 )   ;   z2d(:,:) = 1._wp + sshn(:,:)*tmask(:,:,1) / ht_0(:,:) 
     362!!             ELSEWHERE                ;   z2d(:,:) = 1._wp 
     363!!             END WHERE 
     364!!             DO jk = 1,jpkm1                     ! adjust initial vertical scale factors                 
     365!!                ze3t = e3t_0(:,:,jk) * z2d(:,:) 
     366!!                e3t_n(:,:,jk) = ze3t 
     367!!                e3t_b(:,:,jk) = ze3t 
     368!!                e3t_a(:,:,jk) = ze3t 
     369!!             END DO 
     370!!gm  but since it is only done at the initialisation....  just the following can be acceptable: 
     371!               DO jk = 1,jpkm1                     ! adjust initial vertical scale factors 
     372!                  e3t_n(:,:,jk) = e3t_0(:,:,jk) * (  1._wp + sshn(:,:)*tmask(:,:,1) / (ht_0(:,:) + 1._wp - tmask(:,:,1))  ) 
     373!               END DO 
     374!               e3t_b(:,:,:) = e3t_n(:,:,:) 
     375!               e3t_a(:,:,:) = e3t_n(:,:,:) 
     376!!gm end                
    356377               ! Reconstruction of all vertical scale factors at now and before time-steps 
    357378               ! ========================================================================= 
     
    377398               gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:) 
    378399               DO jk = 2, jpk 
    379                   gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk) 
     400                  gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk  ) 
    380401                  gdepw_n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1) 
    381                   gde3w_n(:,:,jk) = gdept_n(:,:,jk  ) - sshn   (:,:) 
     402                  gde3w_n(:,:,jk) = gdept_n(:,:,jk  ) - sshn (:,:) 
    382403               END DO 
    383404            ENDIF 
     
    387408   END SUBROUTINE ice_update_init 
    388409 
     410#else 
     411   !!---------------------------------------------------------------------- 
     412   !!   Default option         Dummy module          NO  LIM3 sea-ice model 
     413   !!---------------------------------------------------------------------- 
    389414#endif  
    390415 
Note: See TracChangeset for help on using the changeset viewer.