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 12065 for NEMO/branches/2019/dev_r10742_ENHANCE-12_SimonM-Tides/src/ICE/icecor.F90 – NEMO

Ignore:
Timestamp:
2019-12-05T12:06:36+01:00 (4 years ago)
Author:
smueller
Message:

Synchronizing with /NEMO/trunk@12055 (ticket #2194)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r10742_ENHANCE-12_SimonM-Tides/src/ICE/icecor.F90

    r10425 r12065  
    1717   USE phycst         ! physical constants 
    1818   USE ice            ! sea-ice: variable 
    19    USE ice1D          ! sea-ice: thermodynamic sea-ice variables 
     19   USE ice1D          ! sea-ice: thermodynamic variables 
    2020   USE iceitd         ! sea-ice: rebining 
    2121   USE icevar         ! sea-ice: operations 
     
    6060      IF( ln_timing    )   CALL timing_start('icecor')                                                             ! timing 
    6161      IF( ln_icediachk )   CALL ice_cons_hsm(0, 'icecor', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 
     62      IF( ln_icediachk )   CALL ice_cons2D  (0, 'icecor',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) ! conservation 
    6263      ! 
    6364      IF( kt == nit000 .AND. lwp .AND. kn == 2 ) THEN 
     
    6667         WRITE(numout,*) '~~~~~~~' 
    6768      ENDIF 
    68       ! 
    6969      !                             !----------------------------------------------------- 
    70       !                             !  ice thickness must exceed himin (for ice diff)    ! 
     70      !                             !  ice thickness must exceed himin (for temp. diff.) ! 
    7171      !                             !----------------------------------------------------- 
    7272      WHERE( a_i(:,:,:) >= epsi20 )   ;   h_i(:,:,:) = v_i(:,:,:) / a_i(:,:,:) 
     
    7979      !                             !----------------------------------------------------- 
    8080      at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 
    81       DO jl  = 1, jpl 
     81      DO jl = 1, jpl 
    8282         WHERE( at_i(:,:) > rn_amax_2d(:,:) )   a_i(:,:,jl) = a_i(:,:,jl) * rn_amax_2d(:,:) / at_i(:,:) 
    8383      END DO 
     
    8585      !                             !----------------------------------------------------- 
    8686      IF ( nn_icesal == 2 ) THEN    !  salinity must stay in bounds [Simin,Simax]        ! 
    87       !                             !----------------------------------------------------- 
     87         !                          !----------------------------------------------------- 
    8888         zzc = rhoi * r1_rdtice 
    8989         DO jl = 1, jpl 
     
    9797         END DO 
    9898      ENDIF 
    99  
    10099      !                             !----------------------------------------------------- 
    101100      !                             !  Rebin categories with thickness out of bounds     ! 
     
    119118            END DO 
    120119         END DO 
    121          CALL lbc_lnk_multi( 'icecor', u_ice, 'U', -1., v_ice, 'V', -1. )            ! lateral boundary conditions 
     120         CALL lbc_lnk_multi( 'icecor', u_ice, 'U', -1., v_ice, 'V', -1. ) 
    122121      ENDIF 
    123122 
    124 !!gm I guess the trends are only out on demand  
    125 !!   So please, only do this is it exite an iom_use of on a these variables 
    126 !!   furthermore, only allocate the diag_ arrays in this case  
    127 !!   and do the iom_put here so that it is only a local allocation 
    128 !!gm  
    129123      !                             !----------------------------------------------------- 
    130124      SELECT CASE( kn )             !  Diagnostics                                       ! 
     
    132126      CASE( 1 )                        !--- dyn trend diagnostics 
    133127         ! 
    134 !!gm   here I think the number of ice cat is too small to use a SUM instruction... 
    135          DO jj = 1, jpj 
    136             DO ji = 1, jpi             
    137                !                 ! heat content variation (W.m-2) 
    138                diag_heat(ji,jj) = - (  SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) )    &  
    139                   &                  + SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )  ) * r1_rdtice 
    140                !                 ! salt, volume 
    141                diag_sice(ji,jj) = SUM( sv_i(ji,jj,:) - sv_i_b(ji,jj,:) ) * rhoi * r1_rdtice 
    142                diag_vice(ji,jj) = SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * rhoi * r1_rdtice 
    143                diag_vsnw(ji,jj) = SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * rhos * r1_rdtice 
    144             END DO 
    145          END DO 
     128         IF( ln_icediachk .OR. iom_use('hfxdhc') ) THEN 
     129            diag_heat(:,:) = - SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_rdtice &      ! W.m-2 
     130               &             - SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_rdtice 
     131            diag_sice(:,:) =   SUM(     sv_i(:,:,:)          - sv_i_b(:,:,:)                  , dim=3 ) * r1_rdtice * rhoi 
     132            diag_vice(:,:) =   SUM(     v_i (:,:,:)          - v_i_b (:,:,:)                  , dim=3 ) * r1_rdtice * rhoi 
     133            diag_vsnw(:,:) =   SUM(     v_s (:,:,:)          - v_s_b (:,:,:)                  , dim=3 ) * r1_rdtice * rhos 
     134         ENDIF 
    146135         !                       ! concentration tendency (dynamics) 
    147          zafx   (:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice  
    148          afx_tot(:,:) = zafx(:,:) 
    149          IF( iom_use('afxdyn') )   CALL iom_put( 'afxdyn' , zafx(:,:) ) 
     136         IF( iom_use('afxdyn') .OR. iom_use('afxthd') .OR. iom_use('afxtot') ) THEN  
     137            zafx(:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice  
     138            CALL iom_put( 'afxdyn' , zafx ) 
     139         ENDIF 
    150140         ! 
    151141      CASE( 2 )                        !--- thermo trend diagnostics & ice aging 
     
    153143         oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rdt_ice   ! ice natural aging incrementation 
    154144         ! 
    155 !!gm   here I think the number of ice cat is too small to use a SUM instruction... 
    156          DO jj = 1, jpj 
    157             DO ji = 1, jpi             
    158                !                 ! heat content variation (W.m-2) 
    159                diag_heat(ji,jj) = diag_heat(ji,jj) - (  SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) )    &  
    160                   &                                   + SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) )  ) * r1_rdtice 
    161                !                 ! salt, volume 
    162                diag_sice(ji,jj) = diag_sice(ji,jj) + SUM( sv_i(ji,jj,:) - sv_i_b(ji,jj,:) ) * rhoi * r1_rdtice 
    163                diag_vice(ji,jj) = diag_vice(ji,jj) + SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * rhoi * r1_rdtice 
    164                diag_vsnw(ji,jj) = diag_vsnw(ji,jj) + SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * rhos * r1_rdtice 
    165             END DO 
    166          END DO 
     145         IF( ln_icediachk .OR. iom_use('hfxdhc') ) THEN 
     146            diag_heat(:,:) = diag_heat(:,:) & 
     147               &             - SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_rdtice & 
     148               &             - SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_rdtice 
     149            diag_sice(:,:) = diag_sice(:,:) & 
     150               &             + SUM(     sv_i(:,:,:)          - sv_i_b(:,:,:)                  , dim=3 ) * r1_rdtice * rhoi 
     151            diag_vice(:,:) = diag_vice(:,:) & 
     152               &             + SUM(     v_i (:,:,:)          - v_i_b (:,:,:)                  , dim=3 ) * r1_rdtice * rhoi 
     153            diag_vsnw(:,:) = diag_vsnw(:,:) & 
     154               &             + SUM(     v_s (:,:,:)          - v_s_b (:,:,:)                  , dim=3 ) * r1_rdtice * rhos 
     155            CALL iom_put ( 'hfxdhc' , diag_heat )  
     156         ENDIF 
    167157         !                       ! concentration tendency (total + thermo) 
    168          zafx   (:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice 
    169          afx_tot(:,:) = afx_tot(:,:) + zafx(:,:) 
    170          IF( iom_use('afxthd') )   CALL iom_put( 'afxthd' , zafx(:,:) ) 
    171          IF( iom_use('afxtot') )   CALL iom_put( 'afxtot' , afx_tot(:,:) ) 
     158         IF( iom_use('afxdyn') .OR. iom_use('afxthd') .OR. iom_use('afxtot') ) THEN  
     159            zafx(:,:) = zafx(:,:) + SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice 
     160            CALL iom_put( 'afxthd' , SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice ) 
     161            CALL iom_put( 'afxtot' , zafx ) 
     162         ENDIF 
    172163         ! 
    173164      END SELECT 
    174165      ! 
    175166      ! controls 
    176       IF( ln_icediachk   )   CALL ice_cons_hsm(1, 'icecor', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 
    177       IF( ln_ctl         )   CALL ice_prt3D   ('icecor')                                                             ! prints 
    178       IF( ln_icectl .AND. kn == 2 )   CALL ice_prt( kt, iiceprt, jiceprt, 2, ' - Final state - ' )                   ! prints 
    179       IF( ln_timing      )   CALL timing_stop ('icecor')                                                             ! timing 
     167      IF( ln_ctl       )   CALL ice_prt3D   ('icecor')                                                             ! prints 
     168      IF( ln_icectl .AND. kn == 2 ) & 
     169         &                 CALL ice_prt     ( kt, iiceprt, jiceprt, 2, ' - Final state - ' )                       ! prints 
     170      IF( ln_icediachk )   CALL ice_cons_hsm(1, 'icecor', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 
     171      IF( ln_icediachk )   CALL ice_cons2D  (1, 'icecor',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) ! conservation 
     172      IF( ln_timing    )   CALL timing_stop ('icecor')                                                             ! timing 
    180173      ! 
    181174   END SUBROUTINE ice_cor 
Note: See TracChangeset for help on using the changeset viewer.