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 13463 for NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/ICE/icestp.F90 – NEMO

Ignore:
Timestamp:
2020-09-14T17:40:34+02:00 (4 years ago)
Author:
andmirek
Message:

Ticket #2195:update to trunk 13461

Location:
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS

    • Property svn:externals
      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@13382        sette 
  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/ICE/icestp.F90

    r10994 r13463  
    8686   PUBLIC   ice_init   ! called by sbcmod.F90 
    8787 
    88    !! * Substitutions 
    89 #  include "vectopt_loop_substitute.h90" 
    9088   !!---------------------------------------------------------------------- 
    9189   !! NEMO/ICE 4.0 , NEMO Consortium (2018) 
     
    9593CONTAINS 
    9694 
    97    SUBROUTINE ice_stp( kt, ksbc ) 
     95   SUBROUTINE ice_stp( kt, Kbb, Kmm, ksbc ) 
    9896      !!--------------------------------------------------------------------- 
    9997      !!                  ***  ROUTINE ice_stp  *** 
     
    115113      !!                utau, vtau, taum, wndm, qns , qsr, emp , sfx 
    116114      !!--------------------------------------------------------------------- 
    117       INTEGER, INTENT(in) ::   kt      ! ocean time step 
    118       INTEGER, INTENT(in) ::   ksbc    ! flux formulation (user defined, bulk, or Pure Coupled) 
     115      INTEGER, INTENT(in) ::   kt       ! ocean time step 
     116      INTEGER, INTENT(in) ::   Kbb, Kmm ! ocean time level indices 
     117      INTEGER, INTENT(in) ::   ksbc     ! flux formulation (user defined, bulk, or Pure Coupled) 
    119118      ! 
    120119      INTEGER ::   jl   ! dummy loop index 
     
    160159         ! 
    161160         IF( ln_icedyn .AND. .NOT.lk_c1d )   & 
    162             &                           CALL ice_dyn( kt )            ! -- Ice dynamics 
     161            &                           CALL ice_dyn( kt, Kmm )       ! -- Ice dynamics 
    163162         ! 
    164163         !                          !==  lateral boundary conditions  ==! 
     
    209208      ! --- Ocean time step --- ! 
    210209      !-------------------------! 
    211       IF( ln_icedyn )                   CALL ice_update_tau( kt, ub(:,:,1), vb(:,:,1) )   ! -- update surface ocean stresses 
     210      IF( ln_icedyn )                   CALL ice_update_tau( kt, uu(:,:,1,Kbb), vv(:,:,1,Kbb) )   ! -- update surface ocean stresses 
    212211!!gm   remark, the ocean-ice stress is not saved in ice diag call above .....  find a solution!!! 
    213212      ! 
     
    217216 
    218217 
    219    SUBROUTINE ice_init 
     218   SUBROUTINE ice_init( Kbb, Kmm, Kaa ) 
    220219      !!---------------------------------------------------------------------- 
    221220      !!                  ***  ROUTINE ice_init  *** 
     
    223222      !! ** purpose :   Initialize sea-ice parameters 
    224223      !!---------------------------------------------------------------------- 
     224      INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 
     225      ! 
    225226      INTEGER :: ji, jj, ierr 
    226227      !!---------------------------------------------------------------------- 
     
    232233      IF(lwp) WRITE(numout,*) '~~~~~~~~' 
    233234      ! 
    234       !                                ! Open the reference and configuration namelist files and namelist output file 
    235       CALL ctl_opn( numnam_ice_ref, 'namelist_ice_ref',    'OLD',     'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 
    236       CALL ctl_opn( numnam_ice_cfg, 'namelist_ice_cfg',    'OLD',     'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 
    237       IF(lwm) CALL ctl_opn( numoni, 'output.namelist.ice', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, 1 ) 
     235      !                                ! Load the reference and configuration namelist files and open namelist output file 
     236      CALL load_nml( numnam_ice_ref, 'namelist_ice_ref',    numout, lwm ) 
     237      CALL load_nml( numnam_ice_cfg, 'namelist_ice_cfg',    numout, lwm ) 
     238      IF(lwm) CALL ctl_opn( numoni , 'output.namelist.ice', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, 1 ) 
    238239      ! 
    239240      CALL par_init                ! set some ice run parameters 
     241      ! 
     242#if defined key_agrif 
     243      CALL Agrif_Declare_Var_ice  !  "      "   "   "      "  Sea ice 
     244#endif 
    240245      ! 
    241246      !                                ! Allocate the ice arrays (sbc_ice already allocated in sbc_init) 
     
    254259      IF( .NOT. ln_rstart ) THEN              ! start from rest: sea-ice deduced from sst 
    255260         CALL ice_istate_init 
    256          CALL ice_istate 
     261         CALL ice_istate( nit000, Kbb, Kmm, Kaa ) 
    257262      ELSE                                    ! start from a restart file 
    258          CALL ice_rst_read 
     263         CALL ice_rst_read( Kbb, Kmm, Kaa ) 
    259264      ENDIF 
    260265      CALL ice_var_glo2eqv 
     
    301306      !!------------------------------------------------------------------- 
    302307      ! 
    303       REWIND( numnam_ice_ref )      ! Namelist nampar in reference namelist : Parameters for ice 
    304308      READ  ( numnam_ice_ref, nampar, IOSTAT = ios, ERR = 901) 
    305 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampar in reference namelist', lwp ) 
    306       REWIND( numnam_ice_cfg )      ! Namelist nampar in configuration namelist : Parameters for ice 
     309901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampar in reference namelist' ) 
    307310      READ  ( numnam_ice_cfg, nampar, IOSTAT = ios, ERR = 902 ) 
    308 902   IF( ios > 0 )   CALL ctl_nam ( ios , 'nampar in configuration namelist', lwp ) 
     311902   IF( ios > 0 )   CALL ctl_nam ( ios , 'nampar in configuration namelist' ) 
    309312      IF(lwm) WRITE( numoni, nampar ) 
    310313      ! 
     
    339342      IF( ln_bdy .AND. ln_icediachk )   CALL ctl_warn('par_init: online conservation check does not work with BDY') 
    340343      ! 
    341       rdt_ice   = REAL(nn_fsbc) * rdt          !--- sea-ice timestep and its inverse 
    342       r1_rdtice = 1._wp / rdt_ice 
     344      rDt_ice   = REAL(nn_fsbc) * rn_Dt          !--- sea-ice timestep and its inverse 
     345      r1_Dt_ice = 1._wp / rDt_ice 
    343346      IF(lwp) WRITE(numout,*) 
    344       IF(lwp) WRITE(numout,*) '      ice timestep rdt_ice = nn_fsbc*rdt = ', rdt_ice 
     347      IF(lwp) WRITE(numout,*) '      ice timestep rDt_ice = nn_fsbc*rn_Dt = ', rDt_ice 
    345348      ! 
    346349      r1_nlay_i = 1._wp / REAL( nlay_i, wp )   !--- inverse of nlay_i and nlay_s 
     
    425428      wfx_err_sub(:,:) = 0._wp 
    426429      ! 
    427       afx_tot(:,:) = 0._wp   ; 
    428       ! 
    429430      diag_heat(:,:) = 0._wp ;   diag_sice(:,:) = 0._wp 
    430431      diag_vice(:,:) = 0._wp ;   diag_vsnw(:,:) = 0._wp 
Note: See TracChangeset for help on using the changeset viewer.