Changeset 5059


Ignore:
Timestamp:
2015-02-04T17:22:15+01:00 (6 years ago)
Author:
clem
Message:

LIM3: set ice diffusivity independant of the resolution in the namelist. The dependancy is done in the code itself

Location:
branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO
Files:
9 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90

    r5055 r5059  
    2121 
    2222   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fcor       !: coriolis coefficient 
    23    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   covrai     !: sine of geographic latitude 
    2423   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   area       !: surface of grid cell  
    2524   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tms, tmi   !: temperature mask, mask for stress 
     
    4342      !!------------------------------------------------------------------- 
    4443      ! 
    45       ALLOCATE( fcor(jpi,jpj)                   ,      & 
    46          &      covrai(jpi,jpj) , area(jpi,jpj) ,      & 
     44      ALLOCATE( fcor(jpi,jpj)   , area(jpi,jpj) ,      & 
    4745         &      tms   (jpi,jpj) , tmi (jpi,jpj) ,      & 
    4846         &      tmu   (jpi,jpj) , tmv (jpi,jpj) ,      & 
  • branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/ice.F90

    r5058 r5059  
    380380   ! thd refers to changes induced by thermodynamics 
    381381   ! trp   ''         ''     ''       advection (transport of ice) 
    382    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   d_a_i_thd  , d_a_i_trp                 !: icefractions                   
    383    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   d_v_s_thd  , d_v_s_trp                 !: snow volume 
    384    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   d_v_i_thd  , d_v_i_trp                 !: ice  volume 
    385    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   d_smv_i_thd, d_smv_i_trp               !:      
    386    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   d_oa_i_thd , d_oa_i_trp                !: 
    387  
    388    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   d_e_s_thd  , d_e_s_trp     !: 
    389    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   d_e_i_thd  , d_e_i_trp     !: 
    390    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   d_u_ice_dyn, d_v_ice_dyn   !: ice velocity  
    391  
    392382   LOGICAL , PUBLIC                                        ::   ln_limdiahsb  !: flag for ice diag (T) or not (F) 
    393383   LOGICAL , PUBLIC                                        ::   ln_limdiaout  !: flag for ice diag (T) or not (F) 
     
    414404      INTEGER :: ice_alloc 
    415405      ! 
    416       INTEGER :: ierr(19), ii 
     406      INTEGER :: ierr(17), ii 
    417407      !!----------------------------------------------------------------- 
    418408 
     
    485475         &      oa_i_b (jpi,jpj,jpl)                                                        ,     & 
    486476         &      u_ice_b(jpi,jpj)     , v_ice_b(jpi,jpj)                                   , STAT=ierr(ii) ) 
    487  
    488       ! * Increment of global variables 
    489       ii = ii + 1 
    490       ALLOCATE( d_a_i_thd(jpi,jpj,jpl) , d_a_i_trp (jpi,jpj,jpl) , d_v_s_thd  (jpi,jpj,jpl) , d_v_s_trp  (jpi,jpj,jpl) ,   & 
    491          &      d_v_i_thd(jpi,jpj,jpl) , d_v_i_trp (jpi,jpj,jpl) , d_smv_i_thd(jpi,jpj,jpl) , d_smv_i_trp(jpi,jpj,jpl) ,   &      
    492          &      d_oa_i_thd(jpi,jpj,jpl) , d_oa_i_trp (jpi,jpj,jpl) ,   & 
    493          &     STAT=ierr(ii) ) 
    494       ii = ii + 1 
    495       ALLOCATE( d_e_s_thd(jpi,jpj,nlay_s,jpl) , d_e_i_thd(jpi,jpj,nlay_i,jpl) , d_u_ice_dyn(jpi,jpj) ,     & 
    496          &      d_e_s_trp(jpi,jpj,nlay_s,jpl) , d_e_i_trp(jpi,jpj,nlay_i,jpl) , d_v_ice_dyn(jpi,jpj) , STAT=ierr(ii) ) 
    497477       
    498478      ! * Ice thickness distribution variables 
  • branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90

    r5055 r5059  
    66   !! History :   -   ! Original code from William H. Lipscomb, LANL 
    77   !!            3.0  ! 2004-06  (M. Vancoppenolle)   Energy Conservation  
    8    !!            4.0  ! 2011-02  (G. Madec)  add mpp considerations 
     8   !!            3.5  ! 2011-02  (G. Madec)  add mpp considerations 
    99   !!             -   ! 2014-05  (C. Rousset) add lim_cons_hsm 
    1010   !!---------------------------------------------------------------------- 
     
    207207            IF ( ABS( zsmv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (',cd_routine,') = ',(zsmv * rday) 
    208208            IF ( ABS( zei    ) >  1.    ) WRITE(numout,*) 'violation enthalpy [1e9 J]    (',cd_routine,') = ',(zei) 
    209             IF ( zvmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [m]          (',cd_routine,') = ',(zvmin) 
     209            IF ( zvmin <  1.e-10        ) WRITE(numout,*) 'violation v_i<0  [m]          (',cd_routine,') = ',(zvmin) 
    210210            IF( cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' .AND. zamax > amax+1.e-10 ) THEN 
    211211                                          WRITE(numout,*) 'violation a_i>amax            (',cd_routine,') = ',zamax 
    212212            ENDIF 
    213             IF ( zamin <  0.            ) WRITE(numout,*) 'violation a_i<0               (',cd_routine,') = ',zamin 
     213            IF ( zamin <  1.e-10        ) WRITE(numout,*) 'violation a_i<0               (',cd_routine,') = ',zamin 
    214214         ENDIF 
    215215 
  • branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90

    r5055 r5059  
    7777                  !WRITE(numout,*) ' a_i *** a_i_b   ', a_i      (ji,jj,jl), a_i_b  (ji,jj,jl) 
    7878                  !WRITE(numout,*) ' v_i *** v_i_b   ', v_i      (ji,jj,jl), v_i_b  (ji,jj,jl) 
    79                   !WRITE(numout,*) ' d_a_i_thd/trp   ', d_a_i_thd(ji,jj,jl), d_a_i_trp(ji,jj,jl) 
    80                   !WRITE(numout,*) ' d_v_i_thd/trp   ', d_v_i_thd(ji,jj,jl), d_v_i_trp(ji,jj,jl) 
    8179                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    8280               ENDIF 
     
    187185                  !WRITE(numout,*) ' Category no: ', jl 
    188186                  !WRITE(numout,*) ' a_i        : ', a_i      (ji,jj,jl) , ' a_i_b      : ', a_i_b  (ji,jj,jl)    
    189                   !WRITE(numout,*) ' d_a_i_trp  : ', d_a_i_trp(ji,jj,jl) , ' d_a_i_thd  : ', d_a_i_thd(ji,jj,jl)  
    190187                  !WRITE(numout,*) ' v_i        : ', v_i      (ji,jj,jl) , ' v_i_b      : ', v_i_b  (ji,jj,jl)    
    191                   !WRITE(numout,*) ' d_v_i_trp  : ', d_v_i_trp(ji,jj,jl) , ' d_v_i_thd  : ', d_v_i_thd(ji,jj,jl)  
    192188                  !WRITE(numout,*) ' ' 
    193189               !END DO 
     
    363359               WRITE(numout,*) ' v_ice(i  ,j)  : ', v_ice(ji,jj) 
    364360               WRITE(numout,*) ' strength      : ', strength(ji,jj) 
    365                WRITE(numout,*) ' d_u_ice_dyn   : ', d_u_ice_dyn(ji,jj), ' d_v_ice_dyn   : ', d_v_ice_dyn(ji,jj) 
    366361               WRITE(numout,*) ' u_ice_b       : ', u_ice_b(ji,jj)    , ' v_ice_b       : ', v_ice_b(ji,jj)   
    367362               WRITE(numout,*) 
     
    375370                  WRITE(numout,*) ' sm_i       : ', sm_i(ji,jj,jl)             , ' o_i        : ', o_i(ji,jj,jl) 
    376371                  WRITE(numout,*) ' a_i        : ', a_i(ji,jj,jl)              , ' a_i_b      : ', a_i_b(ji,jj,jl)    
    377                   WRITE(numout,*) ' d_a_i_trp  : ', d_a_i_trp(ji,jj,jl)        , ' d_a_i_thd  : ', d_a_i_thd(ji,jj,jl)  
    378372                  WRITE(numout,*) ' v_i        : ', v_i(ji,jj,jl)              , ' v_i_b      : ', v_i_b(ji,jj,jl)    
    379                   WRITE(numout,*) ' d_v_i_trp  : ', d_v_i_trp(ji,jj,jl)        , ' d_v_i_thd  : ', d_v_i_thd(ji,jj,jl)  
    380373                  WRITE(numout,*) ' v_s        : ', v_s(ji,jj,jl)              , ' v_s_b      : ', v_s_b(ji,jj,jl)   
    381                   WRITE(numout,*) ' d_v_s_trp  : ', d_v_s_trp(ji,jj,jl)        , ' d_v_s_thd  : ', d_v_s_thd(ji,jj,jl) 
    382374                  WRITE(numout,*) ' e_i1       : ', e_i(ji,jj,1,jl)/1.0e9      , ' ei1        : ', e_i_b(ji,jj,1,jl)/1.0e9  
    383                   WRITE(numout,*) ' de_i1_trp  : ', d_e_i_trp(ji,jj,1,jl)/1.0e9, ' de_i1_thd  : ', d_e_i_thd(ji,jj,1,jl)/1.0e9 
    384375                  WRITE(numout,*) ' e_i2       : ', e_i(ji,jj,2,jl)/1.0e9      , ' ei2_b      : ', e_i_b(ji,jj,2,jl)/1.0e9   
    385                   WRITE(numout,*) ' de_i2_trp  : ', d_e_i_trp(ji,jj,2,jl)/1.0e9, ' de_i2_thd  : ', d_e_i_thd(ji,jj,2,jl)/1.0e9 
    386376                  WRITE(numout,*) ' e_snow     : ', e_s(ji,jj,1,jl)            , ' e_snow_b   : ', e_s_b(ji,jj,1,jl)  
    387                   WRITE(numout,*) ' d_e_s_trp  : ', d_e_s_trp(ji,jj,1,jl)      , ' d_e_s_thd  : ', d_e_s_thd(ji,jj,1,jl) 
    388377                  WRITE(numout,*) ' smv_i      : ', smv_i(ji,jj,jl)            , ' smv_i_b    : ', smv_i_b(ji,jj,jl)    
    389                   WRITE(numout,*) ' d_smv_i_trp: ', d_smv_i_trp(ji,jj,jl)      , ' d_smv_i_thd: ', d_smv_i_thd(ji,jj,jl)  
    390378                  WRITE(numout,*) ' oa_i       : ', oa_i(ji,jj,jl)             , ' oa_i_b     : ', oa_i_b(ji,jj,jl) 
    391                   WRITE(numout,*) ' d_oa_i_trp : ', d_oa_i_trp(ji,jj,jl)       , ' d_oa_i_thd : ', d_oa_i_thd(ji,jj,jl) 
    392379               END DO !jl 
    393380                
  • branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90

    r5055 r5059  
    66   !! history :  1.0  ! 2002-08  (C. Ethe, G. Madec)  original VP code  
    77   !!            3.0  ! 2007-03  (MA Morales Maqueda, S. Bouillon, M. Vancoppenolle)  LIM3: EVP-Cgrid 
    8    !!            4.0  ! 2011-02  (G. Madec) dynamical allocation 
     8   !!            3.5  ! 2011-02  (G. Madec) dynamical allocation 
    99   !!---------------------------------------------------------------------- 
    1010#if defined key_lim3 
     
    244244      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    245245      NAMELIST/namicedyn/ cw, pstar, c_rhg, creepl, ecc, ahi0, nevp, relast 
     246      INTEGER  ::   ji, jj 
     247      REAL(wp) ::   za00, zd_max 
    246248      !!------------------------------------------------------------------- 
    247249 
     
    264266         WRITE(numout,*) '   creep limit                                      creepl = ', creepl 
    265267         WRITE(numout,*) '   eccentricity of the elliptical yield curve       ecc    = ', ecc 
    266          WRITE(numout,*) '   horizontal diffusivity coeff. for sea-ice        ahi0   = ', ahi0 
     268         WRITE(numout,*) '   horizontal diffusivity coeff. (orca2 grid)       ahi0   = ', ahi0 
    267269         WRITE(numout,*) '   number of iterations for subcycling              nevp   = ', nevp 
    268270         WRITE(numout,*) '   ratio of elastic timescale over ice time step    relast = ', relast 
     
    271273      usecc2 = 1._wp / ( ecc * ecc ) 
    272274      rhoco  = rau0  * cw 
    273  
     275      ! 
    274276      !  Diffusion coefficients. 
    275       ahiu(:,:) = ahi0 * umask(:,:,1) 
    276       ahiv(:,:) = ahi0 * vmask(:,:,1) 
    277       ! 
     277      zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) ) 
     278      IF( lk_mpp )   CALL mpp_max( zd_max )   ! max over the global domain 
     279            
     280      za00 = ahi0 / ( 1.e05_wp )              ! 1.e05 = 100km = max grid space at 60° latitude in orca2 
     281                                              !                 (i.e. 60° = min latitude for ice cover)   
     282      DO jj = 1, jpj 
     283         DO ji = 1, jpi 
     284            ahiu(ji,jj) = za00 * MAX( e1t(ji,jj), e2t(ji,jj) ) * umask(ji,jj,1) 
     285            ahiv(ji,jj) = za00 * MAX( e1f(ji,jj), e2f(ji,jj) ) * vmask(ji,jj,1) 
     286         END DO 
     287      END DO 
     288      ! 
     289      IF(lwp) WRITE(numout,*) '' 
     290      IF(lwp) WRITE(numout,*) '   laplacian operator: ahim proportional to e1' 
     291      IF(lwp) WRITE(numout,*) '   maximum grid-spacing = ', zd_max, ' maximum value for ahim = ', za00*zd_max 
     292  
    278293   END SUBROUTINE lim_dyn_init 
    279294 
  • branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90

    r5055 r5059  
    6161      !! ** action : 
    6262      !!--------------------------------------------------------------------- 
    63       INTEGER, INTENT(in) ::   kt   ! number of iteration 
     63      INTEGER, INTENT(in) ::   kt           ! number of iteration 
    6464      ! 
    65       INTEGER  ::   ji, jj, jk, jl, jt   ! dummy loop indices 
     65      INTEGER  ::   ji, jj, jk, jl, jt      ! dummy loop indices 
    6666      INTEGER  ::   initad                  ! number of sub-timestep for the advection 
    6767      REAL(wp) ::   zcfl , zusnit           !   -      - 
    68       CHARACTER(len=80) :: cltmp 
     68      CHARACTER(len=80) ::   cltmp 
    6969      ! 
    7070      REAL(wp), POINTER, DIMENSION(:,:)      ::   zsm, zs0at 
     
    7575      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zhimax                   ! old ice thickness 
    7676      REAL(wp), POINTER, DIMENSION(:,:)      ::   zatold, zeiold, zesold   ! old concentration, enthalpies 
    77       REAL(wp) :: zdv, zvi, zvs, zsmv, zes, zei 
    78       ! 
    79       REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
     77      REAL(wp) ::    zdv, zvi, zvs, zsmv, zes, zei 
     78      REAL(wp) ::    zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 
    8079      !!--------------------------------------------------------------------- 
    8180      IF( nn_timing == 1 )  CALL timing_start('limtrp') 
     
    122121               DO ji = 2, jpim1 
    123122                  zhimax(ji,jj,jl) = MAXVAL( ht_i(ji-1:ji+1,jj-1:jj+1,jl) ) 
    124                   !zhimax(ji,jj,jl) = ( ht_i(ji  ,jj  ,jl) * tmask(ji,  jj  ,1) + ht_i(ji-1,jj-1,jl) * tmask(ji-1,jj-1,1) + ht_i(ji+1,jj+1,jl) * tmask(ji+1,jj+1,1) & 
    125                   !     &             + ht_i(ji-1,jj  ,jl) * tmask(ji-1,jj  ,1) + ht_i(ji  ,jj-1,jl) * tmask(ji  ,jj-1,1) & 
    126                   !     &             + ht_i(ji+1,jj  ,jl) * tmask(ji+1,jj  ,1) + ht_i(ji  ,jj+1,jl) * tmask(ji  ,jj+1,1) & 
    127                   !     &             + ht_i(ji-1,jj+1,jl) * tmask(ji-1,jj+1,1) + ht_i(ji+1,jj-1,jl) * tmask(ji+1,jj-1,1) ) 
    128123               END DO 
    129124            END DO 
     
    139134         zcfl  = MAX( zcfl, MAXVAL( ABS( v_ice(:,:) ) * rdt_ice / e2v(:,:) ) ) 
    140135         IF(lk_mpp )   CALL mpp_max( zcfl ) 
    141 !!gm more readability: 
    142 !         IF( zcfl > 0.5 ) THEN   ;   initad = 2   ;   zusnit = 0.5_wp 
    143 !         ELSE                    ;   initad = 1   ;   zusnit = 1.0_wp 
    144 !         ENDIF 
    145 !!gm end 
    146          initad = 1 + NINT( MAX( 0._wp, SIGN( 1._wp, zcfl-0.5 ) ) ) 
    147          zusnit = 1.0 / REAL( initad )  
     136 
     137         IF( zcfl > 0.5 ) THEN   ;   initad = 2   ;   zusnit = 0.5_wp 
     138         ELSE                    ;   initad = 1   ;   zusnit = 1.0_wp 
     139         ENDIF 
     140 
    148141         IF( zcfl > 0.5_wp .AND. lwp )   ncfl = ncfl + 1 
    149142         IF( numit == nlast .AND. lwp ) THEN 
    150143            IF( ncfl > 0 ) THEN    
    151              WRITE(cltmp,'(i6.1)') ncfl 
    152              CALL ctl_stop('STOP',TRIM(cltmp) ) 
     144               WRITE(cltmp,'(i6.1)') ncfl 
     145               CALL ctl_stop('STOP',TRIM(cltmp) ) 
    153146               CALL ctl_warn( 'lim_trp: ', TRIM(cltmp), 'advective ice time-step using a split in sub-time-step ') 
    154147            ELSE 
     
    160153         ! transported fields                                         
    161154         !------------------------- 
    162          zs0ow(:,:,1) = ato_i(:,:) * area(:,:)               ! Open water area  
     155         zs0ow(:,:,1) = ato_i(:,:) * area(:,:)              ! Open water area  
    163156         DO jl = 1, jpl 
    164157            zs0sn (:,:,jl)   = v_s  (:,:,jl) * area(:,:)    ! Snow volume 
     
    277270 
    278271         !------------------------------------------------------------------------------! 
    279          ! 4) Diffusion of Ice fields                   
     272         ! Diffusion of Ice fields                   
    280273         !------------------------------------------------------------------------------! 
    281274 
     
    322315 
    323316         !------------------------------------------------------------------------------! 
    324          ! 5) Update and limit ice properties after transport                            
     317         ! limit ice properties after transport                            
    325318         !------------------------------------------------------------------------------! 
    326  
    327319!!gm & cr   :  MAX should not be active if adv scheme is positive ! 
    328          !-------------------------------------------------- 
    329          ! 5.1) Recover mean values over the grid squares. 
    330          !-------------------------------------------------- 
    331320         DO jl = 1, jpl 
    332321            DO jj = 1, jpj 
     
    340329               END DO 
    341330            END DO 
    342          END DO 
    343          DO jl = 1, jpl 
     331 
    344332            DO jk = 1, nlay_i 
    345333               DO jj = 1, jpj 
     
    458446 
    459447      ! ------------------------------------------------- 
    460       IF( ln_nicep )   CALL lim_prt( kt, jiindx, jjindx,-1, ' - ice dyn & trp - ' )   ! control print 
     448      ! control prints 
    461449      ! ------------------------------------------------- 
    462       IF(ln_ctl) THEN   ! Control print 
    463          CALL prt_ctl_info(' ') 
    464          CALL prt_ctl_info(' - Cell values : ') 
    465          CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    466          CALL prt_ctl(tab2d_1=area , clinfo1=' lim_trp  : cell area :') 
    467          CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_trp  : at_i      :') 
    468          CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_trp  : vt_i      :') 
    469          CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_trp  : vt_s      :') 
    470          DO jl = 1, jpl 
    471             CALL prt_ctl_info(' ') 
    472             CALL prt_ctl_info(' - Category : ', ivar1=jl) 
    473             CALL prt_ctl_info('   ~~~~~~~~~~') 
    474             CALL prt_ctl(tab2d_1=a_i   (:,:,jl)   , clinfo1= ' lim_trp  : a_i      : ') 
    475             CALL prt_ctl(tab2d_1=ht_i  (:,:,jl)   , clinfo1= ' lim_trp  : ht_i     : ') 
    476             CALL prt_ctl(tab2d_1=ht_s  (:,:,jl)   , clinfo1= ' lim_trp  : ht_s     : ') 
    477             CALL prt_ctl(tab2d_1=v_i   (:,:,jl)   , clinfo1= ' lim_trp  : v_i      : ') 
    478             CALL prt_ctl(tab2d_1=v_s   (:,:,jl)   , clinfo1= ' lim_trp  : v_s      : ') 
    479             CALL prt_ctl(tab2d_1=e_s   (:,:,1,jl) , clinfo1= ' lim_trp  : e_s      : ') 
    480             CALL prt_ctl(tab2d_1=t_su  (:,:,jl)   , clinfo1= ' lim_trp  : t_su     : ') 
    481             CALL prt_ctl(tab2d_1=t_s   (:,:,1,jl) , clinfo1= ' lim_trp  : t_snow   : ') 
    482             CALL prt_ctl(tab2d_1=sm_i  (:,:,jl)   , clinfo1= ' lim_trp  : sm_i     : ') 
    483             CALL prt_ctl(tab2d_1=smv_i (:,:,jl)   , clinfo1= ' lim_trp  : smv_i    : ') 
    484             DO jk = 1, nlay_i 
    485                CALL prt_ctl_info(' ') 
    486                CALL prt_ctl_info(' - Layer : ', ivar1=jk) 
    487                CALL prt_ctl_info('   ~~~~~~~') 
    488                CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_trp  : t_i      : ') 
    489                CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_trp  : e_i      : ') 
    490             END DO 
    491          END DO 
    492       ENDIF 
     450      IF( ln_nicep )   CALL lim_prt( kt, jiindx, jjindx,-1, ' - ice dyn & trp - ' ) 
    493451      ! 
    494452      CALL wrk_dealloc( jpi,jpj,           zsm, zs0at, zatold, zeiold, zesold ) 
     
    499457      ! 
    500458      IF( nn_timing == 1 )  CALL timing_stop('limtrp') 
     459 
    501460   END SUBROUTINE lim_trp 
    502461 
     
    509468   END SUBROUTINE lim_trp 
    510469#endif 
    511  
    512470   !!====================================================================== 
    513471END MODULE limtrp 
  • branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90

    r5055 r5059  
    55   !!====================================================================== 
    66   !! History :  3.0  !  2006-04  (M. Vancoppenolle) Original code 
    7    !!            3.6  !  2014-06  (C. Rousset)       Complete rewriting/cleaning 
     7   !!            3.5  !  2014-06  (C. Rousset)       Complete rewriting/cleaning 
    88   !!---------------------------------------------------------------------- 
    99#if defined key_lim3 
     
    1313   !!    lim_update1   : computes update of sea-ice global variables from trend terms 
    1414   !!---------------------------------------------------------------------- 
    15    USE limrhg          ! ice rheology 
    16  
    17    USE dom_oce 
    18    USE oce             ! dynamics and tracers variables 
    19    USE in_out_manager 
    2015   USE sbc_oce         ! Surface boundary condition: ocean fields 
    2116   USE sbc_ice         ! Surface boundary condition: ice fields 
     
    2318   USE phycst          ! physical constants 
    2419   USE ice 
    25    USE limdyn 
    26    USE limtrp 
    27    USE limthd 
    28    USE limsbc 
    29    USE limdiahsb 
    30    USE limwri 
    31    USE limrst 
    3220   USE thd_ice         ! LIM thermodynamic sea-ice variables 
    3321   USE limitd_th 
    34    USE limitd_me 
    3522   USE limvar 
    36    USE prtctl           ! Print control 
    37    USE lbclnk           ! lateral boundary condition - MPP exchanges 
    38    USE wrk_nemo         ! work arrays 
    39    USE lib_fortran     ! glob_sum 
    40    USE in_out_manager   ! I/O manager 
    41    USE iom              ! I/O manager 
    42    USE lib_mpp          ! MPP library 
     23   USE prtctl          ! Print control 
     24   USE wrk_nemo        ! work arrays 
    4325   USE timing          ! Timing 
    44    USE limcons        ! conservation tests 
     26   USE limcons         ! conservation tests 
     27   USE lib_mpp         ! MPP library 
     28   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     29   USE in_out_manager  ! I/O manager 
    4530 
    4631   IMPLICIT NONE 
    4732   PRIVATE 
    4833 
    49    PUBLIC   lim_update1   ! routine called by ice_step 
     34   PUBLIC   lim_update1 
    5035 
    5136   !! * Substitutions 
     
    6651      !!                 
    6752      !!--------------------------------------------------------------------- 
    68       INTEGER, INTENT(in) :: kt    ! number of iteration 
     53      INTEGER, INTENT(in) ::   kt    ! number of iteration 
    6954      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    70       INTEGER  ::   i_ice_switch 
    7155      REAL(wp) ::   zsal 
    72       ! 
    73       REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
     56      REAL(wp) ::   zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    7457      !!------------------------------------------------------------------- 
    7558      IF( nn_timing == 1 )  CALL timing_start('limupdate1') 
     
    141124                  smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl) 
    142125                  ! salinity stays in bounds 
    143                   i_ice_switch    = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 
    144                   smv_i(ji,jj,jl) = i_ice_switch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) 
     126                  rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 
     127                  smv_i(ji,jj,jl) = rswitch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) 
    145128                  ! associated salt flux 
    146129                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 
     
    150133      ENDIF 
    151134 
     135      ! conservation test 
     136      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     137 
    152138      ! ------------------------------------------------- 
    153139      ! Diagnostics 
     
    157143      END DO 
    158144 
    159       d_u_ice_dyn(:,:)     = u_ice(:,:)     - u_ice_b(:,:) 
    160       d_v_ice_dyn(:,:)     = v_ice(:,:)     - v_ice_b(:,:) 
    161       d_a_i_trp  (:,:,:)   = a_i  (:,:,:)   - a_i_b  (:,:,:) 
    162       d_v_s_trp  (:,:,:)   = v_s  (:,:,:)   - v_s_b  (:,:,:)   
    163       d_v_i_trp  (:,:,:)   = v_i  (:,:,:)   - v_i_b  (:,:,:)    
    164       d_e_s_trp  (:,:,:,:) = e_s  (:,:,:,:) - e_s_b  (:,:,:,:)   
    165       d_e_i_trp  (:,:,1:nlay_i,:) = e_i  (:,:,1:nlay_i,:) - e_i_b(:,:,1:nlay_i,:) 
    166       d_oa_i_trp (:,:,:)   = oa_i (:,:,:)   - oa_i_b (:,:,:) 
    167       d_smv_i_trp(:,:,:)   = 0._wp 
    168       IF(  num_sal == 2  ) d_smv_i_trp(:,:,:) = smv_i(:,:,:) - smv_i_b(:,:,:) 
    169  
    170       ! conservation test 
    171       IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    172  
     145      ! heat content variation (W.m-2) 
     146      DO jj = 1, jpj 
     147         DO ji = 1, jpi             
     148            diag_heat_dhc(ji,jj) = ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) +  &  
     149               &                     SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )    & 
     150               &                   ) * unit_fac * r1_rdtice / area(ji,jj)    
     151         END DO 
     152      END DO 
     153 
     154      ! ------------------------------------------------- 
     155      ! control prints 
     156      ! ------------------------------------------------- 
    173157      IF(ln_ctl) THEN   ! Control print 
    174158         CALL prt_ctl_info(' ') 
     
    181165         CALL prt_ctl(tab2d_1=strength   , clinfo1=' lim_update1  : strength    :') 
    182166         CALL prt_ctl(tab2d_1=u_ice      , clinfo1=' lim_update1  : u_ice       :', tab2d_2=v_ice      , clinfo2=' v_ice       :') 
    183          CALL prt_ctl(tab2d_1=d_u_ice_dyn, clinfo1=' lim_update1  : d_u_ice_dyn :', tab2d_2=d_v_ice_dyn, clinfo2=' d_v_ice_dyn :') 
    184167         CALL prt_ctl(tab2d_1=u_ice_b    , clinfo1=' lim_update1  : u_ice_b     :', tab2d_2=v_ice_b    , clinfo2=' v_ice_b     :') 
    185168 
     
    196179            CALL prt_ctl(tab2d_1=a_i        (:,:,jl)        , clinfo1= ' lim_update1  : a_i         : ') 
    197180            CALL prt_ctl(tab2d_1=a_i_b      (:,:,jl)        , clinfo1= ' lim_update1  : a_i_b       : ') 
    198             CALL prt_ctl(tab2d_1=d_a_i_trp  (:,:,jl)        , clinfo1= ' lim_update1  : d_a_i_trp   : ') 
    199181            CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' lim_update1  : v_i         : ') 
    200182            CALL prt_ctl(tab2d_1=v_i_b      (:,:,jl)        , clinfo1= ' lim_update1  : v_i_b       : ') 
    201             CALL prt_ctl(tab2d_1=d_v_i_trp  (:,:,jl)        , clinfo1= ' lim_update1  : d_v_i_trp   : ') 
    202183            CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' lim_update1  : v_s         : ') 
    203184            CALL prt_ctl(tab2d_1=v_s_b      (:,:,jl)        , clinfo1= ' lim_update1  : v_s_b       : ') 
    204             CALL prt_ctl(tab2d_1=d_v_s_trp  (:,:,jl)        , clinfo1= ' lim_update1  : d_v_s_trp   : ') 
    205185            CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : e_i1        : ') 
    206186            CALL prt_ctl(tab2d_1=e_i_b      (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : e_i1_b      : ') 
    207             CALL prt_ctl(tab2d_1=d_e_i_trp  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : de_i1_trp   : ') 
    208187            CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : e_i2        : ') 
    209188            CALL prt_ctl(tab2d_1=e_i_b      (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : e_i2_b      : ') 
    210             CALL prt_ctl(tab2d_1=d_e_i_trp  (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : de_i2_trp   : ') 
    211189            CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' lim_update1  : e_snow      : ') 
    212190            CALL prt_ctl(tab2d_1=e_s_b      (:,:,1,jl)      , clinfo1= ' lim_update1  : e_snow_b    : ') 
    213             CALL prt_ctl(tab2d_1=d_e_s_trp  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : d_e_s_trp   : ') 
    214191            CALL prt_ctl(tab2d_1=smv_i      (:,:,jl)        , clinfo1= ' lim_update1  : smv_i       : ') 
    215192            CALL prt_ctl(tab2d_1=smv_i_b    (:,:,jl)        , clinfo1= ' lim_update1  : smv_i_b     : ') 
    216             CALL prt_ctl(tab2d_1=d_smv_i_trp(:,:,jl)        , clinfo1= ' lim_update1  : d_smv_i_trp : ') 
    217193            CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' lim_update1  : oa_i        : ') 
    218194            CALL prt_ctl(tab2d_1=oa_i_b     (:,:,jl)        , clinfo1= ' lim_update1  : oa_i_b      : ') 
    219             CALL prt_ctl(tab2d_1=d_oa_i_trp (:,:,jl)        , clinfo1= ' lim_update1  : d_oa_i_trp  : ') 
    220195 
    221196            DO jk = 1, nlay_i 
  • branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90

    r5055 r5059  
    55   !!====================================================================== 
    66   !! History :  3.0  !  2006-04  (M. Vancoppenolle) Original code 
    7    !!            3.6  !  2014-06  (C. Rousset)       Complete rewriting/cleaning 
     7   !!            3.5  !  2014-06  (C. Rousset)       Complete rewriting/cleaning 
    88   !!---------------------------------------------------------------------- 
    99#if defined key_lim3 
     
    1313   !!    lim_update2   : computes update of sea-ice global variables from trend terms 
    1414   !!---------------------------------------------------------------------- 
    15    USE limrhg          ! ice rheology 
    16  
    17    USE dom_oce 
    18    USE oce             ! dynamics and tracers variables 
    19    USE in_out_manager 
    2015   USE sbc_oce         ! Surface boundary condition: ocean fields 
    2116   USE sbc_ice         ! Surface boundary condition: ice fields 
     
    2318   USE phycst          ! physical constants 
    2419   USE ice 
    25    USE limdyn 
    26    USE limtrp 
    27    USE limthd 
    28    USE limsbc 
    29    USE limdiahsb 
    30    USE limwri 
    31    USE limrst 
    3220   USE thd_ice         ! LIM thermodynamic sea-ice variables 
    3321   USE limitd_th 
    34    USE limitd_me 
    3522   USE limvar 
    36    USE prtctl           ! Print control 
    37    USE lbclnk           ! lateral boundary condition - MPP exchanges 
    38    USE wrk_nemo         ! work arrays 
    39    USE lib_fortran     ! glob_sum 
     23   USE prtctl          ! Print control 
     24   USE lbclnk          ! lateral boundary condition - MPP exchanges 
     25   USE wrk_nemo        ! work arrays 
    4026   USE timing          ! Timing 
    41    USE limcons        ! conservation tests 
     27   USE limcons         ! conservation tests 
    4228   USE limctl 
     29   USE lib_mpp         ! MPP library 
     30   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     31   USE in_out_manager 
    4332 
    4433   IMPLICIT NONE 
     
    6453      !! 
    6554      !!--------------------------------------------------------------------- 
    66       INTEGER, INTENT(in) :: kt    ! number of iteration 
    67       INTEGER  ::   ji, jj, jk, jl    ! dummy loop indices 
    68       INTEGER  ::   i_ice_switch 
     55      INTEGER, INTENT(in) ::   kt    ! number of iteration 
     56      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    6957      REAL(wp) ::   zh, zsal 
    70       ! 
    71       REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
     58      REAL(wp) ::   zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    7259      !!------------------------------------------------------------------- 
    7360      IF( nn_timing == 1 )  CALL timing_start('limupdate2') 
     
    142129 
    143130      !--------------------- 
    144       ! 2.11) Ice salinity 
     131      ! Ice salinity 
    145132      !--------------------- 
    146133      IF (  num_sal == 2  ) THEN  
     
    151138                  smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl) 
    152139                  ! salinity stays in bounds 
    153                   i_ice_switch    = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 
    154                   smv_i(ji,jj,jl) = i_ice_switch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) !+ s_i_min * ( 1._wp - i_ice_switch ) * v_i(ji,jj,jl) 
     140                  rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 
     141                  smv_i(ji,jj,jl) = rswitch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) !+ s_i_min * ( 1._wp - rswitch ) * v_i(ji,jj,jl) 
    155142                  ! associated salt flux 
    156143                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 
     
    161148 
    162149      !------------------------------------------------------------------------------ 
    163       ! 2) Corrections to avoid wrong values                                        | 
     150      ! Corrections to avoid wrong values                                        | 
    164151      !------------------------------------------------------------------------------ 
    165152      ! Ice drift 
     
    186173      CALL lim_var_agg(2)             ! aggregate ice thickness categories 
    187174 
     175      ! conservation test 
     176      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     177 
    188178      ! ------------------------------------------------- 
    189179      ! Diagnostics 
     
    193183      END DO 
    194184      afx_tot = afx_thd + afx_dyn 
    195  
    196       d_a_i_thd(:,:,:)   = a_i(:,:,:)   - a_i_b(:,:,:)  
    197       d_v_s_thd(:,:,:)   = v_s(:,:,:)   - v_s_b(:,:,:) 
    198       d_v_i_thd(:,:,:)   = v_i(:,:,:)   - v_i_b(:,:,:)   
    199       d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - e_s_b(:,:,:,:)  
    200       d_e_i_thd(:,:,1:nlay_i,:) = e_i(:,:,1:nlay_i,:) - e_i_b(:,:,1:nlay_i,:) 
    201       !?? d_oa_i_thd(:,:,:)  = oa_i (:,:,:) - oa_i_b (:,:,:) 
    202       d_smv_i_thd(:,:,:) = 0._wp 
    203       IF( num_sal == 2 )   d_smv_i_thd(:,:,:) = smv_i(:,:,:) - smv_i_b(:,:,:) 
    204185 
    205186      ! heat content variation (W.m-2) 
    206187      DO jj = 1, jpj 
    207188         DO ji = 1, jpi             
    208             diag_heat_dhc(ji,jj) = ( SUM( d_e_i_trp(ji,jj,1:nlay_i,:) + d_e_i_thd(ji,jj,1:nlay_i,:) ) +  &  
    209                &                     SUM( d_e_s_trp(ji,jj,1:nlay_s,:) + d_e_s_thd(ji,jj,1:nlay_s,:) )    & 
     189            diag_heat_dhc(ji,jj) = diag_heat_dhc(ji,jj)+   & 
     190               &                   ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) +  &  
     191               &                     SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )    & 
    210192               &                   ) * unit_fac * r1_rdtice / area(ji,jj)    
    211193         END DO 
    212194      END DO 
    213195 
    214       ! conservation test 
    215       IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    216  
     196      ! ------------------------------------------------- 
     197      ! control prints 
     198      ! ------------------------------------------------- 
    217199      IF( ln_nicep )   CALL lim_prt( kt, jiindx, jjindx, 2, ' - Final state - ' )   ! control print 
    218200 
     
    241223            CALL prt_ctl(tab2d_1=a_i        (:,:,jl)        , clinfo1= ' lim_update2  : a_i         : ') 
    242224            CALL prt_ctl(tab2d_1=a_i_b      (:,:,jl)        , clinfo1= ' lim_update2  : a_i_b       : ') 
    243             CALL prt_ctl(tab2d_1=d_a_i_thd  (:,:,jl)        , clinfo1= ' lim_update2  : d_a_i_thd   : ') 
    244225            CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' lim_update2  : v_i         : ') 
    245226            CALL prt_ctl(tab2d_1=v_i_b      (:,:,jl)        , clinfo1= ' lim_update2  : v_i_b       : ') 
    246             CALL prt_ctl(tab2d_1=d_v_i_thd  (:,:,jl)        , clinfo1= ' lim_update2  : d_v_i_thd   : ') 
    247227            CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' lim_update2  : v_s         : ') 
    248228            CALL prt_ctl(tab2d_1=v_s_b      (:,:,jl)        , clinfo1= ' lim_update2  : v_s_b       : ') 
    249             CALL prt_ctl(tab2d_1=d_v_s_thd  (:,:,jl)        , clinfo1= ' lim_update2  : d_v_s_thd   : ') 
    250229            CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : e_i1        : ') 
    251230            CALL prt_ctl(tab2d_1=e_i_b      (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : e_i1_b      : ') 
    252             CALL prt_ctl(tab2d_1=d_e_i_thd  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : de_i1_thd   : ') 
    253231            CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : e_i2        : ') 
    254232            CALL prt_ctl(tab2d_1=e_i_b      (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : e_i2_b      : ') 
    255             CALL prt_ctl(tab2d_1=d_e_i_thd  (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : de_i2_thd   : ') 
    256233            CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' lim_update2  : e_snow      : ') 
    257234            CALL prt_ctl(tab2d_1=e_s_b      (:,:,1,jl)      , clinfo1= ' lim_update2  : e_snow_b    : ') 
    258             CALL prt_ctl(tab2d_1=d_e_s_thd  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : d_e_s_thd   : ') 
    259235            CALL prt_ctl(tab2d_1=smv_i      (:,:,jl)        , clinfo1= ' lim_update2  : smv_i       : ') 
    260236            CALL prt_ctl(tab2d_1=smv_i_b    (:,:,jl)        , clinfo1= ' lim_update2  : smv_i_b     : ') 
    261             CALL prt_ctl(tab2d_1=d_smv_i_thd(:,:,jl)        , clinfo1= ' lim_update2  : d_smv_i_thd : ') 
    262237            CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' lim_update2  : oa_i        : ') 
    263238            CALL prt_ctl(tab2d_1=oa_i_b     (:,:,jl)        , clinfo1= ' lim_update2  : oa_i_b      : ') 
    264             CALL prt_ctl(tab2d_1=d_oa_i_thd (:,:,jl)        , clinfo1= ' lim_update2  : d_oa_i_thd  : ') 
    265239 
    266240            DO jk = 1, nlay_i 
  • branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r5058 r5059  
    183183         !------------------------------! 
    184184         numit = numit + nn_fsbc                     ! Ice model time step 
    185          ! 
    186          !                                           ! Store previous ice values 
    187          a_i_b  (:,:,:)   = a_i  (:,:,:)     ! ice area 
    188          e_i_b  (:,:,:,:) = e_i  (:,:,:,:)   ! ice thermal energy 
    189          v_i_b  (:,:,:)   = v_i  (:,:,:)     ! ice volume 
    190          v_s_b  (:,:,:)   = v_s  (:,:,:)     ! snow volume  
    191          e_s_b  (:,:,:,:) = e_s  (:,:,:,:)   ! snow thermal energy 
    192          smv_i_b(:,:,:)   = smv_i(:,:,:)     ! salt content 
    193          oa_i_b (:,:,:)   = oa_i (:,:,:)     ! areal age content 
    194          u_ice_b(:,:)     = u_ice(:,:) 
    195          v_ice_b(:,:)     = v_ice(:,:) 
    196  
    197                           CALL sbc_lim_diag0         ! set diag of mass, heat and salt fluxes to 0 
    198  
    199                           CALL lim_rst_opn( kt )     ! Open Ice restart file 
     185         !                                                    
     186         CALL sbc_lim_update                ! Store previous ice values 
     187 
     188         CALL sbc_lim_diag0                 ! set diag of mass, heat and salt fluxes to 0 
     189          
     190         CALL lim_rst_opn( kt )             ! Open Ice restart file 
    200191         ! 
    201192         ! ---------------------------------------------- 
     
    203194         ! ---------------------------------------------- 
    204195         IF( .NOT. lk_c1d ) THEN 
    205  
    206                           CALL lim_dyn( kt )              ! Ice dynamics    ( rheology/dynamics ) 
    207  
    208                           CALL lim_trp( kt )              ! Ice transport   ( Advection/diffusion ) 
    209  
    210          IF( nn_monocat /= 2 )   & 
    211             &             CALL lim_itd_me                 ! Mechanical redistribution ! (ridging/rafting) 
     196             
     197            CALL lim_dyn( kt )              ! Ice dynamics    ( rheology/dynamics ) 
     198             
     199            CALL lim_trp( kt )              ! Ice transport   ( Advection/diffusion ) 
     200             
     201            IF( nn_monocat /= 2 ) CALL lim_itd_me  ! Mechanical redistribution ! (ridging/rafting) 
    212202 
    213203#if defined key_bdy 
    214                           ! bdy ice thermo  
    215                           CALL lim_var_glo2eqv            ! equivalent variables 
    216                           CALL bdy_ice_lim( kt ) 
    217                           CALL lim_var_zapsmall 
    218                           CALL lim_var_agg(1) 
    219          IF( ln_nicep )   CALL lim_prt( kt, jiindx, jjindx, 1, ' - ice thermo bdy - ' )   ! control print 
     204            CALL lim_var_glo2eqv 
     205            CALL bdy_ice_lim( kt )         ! bdy ice thermo  
     206            CALL lim_var_zapsmall 
     207            CALL lim_var_agg(1) 
     208            IF( ln_nicep )   CALL lim_prt( kt, jiindx, jjindx, 1, ' - ice thermo bdy - ' ) 
    220209#endif 
    221  
    222                           CALL lim_update1( kt ) 
    223  
     210            CALL lim_update1( kt ) 
     211             
    224212         ENDIF 
    225  
    226          !- Change old values for new values 
    227          u_ice_b(:,:)     = u_ice(:,:) 
    228          v_ice_b(:,:)     = v_ice(:,:) 
    229          a_i_b  (:,:,:)   = a_i  (:,:,:) 
    230          v_s_b  (:,:,:)   = v_s  (:,:,:) 
    231          v_i_b  (:,:,:)   = v_i  (:,:,:) 
    232          e_s_b  (:,:,:,:) = e_s  (:,:,:,:) 
    233          e_i_b  (:,:,:,:) = e_i  (:,:,:,:) 
    234          oa_i_b (:,:,:)   = oa_i (:,:,:) 
    235          smv_i_b(:,:,:)   = smv_i(:,:,:) 
     213          
     214         CALL sbc_lim_update                ! Store previous ice values 
    236215  
    237216         ! ---------------------------------------------- 
    238217         ! ice thermodynamics 
    239218         ! ---------------------------------------------- 
    240                           CALL lim_var_glo2eqv            ! equivalent variables 
    241                           CALL lim_var_agg(1)             ! aggregate ice categories 
    242  
    243                           ! previous lead fraction and ice volume for flux calculations 
    244                           pfrld(:,:)   = 1._wp - at_i(:,:) 
    245                           phicif(:,:)  = vt_i(:,:) 
    246  
    247                           SELECT CASE( kblk ) 
    248                              CASE ( jp_cpl ) 
    249                              CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su    ) 
    250                              IF( nn_limflx == 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   & 
    251                           &                                           dqns_ice, qla_ice, dqla_ice, nn_limflx ) 
    252                              ! Latent heat flux is forced to 0 in coupled: it is included in qns (non-solar heat flux) 
    253                              qla_ice  (:,:,:) = 0._wp 
    254                              dqla_ice (:,:,:) = 0._wp 
    255                           END SELECT 
    256                           ! 
    257                           CALL lim_thd( kt )              ! Ice thermodynamics  
    258  
    259                           CALL lim_update2( kt )          ! Global variables update 
    260          ! 
    261                           CALL lim_sbc_flx( kt )          ! Update surface ocean mass, heat and salt fluxes 
    262          ! 
    263          IF(ln_limdiaout) CALL lim_diahsb                 ! Diagnostics and outputs  
    264  
    265                           CALL lim_wri( 1 )               ! Ice outputs  
    266  
     219         CALL lim_var_glo2eqv 
     220         CALL lim_var_agg(1) 
     221          
     222         ! previous lead fraction and ice volume for flux calculations 
     223         pfrld(:,:)   = 1._wp - at_i(:,:) 
     224         phicif(:,:)  = vt_i(:,:) 
     225          
     226         SELECT CASE( kblk ) 
     227         CASE ( jp_cpl ) 
     228            CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su    ) 
     229            IF( nn_limflx == 2 )   CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice ,   & 
     230               &                                           dqns_ice, qla_ice, dqla_ice, nn_limflx ) 
     231            ! Latent heat flux is forced to 0 in coupled: it is included in qns (non-solar heat flux) 
     232            qla_ice  (:,:,:) = 0._wp 
     233            dqla_ice (:,:,:) = 0._wp 
     234         END SELECT 
     235         ! 
     236         CALL lim_thd( kt )                         ! Ice thermodynamics  
     237          
     238         CALL lim_update2( kt )                     ! Global variables update 
     239         ! 
     240         CALL lim_sbc_flx( kt )                     ! Update surface ocean mass, heat and salt fluxes 
     241         ! 
     242         IF(ln_limdiaout) CALL lim_diahsb           ! Diagnostics and outputs  
     243          
     244         CALL lim_wri( 1 )                          ! Ice outputs  
     245          
    267246         IF( kt == nit000 .AND. ln_rstart )   & 
    268             &             CALL iom_close( numrir )        ! close input ice restart file 
    269          ! 
    270          IF( lrst_ice )   CALL lim_rst_write( kt )        ! Ice restart file  
    271                           CALL lim_var_glo2eqv            ! ??? 
    272          ! 
    273          IF( ln_nicep )   CALL lim_ctl( kt )              ! alerts in case of model crash 
     247            &             CALL iom_close( numrir )  ! close input ice restart file 
     248         ! 
     249         IF( lrst_ice )   CALL lim_rst_write( kt )  ! Ice restart file  
     250         CALL lim_var_glo2eqv                       ! ??? 
     251         ! 
     252         IF( ln_nicep )   CALL lim_ctl( kt )        ! alerts in case of model crash 
    274253         ! 
    275254         CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 
    276255         ! 
    277       ENDIF                                    ! End sea-ice time step only 
    278  
    279       !                                        !--------------------------! 
    280       !                                        !  at all ocean time step  ! 
    281       !                                        !--------------------------! 
    282       !                                                
    283       !                                              ! Update surface ocean stresses (only in ice-dynamic case) 
    284       !                                                   ! otherwise the atm.-ocean stresses are used everywhere 
     256      ENDIF   ! End sea-ice time step only 
     257 
     258      !--------------------------------! 
     259      ! --- at all ocean time step --- ! 
     260      !--------------------------------! 
     261      ! Update surface ocean stresses (only in ice-dynamic case) 
     262      !    otherwise the atm.-ocean stresses are used everywhere 
    285263      IF( ln_limdyn )     CALL lim_sbc_tau( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents 
    286264!!gm   remark, the ocean-ice stress is not saved in ice diag call above .....  find a solution!!! 
     
    504482         &                          pdqn_ice, pqla_ice, pdql_ice, k_limflx ) 
    505483      !!--------------------------------------------------------------------- 
    506       !!                  ***  ROUTINE sbc_ice_lim  *** 
     484      !!                  ***  ROUTINE ice_lim_flx  *** 
    507485      !!                    
    508486      !! ** Purpose :   update the ice surface boundary condition by averaging and / or 
     
    580558   END SUBROUTINE ice_lim_flx 
    581559 
     560   SUBROUTINE sbc_lim_update 
     561      !!---------------------------------------------------------------------- 
     562      !!                  ***  ROUTINE sbc_lim_update  *** 
     563      !! 
     564      !! ** purpose :  store ice variables at "before" time step  
     565      !!---------------------------------------------------------------------- 
     566      a_i_b  (:,:,:)   = a_i  (:,:,:)     ! ice area 
     567      e_i_b  (:,:,:,:) = e_i  (:,:,:,:)   ! ice thermal energy 
     568      v_i_b  (:,:,:)   = v_i  (:,:,:)     ! ice volume 
     569      v_s_b  (:,:,:)   = v_s  (:,:,:)     ! snow volume  
     570      e_s_b  (:,:,:,:) = e_s  (:,:,:,:)   ! snow thermal energy 
     571      smv_i_b(:,:,:)   = smv_i(:,:,:)     ! salt content 
     572      oa_i_b (:,:,:)   = oa_i (:,:,:)     ! areal age content 
     573      u_ice_b(:,:)     = u_ice(:,:) 
     574      v_ice_b(:,:)     = v_ice(:,:) 
     575       
     576   END SUBROUTINE sbc_lim_update 
     577 
    582578   SUBROUTINE sbc_lim_diag0 
    583579      !!---------------------------------------------------------------------- 
    584       !!                  ***  ROUTINE sbc_lim_flx0  *** 
     580      !!                  ***  ROUTINE sbc_lim_diag0  *** 
    585581      !! 
    586582      !! ** purpose :  set ice-ocean and ice-atm. fluxes to zeros at the beggining 
     
    612608      afx_tot(:,:) = 0._wp   ; 
    613609      afx_dyn(:,:) = 0._wp   ;   afx_thd(:,:) = 0._wp 
     610 
     611      diag_heat_dhc(:,:) = 0._wp ; 
    614612       
    615613   END SUBROUTINE sbc_lim_diag0 
Note: See TracChangeset for help on using the changeset viewer.