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 8486 for branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/icectl.F90 – NEMO

Ignore:
Timestamp:
2017-09-01T15:49:35+02:00 (7 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/icectl.F90

    r8426 r8486  
    99#if defined key_lim3 
    1010   !!---------------------------------------------------------------------- 
    11    !!   'key_lim3'                                      LIM3 sea-ice model 
     11   !!   'key_lim3'                                       LIM3 sea-ice model 
    1212   !!---------------------------------------------------------------------- 
    1313   !!    ice_ctl   : control prints in case of crash 
     
    1515   !!    ice_prt3D : control prints of ice arrays 
    1616   !!---------------------------------------------------------------------- 
    17    USE oce             ! ocean dynamics and tracers 
    18    USE dom_oce         ! ocean space and time domain 
    19    USE ice             ! LIM-3: ice variables 
    20    USE ice1D           ! LIM-3: thermodynamical variables 
    21    USE sbc_oce         ! Surface boundary condition: ocean fields 
    22    USE sbc_ice         ! Surface boundary condition: ice   fields 
    23    USE phycst          ! Define parameters for the routines 
     17   USE oce            ! ocean dynamics and tracers 
     18   USE dom_oce        ! ocean space and time domain 
     19   USE ice            ! LIM-3: ice variables 
     20   USE ice1D          ! LIM-3: thermodynamical variables 
     21   USE sbc_oce        ! Surface boundary condition: ocean fields 
     22   USE sbc_ice        ! Surface boundary condition: ice   fields 
     23   USE phycst         ! Define parameters for the routines 
    2424   ! 
    25    USE lib_mpp         ! MPP library 
    26    USE timing          ! Timing 
    27    USE in_out_manager  ! I/O manager 
    28    USE prtctl          ! Print control 
    29    USE lib_fortran     !  
     25   USE lib_mpp        ! MPP library 
     26   USE timing         ! Timing 
     27   USE in_out_manager ! I/O manager 
     28   USE prtctl         ! Print control 
     29   USE lib_fortran    !  
    3030 
    3131   IMPLICIT NONE 
     
    4141#  include "vectopt_loop_substitute.h90" 
    4242   !!---------------------------------------------------------------------- 
    43    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     43   !! NEMO/ICE 4.0 , NEMO Consortium (2017) 
    4444   !! $Id: icectl.F90 5043 2015-01-28 16:44:18Z clem $ 
    4545   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4646   !!---------------------------------------------------------------------- 
    47  
    4847CONTAINS 
    4948 
    5049   SUBROUTINE ice_cons_hsm( icount, cd_routine, zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b ) 
    51       !!-------------------------------------------------------------------------------------------------------- 
    52       !!                                        ***  ROUTINE ice_cons_hsm *** 
     50      !!---------------------------------------------------------------------- 
     51      !!                       ***  ROUTINE ice_cons_hsm *** 
    5352      !! 
    5453      !! ** Purpose : Test the conservation of heat, salt and mass for each ice routine 
     
    6160      !!              For salt and heat thresholds, ice is considered to have a salinity of 10  
    6261      !!              and a heat content of 3e5 J/kg (=latent heat of fusion)  
    63       !!-------------------------------------------------------------------------------------------------------- 
    64       INTEGER         , INTENT(in)    :: icount        ! determine wether this is the beggining of the routine (0) or the end (1) 
    65       CHARACTER(len=*), INTENT(in)    :: cd_routine    ! name of the routine 
    66       REAL(wp)        , INTENT(inout) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
     62      !!---------------------------------------------------------------------- 
     63      INTEGER         , INTENT(in)    ::   icount        ! called at: =0 the begining of the routine, =1  the end 
     64      CHARACTER(len=*), INTENT(in)    ::   cd_routine    ! name of the routine 
     65      REAL(wp)        , INTENT(inout) ::   zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b   ! ???? 
     66      !! 
    6767      REAL(wp)                        :: zvi,   zsmv,   zei,   zfs,   zfw,   zft 
    6868      REAL(wp)                        :: zvmin, zamin, zamax  
     
    7070      REAL(wp)                        :: zarea, zv_sill, zs_sill, zh_sill 
    7171      REAL(wp), PARAMETER             :: zconv = 1.e-9 ! convert W to GW and kg to Mt 
    72  
     72      !!---------------------------------------------------------------------- 
     73 
     74!!gm  Note that glo_sum for a 2D or 3D array use a multiplication by tmask_i(ji,jj) 
     75!!    so below  the  * tmask(:,:,1) is useless   ===>> I have removed them 
     76!!    I also move the conversion factor from then glo_sum argument (become a single multiplication 
     77  
    7378      IF( icount == 0 ) THEN 
    74  
    75          ! salt flux 
     79         !                          ! salt flux 
    7680         zfs_b  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  & 
    7781            &                  sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) + sfx_lam(:,:)    & 
    78             &                ) *  e1e2t(:,:) * tmask(:,:,1) * zconv ) 
    79  
    80          ! water flux 
     82            &                ) *  e1e2t(:,:) ) * zconv  
     83         ! 
     84         !                          ! water flux 
    8185         zfw_b  = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:)     + wfx_sum(:,:)     + wfx_sni(:,:)     +                     & 
    8286            &                  wfx_opw(:,:) + wfx_res(:,:)     + wfx_dyn(:,:)     + wfx_lam(:,:)     + wfx_ice_sub(:,:) +  & 
    83             &                  wfx_snw_sni(:,:) + wfx_snw_sum(:,:) + wfx_snw_dyn(:,:) + wfx_snw_sub(:,:) + wfx_spr(:,:)        & 
    84             &                ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) 
    85  
    86          ! heat flux 
     87            &                  wfx_snw_sni(:,:) + wfx_snw_sum(:,:) + wfx_snw_dyn(:,:) + wfx_snw_sub(:,:) + wfx_spr(:,:)    & 
     88            &                ) * e1e2t(:,:) ) * zconv 
     89         ! 
     90         !                          ! heat flux 
    8791         zft_b  = glob_sum(  ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  &  
    8892            &                - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   & 
    89             &                ) *  e1e2t(:,:) * tmask(:,:,1) * zconv ) 
    90  
    91          zvi_b  = glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) * e1e2t * tmask(:,:,1) * zconv ) 
    92  
    93          zsmv_b = glob_sum( SUM( smv_i * rhoic            , dim=3 ) * e1e2t * tmask(:,:,1) * zconv ) 
    94  
    95          zei_b  = glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) +  & 
    96             &                 SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )    & 
    97                             ) * e1e2t * tmask(:,:,1) * zconv ) 
     93            &                ) *  e1e2t(:,:) ) * zconv 
     94 
     95         zvi_b  = glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) * e1e2t * zconv ) 
     96 
     97         zsmv_b = glob_sum( SUM( smv_i * rhoic            , dim=3 ) * e1e2t * zconv ) 
     98 
     99         zei_b  = glob_sum( (  SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 )     & 
     100            &                + SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )   ) * e1e2t ) * zconv 
    98101 
    99102      ELSEIF( icount == 1 ) THEN 
     
    102105         zfs  = glob_sum(  ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  & 
    103106            &                sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) + sfx_lam(:,:)    &  
    104             &              ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zfs_b 
     107            &              ) * e1e2t(:,:) ) * zconv - zfs_b 
    105108 
    106109         ! water flux 
     
    108111            &                wfx_opw(:,:) + wfx_res(:,:)     + wfx_dyn(:,:)     + wfx_lam(:,:)     + wfx_ice_sub(:,:) +  & 
    109112            &                wfx_snw_sni(:,:) + wfx_snw_sum(:,:) + wfx_snw_dyn(:,:) + wfx_snw_sub(:,:) + wfx_spr(:,:)        & 
    110             &              ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zfw_b 
     113            &              ) * e1e2t(:,:) ) * zconv - zfw_b 
    111114 
    112115         ! heat flux 
    113116         zft  = glob_sum(  ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  &  
    114117            &              - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   & 
    115             &              ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zft_b 
     118            &              ) * e1e2t(:,:) ) * zconv - zft_b 
    116119  
    117120         ! outputs 
    118          zvi  = ( ( glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) & 
    119             &                    * e1e2t * tmask(:,:,1) * zconv ) - zvi_b ) * r1_rdtice - zfw ) * rday 
    120  
    121          zsmv = ( ( glob_sum( SUM( smv_i * rhoic            , dim=3 ) & 
    122             &                    * e1e2t * tmask(:,:,1) * zconv ) - zsmv_b ) * r1_rdtice + zfs ) * rday 
    123  
    124          zei  = ( glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) +  & 
    125             &                 SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )    & 
    126             &                ) * e1e2t * tmask(:,:,1) * zconv ) - zei_b ) * r1_rdtice + zft 
     121         zvi  = ( ( glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) * e1e2t  ) * zconv & 
     122            &       - zvi_b ) * r1_rdtice - zfw ) * rday 
     123 
     124         zsmv = ( ( glob_sum( SUM( smv_i * rhoic            , dim=3 ) * e1e2t ) * zconv & 
     125            &       - zsmv_b ) * r1_rdtice + zfs ) * rday 
     126 
     127         zei  = ( glob_sum( (  SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 )   & 
     128            &                + SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) ) * e1e2t ) * zconv   & 
     129            &   - zei_b ) * r1_rdtice + zft 
    127130 
    128131         ! zvtrp and zetrp must be close to 0 if the advection scheme is conservative 
    129          zvtrp = glob_sum( ( diag_trp_vi * rhoic + diag_trp_vs * rhosn ) * e1e2t * tmask(:,:,1) * zconv ) * rday  
    130          zetrp = glob_sum( ( diag_trp_ei         + diag_trp_es         ) * e1e2t * tmask(:,:,1) * zconv ) 
     132         zvtrp = glob_sum( ( diag_trp_vi * rhoic + diag_trp_vs * rhosn ) * e1e2t  ) * zconv * rday  
     133         zetrp = glob_sum( ( diag_trp_ei         + diag_trp_es         ) * e1e2t  ) * zconv 
    131134 
    132135         zvmin = glob_min( v_i ) 
     
    135138 
    136139         ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice)  
    137          zarea   = glob_sum( SUM( a_i + epsi10, dim=3 ) * e1e2t * zconv ) ! in 1.e9 m2 
     140         zarea   = glob_sum( SUM( a_i + epsi10, dim=3 ) * e1e2t ) * zconv ! in 1.e9 m2 
    138141         zv_sill = zarea * 2.5e-5 
    139142         zs_sill = zarea * 25.e-5 
     
    156159            IF (      zamin  < -epsi10 ) WRITE(numout,*) 'violation a_i<0               (',cd_routine,') = ',zamin 
    157160         ENDIF 
    158  
     161         ! 
    159162      ENDIF 
    160163 
     
    163166 
    164167   SUBROUTINE ice_cons_final( cd_routine ) 
    165       !!--------------------------------------------------------------------------------------------------------- 
    166       !!                                   ***  ROUTINE ice_cons_final *** 
     168      !!---------------------------------------------------------------------- 
     169      !!                     ***  ROUTINE ice_cons_final *** 
    167170      !! 
    168171      !! ** Purpose : Test the conservation of heat, salt and mass at the end of each ice time-step 
     
    174177      !!              For salt and heat thresholds, ice is considered to have a salinity of 10  
    175178      !!              and a heat content of 3e5 J/kg (=latent heat of fusion)  
    176       !!-------------------------------------------------------------------------------------------------------- 
     179      !!---------------------------------------------------------------------- 
    177180      CHARACTER(len=*), INTENT(in)    :: cd_routine    ! name of the routine 
    178181      REAL(wp)                        :: zhfx, zsfx, zvfx 
    179182      REAL(wp)                        :: zarea, zv_sill, zs_sill, zh_sill 
    180183      REAL(wp), PARAMETER             :: zconv = 1.e-9 ! convert W to GW and kg to Mt 
     184      !!---------------------------------------------------------------------- 
    181185 
    182186      ! heat flux 
    183187      zhfx  = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es   & 
    184188      !  &              - SUM( qevap_ice * a_i_b, dim=3 )                           & !!clem: I think this line must be commented (but need check) 
    185          &              ) * e1e2t * tmask(:,:,1) * zconv )  
     189         &              ) * e1e2t ) * zconv 
    186190      ! salt flux 
    187       zsfx  = glob_sum( ( sfx + diag_smvi ) * e1e2t * tmask(:,:,1) * zconv ) * rday 
     191      zsfx  = glob_sum( ( sfx + diag_smvi ) * e1e2t ) * zconv * rday 
    188192      ! water flux 
    189       zvfx  = glob_sum( ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e1e2t * tmask(:,:,1) * zconv ) * rday 
     193      zvfx  = glob_sum( ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e1e2t ) * zconv * rday 
    190194 
    191195      ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice)  
    192       zarea   = glob_sum( SUM( a_i + epsi10, dim=3 ) * e1e2t * zconv ) ! in 1.e9 m2 
     196      zarea   = glob_sum( SUM( a_i + epsi10, dim=3 ) * e1e2t ) * zconv ! in 1.e9 m2 
    193197      zv_sill = zarea * 2.5e-5 
    194198      zs_sill = zarea * 25.e-5 
    195199      zh_sill = zarea * 10.e-5 
    196200 
    197       IF( ABS( zvfx ) > zv_sill ) WRITE(numout,*) 'violation vfx    [Mt/day]       (',cd_routine,')  = ',(zvfx) 
    198       IF( ABS( zsfx ) > zs_sill ) WRITE(numout,*) 'violation sfx    [psu*Mt/day]   (',cd_routine,')  = ',(zsfx) 
    199       IF( ABS( zhfx ) > zh_sill ) WRITE(numout,*) 'violation hfx    [GW]           (',cd_routine,')  = ',(zhfx) 
    200  
     201      IF(lwp) THEN 
     202         IF( ABS( zvfx ) > zv_sill )   WRITE(numout,*) 'violation vfx    [Mt/day]       (',cd_routine,')  = ',(zvfx) 
     203         IF( ABS( zsfx ) > zs_sill )   WRITE(numout,*) 'violation sfx    [psu*Mt/day]   (',cd_routine,')  = ',(zsfx) 
     204         IF( ABS( zhfx ) > zh_sill )   WRITE(numout,*) 'violation hfx    [GW]           (',cd_routine,')  = ',(zhfx) 
     205      ENDIF 
     206      ! 
    201207   END SUBROUTINE ice_cons_final 
    202208 
     
    671677   !!   Default option         Empty Module               No LIM3 sea-ice model 
    672678   !!-------------------------------------------------------------------------- 
    673 CONTAINS 
    674    SUBROUTINE ice_ctl     ! Empty routine 
    675    END SUBROUTINE ice_ctl 
    676    SUBROUTINE ice_prt     ! Empty routine 
    677    END SUBROUTINE ice_prt 
    678    SUBROUTINE ice_prt3D   ! Empty routine 
    679    END SUBROUTINE ice_prt3D 
    680679#endif 
     680 
    681681   !!====================================================================== 
    682682END MODULE icectl 
Note: See TracChangeset for help on using the changeset viewer.