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 3524 for branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90 – NEMO

Ignore:
Timestamp:
2012-11-02T07:13:40+01:00 (11 years ago)
Author:
gm
Message:

Branch: dev_r3385_NOCS04_HAMF; #665. add USE lib_fortran when SIGN is used (TOP,OPA,LIM2&3) ; salt flux names start with sfx_ in LIM3

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r3517 r3524  
    1616   !!   'key_lim3'                                      LIM3 sea-ice model 
    1717   !!---------------------------------------------------------------------- 
    18    !!   lim_thd        : thermodynamic of sea ice 
    19    !!   lim_thd_init   : initialisation of sea-ice thermodynamic 
     18   !!   lim_thd       : thermodynamic of sea ice 
     19   !!   lim_thd_init  : initialisation of sea-ice thermodynamic 
    2020   !!---------------------------------------------------------------------- 
    21    USE phycst          ! physical constants 
    22    USE dom_oce         ! ocean space and time domain variables 
    23    USE ice             ! LIM: sea-ice variables 
    24    USE par_ice         ! LIM: sea-ice parameters 
    25    USE sbc_oce         ! Surface boundary condition: ocean fields 
    26    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 
    29    USE domvvl          ! domain: variable volume level 
    30    USE limthd_dif      ! LIM: thermodynamics, vertical diffusion 
    31    USE limthd_dh       ! LIM: thermodynamics, ice and snow thickness variation 
    32    USE limthd_sal      ! LIM: thermodynamics, ice salinity 
    33    USE limthd_ent      ! LIM: thermodynamics, ice enthalpy redistribution 
    34    USE limtab          ! LIM: 1D <==> 2D transformation 
    35    USE limvar          ! LIM: sea-ice variables 
    36    USE lbclnk          ! lateral boundary condition - MPP links 
    37    USE lib_mpp         ! MPP library 
    38    USE wrk_nemo        ! work arrays 
    39    USE in_out_manager  ! I/O manager 
    40    USE prtctl          ! Print control 
     21   USE phycst         ! physical constants 
     22   USE dom_oce        ! ocean space and time domain variables 
     23   USE ice            ! LIM: sea-ice variables 
     24   USE par_ice        ! LIM: sea-ice parameters 
     25   USE sbc_oce        ! Surface boundary condition: ocean fields 
     26   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 
     29   USE domvvl         ! domain: variable volume level 
     30   USE limthd_dif     ! LIM: thermodynamics, vertical diffusion 
     31   USE limthd_dh      ! LIM: thermodynamics, ice and snow thickness variation 
     32   USE limthd_sal     ! LIM: thermodynamics, ice salinity 
     33   USE limthd_ent     ! LIM: thermodynamics, ice enthalpy redistribution 
     34   USE limtab         ! LIM: 1D <==> 2D transformation 
     35   USE limvar         ! LIM: sea-ice variables 
     36   USE lbclnk         ! lateral boundary condition - MPP links 
     37   USE lib_mpp        ! MPP library 
     38   USE wrk_nemo       ! work arrays 
     39   USE in_out_manager ! I/O manager 
     40   USE prtctl         ! Print control 
     41   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    4142 
    4243   IMPLICIT NONE 
     
    143144      rdm_ice(:,:) = 0.e0   ! variation of ice mass per unit area 
    144145      hicifp (:,:) = 0.e0   ! daily thermodynamic ice production.  
    145       fsbri  (:,:) = 0.e0   ! brine flux contribution to salt flux to the ocean 
     146      sfx_bri(:,:) = 0.e0   ! brine flux contribution to salt flux to the ocean 
    146147      fhbri  (:,:) = 0.e0   ! brine flux contribution to heat flux to the ocean 
    147       fseqv  (:,:) = 0.e0   ! equivalent salt flux to the ocean due to ice/growth decay 
     148      sfx_thd(:,:) = 0.e0   ! equivalent salt flux to the ocean due to ice/growth decay 
    148149 
    149150      !----------------------------------- 
     
    273274            CALL tab_2d_1d( nbpb, fr2_i0_1d  (1:nbpb), fr2_i0          , jpi, jpj, npb(1:nbpb) ) 
    274275            CALL tab_2d_1d( nbpb, qnsr_ice_1d(1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    275  
    276276#if ! defined key_coupled 
    277             CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    278             CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl)   , jpi, jpj, npb(1:nbpb) ) 
     277            CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
     278            CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
    279279#endif 
    280  
    281             CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl)   , jpi, jpj, npb(1:nbpb) ) 
    282             CALL tab_2d_1d( nbpb, t_bo_b     (1:nbpb), t_bo       , jpi, jpj, npb(1:nbpb) ) 
    283             CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip    , jpi, jpj, npb(1:nbpb) )  
    284             CALL tab_2d_1d( nbpb, fbif_1d    (1:nbpb), fbif       , jpi, jpj, npb(1:nbpb) ) 
    285             CALL tab_2d_1d( nbpb, qldif_1d   (1:nbpb), qldif      , jpi, jpj, npb(1:nbpb) ) 
    286             CALL tab_2d_1d( nbpb, rdm_ice_1d (1:nbpb), rdm_ice    , jpi, jpj, npb(1:nbpb) ) 
    287             CALL tab_2d_1d( nbpb, rdm_snw_1d (1:nbpb), rdm_snw    , jpi, jpj, npb(1:nbpb) ) 
    288             CALL tab_2d_1d( nbpb, dmgwi_1d   (1:nbpb), dmgwi      , jpi, jpj, npb(1:nbpb) ) 
    289             CALL tab_2d_1d( nbpb, qlbbq_1d   (1:nbpb), zqlbsbq    , jpi, jpj, npb(1:nbpb) ) 
    290  
    291             CALL tab_2d_1d( nbpb, fseqv_1d   (1:nbpb), fseqv      , jpi, jpj, npb(1:nbpb) ) 
    292             CALL tab_2d_1d( nbpb, fsbri_1d   (1:nbpb), fsbri      , jpi, jpj, npb(1:nbpb) ) 
    293             CALL tab_2d_1d( nbpb, fhbri_1d   (1:nbpb), fhbri      , jpi, jpj, npb(1:nbpb) ) 
    294             CALL tab_2d_1d( nbpb, fstbif_1d  (1:nbpb), fstric     , jpi, jpj, npb(1:nbpb) ) 
    295             CALL tab_2d_1d( nbpb, qfvbq_1d   (1:nbpb), qfvbq      , jpi, jpj, npb(1:nbpb) ) 
     280            CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
     281            CALL tab_2d_1d( nbpb, t_bo_b     (1:nbpb), t_bo            , jpi, jpj, npb(1:nbpb) ) 
     282            CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip         , jpi, jpj, npb(1:nbpb) )  
     283            CALL tab_2d_1d( nbpb, fbif_1d    (1:nbpb), fbif            , jpi, jpj, npb(1:nbpb) ) 
     284            CALL tab_2d_1d( nbpb, qldif_1d   (1:nbpb), qldif           , jpi, jpj, npb(1:nbpb) ) 
     285            CALL tab_2d_1d( nbpb, rdm_ice_1d (1:nbpb), rdm_ice         , jpi, jpj, npb(1:nbpb) ) 
     286            CALL tab_2d_1d( nbpb, rdm_snw_1d (1:nbpb), rdm_snw         , jpi, jpj, npb(1:nbpb) ) 
     287            CALL tab_2d_1d( nbpb, dmgwi_1d   (1:nbpb), dmgwi           , jpi, jpj, npb(1:nbpb) ) 
     288            CALL tab_2d_1d( nbpb, qlbbq_1d   (1:nbpb), zqlbsbq         , jpi, jpj, npb(1:nbpb) ) 
     289 
     290            CALL tab_2d_1d( nbpb, sfx_thd_1d (1:nbpb), sfx_thd         , jpi, jpj, npb(1:nbpb) ) 
     291            CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri         , jpi, jpj, npb(1:nbpb) ) 
     292            CALL tab_2d_1d( nbpb, fhbri_1d   (1:nbpb), fhbri           , jpi, jpj, npb(1:nbpb) ) 
     293            CALL tab_2d_1d( nbpb, fstbif_1d  (1:nbpb), fstric          , jpi, jpj, npb(1:nbpb) ) 
     294            CALL tab_2d_1d( nbpb, qfvbq_1d   (1:nbpb), qfvbq           , jpi, jpj, npb(1:nbpb) ) 
    296295 
    297296            !-------------------------------- 
     
    331330            !-------------------------------- 
    332331 
    333             CALL tab_1d_2d( nbpb, at_i        , npb, at_i_b(1:nbpb), jpi, jpj ) 
    334             CALL tab_1d_2d( nbpb, ht_i(:,:,jl), npb, ht_i_b(1:nbpb), jpi, jpj ) 
    335             CALL tab_1d_2d( nbpb, ht_s(:,:,jl), npb, ht_s_b(1:nbpb), jpi, jpj ) 
    336             CALL tab_1d_2d( nbpb, a_i (:,:,jl), npb, a_i_b(1:nbpb) , jpi, jpj ) 
    337             CALL tab_1d_2d( nbpb, t_su(:,:,jl), npb, t_su_b(1:nbpb), jpi, jpj ) 
    338             CALL tab_1d_2d( nbpb, sm_i(:,:,jl), npb, sm_i_b(1:nbpb), jpi, jpj ) 
    339  
     332               CALL tab_1d_2d( nbpb, at_i          , npb, at_i_b    (1:nbpb)   , jpi, jpj ) 
     333               CALL tab_1d_2d( nbpb, ht_i(:,:,jl)  , npb, ht_i_b    (1:nbpb)   , jpi, jpj ) 
     334               CALL tab_1d_2d( nbpb, ht_s(:,:,jl)  , npb, ht_s_b    (1:nbpb)   , jpi, jpj ) 
     335               CALL tab_1d_2d( nbpb, a_i (:,:,jl)  , npb, a_i_b     (1:nbpb)   , jpi, jpj ) 
     336               CALL tab_1d_2d( nbpb, t_su(:,:,jl)  , npb, t_su_b    (1:nbpb)   , jpi, jpj ) 
     337               CALL tab_1d_2d( nbpb, sm_i(:,:,jl)  , npb, sm_i_b    (1:nbpb)   , jpi, jpj ) 
    340338            DO jk = 1, nlay_s 
    341                CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_b(1:nbpb,jk), jpi, jpj) 
    342                CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_b(1:nbpb,jk), jpi, jpj) 
     339               CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_b     (1:nbpb,jk), jpi, jpj) 
     340               CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_b     (1:nbpb,jk), jpi, jpj) 
    343341            END DO 
    344  
    345342            DO jk = 1, nlay_i 
    346                CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_b(1:nbpb,jk), jpi, jpj) 
    347                CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_b(1:nbpb,jk), jpi, jpj) 
    348                CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_b(1:nbpb,jk), jpi, jpj) 
     343               CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_b     (1:nbpb,jk), jpi, jpj) 
     344               CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_b     (1:nbpb,jk), jpi, jpj) 
     345               CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_b     (1:nbpb,jk), jpi, jpj) 
    349346            END DO 
    350  
    351             CALL tab_1d_2d( nbpb, fstric , npb, fstbif_1d (1:nbpb), jpi, jpj ) 
    352             CALL tab_1d_2d( nbpb, qldif  , npb, qldif_1d  (1:nbpb), jpi, jpj ) 
    353             CALL tab_1d_2d( nbpb, qfvbq  , npb, qfvbq_1d  (1:nbpb), jpi, jpj ) 
    354             CALL tab_1d_2d( nbpb, rdm_ice, npb, rdm_ice_1d(1:nbpb), jpi, jpj ) 
    355             CALL tab_1d_2d( nbpb, rdm_snw, npb, rdm_snw_1d(1:nbpb), jpi, jpj ) 
    356             CALL tab_1d_2d( nbpb, dmgwi  , npb, dmgwi_1d  (1:nbpb), jpi, jpj ) 
    357             CALL tab_1d_2d( nbpb, rdvosif, npb, dvsbq_1d  (1:nbpb), jpi, jpj ) 
    358             CALL tab_1d_2d( nbpb, rdvobif, npb, dvbbq_1d  (1:nbpb), jpi, jpj ) 
    359             CALL tab_1d_2d( nbpb, fdvolif, npb, dvlbq_1d  (1:nbpb), jpi, jpj ) 
    360             CALL tab_1d_2d( nbpb, rdvonif, npb, dvnbq_1d  (1:nbpb), jpi, jpj )  
    361             CALL tab_1d_2d( nbpb, fseqv  , npb, fseqv_1d  (1:nbpb), jpi, jpj ) 
     347               CALL tab_1d_2d( nbpb, fstric        , npb, fstbif_1d (1:nbpb)   , jpi, jpj ) 
     348               CALL tab_1d_2d( nbpb, qldif         , npb, qldif_1d  (1:nbpb)   , jpi, jpj ) 
     349               CALL tab_1d_2d( nbpb, qfvbq         , npb, qfvbq_1d  (1:nbpb)   , jpi, jpj ) 
     350               CALL tab_1d_2d( nbpb, rdm_ice       , npb, rdm_ice_1d(1:nbpb)   , jpi, jpj ) 
     351               CALL tab_1d_2d( nbpb, rdm_snw       , npb, rdm_snw_1d(1:nbpb)   , jpi, jpj ) 
     352               CALL tab_1d_2d( nbpb, dmgwi         , npb, dmgwi_1d  (1:nbpb)   , jpi, jpj ) 
     353               CALL tab_1d_2d( nbpb, rdvosif       , npb, dvsbq_1d  (1:nbpb)   , jpi, jpj ) 
     354               CALL tab_1d_2d( nbpb, rdvobif       , npb, dvbbq_1d  (1:nbpb)   , jpi, jpj ) 
     355               CALL tab_1d_2d( nbpb, fdvolif       , npb, dvlbq_1d  (1:nbpb)   , jpi, jpj ) 
     356               CALL tab_1d_2d( nbpb, rdvonif       , npb, dvnbq_1d  (1:nbpb)   , jpi, jpj )  
     357               CALL tab_1d_2d( nbpb, sfx_thd       , npb, sfx_thd_1d(1:nbpb)   , jpi, jpj ) 
    362358            ! 
    363359            IF( num_sal == 2 ) THEN 
    364                CALL tab_1d_2d( nbpb, fsbri, npb, fsbri_1d(1:nbpb), jpi, jpj ) 
    365                CALL tab_1d_2d( nbpb, fhbri, npb, fhbri_1d(1:nbpb), jpi, jpj ) 
     360               CALL tab_1d_2d( nbpb, sfx_bri       , npb, sfx_bri_1d(1:nbpb)   , jpi, jpj ) 
     361               CALL tab_1d_2d( nbpb, fhbri         , npb, fhbri_1d  (1:nbpb)   , jpi, jpj ) 
    366362            ENDIF 
    367363            ! 
    368             !+++++ 
    369             !temporary stuff for a dummy version 
     364            !+++++       temporary stuff for a dummy version 
    370365            CALL tab_1d_2d( nbpb, dh_i_surf2D, npb, dh_i_surf(1:nbpb)      , jpi, jpj ) 
    371366            CALL tab_1d_2d( nbpb, dh_i_bott2D, npb, dh_i_bott(1:nbpb)      , jpi, jpj ) 
     
    389384      ! 5.1) Ice heat content               
    390385      !------------------------ 
    391       ! Enthalpies are global variables we have to readjust the units 
     386      ! Enthalpies are global variables we have to readjust the units (heat content in 10^9 Joules) 
    392387      zcoef = 1._wp / ( unit_fac * REAL( nlay_i ) ) 
    393388      DO jl = 1, jpl 
    394389         DO jk = 1, nlay_i 
    395             ! Multiply by volume, divide by nlayers so that heat content in 10^9 Joules 
    396390            e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_i(:,:,jl) * zcoef 
    397391         END DO 
     
    401395      ! 5.2) Snow heat content               
    402396      !------------------------ 
    403       ! Enthalpies are global variables we have to readjust the units 
     397      ! Enthalpies are global variables we have to readjust the units (heat content in 10^9 Joules) 
    404398      zcoef = 1._wp / ( unit_fac * REAL( nlay_s ) ) 
    405399      DO jl = 1, jpl 
    406400         DO jk = 1, nlay_s 
    407             ! Multiply by volume, so that heat content in 10^9 Joules 
    408401            e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_s(:,:,jl) * zcoef 
    409402         END DO 
Note: See TracChangeset for help on using the changeset viewer.