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 15734 for NEMO/branches/UKMO/NEMO_4.0.4_ice_strength_EAP/src/ICE/icedyn_rdgrft.F90 – NEMO

Ignore:
Timestamp:
2022-03-03T13:00:16+01:00 (2 years ago)
Author:
emmafiedler
Message:

Opening, ridging and yield curve diagnostics (and bug fix in timing)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/NEMO_4.0.4_ice_strength_EAP/src/ICE/icedyn_rdgrft.F90

    r15647 r15734  
    5656   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ze_i_2d 
    5757   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ze_s_2d 
     58   ! 
     59   ! For ridging diagnostics 
     60   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)     ::   airdg1          ! Ridging ice area loss 
     61   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)     ::   airft1          ! Rafting ice area loss 
     62   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)     ::   airdg2          ! New ridged ice area gain 
     63   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)     ::   airft2          ! New rafted ice area gain 
    5864   ! 
    5965   REAL(wp), PARAMETER ::   hrdg_hi_min = 1.1_wp    ! min ridge thickness multiplier: min(hrdg/hi) 
     
    100106         &      zaksum(jpij)       , hraft(jpij,jpl)   , hrexp(jpij,jpl)     ,  & 
    101107         &      hi_hrdg(jpij,jpl)  , araft(jpij,jpl)   , aridge(jpij,jpl)    , zasum(jpij), & 
    102          &      ze_i_2d(jpij,nlay_i,jpl), ze_s_2d(jpij,nlay_s,jpl), STAT=ice_dyn_rdgrft_alloc ) 
     108         &      ze_i_2d(jpij,nlay_i,jpl), ze_s_2d(jpij,nlay_s,jpl), & 
     109         &      airdg1(jpij), airft1(jpij), airdg2(jpij), airft2(jpij), STAT=ice_dyn_rdgrft_alloc ) 
    103110 
    104111      CALL mpp_sum ( 'icedyn_rdgrft', ice_dyn_rdgrft_alloc ) 
     
    150157      REAL(wp), DIMENSION(jpij) ::   zdivu, zdelt  ! 1D divu_i & delta_i 
    151158      REAL(wp), DIMENSION(jpij) ::   zconv         ! 1D rdg_conv (if EAP rheology) 
     159 
     160      REAL(wp), DIMENSION(jpi,jpj) ::   opning_2d  ! Lead opening diagnostic 
     161      REAL(wp), DIMENSION(jpi,jpj) ::   airdg1_2d  ! Ridging ice area loss diagnostic 
     162      REAL(wp), DIMENSION(jpi,jpj) ::   airft1_2d  ! Rafting ice area loss diagnostic 
     163      REAL(wp), DIMENSION(jpi,jpj) ::   airdg2_2d  ! New ridged ice area gain diagnostic 
     164      REAL(wp), DIMENSION(jpi,jpj) ::   airft2_2d  ! New rafted ice area gain diagnostic 
     165      REAL(wp), DIMENSION(jpi,jpj) ::   dairdg1dt  ! Ridging ice area loss rate diagnostic 
     166      REAL(wp), DIMENSION(jpi,jpj) ::   dairft1dt  ! Rafting ice area loss rate diagnostic 
     167      REAL(wp), DIMENSION(jpi,jpj) ::   dairdg2dt  ! New ridged ice area gain rate diagnostic 
     168      REAL(wp), DIMENSION(jpi,jpj) ::   dairft2dt  ! New rafted ice area gain rate diagnostic 
     169      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00     ! Mask for ice presence 
    152170      ! 
    153171      INTEGER, PARAMETER ::   jp_itermax = 20     
     
    162180         IF(lwp) WRITE(numout,*)'ice_dyn_rdgrft: ice ridging and rafting' 
    163181         IF(lwp) WRITE(numout,*)'~~~~~~~~~~~~~~' 
    164       ENDIF       
     182      ENDIF      
     183 
     184      ! Initialise ridging diagnostics 
     185      opning_2d(:,:) = 0.0_wp 
     186      dairdg1dt(:,:) = 0.0_wp 
     187      dairft1dt(:,:) = 0.0_wp 
     188      dairdg2dt(:,:) = 0.0_wp 
     189      dairft2dt(:,:) = 0.0_wp 
     190      airdg1_2d(:,:) = 0.0_wp 
     191      airft1_2d(:,:) = 0.0_wp 
     192      airdg2_2d(:,:) = 0.0_wp 
     193      airft2_2d(:,:) = 0.0_wp 
    165194 
    166195      !-------------------------------- 
     
    173202      DO jj = 1, jpj 
    174203         DO ji = 1, jpi 
     204            zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice, 0 if no ice. epsi06 used here rather than epsi10 as below for consistency with ice masking elsewhere 
    175205            IF ( at_i(ji,jj) > epsi10 ) THEN 
    176206               npti           = npti + 1 
     
    278308         CALL ice_dyn_1d2d( 2 )            ! --- Move to 2D arrays --- ! 
    279309 
     310! --- Ridging diagnostics --- ! 
     311 
     312         IF( iom_use('opning') ) THEN 
     313           CALL tab_1d_2d( npti, nptidx(1:npti), opning(1:npti), opning_2d(:,:) ) 
     314         END IF 
     315 
     316         IF( iom_use('dairdg1dt') .OR. iom_use('dairft1dt') .OR. iom_use('dairdg2dt') .OR. iom_use('dairft2dt') ) THEN 
     317           ! 
     318           CALL tab_1d_2d( npti, nptidx(1:npti), airdg1(1:npti), airdg1_2d(:,:) ) 
     319           CALL tab_1d_2d( npti, nptidx(1:npti), airft1(1:npti), airft1_2d(:,:) ) 
     320           CALL tab_1d_2d( npti, nptidx(1:npti), airdg2(1:npti), airdg2_2d(:,:) ) 
     321           CALL tab_1d_2d( npti, nptidx(1:npti), airft2(1:npti), airft2_2d(:,:) ) 
     322           ! 
     323           DO jj = 1, jpj 
     324              DO ji = 1, jpi 
     325              ! 
     326              dairdg1dt(ji,jj) = airdg1_2d(ji,jj) * r1_rdtice 
     327              dairft1dt(ji,jj) = airft1_2d(ji,jj) * r1_rdtice                       
     328              dairdg2dt(ji,jj) = airdg2_2d(ji,jj) * r1_rdtice 
     329              dairft2dt(ji,jj) = airft2_2d(ji,jj) * r1_rdtice  
     330              ! 
     331              END DO 
     332           END DO     
     333          !          
     334         ENDIF 
     335        !  
     336      ENDIF  ! npti>0 
     337 
     338 
     339      IF( iom_use('opning') ) THEN 
     340        CALL lbc_lnk( 'icedyn_rdgrft', opning_2d(:,:), 'T', 1. ) 
     341        CALL iom_put( 'opning', opning_2d(:,:) * zmsk00(:,:) )     ! Lead area opening rate 
    280342      ENDIF 
    281     
     343 
     344      IF( iom_use('dairdg1dt') ) THEN 
     345        CALL lbc_lnk( 'icedyn_rdgrft', dairdg1dt(:,:), 'T', 1. ) 
     346        CALL iom_put( 'dairdg1dt', dairdg1dt(:,:) * zmsk00(:,:) )  ! Ridging ice area loss rate 
     347      ENDIF 
     348 
     349      IF( iom_use('dairft1dt') ) THEN 
     350        CALL lbc_lnk( 'icedyn_rdgrft', dairft1dt(:,:), 'T', 1. ) 
     351        CALL iom_put( 'dairft1dt', dairft1dt(:,:) * zmsk00(:,:) )  ! Rafting ice area loss rate 
     352      ENDIF 
     353 
     354      IF( iom_use('dairdg2dt') ) THEN 
     355        CALL lbc_lnk( 'icedyn_rdgrft', dairdg2dt(:,:), 'T', 1. ) 
     356        CALL iom_put( 'dairdg2dt', dairdg2dt(:,:) * zmsk00(:,:) )  ! New ridged ice area gain rate 
     357      ENDIF 
     358 
     359      IF( iom_use('dairft2dt') ) THEN 
     360        CALL lbc_lnk( 'icedyn_rdgrft', dairft2dt(:,:), 'T', 1. ) 
     361        CALL iom_put( 'dairft2dt', dairft2dt(:,:) * zmsk00(:,:) )  ! New rafted ice area gain rate 
     362      ENDIF 
     363 
     364! ------- ! 
     365 
    282366      CALL ice_var_agg( 1 )  
    283367 
     
    533617      REAL(wp) ::   vsw                        ! vol of water trapped into ridges 
    534618      REAL(wp) ::   afrdg, afrft               ! fraction of category area ridged/rafted  
    535       REAL(wp)                  ::   airdg1, oirdg1, aprdg1, virdg1, sirdg1 
    536       REAL(wp)                  ::   airft1, oirft1, aprft1 
    537       REAL(wp), DIMENSION(jpij) ::   airdg2, oirdg2, aprdg2, virdg2, sirdg2, vsrdg, vprdg, vlrdg  ! area etc of new ridges 
    538       REAL(wp), DIMENSION(jpij) ::   airft2, oirft2, aprft2, virft , sirft , vsrft, vprft, vlrft  ! area etc of rafted ice 
     619      REAL(wp)                  ::   oirdg1, aprdg1, virdg1, sirdg1 
     620      REAL(wp)                  ::   oirft1, aprft1 
     621      REAL(wp), DIMENSION(jpij) ::   oirdg2, aprdg2, virdg2, sirdg2, vsrdg, vprdg, vlrdg  ! area etc of new ridges 
     622      REAL(wp), DIMENSION(jpij) ::   oirft2, aprft2, virft , sirft , vsrft, vprft, vlrft  ! area etc of rafted ice 
    539623      ! 
    540624      REAL(wp), DIMENSION(jpij) ::   ersw             ! enth of water trapped into ridges 
     
    576660                
    577661               ! area of ridging / rafting ice (airdg1) and of new ridge (airdg2) 
    578                airdg1 = aridge(ji,jl1) * closing_gross(ji) * rdt_ice 
    579                airft1 = araft (ji,jl1) * closing_gross(ji) * rdt_ice 
    580  
    581                airdg2(ji) = airdg1 * hi_hrdg(ji,jl1) 
    582                airft2(ji) = airft1 * hi_hrft 
     662               airdg1(ji) = aridge(ji,jl1) * closing_gross(ji) * rdt_ice 
     663               airft1(ji) = araft (ji,jl1) * closing_gross(ji) * rdt_ice 
     664 
     665               airdg2(ji) = airdg1(ji) * hi_hrdg(ji,jl1) 
     666               airft2(ji) = airft1(ji) * hi_hrft 
    583667 
    584668               ! ridging /rafting fractions 
    585                afrdg = airdg1 * z1_ai(ji) 
    586                afrft = airft1 * z1_ai(ji) 
     669               afrdg = airdg1(ji) * z1_ai(ji) 
     670               afrft = airft1(ji) * z1_ai(ji) 
    587671 
    588672               ! volume and enthalpy (J/m2, >0) of seawater trapped into ridges 
     
    640724               ! Remove area, volume of new ridge to each category jl1 
    641725               !------------------------------------------------------ 
    642                a_i_2d (ji,jl1) = a_i_2d (ji,jl1) - airdg1    - airft1 
     726               a_i_2d (ji,jl1) = a_i_2d (ji,jl1) - airdg1(ji)- airft1(ji) 
    643727               v_i_2d (ji,jl1) = v_i_2d (ji,jl1) - virdg1    - virft(ji) 
    644728               v_s_2d (ji,jl1) = v_s_2d (ji,jl1) - vsrdg(ji) - vsrft(ji) 
Note: See TracChangeset for help on using the changeset viewer.