Ignore:
Timestamp:
2019-09-09T19:57:45+02:00 (14 months ago)
Author:
clem
Message:

add the final touch to the famous gaston's branch. More precisely, add the possibility to have melt ponds as input file when using bdy

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/ICE/iceistate.F90

    r11402 r11518  
    101101      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zti_3d , zts_3d                            !temporary arrays 
    102102      !! 
    103       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zhi_2d, zhs_2d, zai_2d, zti_2d, zts_2d, ztsu_2d, zsi_2d 
     103      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zhi_2d, zhs_2d, zai_2d, zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d 
    104104      !-------------------------------------------------------------------- 
    105105 
     
    209209            ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) 
    210210            ! 
    211             ! ponds 
     211            ! pond concentration 
    212212            IF( TRIM(si(jp_apd)%clrootname) == 'NOT USED' ) & 
    213                &     si(jp_apd)%fnow(:,:,1) = ( rn_apd_ini_n * zswitch + rn_apd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
     213               &     si(jp_apd)%fnow(:,:,1) = ( rn_apd_ini_n * zswitch + rn_apd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) & ! rn_apd = pond fraction => rn_apnd * a_i = pond conc. 
     214               &                              * si(jp_ati)%fnow(:,:,1)  
    214215            zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) 
     216            ! 
     217            ! pond depth 
    215218            IF( TRIM(si(jp_hpd)%clrootname) == 'NOT USED' ) & 
    216219               &     si(jp_hpd)%fnow(:,:,1) = ( rn_hpd_ini_n * zswitch + rn_hpd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
     
    238241               zt_su_ini(:,:) = rn_tsu_ini_n * zswitch(:,:) 
    239242               ztm_s_ini(:,:) = rn_tms_ini_n * zswitch(:,:) 
    240                zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) 
     243               zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc.  
    241244               zhpnd_ini(:,:) = rn_hpd_ini_n * zswitch(:,:) 
    242245            ELSEWHERE 
     
    248251               zt_su_ini(:,:) = rn_tsu_ini_s * zswitch(:,:) 
    249252               ztm_s_ini(:,:) = rn_tms_ini_s * zswitch(:,:) 
    250                zapnd_ini(:,:) = rn_apd_ini_s * zswitch(:,:) 
     253               zapnd_ini(:,:) = rn_apd_ini_s * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 
    251254               zhpnd_ini(:,:) = rn_hpd_ini_s * zswitch(:,:) 
    252255            END WHERE 
    253256            ! 
    254257         ENDIF 
     258 
     259         ! make sure ponds = 0 if no ponds scheme 
     260         IF ( .NOT.ln_pnd ) THEN 
     261            zapnd_ini(:,:) = 0._wp 
     262            zhpnd_ini(:,:) = 0._wp 
     263         ENDIF 
     264          
    255265         !-------------! 
    256266         ! fill fields ! 
     
    275285         CALL tab_2d_1d( npti, nptidx(1:npti), t_su_1d(1:npti)  , zt_su_ini ) 
    276286         CALL tab_2d_1d( npti, nptidx(1:npti), s_i_1d (1:npti)  , zsm_i_ini ) 
     287         CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d(1:npti)  , zapnd_ini ) 
     288         CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d(1:npti)  , zhpnd_ini ) 
    277289 
    278290         ! allocate temporary arrays 
    279291         ALLOCATE( zhi_2d(npti,jpl), zhs_2d(npti,jpl), zai_2d (npti,jpl), & 
    280             &      zti_2d(npti,jpl), zts_2d(npti,jpl), ztsu_2d(npti,jpl), zsi_2d(npti,jpl) ) 
     292            &      zti_2d(npti,jpl), zts_2d(npti,jpl), ztsu_2d(npti,jpl), zsi_2d(npti,jpl), zaip_2d(npti,jpl), zhip_2d(npti,jpl) ) 
    281293          
    282294         ! distribute 1-cat into jpl-cat: (jpi*jpj) -> (jpi*jpj,jpl) 
    283          CALL ice_var_itd( h_i_1d(1:npti)  , h_s_1d(1:npti)  , at_i_1d(1:npti),                   zhi_2d, zhs_2d, zai_2d , & 
    284             &              t_i_1d(1:npti,1), t_s_1d(1:npti,1), t_su_1d(1:npti), s_i_1d(1:npti),   zti_2d, zts_2d, ztsu_2d, zsi_2d ) 
     295         CALL ice_var_itd( h_i_1d(1:npti)  , h_s_1d(1:npti)  , at_i_1d(1:npti),                                                   & 
     296            &              zhi_2d          , zhs_2d          , zai_2d         ,                                                   & 
     297            &              t_i_1d(1:npti,1), t_s_1d(1:npti,1), t_su_1d(1:npti), s_i_1d(1:npti), a_ip_1d(1:npti), h_ip_1d(1:npti), & 
     298            &              zti_2d          , zts_2d          , ztsu_2d        , zsi_2d        , zaip_2d        , zhip_2d ) 
    285299 
    286300         ! move to 3D arrays: (jpi*jpj,jpl) -> (jpi,jpj,jpl) 
     
    289303            zts_3d(:,:,jl) = rt0 * tmask(:,:,1) 
    290304         END DO 
    291          CALL tab_2d_3d( npti, nptidx(1:npti), zhi_2d  , h_i  ) 
    292          CALL tab_2d_3d( npti, nptidx(1:npti), zhs_2d  , h_s  ) 
    293          CALL tab_2d_3d( npti, nptidx(1:npti), zai_2d  , a_i  ) 
    294          CALL tab_2d_3d( npti, nptidx(1:npti), zti_2d  , zti_3d ) 
    295          CALL tab_2d_3d( npti, nptidx(1:npti), zts_2d  , zts_3d ) 
    296          CALL tab_2d_3d( npti, nptidx(1:npti), ztsu_2d , t_su ) 
    297          CALL tab_2d_3d( npti, nptidx(1:npti), zsi_2d  , s_i  ) 
     305         CALL tab_2d_3d( npti, nptidx(1:npti), zhi_2d   , h_i    ) 
     306         CALL tab_2d_3d( npti, nptidx(1:npti), zhs_2d   , h_s    ) 
     307         CALL tab_2d_3d( npti, nptidx(1:npti), zai_2d   , a_i    ) 
     308         CALL tab_2d_3d( npti, nptidx(1:npti), zti_2d   , zti_3d ) 
     309         CALL tab_2d_3d( npti, nptidx(1:npti), zts_2d   , zts_3d ) 
     310         CALL tab_2d_3d( npti, nptidx(1:npti), ztsu_2d  , t_su   ) 
     311         CALL tab_2d_3d( npti, nptidx(1:npti), zsi_2d   , s_i    ) 
     312         CALL tab_2d_3d( npti, nptidx(1:npti), zaip_2d  , a_ip   ) 
     313         CALL tab_2d_3d( npti, nptidx(1:npti), zhip_2d  , h_ip   ) 
    298314 
    299315         ! deallocate temporary arrays 
    300316         DEALLOCATE( zhi_2d, zhs_2d, zai_2d , & 
    301             &        zti_2d, zts_2d, ztsu_2d, zsi_2d ) 
    302  
    303          ! Melt ponds: distribute uniformely over the categories 
    304          IF ( ln_pnd_CST .OR. ln_pnd_H12 ) THEN 
    305             DO jl = 1, jpl 
    306                a_ip_frac(:,:,jl) = zapnd_ini(:,:) 
    307                h_ip     (:,:,jl) = zhpnd_ini(:,:) 
    308                a_ip     (:,:,jl) = a_ip_frac(:,:,jl) * a_i (:,:,jl)  
    309                v_ip     (:,:,jl) = h_ip     (:,:,jl) * a_ip(:,:,jl) 
    310             END DO 
    311          ENDIF 
    312            
     317            &        zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d ) 
     318 
    313319         ! calculate extensive and intensive variables 
    314320         CALL ice_var_salprof ! for sz_i 
     
    350356         END DO 
    351357 
     358         ! Melt ponds 
     359         WHERE( a_i > epsi10 ) 
     360            a_ip_frac(:,:,:) = a_ip(:,:,:) / a_i(:,:,:) 
     361         ELSEWHERE 
     362            a_ip_frac(:,:,:) = 0._wp 
     363         END WHERE 
     364         v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:) 
     365           
    352366         ! specific temperatures for coupled runs 
    353367         tn_ice(:,:,:) = t_su(:,:,:) 
     
    512526      ENDIF 
    513527      ! 
     528      IF( .NOT.ln_pnd ) THEN 
     529         rn_apd_ini_n = 0. ; rn_apd_ini_s = 0. 
     530         rn_hpd_ini_n = 0. ; rn_hpd_ini_s = 0. 
     531         CALL ctl_warn( 'rn_apd_ini & rn_hpd_ini = 0 when no ponds' ) 
     532      ENDIF 
     533      ! 
    514534   END SUBROUTINE ice_istate_init 
    515535 
Note: See TracChangeset for help on using the changeset viewer.