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 6140 for trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90 – NEMO

Ignore:
Timestamp:
2015-12-21T12:35:23+01:00 (8 years ago)
Author:
timgraham
Message:

Merge of branches/2015/dev_merge_2015 back into trunk. Merge excludes NEMOGCM/TOOLS/OBSTOOLS/ for now due to issues with the change of file type. Will sort these manually with further commits.

Branch merged as follows:
In the working copy of branch ran:
svn merge ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk@HEAD
Small conflicts due to bug fixes applied to trunk since the dev_merge_2015 was copied. Bug fixes were applied to the branch as well so these were easy to resolve.
Branch committed at this stage

In working copy run:
svn switch ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
to switch working copy

Run:
svn merge --reintegrate ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2015/dev_merge_2015
to merge the branch into the trunk and then commit - no conflicts at this stage.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r5836 r6140  
    2525   USE sbc_oce        ! Surface boundary condition: ocean fields 
    2626   USE sbc_ice        ! Surface boundary condition: ice fields 
    27    USE thd_ice        ! LIM thermodynamic sea-ice variables 
    28    USE dom_ice        ! LIM sea-ice domain 
     27   USE dom_ice        ! LIM: sea-ice domain 
     28   USE thd_ice        ! LIM: thermodynamic sea-ice variables 
    2929   USE limthd_dif     ! LIM: thermodynamics, vertical diffusion 
    3030   USE limthd_dh      ! LIM: thermodynamics, ice and snow thickness variation 
    3131   USE limthd_sal     ! LIM: thermodynamics, ice salinity 
    3232   USE limthd_ent     ! LIM: thermodynamics, ice enthalpy redistribution 
    33    USE limthd_lac     ! LIM-3 lateral accretion 
    34    USE limitd_th      ! remapping thickness distribution 
     33   USE limthd_lac     ! LIM: lateral accretion 
     34   USE limitd_th      ! LIM: remapping thickness distribution 
    3535   USE limtab         ! LIM: 1D <==> 2D transformation 
    3636   USE limvar         ! LIM: sea-ice variables 
     37   USE limcons        ! LIM: conservation tests 
     38   USE limctl         ! LIM: control print 
     39   ! 
     40   USE in_out_manager ! I/O manager 
     41   USE prtctl         ! Print control 
    3742   USE lbclnk         ! lateral boundary condition - MPP links 
    3843   USE lib_mpp        ! MPP library 
    3944   USE wrk_nemo       ! work arrays 
    40    USE in_out_manager ! I/O manager 
    41    USE prtctl         ! Print control 
    4245   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    4346   USE timing         ! Timing 
    44    USE limcons        ! conservation tests 
    45    USE limctl 
    4647 
    4748   IMPLICIT NONE 
    … …  
    5253 
    5354   !! * Substitutions 
    54 #  include "domzgr_substitute.h90" 
    5555#  include "vectopt_loop_substitute.h90" 
    5656   !!---------------------------------------------------------------------- 
    … …  
    8181      !!--------------------------------------------------------------------- 
    8282      INTEGER, INTENT(in) :: kt    ! number of iteration 
    83       !! 
     83      ! 
    8484      INTEGER  :: ji, jj, jk, jl   ! dummy loop indices 
    8585      INTEGER  :: nbpb             ! nb of icy pts for vertical thermo calculations 
    86       INTEGER  :: ii, ij           ! temporary dummy loop index 
    8786      REAL(wp) :: zfric_u, zqld, zqfr 
    8887      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    8988      REAL(wp), PARAMETER :: zfric_umin = 0._wp           ! lower bound for the friction velocity (cice value=5.e-04) 
    9089      REAL(wp), PARAMETER :: zch        = 0.0057_wp       ! heat transfer coefficient 
    91       ! 
    9290      !!------------------------------------------------------------------- 
    9391 
    94       IF( nn_timing == 1 )  CALL timing_start('limthd') 
     92      IF( nn_timing == 1 )   CALL timing_start('limthd') 
    9593 
    9694      ! conservation test 
    97       IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     95      IF( ln_limdiahsb )   CALL lim_cons_hsm( 0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b ) 
    9896 
    9997      CALL lim_var_glo2eqv 
    … …  
    147145 
    148146            ! --- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! 
    149             zqfr = tmask(ji,jj,1) * rau0 * rcp * fse3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 
     147            zqfr = tmask(ji,jj,1) * rau0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 
    150148 
    151149            ! --- Energy from the turbulent oceanic heat flux (W/m2) --- ! 
    … …  
    226224 
    227225         IF( nbpb > 0 ) THEN  ! If there is no ice, do nothing. 
    228  
    229             !-------------------------! 
    230             ! --- Move to 1D arrays --- 
    231             !-------------------------! 
    232             CALL lim_thd_1d2d( nbpb, jl, 1 ) 
    233  
    234             !--------------------------------------! 
    235             ! --- Ice/Snow Temperature profile --- ! 
    236             !--------------------------------------! 
    237             CALL lim_thd_dif( 1, nbpb ) 
    238  
    239             !---------------------------------! 
    240             ! --- Ice/Snow thickness ---      ! 
    241             !---------------------------------! 
    242             CALL lim_thd_dh( 1, nbpb )     
    243  
    244             ! --- Ice enthalpy remapping --- ! 
    245             CALL lim_thd_ent( 1, nbpb, q_i_1d(1:nbpb,:) )  
    246                                              
    247             !---------------------------------! 
    248             ! --- Ice salinity ---            ! 
    249             !---------------------------------! 
    250             CALL lim_thd_sal( 1, nbpb )     
    251  
    252             !---------------------------------! 
    253             ! --- temperature update ---      ! 
    254             !---------------------------------! 
    255             CALL lim_thd_temp( 1, nbpb ) 
    256  
    257             !------------------------------------! 
    258             ! --- lateral melting if monocat --- ! 
    259             !------------------------------------! 
     226            ! 
     227            CALL lim_thd_1d2d( nbpb, jl, 1 )                ! --- Move to 1D arrays ---! 
     228            ! 
     229            CALL lim_thd_dif ( 1, nbpb )                    ! --- Ice/Snow Temperature profile --- ! 
     230            ! 
     231            CALL lim_thd_dh  ( 1, nbpb )                    ! --- Ice/Snow thickness ---! 
     232            ! 
     233            CALL lim_thd_ent ( 1, nbpb, q_i_1d(1:nbpb,:) )  ! --- Ice enthalpy remapping --- ! 
     234            ! 
     235            CALL lim_thd_sal ( 1, nbpb )                    ! --- Ice salinity ---            ! 
     236            ! 
     237            CALL lim_thd_temp( 1, nbpb )                    ! --- temperature update ---      ! 
     238            ! 
     239            !                                               ! --- lateral melting if monocat --- ! 
    260240            IF ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 ) THEN 
    261241               CALL lim_thd_lam( 1, nbpb ) 
    262242            END IF 
    263  
    264             !-------------------------! 
    265             ! --- Move to 2D arrays --- 
    266             !-------------------------! 
    267             CALL lim_thd_1d2d( nbpb, jl, 2 ) 
    268  
    269             ! 
    270             IF( lk_mpp )   CALL mpp_comm_free( ncomm_ice ) !RB necessary ?? 
     243            ! 
     244            CALL lim_thd_1d2d( nbpb, jl, 2 )                ! --- Move to 2D arrays --- 
     245            ! 
     246            IF( lk_mpp )   CALL mpp_comm_free( ncomm_ice )  !RB necessary ?? 
    271247         ENDIF 
    272248         ! 
    … …  
    410386      ENDIF 
    411387      ! 
    412       IF( nn_timing == 1 )  CALL timing_stop('limthd') 
    413  
     388      IF( nn_timing == 1 )   CALL timing_stop('limthd') 
     389      ! 
    414390   END SUBROUTINE lim_thd  
    415391 
    … …  
    424400      !!------------------------------------------------------------------- 
    425401      INTEGER, INTENT(in) ::   kideb, kiut   ! bounds for the spatial loop 
    426       !! 
     402      ! 
    427403      INTEGER  ::   ji, jk   ! dummy loop indices 
    428404      REAL(wp) ::   ztmelts, zaaa, zbbb, zccc, zdiscrim  ! local scalar  
    … …  
    444420         END DO  
    445421      END DO  
    446  
     422      ! 
    447423   END SUBROUTINE lim_thd_temp 
     424 
    448425 
    449426   SUBROUTINE lim_thd_lam( kideb, kiut ) 
    … …  
    455432      !!----------------------------------------------------------------------- 
    456433      INTEGER, INTENT(in) ::   kideb, kiut        ! bounds for the spatial loop 
    457       INTEGER             ::   ji                 ! dummy loop indices 
    458       REAL(wp)            ::   zhi_bef            ! ice thickness before thermo 
    459       REAL(wp)            ::   zdh_mel, zda_mel   ! net melting 
    460       REAL(wp)            ::   zvi, zvs           ! ice/snow volumes  
    461  
     434      ! 
     435      INTEGER  ::   ji                 ! dummy loop indices 
     436      REAL(wp) ::   zhi_bef            ! ice thickness before thermo 
     437      REAL(wp) ::   zdh_mel, zda_mel   ! net melting 
     438      REAL(wp) ::   zvi, zvs           ! ice/snow volumes  
     439      !!----------------------------------------------------------------------- 
     440      ! 
    462441      DO ji = kideb, kiut 
    463442         zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) ) 
    … …  
    477456         END IF 
    478457      END DO 
    479        
     458      ! 
    480459   END SUBROUTINE lim_thd_lam 
     460 
    481461 
    482462   SUBROUTINE lim_thd_1d2d( nbpb, jl, kn ) 
    … …  
    486466      !! ** Purpose :   move arrays from 1d to 2d and the reverse 
    487467      !!----------------------------------------------------------------------- 
    488       INTEGER, INTENT(in) ::   kn       ! 1= from 2D to 1D 
    489                                         ! 2= from 1D to 2D 
     468      INTEGER, INTENT(in) ::   kn       ! 1= from 2D to 1D   ;   2= from 1D to 2D 
    490469      INTEGER, INTENT(in) ::   nbpb     ! size of 1D arrays 
    491470      INTEGER, INTENT(in) ::   jl       ! ice cat 
     471      ! 
    492472      INTEGER             ::   jk       ! dummy loop indices 
    493  
     473      !!----------------------------------------------------------------------- 
     474      ! 
    494475      SELECT CASE( kn ) 
    495  
    496       CASE( 1 ) 
    497  
     476      ! 
     477      CASE( 1 )            ! from 2D to 1D 
     478         ! 
    498479         CALL tab_2d_1d( nbpb, at_i_1d     (1:nbpb), at_i            , jpi, jpj, npb(1:nbpb) ) 
    499480         CALL tab_2d_1d( nbpb, a_i_1d      (1:nbpb), a_i(:,:,jl)     , jpi, jpj, npb(1:nbpb) ) 
    500481         CALL tab_2d_1d( nbpb, ht_i_1d     (1:nbpb), ht_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    501482         CALL tab_2d_1d( nbpb, ht_s_1d     (1:nbpb), ht_s(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    502           
     483         ! 
    503484         CALL tab_2d_1d( nbpb, t_su_1d     (1:nbpb), t_su(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    504485         CALL tab_2d_1d( nbpb, sm_i_1d     (1:nbpb), sm_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    … …  
    512493            CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
    513494         END DO 
    514           
     495         ! 
    515496         CALL tab_2d_1d( nbpb, qprec_ice_1d(1:nbpb), qprec_ice(:,:) , jpi, jpj, npb(1:nbpb) ) 
    516497         CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    … …  
    526507         CALL tab_2d_1d( nbpb, qlead_1d   (1:nbpb), qlead           , jpi, jpj, npb(1:nbpb) ) 
    527508         CALL tab_2d_1d( nbpb, fhld_1d    (1:nbpb), fhld            , jpi, jpj, npb(1:nbpb) ) 
    528           
     509         ! 
    529510         CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw         , jpi, jpj, npb(1:nbpb) ) 
    530511         CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub         , jpi, jpj, npb(1:nbpb) ) 
    531           
     512         ! 
    532513         CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog         , jpi, jpj, npb(1:nbpb) ) 
    533514         CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom         , jpi, jpj, npb(1:nbpb) ) 
    … …  
    536517         CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res         , jpi, jpj, npb(1:nbpb) ) 
    537518         CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr         , jpi, jpj, npb(1:nbpb) ) 
    538           
     519         ! 
    539520         CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog         , jpi, jpj, npb(1:nbpb) ) 
    540521         CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom         , jpi, jpj, npb(1:nbpb) ) 
    … …  
    543524         CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri         , jpi, jpj, npb(1:nbpb) ) 
    544525         CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res         , jpi, jpj, npb(1:nbpb) ) 
    545           
     526         ! 
    546527         CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd         , jpi, jpj, npb(1:nbpb) ) 
    547528         CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr         , jpi, jpj, npb(1:nbpb) ) 
    … …  
    557538         CALL tab_2d_1d( nbpb, hfx_err_dif_1d (1:nbpb), hfx_err_dif , jpi, jpj, npb(1:nbpb) ) 
    558539         CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) ) 
    559  
    560       CASE( 2 ) 
    561  
     540         ! 
     541      CASE( 2 )            ! from 1D to 2D 
     542         ! 
    562543         CALL tab_1d_2d( nbpb, at_i          , npb, at_i_1d    (1:nbpb)   , jpi, jpj ) 
    563544         CALL tab_1d_2d( nbpb, ht_i(:,:,jl)  , npb, ht_i_1d    (1:nbpb)   , jpi, jpj ) 
    … …  
    576557         END DO 
    577558         CALL tab_1d_2d( nbpb, qlead         , npb, qlead_1d  (1:nbpb)   , jpi, jpj ) 
    578           
     559         ! 
    579560         CALL tab_1d_2d( nbpb, wfx_snw       , npb, wfx_snw_1d(1:nbpb)   , jpi, jpj ) 
    580561         CALL tab_1d_2d( nbpb, wfx_sub       , npb, wfx_sub_1d(1:nbpb)   , jpi, jpj ) 
    581           
     562         ! 
    582563         CALL tab_1d_2d( nbpb, wfx_bog       , npb, wfx_bog_1d(1:nbpb)   , jpi, jpj ) 
    583564         CALL tab_1d_2d( nbpb, wfx_bom       , npb, wfx_bom_1d(1:nbpb)   , jpi, jpj ) 
    … …  
    586567         CALL tab_1d_2d( nbpb, wfx_res       , npb, wfx_res_1d(1:nbpb)   , jpi, jpj ) 
    587568         CALL tab_1d_2d( nbpb, wfx_spr       , npb, wfx_spr_1d(1:nbpb)   , jpi, jpj ) 
    588           
     569         ! 
    589570         CALL tab_1d_2d( nbpb, sfx_bog       , npb, sfx_bog_1d(1:nbpb)   , jpi, jpj ) 
    590571         CALL tab_1d_2d( nbpb, sfx_bom       , npb, sfx_bom_1d(1:nbpb)   , jpi, jpj ) 
    … …  
    593574         CALL tab_1d_2d( nbpb, sfx_res       , npb, sfx_res_1d(1:nbpb)   , jpi, jpj ) 
    594575         CALL tab_1d_2d( nbpb, sfx_bri       , npb, sfx_bri_1d(1:nbpb)   , jpi, jpj ) 
    595           
     576         ! 
    596577         CALL tab_1d_2d( nbpb, hfx_thd       , npb, hfx_thd_1d(1:nbpb)   , jpi, jpj ) 
    597578         CALL tab_1d_2d( nbpb, hfx_spr       , npb, hfx_spr_1d(1:nbpb)   , jpi, jpj ) 
    … …  
    612593         !          
    613594      END SELECT 
    614  
     595      ! 
    615596   END SUBROUTINE lim_thd_1d2d 
    616597 
    … …  
    629610      !!------------------------------------------------------------------- 
    630611      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    631       NAMELIST/namicethd/ rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb,                       & 
    632          &                rn_himin, rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon, & 
     612      !! 
     613      NAMELIST/namicethd/ rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb,                & 
     614         &                rn_himin, rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon,  & 
    633615         &                nn_monocat, ln_it_qnsice 
    634616      !!------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.