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 3372 – NEMO

Changeset 3372


Ignore:
Timestamp:
2012-04-30T12:50:36+02:00 (12 years ago)
Author:
sga
Message:

NEMO branch dev_r3337_NOCS10_ICB: change all routine names and create more Gurvanistic havoc

Location:
branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB
Files:
10 edited

Legend:

Unmodified
Added
Removed

  • branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icbclv.F90

    r3370 r3372  
    1212   !!---------------------------------------------------------------------- 
    1313   !!---------------------------------------------------------------------- 
    14    !!   accumulate_calving : 
    15    !!   icb_gen            : generate test icebergs 
     14   !!   icb_clv_flx   : transfer input flux of ice into iceberg classes 
     15   !!   icb_clv       : calve icebergs from stored ice 
    1616   !!---------------------------------------------------------------------- 
    1717   USE par_oce        ! NEMO parameters 
    … …  
    2828   PRIVATE 
    2929 
    30    PUBLIC   accumulate_calving  ! routine called in icbrun.F90 module 
    31    PUBLIC   calve_icebergs      ! routine called in icbrun.F90 module 
     30   PUBLIC   icb_clv_flx  ! routine called in icbrun.F90 module 
     31   PUBLIC   icb_clv      ! routine called in icbrun.F90 module 
    3232 
    3333   !!---------------------------------------------------------------------- 
    … …  
    3838CONTAINS 
    3939 
    40    SUBROUTINE accumulate_calving( kt ) 
     40   SUBROUTINE icb_clv_flx( kt ) 
    4141      !!---------------------------------------------------------------------- 
    42       !!                 ***  ROUTINE accumulate_calving  *** 
     42      !!                 ***  ROUTINE icb_clv_flx  *** 
    4343      !! 
    4444      !! ** Purpose :   ? 
    … …  
    9595      berg_grid%tmp(:,:) = berg_dt * berg_grid%calving_hflx(:,:) * e1e2t(:,:) * tmask_i(:,:) 
    9696      berg_grid%stored_heat (:,:) = berg_grid%stored_heat (:,:) + berg_grid%tmp(:,:) 
    97       CALL incoming_budget( kt,  zcalving_used, berg_grid%tmp ) 
     97      CALL icb_dia_income( kt,  zcalving_used, berg_grid%tmp ) 
    9898      ! 
    99    END SUBROUTINE accumulate_calving 
     99   END SUBROUTINE icb_clv_flx 
    100100 
    101    SUBROUTINE calve_icebergs() 
     101   SUBROUTINE icb_clv() 
    102102      !!---------------------------------------------------------------------- 
    103       !!                 ***  ROUTINE calve_icebergs  *** 
     103      !!                 ***  ROUTINE icb_clv  *** 
    104104      !! 
    105       !! ** Purpose :   This seems to be the routine that takes a stored ice field and calves to the ocean, 
    106       !!                so I assume that the gridded array stored_ice has only non-zero entries at selected 
     105      !! ** Purpose :   This routine takes a stored ice field and calves to the ocean, 
     106      !!                so the gridded array stored_ice has only non-zero entries at selected 
    107107      !!                wet points adjacent to known land based calving points 
    108108      !! 
    109109      !! ** method  : - Look at each grid point and see if there's enough for each size class to calve 
    110110      !!                If there is, a new iceberg is calved.  This happens in the order determined by 
    111       !!                the class definition arrays (largest first?) 
     111      !!                the class definition arrays (which in the default case is smallest first) 
    112112      !!                Note that only the non-overlapping part of the processor where icebergs are allowed 
    113113      !!                is considered 
    … …  
    150150                  newpt%heat_density = berg_grid%stored_heat(ji,jj) / berg_grid%stored_ice(ji,jj,jn)   ! This is in J/kg 
    151151                  ! 
    152                   CALL increment_kounter() 
     152                  CALL icb_utl_incr() 
    153153                  newberg%number(:) = num_bergs(:) 
    154154                  ! 
    155                   CALL add_new_berg_to_list( newberg, newpt ) 
     155                  CALL icb_utl_add( newberg, newpt ) 
    156156                  ! 
    157157                  zcalved_to_berg = rn_initial_mass(jn) * rn_mass_scaling(jn)           ! Units of kg 
    … …  
    165165                  icnt = icnt + 1 
    166166                  ! 
    167                   CALL calving_budget(ji, jj, jn,  zcalved_to_berg, zheat_to_berg ) 
     167                  CALL icb_dia_calve(ji, jj, jn,  zcalved_to_berg, zheat_to_berg ) 
    168168               END DO 
    169169               icntmax = MAX( icntmax, icnt ) 
    … …  
    177177      CALL lbc_lnk( berg_grid%stored_heat, 'T', 1._wp ) 
    178178      ! 
    179       IF( nn_verbose_level > 0 .AND. icntmax > 1 )   WRITE(numicb,*) 'calve_icebergs: icnt=', icnt,' on', narea 
     179      IF( nn_verbose_level > 0 .AND. icntmax > 1 )   WRITE(numicb,*) 'icb_clv: icnt=', icnt,' on', narea 
    180180      ! 
    181    END SUBROUTINE  calve_icebergs 
     181   END SUBROUTINE  icb_clv 
    182182 
    183183   !!====================================================================== 

  • branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icbdia.F90

    r3370 r3372  
    1414   !!---------------------------------------------------------------------- 
    1515   !!---------------------------------------------------------------------- 
    16    !! icb_budget_end  : end        iceberg budgeting 
    17    !! icb_budget_init : initialise iceberg budgeting 
     16   !! icb_dia_end  : end        iceberg budgeting 
     17   !! icb_dia_init : initialise iceberg budgeting 
    1818   !!---------------------------------------------------------------------- 
    1919   USE par_oce        ! ocean parameters 
    … …  
    2828   PRIVATE 
    2929 
    30    PUBLIC   icb_budget_end    ! routine called in icbrun.F90 module 
    31    PUBLIC   icb_budget_init   ! routine called in icbini.F90 module 
    32    PUBLIC   icb_budget        ! routine called in icbrun.F90 module 
    33    PUBLIC   icb_budget_step   ! routine called in icbrun.F90 module 
    34    PUBLIC   icb_budget_put    ! routine called in icbrun.F90 module 
    35    PUBLIC   melt_budget       ! routine called in icbthm.F90 module 
    36    PUBLIC   size_budget       ! routine called in icbthm.F90 module 
    37    PUBLIC   speed_budget      ! routine called in icbdyn.F90 module 
    38    PUBLIC   calving_budget    ! routine called in icbclv.F90 module 
    39    PUBLIC   incoming_budget   ! routine called in icbclv.F90 module 
     30   PUBLIC   icb_dia_end       ! routine called in icbrun.F90 module 
     31   PUBLIC   icb_dia_init      ! routine called in icbini.F90 module 
     32   PUBLIC   icb_dia           ! routine called in icbrun.F90 module 
     33   PUBLIC   icb_dia_step      ! routine called in icbrun.F90 module 
     34   PUBLIC   icb_dia_put       ! routine called in icbrun.F90 module 
     35   PUBLIC   icb_dia_melt      ! routine called in icbthm.F90 module 
     36   PUBLIC   icb_dia_size      ! routine called in icbthm.F90 module 
     37   PUBLIC   icb_dia_speed     ! routine called in icbdyn.F90 module 
     38   PUBLIC   icb_dia_calve     ! routine called in icbclv.F90 module 
     39   PUBLIC   icb_dia_income    ! routine called in icbclv.F90 module 
    4040 
    4141   REAL(wp), DIMENSION(:,:)  , POINTER, PUBLIC  ::   berg_melt    => NULL()   ! Melting+erosion rate of icebergs     [kg/s/m2] 
    … …  
    8383CONTAINS 
    8484 
    85    SUBROUTINE icb_budget_end 
     85   SUBROUTINE icb_dia_end 
    8686      !!---------------------------------------------------------------------- 
    8787      ! 
    … …  
    103103      ENDIF 
    104104      ! 
    105    END SUBROUTINE icb_budget_end 
    106  
    107    !!------------------------------------------------------------------------- 
    108  
    109    SUBROUTINE icb_budget_init( ) 
     105   END SUBROUTINE icb_dia_end 
     106 
     107 
     108   SUBROUTINE icb_dia_init( ) 
    110109      !!---------------------------------------------------------------------- 
    111110      !!---------------------------------------------------------------------- 
    … …  
    160159      bits_src_net              = 0._wp 
    161160 
    162       floating_mass_start       = sum_mass( first_berg ) 
    163       bergs_mass_start          = sum_mass( first_berg, justbergs=.true. ) 
    164       bits_mass_start           = sum_mass( first_berg, justbits=.true. ) 
     161      floating_mass_start       = icb_utl_mass( first_berg ) 
     162      bergs_mass_start          = icb_utl_mass( first_berg, justbergs=.true. ) 
     163      bits_mass_start           = icb_utl_mass( first_berg, justbits=.true. ) 
    165164      IF( lk_mpp ) THEN 
    166165         ALLOCATE( rsumbuf(23) )          ; rsumbuf(:) = 0._wp 
    … …  
    175174      ENDIF 
    176175      ! 
    177    END SUBROUTINE icb_budget_init 
    178  
    179  
    180    SUBROUTINE icb_budget( ld_budge ) 
     176   END SUBROUTINE icb_dia_init 
     177 
     178 
     179   SUBROUTINE icb_dia( ld_budge ) 
    181180      !!---------------------------------------------------------------------- 
    182181      !!---------------------------------------------------------------------- 
    … …  
    207206         stored_end        = SUM( berg_grid%stored_ice(:,:,:) ) 
    208207         stored_heat_end   = SUM( berg_grid%stored_heat(:,:) ) 
    209          floating_mass_end = sum_mass( first_berg ) 
    210          bergs_mass_end    = sum_mass( first_berg,justbergs=.true. ) 
    211          bits_mass_end     = sum_mass( first_berg,justbits=.true. ) 
    212          floating_heat_end = sum_heat( first_berg ) 
    213  
    214          nbergs_end        = count_bergs() 
     208         floating_mass_end = icb_utl_mass( first_berg ) 
     209         bergs_mass_end    = icb_utl_mass( first_berg,justbergs=.true. ) 
     210         bits_mass_end     = icb_utl_mass( first_berg,justbits=.true. ) 
     211         floating_heat_end = icb_utl_heat( first_berg ) 
     212 
     213         nbergs_end        = icb_utl_count() 
    215214         zgrdd_berg_mass   = SUM( berg_mass (:,:)*e1e2t(:,:)*tmask_i(:,:) ) 
    216215         zgrdd_bits_mass   = SUM( bits_mass(:,:)*e1e2t(:,:)*tmask_i(:,:) ) 
    … …  
    364363      ENDIF 
    365364      ! 
    366    END SUBROUTINE icb_budget 
    367  
    368  
    369    SUBROUTINE icb_budget_step 
     365   END SUBROUTINE icb_dia 
     366 
     367 
     368   SUBROUTINE icb_dia_step 
    370369      !!---------------------------------------------------------------------- 
    371370      !! things to reset at the beginning of each timestep 
    … …  
    385384      real_calving (:,:,:) = 0._wp 
    386385      ! 
    387    END SUBROUTINE icb_budget_step 
    388  
    389  
    390    SUBROUTINE icb_budget_put 
     386   END SUBROUTINE icb_dia_step 
     387 
     388 
     389   SUBROUTINE icb_dia_put 
    391390      !!---------------------------------------------------------------------- 
    392391      !!---------------------------------------------------------------------- 
    … …  
    405404      CALL iom_put( "berg_real_calving", real_calving(:,:,:) )   ! Calving into iceberg class                [kg/s] 
    406405      ! 
    407    END SUBROUTINE icb_budget_put 
    408  
    409  
    410    SUBROUTINE calving_budget( ki, kj, kn, pcalved, pheated ) 
     406   END SUBROUTINE icb_dia_put 
     407 
     408 
     409   SUBROUTINE icb_dia_calve( ki, kj, kn, pcalved, pheated ) 
    411410      !!---------------------------------------------------------------------- 
    412411      !!---------------------------------------------------------------------- 
    … …  
    423422      heat_to_bergs_net          = heat_to_bergs_net    + pheated 
    424423      ! 
    425    END SUBROUTINE calving_budget 
    426  
    427  
    428    SUBROUTINE incoming_budget( kt,  pcalving_used, pheat_used ) 
     424   END SUBROUTINE icb_dia_calve 
     425 
     426 
     427   SUBROUTINE icb_dia_income( kt,  pcalving_used, pheat_used ) 
    429428      !!---------------------------------------------------------------------- 
    430429      !!---------------------------------------------------------------------- 
    … …  
    439438         stored_start = SUM( berg_grid%stored_ice(:,:,:) ) 
    440439         IF( lk_mpp ) CALL mpp_sum( stored_start ) 
    441          WRITE(numicb,'(a,es13.6,a)')   'accumulate_calving: initial stored mass=',stored_start,' kg' 
     440         WRITE(numicb,'(a,es13.6,a)')   'icb_dia_income: initial stored mass=',stored_start,' kg' 
    442441         ! 
    443442         stored_heat_start = SUM( berg_grid%stored_heat(:,:) ) 
    444443         IF( lk_mpp ) CALL mpp_sum( stored_heat_start ) 
    445          WRITE(numicb,'(a,es13.6,a)')    'accumulate_calving: initial stored heat=',stored_heat_start,' J' 
     444         WRITE(numicb,'(a,es13.6,a)')    'icb_dia_income: initial stored heat=',stored_heat_start,' J' 
    446445      ENDIF 
    447446      ! 
    … …  
    453452      calving_src_heat_used_net = calving_src_heat_used_net + SUM( pheat_used(:,:) ) 
    454453      ! 
    455    END SUBROUTINE incoming_budget 
    456  
    457  
    458    SUBROUTINE size_budget(ki, kj, pWn, pLn, pAbits,   & 
    459       &                   pmass_scale, pMnew, pnMbits, pz1_e1e2) 
     454   END SUBROUTINE icb_dia_income 
     455 
     456 
     457   SUBROUTINE icb_dia_size(ki, kj, pWn, pLn, pAbits,   & 
     458      &                    pmass_scale, pMnew, pnMbits, pz1_e1e2) 
    460459      !!---------------------------------------------------------------------- 
    461460      !!---------------------------------------------------------------------- 
    … …  
    469468      bits_mass(ki,kj)    = bits_mass(ki,kj) + pnMbits * pz1_e1e2                           ! kg/m2 
    470469      ! 
    471    END SUBROUTINE size_budget 
    472  
    473  
    474    SUBROUTINE speed_budget() 
     470   END SUBROUTINE icb_dia_size 
     471 
     472 
     473   SUBROUTINE icb_dia_speed() 
    475474      !!---------------------------------------------------------------------- 
    476475      !!---------------------------------------------------------------------- 
    … …  
    479478      nspeeding_tickets = nspeeding_tickets + 1 
    480479      ! 
    481    END SUBROUTINE speed_budget 
    482  
    483  
    484    SUBROUTINE melt_budget(ki, kj, pmnew, pheat, pmass_scale,   & 
     480   END SUBROUTINE icb_dia_speed 
     481 
     482 
     483   SUBROUTINE icb_dia_melt(ki, kj, pmnew, pheat, pmass_scale,   & 
    485484      &                   pdM, pdMbitsE, pdMbitsM, pdMb, pdMe,   & 
    486485      &                   pdMv, pz1_dt_e1e2 ) 
    … …  
    503502      IF( pmnew <= 0._wp ) nbergs_melted = nbergs_melted + 1                        ! Delete the berg if completely melted 
    504503      ! 
    505    END SUBROUTINE melt_budget 
     504   END SUBROUTINE icb_dia_melt 
    506505 
    507506 

  • branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icbdyn.F90

    r3370 r3372  
    2424   PRIVATE 
    2525 
    26    PUBLIC   evolve_icebergs  ! routine called in icbrun.F90 module 
     26   PUBLIC   icb_dyn  ! routine called in icbrun.F90 module 
    2727 
    2828   !!---------------------------------------------------------------------- 
    … …  
    3333CONTAINS 
    3434 
    35    SUBROUTINE evolve_icebergs() 
    36       !!---------------------------------------------------------------------- 
    37       !!                  ***  ROUTINE evolve_icebergs  *** 
     35   SUBROUTINE icb_dyn() 
     36      !!---------------------------------------------------------------------- 
     37      !!                  ***  ROUTINE icb_dyn  *** 
    3838      !! 
    3939      !! ** Purpose :   iceberg evolution. 
    … …  
    8484 
    8585         !                                         !**   A1 = A(X1,V1) 
    86          CALL accel( berg , zxi1, ze1, zuvel1, zuvel1, zax1,     & 
    87             &               zyj1, ze2, zvvel1, zvvel1, zay1, zdt_2 ) 
     86         CALL icb_accel( berg , zxi1, ze1, zuvel1, zuvel1, zax1,     & 
     87            &                   zyj1, ze2, zvvel1, zvvel1, zay1, zdt_2 ) 
    8888         ! 
    8989         zu1 = zuvel1 / ze1                           !**   V1 in d(i,j)/dt 
    … …  
    9797         zyj2 = zyj1 + zdt_2 * zv1          ;   zvvel2 = zvvel1 + zdt_2 * zay1 
    9898         ! 
    99          CALL adjust_to_ground( zxi2, zxi1, zu1,   & 
    100          &                      zyj2, zyj1, zv1, ll_bounced ) 
     99         CALL icb_ground( zxi2, zxi1, zu1,   & 
     100         &                zyj2, zyj1, zv1, ll_bounced ) 
    101101 
    102102         !                                         !**   A2 = A(X2,V2) 
    103          CALL accel( berg , zxi2, ze1, zuvel2, zuvel1, zax2,    & 
    104             &               zyj2, ze2, zvvel2, zvvel1, zay2, zdt_2 ) 
     103         CALL icb_accel( berg , zxi2, ze1, zuvel2, zuvel1, zax2,    & 
     104            &                   zyj2, ze2, zvvel2, zvvel1, zay2, zdt_2 ) 
    105105         ! 
    106106         zu2 = zuvel2 / ze1                           !**   V2 in d(i,j)/dt 
    … …  
    113113         zyj3  = zyj1  + zdt_2 * zv2   ;   zvvel3 = zvvel1 + zdt_2 * zay2 
    114114         ! 
    115          CALL adjust_to_ground( zxi3, zxi1, zu3,   & 
    116          &                      zyj3, zyj1, zv3, ll_bounced ) 
     115         CALL icb_ground( zxi3, zxi1, zu3,   & 
     116         &                zyj3, zyj1, zv3, ll_bounced ) 
    117117 
    118118         !                                         !**   A3 = A(X3,V3) 
    119          CALL accel( berg , zxi3, ze1, zuvel3, zuvel1, zax3,    & 
    120             &               zyj3, ze2, zvvel3, zvvel1, zay3, zdt ) 
     119         CALL icb_accel( berg , zxi3, ze1, zuvel3, zuvel1, zax3,    & 
     120            &                   zyj3, ze2, zvvel3, zvvel1, zay3, zdt ) 
    121121         ! 
    122122         zu3 = zuvel3 / ze1                           !**   V3 in d(i,j)/dt 
    … …  
    129129         zyj4 = zyj1 + zdt * zv3   ;   zvvel4 = zvvel1 + zdt * zay3 
    130130 
    131          CALL adjust_to_ground( zxi4, zxi1, zu4,   & 
    132          &                      zyj4, zyj1, zv4, ll_bounced ) 
     131         CALL icb_ground( zxi4, zxi1, zu4,   & 
     132         &                zyj4, zyj1, zv4, ll_bounced ) 
    133133 
    134134         !                                         !**   A4 = A(X4,V4) 
    135          CALL accel( berg , zxi4, ze1, zuvel4, zuvel1, zax4,    & 
    136             &               zyj4, ze2, zvvel4, zvvel1, zay4, zdt ) 
     135         CALL icb_accel( berg , zxi4, ze1, zuvel4, zuvel1, zax4,    & 
     136            &                   zyj4, ze2, zvvel4, zvvel1, zay4, zdt ) 
    137137 
    138138         zu4 = zuvel4 / ze1                           !**   V4 in d(i,j)/dt 
    … …  
    148148         zvvel_n = pt%vvel + zdt_6 * (  zay1 + 2.*(zay2 + zay3) + zay4 ) 
    149149 
    150          CALL adjust_to_ground( zxi_n, zxi1, zuvel_n,   & 
     150         CALL icb_ground( zxi_n, zxi1, zuvel_n,   & 
    151151         &                      zyj_n, zyj1, zvvel_n, ll_bounced ) 
    152152 
    … …  
    157157 
    158158         ! update actual position 
    159          pt%lon  = bilin_x(glamt, pt%xi, pt%yj ) 
    160          pt%lat  = bilin(gphit, pt%xi, pt%yj, 'T', 0, 0 ) 
     159         pt%lon  = icb_utl_bilin_x(glamt, pt%xi, pt%yj ) 
     160         pt%lat  = icb_utl_bilin(gphit, pt%xi, pt%yj, 'T', 0, 0 ) 
    161161 
    162162         berg => berg%next                         ! switch to the next berg 
    … …  
    164164      END DO                                  !==  end loop over all bergs  ==! 
    165165      ! 
    166    END SUBROUTINE evolve_icebergs 
    167  
    168  
    169    SUBROUTINE adjust_to_ground( pi, pi0, pu,   & 
     166   END SUBROUTINE icb_dyn 
     167 
     168 
     169   SUBROUTINE icb_ground( pi, pi0, pu,   & 
    170170      &                         pj, pj0, pv, ld_bounced ) 
    171171      !!---------------------------------------------------------------------- 
    172       !!                  ***  ROUTINE adjust_to_ground  *** 
     172      !!                  ***  ROUTINE icb_ground  *** 
    173173      !! 
    174174      !! ** Purpose :   iceberg grounding. 
    … …  
    230230      END SELECT 
    231231      ! 
    232    END SUBROUTINE adjust_to_ground 
    233  
    234  
    235    SUBROUTINE accel( berg , pxi, pe1, puvel, puvel0, pax,                & 
    236       &                     pyj, pe2, pvvel, pvvel0, pay, pdt ) 
    237       !!---------------------------------------------------------------------- 
    238       !!                  ***  ROUTINE accel  *** 
     232   END SUBROUTINE icb_ground 
     233 
     234 
     235   SUBROUTINE icb_accel( berg , pxi, pe1, puvel, puvel0, pax,                & 
     236      &                         pyj, pe2, pvvel, pvvel0, pay, pdt ) 
     237      !!---------------------------------------------------------------------- 
     238      !!                  ***  ROUTINE icb_accel  *** 
    239239      !! 
    240240      !! ** Purpose :   compute the iceberg acceleration. 
    … …  
    268268      ! Interpolate gridded fields to berg 
    269269      nknberg = berg%number(1) 
    270       CALL interp_flds( pxi, pe1, zuo, zui, zua, zssh_x,                     & 
    271          &              pyj, pe2, zvo, zvi, zva, zssh_y, zsst, zcn, zhi, zff ) 
     270      CALL icb_utl_interp( pxi, pe1, zuo, zui, zua, zssh_x,                     & 
     271         &                 pyj, pe2, zvo, zvi, zva, zssh_y, zsst, zcn, zhi, zff ) 
    272272 
    273273      zM = berg%current_point%mass 
    … …  
    364364               zuveln = zuveln * ( zspeed_new / zspeed )        ! Scale velocity to reduce speed 
    365365               zvveln = zvveln * ( zspeed_new / zspeed )        ! without changing the direction 
    366                CALL speed_budget() 
     366               CALL icb_dia_speed() 
    367367            ENDIF 
    368368         ENDIF 
    … …  
    374374         WRITE(numicb,'("pe=",i3,x,a)') narea,'Dump triggered by excessive acceleration' 
    375375      ! 
    376    END SUBROUTINE accel 
     376   END SUBROUTINE icb_accel 
    377377 
    378378   !!====================================================================== 

  • branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90

    r3371 r3372  
    1212   !!---------------------------------------------------------------------- 
    1313   !!---------------------------------------------------------------------- 
    14    !!   icb_init      : initialise icebergs 
    15    !!   icb_gen       : generate test icebergs 
    16    !!   icb_nam       : read iceberg namelist 
     14   !!   icb_init     : initialise icebergs 
     15   !!   icb_ini_gen  : generate test icebergs 
     16   !!   icb_nam      : read iceberg namelist 
    1717   !!---------------------------------------------------------------------- 
    1818   USE dom_oce        ! ocean domain 
    … …  
    3434 
    3535   PUBLIC   icb_init  ! routine called in nemogcm.F90 module 
    36    PUBLIC   icb_gen   ! routine called in icbclv.F90 module 
    3736 
    3837   CHARACTER(len=100) ::   cn_dir = './'   ! Root directory for location of icb files 
    … …  
    244243 
    245244      IF( .NOT.ln_rstart ) THEN 
    246          IF( nn_test_icebergs > 0 )   CALL icb_gen() 
     245         IF( nn_test_icebergs > 0 )   CALL icb_ini_gen() 
    247246      ELSE 
    248247         IF( nn_test_icebergs > 0 ) THEN 
    249             CALL icb_gen() 
     248            CALL icb_ini_gen() 
    250249         ELSE 
    251             CALL icebergs_read_restart() 
    252              l_restarted_bergs = .TRUE. 
    253          ENDIF 
    254       ENDIF 
    255       ! 
    256       IF( nn_sample_rate .GT. 0 ) CALL traj_init( nitend ) 
    257       ! 
    258       CALL icb_budget_init() 
    259       ! 
    260       IF( nn_verbose_level >= 2 )   CALL print_bergs('icb_init, initial status', nit000-1) 
     250            CALL icb_rst_read() 
     251            l_restarted_bergs = .TRUE. 
     252         ENDIF 
     253      ENDIF 
     254      ! 
     255      IF( nn_sample_rate .GT. 0 ) CALL icb_trj_init( nitend ) 
     256      ! 
     257      CALL icb_dia_init() 
     258      ! 
     259      IF( nn_verbose_level >= 2 )   CALL icb_utl_print('icb_init, initial status', nit000-1) 
    261260      ! 
    262261   END SUBROUTINE icb_init 
    263262 
    264    SUBROUTINE icb_gen() 
    265       !!---------------------------------------------------------------------- 
    266       !!                  ***  ROUTINE icb_gen  *** 
     263   SUBROUTINE icb_ini_gen() 
     264      !!---------------------------------------------------------------------- 
     265      !!                  ***  ROUTINE icb_ini_gen  *** 
    267266      !! 
    268267      !! ** Purpose :   iceberg generation 
    269268      !! 
    270       !! ** Method  : - blah blah 
     269      !! ** Method  : - at each grid point of the test box supplied in the namelist 
     270      !!                generate an iceberg in one class determined by the value of 
     271      !!                parameter nn_test_icebergs 
    271272      !!---------------------------------------------------------------------- 
    272273      INTEGER                         ::   ji, jj, ibergs 
    … …  
    301302               localpt%xi = REAL( nimpp+ji-1, wp ) 
    302303               localpt%yj = REAL( njmpp+jj-1, wp ) 
    303                localpt%lon = bilin(glamt, localpt%xi, localpt%yj, 'T', 0, 0 ) 
    304                localpt%lat = bilin(gphit, localpt%xi, localpt%yj, 'T', 0, 0 ) 
     304               localpt%lon = icb_utl_bilin(glamt, localpt%xi, localpt%yj, 'T', 0, 0 ) 
     305               localpt%lat = icb_utl_bilin(gphit, localpt%xi, localpt%yj, 'T', 0, 0 ) 
    305306               localpt%mass      = rn_initial_mass     (iberg) 
    306307               localpt%thickness = rn_initial_thickness(iberg) 
    … …  
    313314               localpt%uvel = 0._wp 
    314315               localpt%vvel = 0._wp 
    315                CALL increment_kounter() 
     316               CALL icb_utl_incr() 
    316317               localberg%number(:) = num_bergs(:) 
    317                call add_new_berg_to_list(localberg, localpt) 
     318               call icb_utl_add(localberg, localpt) 
    318319            ENDIF 
    319320         END DO 
    320321      END DO 
    321322      ! 
    322       ibergs = count_bergs() 
     323      ibergs = icb_utl_count() 
    323324      IF( lk_mpp ) CALL mpp_sum(ibergs) 
    324       WRITE(numicb,'(a,i6,a)') 'diamonds, icb_gen: ',ibergs,' were generated' 
    325       ! 
    326    END SUBROUTINE icb_gen 
     325      WRITE(numicb,'(a,i6,a)') 'diamonds, icb_ini_gen: ',ibergs,' were generated' 
     326      ! 
     327   END SUBROUTINE icb_ini_gen 
    327328 
    328329   SUBROUTINE icb_nam 
    … …  
    381382      IF( zfact < 1._wp ) THEN 
    382383         IF( zfact <= 0._wp ) THEN 
    383             CALL ctl_stop( 'icb_init: sum of berg distribution equal to zero' ) 
     384            CALL ctl_stop( 'icb_nam: sum of berg distribution equal to zero' ) 
    384385         ELSE 
    385386            rn_distribution(:) = rn_distribution(:) / zfact 
    386             CALL ctl_warn( 'icb_init: sum of berg input distribution not equal to one and so RESCALED' ) 
     387            CALL ctl_warn( 'icb_nam: sum of berg input distribution not equal to one and so RESCALED' ) 
    387388         ENDIF 
    388389      ENDIF 

  • branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icblbc.F90

    r3370 r3372  
    1414   !!---------------------------------------------------------------------- 
    1515   !!---------------------------------------------------------------------- 
    16    !!   mpp_send_bergs   :  In MPP pass icebergs from linked list between processors 
    17    !!                       as they advect around 
    18    !!                       Lagrangian processes cannot be handled by existing NEMO MPP 
    19    !!                       routines because they do not lie on regular jpi,jpj grids 
    20    !!                       Processor exchanges are handled as in lib_mpp whenever icebergs step  
    21    !!                       across boundary of interior domain (nicbdi-nicbei, nicbdj-nicbej) 
    22    !!                       so that iceberg does not exist in more than one processor 
    23    !!                       North fold exchanges controlled by three arrays: 
    24    !!                          nicbflddest - unique processor numbers that current one exchanges with 
    25    !!                          nicbfldproc - processor number that current grid point exchanges with 
    26    !!                          nicbfldpts  - packed i,j point in exchanging processor 
     16   !!   icb_lbc       :  Pass icebergs across cyclic boundaries 
     17   !!   icb_lbc_mpp   :  In MPP pass icebergs from linked list between processors 
     18   !!                    as they advect around 
     19   !!                    Lagrangian processes cannot be handled by existing NEMO MPP 
     20   !!                    routines because they do not lie on regular jpi,jpj grids 
     21   !!                    Processor exchanges are handled as in lib_mpp whenever icebergs step  
     22   !!                    across boundary of interior domain (nicbdi-nicbei, nicbdj-nicbej) 
     23   !!                    so that iceberg does not exist in more than one processor 
     24   !!                    North fold exchanges controlled by three arrays: 
     25   !!                       nicbflddest - unique processor numbers that current one exchanges with 
     26   !!                       nicbfldproc - processor number that current grid point exchanges with 
     27   !!                       nicbfldpts  - packed i,j point in exchanging processor 
    2728   !!---------------------------------------------------------------------- 
    2829 
    … …  
    6162#endif 
    6263 
    63    PUBLIC   lbc_send_bergs 
    64    PRIVATE  lbc_nfld_bergs 
    65    PUBLIC   mpp_send_bergs 
    66    PUBLIC   dealloc_buffers 
    67  
    68 #if defined key_mpp_mpi 
    69    PRIVATE  mpp_nfld_bergs 
    70    PRIVATE  dealloc_buffer 
    71    PRIVATE  pack_berg_into_buffer 
    72    PRIVATE  unpack_berg_from_buffer 
    73    PRIVATE  increase_buffer 
    74    PRIVATE  increase_ibuffer 
    75 #endif 
     64   PUBLIC   icb_lbc 
     65   PUBLIC   icb_lbc_mpp 
    7666 
    7767   !!---------------------------------------------------------------------- 
    … …  
    8272CONTAINS 
    8373 
    84    SUBROUTINE lbc_send_bergs() 
    85       !!---------------------------------------------------------------------- 
    86       !!                 ***  SUBROUTINE lbc_send_bergs  *** 
     74   SUBROUTINE icb_lbc() 
     75      !!---------------------------------------------------------------------- 
     76      !!                 ***  SUBROUTINE icb_lbc  *** 
    8777      !! 
    8878      !! ** Purpose :   in non-mpp case need to deal with cyclic conditions 
    … …  
    118108      IF( nperio == 2 )   CALL ctl_stop(' south symmetric condition not implemented for icebergs') 
    119109      ! north fold 
    120       IF( nperio == 3 .OR. nperio == 4 .OR. nperio == 5 .OR. nperio == 6 )   CALL lbc_nfld_bergs() 
    121       ! 
    122    END SUBROUTINE lbc_send_bergs 
    123  
    124  
    125    SUBROUTINE lbc_nfld_bergs() 
    126       !!---------------------------------------------------------------------- 
    127       !!                 ***  SUBROUTINE lbc_nfld_bergs  *** 
     110      IF( nperio == 3 .OR. nperio == 4 .OR. nperio == 5 .OR. nperio == 6 )   CALL icb_lbc_nfld() 
     111      ! 
     112   END SUBROUTINE icb_lbc 
     113 
     114 
     115   SUBROUTINE icb_lbc_nfld() 
     116      !!---------------------------------------------------------------------- 
     117      !!                 ***  SUBROUTINE icb_lbc_nfld  *** 
    128118      !! 
    129119      !! ** Purpose :   single processor north fold exchange 
    … …  
    156146      END DO 
    157147      ! 
    158    END SUBROUTINE lbc_nfld_bergs 
     148   END SUBROUTINE icb_lbc_nfld 
    159149 
    160150#if defined key_mpp_mpi 
    … …  
    163153   !!---------------------------------------------------------------------- 
    164154 
    165    SUBROUTINE mpp_send_bergs() 
    166       !!---------------------------------------------------------------------- 
    167       !!                 ***  SUBROUTINE mpp_send_bergs  *** 
     155   SUBROUTINE icb_lbc_mpp() 
     156      !!---------------------------------------------------------------------- 
     157      !!                 ***  SUBROUTINE icb_lbc_mpp  *** 
    168158      !! 
    169159      !! ** Purpose :   multi processor exchange 
    … …  
    221211      ! periodicity is handled here when using mpp when there is more than one processor in 
    222212      ! the i direction, but it also has to happen when jpni=1 case so this is dealt with 
    223       ! in lbc_send_bergs and called here 
    224  
    225       IF( jpni == 1 ) CALL lbc_send_bergs() 
     213      ! in icb_lbc and called here 
     214 
     215      IF( jpni == 1 ) CALL icb_lbc() 
    226216 
    227217      ! Note that xi is adjusted when swapping because of periodic condition 
    … …  
    229219      IF( nn_verbose_level > 0 ) THEN 
    230220         ! store the number of icebergs on this processor at start 
    231          ibergs_start = count_bergs() 
     221         ibergs_start = icb_utl_count() 
    232222      ENDIF 
    233223 
    … …  
    257247               tmpberg%current_point%xi = ricb_right + MOD(tmpberg%current_point%xi, 1._wp ) - 1._wp 
    258248               ! now pack it into buffer and delete from list 
    259                CALL pack_berg_into_buffer( tmpberg, obuffer_e, ibergs_to_send_e) 
    260                CALL delete_iceberg_from_list(first_berg, tmpberg) 
     249               CALL icb_pack_into_buffer( tmpberg, obuffer_e, ibergs_to_send_e) 
     250               CALL icb_utl_delete(first_berg, tmpberg) 
    261251            ELSE IF( ipe_W >= 0 .AND. iine < nimpp+nicbdi-1 ) THEN 
    262252               tmpberg => this 
    … …  
    270260               tmpberg%current_point%xi = ricb_left + MOD(tmpberg%current_point%xi, 1._wp ) 
    271261               ! now pack it into buffer and delete from list 
    272                CALL pack_berg_into_buffer( tmpberg, obuffer_w, ibergs_to_send_w) 
    273                CALL delete_iceberg_from_list(first_berg, tmpberg) 
     262               CALL icb_pack_into_buffer( tmpberg, obuffer_w, ibergs_to_send_w) 
     263               CALL icb_utl_delete(first_berg, tmpberg) 
    274264            ELSE 
    275265               this => this%next 
    … …  
    320310         IF( ibergs_to_send_e > 0 ) CALL mppsend( 14, obuffer_e%data, ibergs_to_send_e*jp_buffer_width, ipe_E, iml_req1 ) 
    321311         IF( ibergs_rcvd_from_e > 0 ) THEN 
    322             CALL increase_ibuffer(ibuffer_e, ibergs_rcvd_from_e) 
     312            CALL icb_increase_ibuffer(ibuffer_e, ibergs_rcvd_from_e) 
    323313            CALL mpprecv( 13, ibuffer_e%data, ibergs_rcvd_from_e*jp_buffer_width ) 
    324314         ENDIF 
    … …  
    329319               CALL flush( numicb ) 
    330320            ENDIF 
    331             CALL unpack_berg_from_buffer(first_berg, ibuffer_e, i) 
     321            CALL icb_unpack_from_buffer(first_berg, ibuffer_e, i) 
    332322         ENDDO 
    333323      CASE(  0 ) 
    … …  
    335325         IF( ibergs_to_send_e > 0 ) CALL mppsend( 14, obuffer_e%data, ibergs_to_send_e*jp_buffer_width, ipe_E, iml_req3 ) 
    336326         IF( ibergs_rcvd_from_e > 0 ) THEN 
    337             CALL increase_ibuffer(ibuffer_e, ibergs_rcvd_from_e) 
     327            CALL icb_increase_ibuffer(ibuffer_e, ibergs_rcvd_from_e) 
    338328            CALL mpprecv( 13, ibuffer_e%data, ibergs_rcvd_from_e*jp_buffer_width ) 
    339329         ENDIF 
    340330         IF( ibergs_rcvd_from_w > 0 ) THEN 
    341             CALL increase_ibuffer(ibuffer_w, ibergs_rcvd_from_w) 
     331            CALL icb_increase_ibuffer(ibuffer_w, ibergs_rcvd_from_w) 
    342332            CALL mpprecv( 14, ibuffer_w%data, ibergs_rcvd_from_w*jp_buffer_width ) 
    343333         ENDIF 
    … …  
    349339               CALL flush( numicb ) 
    350340            ENDIF 
    351             CALL unpack_berg_from_buffer(first_berg, ibuffer_e, i) 
     341            CALL icb_unpack_from_buffer(first_berg, ibuffer_e, i) 
    352342         END DO 
    353343         DO i = 1, ibergs_rcvd_from_w 
    … …  
    356346               CALL flush( numicb ) 
    357347            ENDIF 
    358             CALL unpack_berg_from_buffer(first_berg, ibuffer_w, i) 
     348            CALL icb_unpack_from_buffer(first_berg, ibuffer_w, i) 
    359349         ENDDO 
    360350      CASE(  1 ) 
    361351         IF( ibergs_to_send_w > 0 ) CALL mppsend( 13, obuffer_w%data, ibergs_to_send_w*jp_buffer_width, ipe_W, iml_req4 ) 
    362352         IF( ibergs_rcvd_from_w > 0 ) THEN 
    363             CALL increase_ibuffer(ibuffer_w, ibergs_rcvd_from_w) 
     353            CALL icb_increase_ibuffer(ibuffer_w, ibergs_rcvd_from_w) 
    364354            CALL mpprecv( 14, ibuffer_w%data, ibergs_rcvd_from_w*jp_buffer_width ) 
    365355         ENDIF 
    … …  
    370360               CALL flush( numicb ) 
    371361            ENDIF 
    372             CALL unpack_berg_from_buffer(first_berg, ibuffer_w, i) 
     362            CALL icb_unpack_from_buffer(first_berg, ibuffer_w, i) 
    373363         END DO 
    374364      END SELECT 
    … …  
    392382                  CALL flush( numicb ) 
    393383               ENDIF 
    394                CALL pack_berg_into_buffer( tmpberg, obuffer_n, ibergs_to_send_n) 
    395                CALL delete_iceberg_from_list(first_berg, tmpberg) 
     384               CALL icb_pack_into_buffer( tmpberg, obuffer_n, ibergs_to_send_n) 
     385               CALL icb_utl_delete(first_berg, tmpberg) 
    396386            ELSE IF( ipe_S >= 0 .AND. ijne .LT. njmpp+nicbdj-1 ) THEN 
    397387               tmpberg => this 
    … …  
    402392                  CALL flush( numicb ) 
    403393               ENDIF 
    404                CALL pack_berg_into_buffer( tmpberg, obuffer_s, ibergs_to_send_s) 
    405                CALL delete_iceberg_from_list(first_berg, tmpberg) 
     394               CALL icb_pack_into_buffer( tmpberg, obuffer_s, ibergs_to_send_s) 
     395               CALL icb_utl_delete(first_berg, tmpberg) 
    406396            ELSE 
    407397               this => this%next 
    … …  
    451441         IF( ibergs_to_send_n > 0 ) CALL mppsend( 18, obuffer_n%data, ibergs_to_send_n*jp_buffer_width, ipe_N, iml_req1 ) 
    452442         IF( ibergs_rcvd_from_n > 0 ) THEN 
    453             CALL increase_ibuffer(ibuffer_n, ibergs_rcvd_from_n) 
     443            CALL icb_increase_ibuffer(ibuffer_n, ibergs_rcvd_from_n) 
    454444            CALL mpprecv( 17, ibuffer_n%data, ibergs_rcvd_from_n*jp_buffer_width ) 
    455445         ENDIF 
    … …  
    460450               CALL flush( numicb ) 
    461451            ENDIF 
    462             CALL unpack_berg_from_buffer(first_berg, ibuffer_n, i) 
     452            CALL icb_unpack_from_buffer(first_berg, ibuffer_n, i) 
    463453         END DO 
    464454      CASE(  0 ) 
    … …  
    466456         IF( ibergs_to_send_n > 0 ) CALL mppsend( 18, obuffer_n%data, ibergs_to_send_n*jp_buffer_width, ipe_N, iml_req3 ) 
    467457         IF( ibergs_rcvd_from_n > 0 ) THEN 
    468             CALL increase_ibuffer(ibuffer_n, ibergs_rcvd_from_n) 
     458            CALL icb_increase_ibuffer(ibuffer_n, ibergs_rcvd_from_n) 
    469459            CALL mpprecv( 17, ibuffer_n%data, ibergs_rcvd_from_n*jp_buffer_width ) 
    470460         ENDIF 
    471461         IF( ibergs_rcvd_from_s > 0 ) THEN 
    472             CALL increase_ibuffer(ibuffer_s, ibergs_rcvd_from_s) 
     462            CALL icb_increase_ibuffer(ibuffer_s, ibergs_rcvd_from_s) 
    473463            CALL mpprecv( 18, ibuffer_s%data, ibergs_rcvd_from_s*jp_buffer_width ) 
    474464         ENDIF 
    … …  
    480470               CALL flush( numicb ) 
    481471            ENDIF 
    482             CALL unpack_berg_from_buffer(first_berg, ibuffer_n, i) 
     472            CALL icb_unpack_from_buffer(first_berg, ibuffer_n, i) 
    483473         END DO 
    484474         DO i = 1, ibergs_rcvd_from_s 
    … …  
    487477               CALL flush( numicb ) 
    488478            ENDIF 
    489             CALL unpack_berg_from_buffer(first_berg, ibuffer_s, i) 
     479            CALL icb_unpack_from_buffer(first_berg, ibuffer_s, i) 
    490480         ENDDO 
    491481      CASE(  1 ) 
    492482         IF( ibergs_to_send_s > 0 ) CALL mppsend( 17, obuffer_s%data, ibergs_to_send_s*jp_buffer_width, ipe_S, iml_req4 ) 
    493483         IF( ibergs_rcvd_from_s > 0 ) THEN 
    494             CALL increase_ibuffer(ibuffer_s, ibergs_rcvd_from_s) 
     484            CALL icb_increase_ibuffer(ibuffer_s, ibergs_rcvd_from_s) 
    495485            CALL mpprecv( 18, ibuffer_s%data, ibergs_rcvd_from_s*jp_buffer_width ) 
    496486         ENDIF 
    … …  
    501491               CALL flush( numicb ) 
    502492            ENDIF 
    503             CALL unpack_berg_from_buffer(first_berg, ibuffer_s, i) 
     493            CALL icb_unpack_from_buffer(first_berg, ibuffer_s, i) 
    504494         END DO 
    505495      END SELECT 
    … …  
    507497      IF( nn_verbose_level > 0 ) THEN 
    508498         ! compare the number of icebergs on this processor from the start to the end 
    509          ibergs_end = count_bergs() 
     499         ibergs_end = icb_utl_count() 
    510500         i = ( ibergs_rcvd_from_n + ibergs_rcvd_from_s + ibergs_rcvd_from_e + ibergs_rcvd_from_w ) - & 
    511501             ( ibergs_to_send_n + ibergs_to_send_s + ibergs_to_send_e + ibergs_to_send_w ) 
    … …  
    542532 
    543533      ! deal with north fold if we necessary when there is more than one top row processor 
    544       ! note that for jpni=1 north fold has been dealt with above in call to lbc_send_bergs 
    545       IF( npolj /= 0 .AND. jpni > 1 ) CALL mpp_nfld_bergs( ) 
     534      ! note that for jpni=1 north fold has been dealt with above in call to icb_lbc 
     535      IF( npolj /= 0 .AND. jpni > 1 ) CALL icb_lbc_mpp_nfld( ) 
    546536 
    547537      IF( nn_verbose_level > 0 ) THEN 
    … …  
    574564      CALL mppsync() 
    575565      ! 
    576    END SUBROUTINE mpp_send_bergs 
    577  
    578  
    579    SUBROUTINE mpp_nfld_bergs() 
    580       !!---------------------------------------------------------------------- 
    581       !!                 ***  SUBROUTINE mpp_nfld_bergs  *** 
     566   END SUBROUTINE icb_lbc_mpp 
     567 
     568 
     569   SUBROUTINE icb_lbc_mpp_nfld() 
     570      !!---------------------------------------------------------------------- 
     571      !!                 ***  SUBROUTINE icb_lbc_mpp_nfld  *** 
    582572      !! 
    583573      !! ** Purpose :   north fold treatment in multi processor exchange 
    … …  
    639629                           CALL flush( numicb ) 
    640630                        ENDIF 
    641                         CALL pack_berg_into_buffer( tmpberg, obuffer_f, ibergs_to_send) 
    642                         CALL delete_iceberg_from_list(first_berg, tmpberg) 
     631                        CALL icb_pack_into_buffer( tmpberg, obuffer_f, ibergs_to_send) 
     632                        CALL icb_utl_delete(first_berg, tmpberg) 
    643633                     ENDIF 
    644634                     ! 
    … …  
    668658             CALL mppsend( 12, obuffer_f%data, ibergs_to_send*jp_buffer_width, ifldproc-1, iml_req2 ) 
    669659         IF( ibergs_to_rcv  > 0 ) THEN 
    670             CALL increase_ibuffer(ibuffer_f, ibergs_to_rcv) 
     660            CALL icb_increase_ibuffer(ibuffer_f, ibergs_to_rcv) 
    671661            CALL mpprecv( 12, ibuffer_f%data, ibergs_to_rcv*jp_buffer_width ) 
    672662         ENDIF 
    … …  
    677667               CALL flush( numicb ) 
    678668            ENDIF 
    679             CALL unpack_berg_from_buffer(first_berg, ibuffer_f, jk ) 
     669            CALL icb_unpack_from_buffer(first_berg, ibuffer_f, jk ) 
    680670         END DO 
    681671         ! 
    682672      END DO 
    683673      ! 
    684    END SUBROUTINE mpp_nfld_bergs 
    685  
    686  
    687    SUBROUTINE dealloc_buffers() 
    688       !!---------------------------------------------------------------------- 
    689       !!---------------------------------------------------------------------- 
    690       CALL dealloc_buffer( obuffer_n ) 
    691       CALL dealloc_buffer( obuffer_s ) 
    692       CALL dealloc_buffer( obuffer_e ) 
    693       CALL dealloc_buffer( obuffer_w ) 
    694       CALL dealloc_buffer( ibuffer_n ) 
    695       CALL dealloc_buffer( ibuffer_s ) 
    696       CALL dealloc_buffer( ibuffer_e ) 
    697       CALL dealloc_buffer( ibuffer_w ) 
    698  
    699    END SUBROUTINE dealloc_buffers 
    700  
    701  
    702    SUBROUTINE dealloc_buffer( pbuff ) 
    703       !!---------------------------------------------------------------------- 
    704       !!---------------------------------------------------------------------- 
    705       TYPE(buffer), POINTER :: pbuff 
    706       !!---------------------------------------------------------------------- 
    707       IF( ASSOCIATED(pbuff) ) THEN 
    708          IF( ASSOCIATED(pbuff%data)) DEALLOCATE(pbuff%data) 
    709          DEALLOCATE(pbuff) 
    710       ENDIF 
    711    END SUBROUTINE dealloc_buffer 
    712  
    713  
    714    SUBROUTINE pack_berg_into_buffer( berg, pbuff, kb ) 
     674   END SUBROUTINE icb_lbc_mpp_nfld 
     675 
     676 
     677   SUBROUTINE icb_pack_into_buffer( berg, pbuff, kb ) 
    715678      !!---------------------------------------------------------------------- 
    716679      !!---------------------------------------------------------------------- 
    … …  
    722685      !!---------------------------------------------------------------------- 
    723686      ! 
    724       IF( .NOT. ASSOCIATED(pbuff) ) CALL increase_buffer( pbuff, jp_delta_buf ) 
    725       IF( kb .GT. pbuff%size ) CALL increase_buffer( pbuff, jp_delta_buf ) 
     687      IF( .NOT. ASSOCIATED(pbuff) ) CALL icb_increase_buffer( pbuff, jp_delta_buf ) 
     688      IF( kb .GT. pbuff%size ) CALL icb_increase_buffer( pbuff, jp_delta_buf ) 
    726689 
    727690      !! pack points into buffer 
    … …  
    747710      END DO 
    748711      ! 
    749    END SUBROUTINE pack_berg_into_buffer 
    750  
    751  
    752    SUBROUTINE unpack_berg_from_buffer(first, pbuff, kb) 
     712   END SUBROUTINE icb_pack_into_buffer 
     713 
     714 
     715   SUBROUTINE icb_unpack_from_buffer(first, pbuff, kb) 
    753716      !!---------------------------------------------------------------------- 
    754717      !!---------------------------------------------------------------------- 
    … …  
    782745      END DO 
    783746      ! 
    784       CALL add_new_berg_to_list(currentberg, pt ) 
    785       ! 
    786    END SUBROUTINE unpack_berg_from_buffer 
    787  
    788  
    789    SUBROUTINE increase_buffer(old,kdelta) 
     747      CALL icb_utl_add(currentberg, pt ) 
     748      ! 
     749   END SUBROUTINE icb_unpack_from_buffer 
     750 
     751 
     752   SUBROUTINE icb_increase_buffer(old,kdelta) 
    790753      !!---------------------------------------------------------------------- 
    791754      TYPE(buffer), POINTER    :: old 
    … …  
    809772      old => new 
    810773      ! 
    811    END SUBROUTINE increase_buffer 
    812  
    813  
    814    SUBROUTINE increase_ibuffer(old,kdelta) 
     774   END SUBROUTINE icb_increase_buffer 
     775 
     776 
     777   SUBROUTINE icb_increase_ibuffer(old,kdelta) 
    815778      !!---------------------------------------------------------------------- 
    816779      !!---------------------------------------------------------------------- 
    … …  
    844807         ENDIF 
    845808         old => new 
    846         !WRITE( numicb,*) 'increase_ibuffer',narea,' increased to',inew_size 
    847       ENDIF 
    848       ! 
    849    END SUBROUTINE increase_ibuffer 
     809        !WRITE( numicb,*) 'icb_increase_ibuffer',narea,' increased to',inew_size 
     810      ENDIF 
     811      ! 
     812   END SUBROUTINE icb_increase_ibuffer 
    850813 
    851814#else 
    … …  
    853816   !!   Default case:            Dummy module        share memory computing 
    854817   !!---------------------------------------------------------------------- 
    855    SUBROUTINE mpp_send_bergs() 
    856       WRITE(numout,*) 'mpp_send_bergs: You should not have seen this message!!' 
    857    END SUBROUTINE mpp_send_bergs 
    858  
    859    SUBROUTINE dealloc_buffers() 
    860       WRITE(numout,*) 'dealloc_buffers: You should not have seen this message!!' 
    861    END SUBROUTINE dealloc_buffers 
     818   SUBROUTINE icb_lbc_mpp() 
     819      WRITE(numout,*) 'icb_lbc_mpp: You should not have seen this message!!' 
     820   END SUBROUTINE icb_lbc_mpp 
    862821 
    863822#endif 

  • branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90

    r3370 r3372  
    1414   !!---------------------------------------------------------------------- 
    1515   !!---------------------------------------------------------------------- 
    16    !!   icebergs_read_restart    : initialise                      !!gm suggested name : icebergs_rst_read  or better icb_rst_read 
    17    !!   icebergs_write_restart   : generate test icebergs          !!gm                  icebergs_rst_write or better icb_rst_write 
     16   !!   icb_rst_read    : initialise                      !!gm suggested name : icebergs_rst_read  or better icb_rst_read 
     17   !!   icb_rst_write   : generate test icebergs          !!gm                  icebergs_rst_write or better icb_rst_write 
    1818   !!---------------------------------------------------------------------- 
    1919   USE par_oce        ! NEMO parameters 
    … …  
    2828   PRIVATE 
    2929 
    30    PUBLIC   icebergs_read_restart    ! routine called in icbini.F90 module 
    31    PUBLIC   icebergs_write_restart   ! routine called in icbrun.F90 module 
     30   PUBLIC   icb_rst_read    ! routine called in icbini.F90 module 
     31   PUBLIC   icb_rst_write   ! routine called in icbrun.F90 module 
    3232    
    3333   INTEGER ::   nlonid, nlatid, nxid, nyid, nuvelid, nvvelid 
    … …  
    4848CONTAINS 
    4949 
    50    SUBROUTINE icebergs_read_restart() 
    51       !!---------------------------------------------------------------------- 
    52       !!                 ***  SUBROUTINE icebergs_read_restart  *** 
     50   SUBROUTINE icb_rst_read() 
     51      !!---------------------------------------------------------------------- 
     52      !!                 ***  SUBROUTINE icb_rst_read  *** 
    5353      !! 
    5454      !! ** Purpose :   read a iceberg restart file 
    … …  
    176176            localpt%heat_density = zdata(1) 
    177177            ! 
    178             CALL add_new_berg_to_list( localberg, localpt ) 
     178            CALL icb_utl_add( localberg, localpt ) 
    179179         END DO 
    180180         ! 
    … …  
    216216 
    217217      ! Sanity check 
    218       jn = count_bergs() 
     218      jn = icb_utl_count() 
    219219      IF (nn_verbose_level >= 0)   & 
    220220         WRITE(numout,'(2(a,i5))') 'icebergs, read_restart_bergs: # bergs =',jn,' on PE',narea-1 
    … …  
    228228      IF( lwp .and. nn_verbose_level >= 0)  WRITE(numout,'(a)') 'icebergs, read_restart_bergs: completed' 
    229229      ! 
    230    END SUBROUTINE icebergs_read_restart 
    231  
    232  
    233    SUBROUTINE icebergs_write_restart( kt ) 
    234       !!---------------------------------------------------------------------- 
    235       !!                 ***  SUBROUTINE icebergs_write_restart  *** 
     230   END SUBROUTINE icb_rst_read 
     231 
     232 
     233   SUBROUTINE icb_rst_write( kt ) 
     234      !!---------------------------------------------------------------------- 
     235      !!                 ***  SUBROUTINE icb_rst_write  *** 
    236236      !! 
    237237      !!---------------------------------------------------------------------- 
    … …  
    420420      IF (nret /= NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_close failed') 
    421421      ! 
    422    END SUBROUTINE icebergs_write_restart 
     422   END SUBROUTINE icb_rst_write 
    423423   ! 
    424424END MODULE icbrst 

  • branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icbrun.F90

    r3370 r3372  
    7777 
    7878      ! anything that needs to be reset to zero each timestep for budgets is dealt with here 
    79       CALL icb_budget_step() 
     79      CALL icb_dia_step() 
    8080 
    8181      ! Manage time 
    … …  
    8989      isec = nsec_day - ihr*3600 - imin*60 
    9090      current_year    = iyr 
    91       current_yearday = yearday(imon, iday, ihr, imin, isec) 
     91      current_yearday = icb_utl_yearday(imon, iday, ihr, imin, isec) 
    9292 
    9393      ll_verbose = .FALSE. 
    … …  
    100100      ! copy nemo forcing arrays into iceberg versions with extra halo 
    101101      ! only necessary for variables not on T points 
    102       CALL copy_flds() 
     102      CALL icb_utl_copy() 
    103103 
    104104      !!---------------------------------------------------------------------- 
    105105      !! process icebergs 
    106106 
    107                                      CALL accumulate_calving( kt )   ! Accumulate ice from calving 
    108  
    109                                      CALL calve_icebergs()           ! Calve excess stored ice into icebergs 
    110  
    111  
    112       !                               !==  For each berg, evolve  ==! 
    113       ! 
    114       IF( ASSOCIATED(first_berg) )   CALL evolve_icebergs()          ! ice berg dynamics 
    115  
    116       IF( lk_mpp ) THEN          ;   CALL mpp_send_bergs ()          ! Send bergs to other PEs 
    117       ELSE                       ;   CALL lbc_send_bergs()           ! Deal with any cyclic boundaries in non-mpp case 
     107                                     CALL icb_clv_flx( kt )   ! Accumulate ice from calving 
     108 
     109                                     CALL icb_clv()           ! Calve excess stored ice into icebergs 
     110 
     111 
     112!                               !==  For each berg, evolve  ==! 
     113      ! 
     114      IF( ASSOCIATED(first_berg) )   CALL icb_dyn()           ! ice berg dynamics 
     115 
     116      IF( lk_mpp ) THEN          ;   CALL icb_lbc_mpp()       ! Send bergs to other PEs 
     117      ELSE                       ;   CALL icb_lbc()           ! Deal with any cyclic boundaries in non-mpp case 
    118118      ENDIF 
    119119 
    120       IF( ASSOCIATED(first_berg) )   CALL thermodynamics ( kt )      ! Ice berg thermodynamics (melting) + rolling 
     120      IF( ASSOCIATED(first_berg) )   CALL icb_thm( kt )       ! Ice berg thermodynamics (melting) + rolling 
    121121 
    122122      !!---------------------------------------------------------------------- 
    … …  
    126126      IF( nn_sample_rate > 0 .AND. MOD(kt-1,nn_sample_rate) == 0 )   ll_sample_traj = .TRUE. 
    127127      IF( ll_sample_traj .AND.   & 
    128           ASSOCIATED(first_berg) )   CALL traj_write    ( kt )  ! For each berg, record trajectory 
     128          ASSOCIATED(first_berg) )   CALL icb_trj_write( kt )  ! For each berg, record trajectory 
    129129 
    130130      ! Gridded diagnostics 
    … …  
    136136      CALL iom_put( "berg_stored_ice"   , berg_grid%stored_ice   (:,:,:) )  ! 'Accumulated ice mass by class', 'kg' 
    137137 
    138       ! write out mean budgets 
    139       CALL icb_budget_put() 
     138      ! store mean budgets 
     139      CALL icb_dia_put() 
    140140 
    141141      ! Dump icebergs to screen 
    142       if ( nn_verbose_level >= 2 )   CALL print_bergs( 'icb_stp, status', kt ) 
     142      if ( nn_verbose_level >= 2 )   CALL icb_utl_print( 'icb_stp, status', kt ) 
    143143 
    144144      ! Diagnose budgets 
    145145      ll_budget = .FALSE. 
    146146      IF( nn_verbose_write > 0 .AND. MOD(kt-1,nn_verbose_write) == 0 )   ll_budget = ln_bergdia 
    147       CALL icb_budget( ll_budget ) 
     147      CALL icb_dia( ll_budget ) 
    148148 
    149149      IF( MOD(kt,nn_stock) == 0 ) THEN 
    150          CALL icebergs_write_restart( kt ) 
    151          IF( nn_sample_rate > 0 )   CALL traj_sync() 
     150         CALL icb_rst_write( kt ) 
     151         IF( nn_sample_rate > 0 )   CALL icb_trj_sync() 
    152152      ENDIF 
    153153 
    … …  
    160160      !!                  ***  ROUTINE icb_end  *** 
    161161      !! 
    162       !! ** Purpose :   deallocate icebergs arrays and  
     162      !! ** Purpose :   close iceberg files 
    163163      !! 
    164164      !!---------------------------------------------------------------------- 
    … …  
    184184      DEALLOCATE( nicbfldproc ) 
    185185 
    186       IF( lk_mpp ) CALL dealloc_buffers() 
    187  
    188186      IF (.NOT.ASSOCIATED(berg_grid)) RETURN 
    189187 
    190188      ! only write a restart if not done in icb_stp 
    191       IF( MOD(kt,nn_stock) .NE. 0 ) CALL icebergs_write_restart( kt ) 
     189      IF( MOD(kt,nn_stock) .NE. 0 ) CALL icb_rst_write( kt ) 
    192190 
    193191      ! finish with trajectories if they were written 
    194       IF( nn_sample_rate .GT. 0 ) CALL traj_end() 
     192      IF( nn_sample_rate .GT. 0 ) CALL icb_trj_end() 
    195193 
    196194      ! Delete bergs and structures 
    … …  
    198196      DO WHILE (ASSOCIATED(this)) 
    199197        next=>this%next 
    200         CALL destroy_iceberg(this) 
     198        CALL icb_utl_destroy(this) 
    201199        this=>next 
    202200      END DO 
    203201 
    204       CALL icb_budget_end() 
     202      CALL icb_dia_end() 
    205203 
    206204      DEALLOCATE(berg_grid%calving) 

  • branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icbthm.F90

    r3370 r3372  
    1212   !!---------------------------------------------------------------------- 
    1313   !!---------------------------------------------------------------------- 
    14    !!   thermodynamics : initialise 
    15    !!                    reference for equations - M = Martin + Adcroft, OM 34, 2010 
     14   !!   icb_thm : initialise 
     15   !!             reference for equations - M = Martin + Adcroft, OM 34, 2010 
    1616   !!---------------------------------------------------------------------- 
    1717   USE par_oce        ! NEMO parameters 
    … …  
    2929   PRIVATE 
    3030 
    31    PUBLIC   thermodynamics ! routine called in icbrun.F90 module 
     31   PUBLIC   icb_thm ! routine called in icbrun.F90 module 
    3232 
    3333CONTAINS 
    3434 
    35    SUBROUTINE thermodynamics( kt ) 
     35   SUBROUTINE icb_thm( kt ) 
    3636      !!---------------------------------------------------------------------- 
    37       !!                  ***  ROUTINE thermodynamics  *** 
     37      !!                  ***  ROUTINE icb_thm  *** 
    3838      !! 
    3939      !! ** Purpose :   compute the iceberg thermodynamics. 
    … …  
    4141      !! ** Method  : - blah blah 
    4242      !!---------------------------------------------------------------------- 
    43       INTEGER, INTENT(in) ::   kt   ! timestep number, just passed to print_berg 
     43      INTEGER, INTENT(in) ::   kt   ! timestep number, just passed to icb_utl_print_berg 
    4444      ! 
    4545      INTEGER  ::   ii, ij 
    … …  
    6868         pt => this%current_point 
    6969         nknberg = this%number(1) 
    70          CALL interp_flds( pt%xi, pt%e1, pt%uo, pt%ui, pt%ua, pt%ssh_x, & 
    71          &                 pt%yj, pt%e2, pt%vo, pt%vi, pt%va, pt%ssh_y, & 
     70         CALL icb_utl_interp( pt%xi, pt%e1, pt%uo, pt%ui, pt%ua, pt%ssh_x, & 
     71         &                    pt%yj, pt%e2, pt%vo, pt%vi, pt%va, pt%ssh_y, & 
    7272         &                 pt%sst, pt%cn, pt%hi, zff ) 
    7373         ! 
    … …  
    159159            zheat = zmelt * pt%heat_density              ! kg/s x J/kg = J/s 
    160160            berg_grid%calving_hflx (ii,ij) = berg_grid%calving_hflx (ii,ij) + zheat    * z1_e1e2    ! W/m2 
    161             CALL melt_budget( ii, ij, zMnew, zheat, this%mass_scaling,       & 
    162             &                         zdM, zdMbitsE, zdMbitsM, zdMb, zdMe,   & 
    163             &                         zdMv, z1_dt_e1e2 ) 
     161            CALL icb_dia_melt( ii, ij, zMnew, zheat, this%mass_scaling,       & 
     162            &                          zdM, zdMbitsE, zdMbitsM, zdMb, zdMe,   & 
     163            &                          zdMv, z1_dt_e1e2 ) 
    164164         ELSE 
    165             WRITE(numout,*) 'thermodynamics: berg ',this%number(:),' appears to have grounded  at ',narea,ii,ij 
    166             CALL print_berg( this, kt ) 
     165            WRITE(numout,*) 'icb_thm: berg ',this%number(:),' appears to have grounded  at ',narea,ii,ij 
     166            CALL icb_utl_print_berg( this, kt ) 
    167167            WRITE(numout,*) 'msk=',tmask(ii,ij,1), e1e2t(ii,ij) 
    168             CALL ctl_stop('thermodynamics', 'berg appears to have grounded!') 
     168            CALL ctl_stop('icb_thm', 'berg appears to have grounded!') 
    169169         ENDIF 
    170170 
    … …  
    189189 
    190190         IF( zMnew <= 0._wp ) THEN       ! Delete the berg if completely melted 
    191             CALL delete_iceberg_from_list( first_berg, this ) 
     191            CALL icb_utl_delete( first_berg, this ) 
    192192            ! 
    193193         ELSE                            ! Diagnose mass distribution on grid 
    194194            z1_e1e2 = 1._wp / e1e2t(ii,ij) * this%mass_scaling 
    195             CALL size_budget( ii, ij, zWn, zLn, zAbits,   & 
    196             &                 this%mass_scaling, zMnew, znMbits, z1_e1e2) 
     195            CALL icb_dia_size( ii, ij, zWn, zLn, zAbits,   & 
     196            &                  this%mass_scaling, zMnew, znMbits, z1_e1e2) 
    197197         ENDIF 
    198198         ! 
    … …  
    209209      ENDIF 
    210210      ! 
    211    END SUBROUTINE thermodynamics 
     211   END SUBROUTINE icb_thm 
    212212 
    213213   !!====================================================================== 

  • branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icbtrj.F90

    r3370 r3372  
    2626   PRIVATE 
    2727 
    28    PUBLIC   traj_init    ! routine called in icbini.F90 module 
    29    PUBLIC   traj_write   ! routine called in icbrun.F90 module 
    30    PUBLIC   traj_sync    ! routine called in icbrun.F90 module 
    31    PUBLIC   traj_end     ! routine called in icbrun.F90 module 
     28   PUBLIC   icb_trj_init    ! routine called in icbini.F90 module 
     29   PUBLIC   icb_trj_write   ! routine called in icbrun.F90 module 
     30   PUBLIC   icb_trj_sync    ! routine called in icbrun.F90 module 
     31   PUBLIC   icb_trj_end     ! routine called in icbrun.F90 module 
    3232 
    3333   INTEGER ::   num_traj 
    … …  
    5151   !!------------------------------------------------------------------------- 
    5252 
    53    SUBROUTINE traj_init( ktend ) 
     53   SUBROUTINE icb_trj_init( ktend ) 
    5454 
    5555      ! local variables 
    … …  
    6464      ELSE                ;   WRITE(cl_filename,'("trajectory_icebergs_",I6.6         ,".nc")') ktend 
    6565      ENDIF 
    66       IF ( lwp .AND. nn_verbose_level >= 0) WRITE(numout,'(2a)') 'icebergs, traj_init: creating ',TRIM(cl_filename) 
     66      IF ( lwp .AND. nn_verbose_level >= 0) WRITE(numout,'(2a)') 'icebergs, icb_trj_init: creating ',TRIM(cl_filename) 
    6767 
    6868      iret = NF90_CREATE(TRIM(cl_filename), NF90_CLOBBER, ntrajid) 
    69       IF (iret .NE. NF90_NOERR) CALL ctl_stop('icebergs, traj_init: nf_create failed') 
     69      IF (iret .NE. NF90_NOERR) CALL ctl_stop('icebergs, icb_trj_init: nf_create failed') 
    7070 
    7171      ! Dimensions 
    7272      iret = NF90_DEF_DIM(ntrajid, 'n', NF90_UNLIMITED, n_dim) 
    73       IF (iret .NE. NF90_NOERR) CALL ctl_stop('icebergs, traj_init: nf_def_dim n failed') 
     73      IF (iret .NE. NF90_NOERR) CALL ctl_stop('icebergs, icb_trj_init: nf_def_dim n failed') 
    7474      iret = NF90_DEF_DIM(ntrajid, 'k', nkounts, m_dim) 
    75       IF (iret .NE. NF90_NOERR) CALL ctl_stop('icebergs, traj_init: nf_def_dim k failed') 
     75      IF (iret .NE. NF90_NOERR) CALL ctl_stop('icebergs, icb_trj_init: nf_def_dim k failed') 
    7676 
    7777      ! Variables 
    … …  
    166166      iret = NF90_ENDDEF(ntrajid) 
    167167      ! 
    168    END SUBROUTINE traj_init 
    169  
    170  
    171    SUBROUTINE traj_write( kt ) 
    172       !!---------------------------------------------------------------------- 
    173       !!                  ***  ROUTINE traj_write  *** 
     168   END SUBROUTINE icb_trj_init 
     169 
     170 
     171   SUBROUTINE icb_trj_write( kt ) 
     172      !!---------------------------------------------------------------------- 
     173      !!                  ***  ROUTINE icb_trj_write  *** 
    174174      !! 
    175       !! ** Purpose :   compute the iceberg thermodynamics. 
     175      !! ** Purpose :   write out iceberg trajectories 
    176176      !! 
    177177      !! ** Method  : - for the moment write out each snapshot of positions later 
    178       !!   can rewrite so that it is buffered and written out more efficiently 
     178      !!                can rewrite so that it is buffered and written out more efficiently 
    179179      !!---------------------------------------------------------------------- 
    180180      INTEGER, INTENT( in ) ::   kt 
    … …  
    230230      num_traj = jn 
    231231      ! 
    232    END SUBROUTINE traj_write 
     232   END SUBROUTINE icb_trj_write 
    233233 
    234234   !!------------------------------------------------------------------------- 
    235235 
    236    SUBROUTINE traj_sync() 
    237       !!---------------------------------------------------------------------- 
    238       !!                  ***  ROUTINE traj_sync  *** 
     236   SUBROUTINE icb_trj_sync() 
     237      !!---------------------------------------------------------------------- 
     238      !!                  ***  ROUTINE icb_trj_sync  *** 
    239239      !! 
    240240      !! ** Purpose :    
    … …  
    244244      ! flush to file 
    245245      iret = NF90_SYNC(ntrajid) 
    246       IF(iret /= NF90_NOERR)   CALL ctl_stop( 'icebergs, traj_sync: nf_sync failed' ) 
    247       ! 
    248    END SUBROUTINE traj_sync 
    249  
    250  
    251    SUBROUTINE traj_end() 
     246      IF(iret /= NF90_NOERR)   CALL ctl_stop( 'icebergs, icb_trj_sync: nf_sync failed' ) 
     247      ! 
     248   END SUBROUTINE icb_trj_sync 
     249 
     250 
     251   SUBROUTINE icb_trj_end() 
    252252      ! Local variables 
    253253      INTEGER                               :: iret 
    … …  
    255255      ! Finish up 
    256256      iret = NF90_CLOSE(ntrajid) 
    257       IF (iret /= NF90_NOERR)   CALL ctl_stop( 'icebergs, traj_end: nf_close failed' ) 
    258       ! 
    259    END SUBROUTINE traj_end 
     257      IF (iret /= NF90_NOERR)   CALL ctl_stop( 'icebergs, icb_trj_end: nf_close failed' ) 
     258      ! 
     259   END SUBROUTINE icb_trj_end 
    260260 
    261261   !!------------------------------------------------------------------------- 

  • branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icbutl.F90

    r3370 r3372  
    1111   !!---------------------------------------------------------------------- 
    1212   !!---------------------------------------------------------------------- 
    13    !!   interp_flds   : 
    14    !!   bilin         : 
    15    !!   bilin_e       : 
     13   !!   icb_utl_interp   : 
     14   !!   icb_utl_bilin    : 
     15   !!   icb_utl_bilin_e  : 
    1616   !!---------------------------------------------------------------------- 
    1717   USE par_oce                             ! ocean parameters 
    … …  
    3434   PRIVATE 
    3535 
    36    PUBLIC   copy_flds                    ! routine called in icbrun module 
    37    PUBLIC   interp_flds                  ! routine called in icbdyn, icbthm modules 
    38    PUBLIC   bilin                        ! routine called in icbini, icbdyn modules 
    39    PUBLIC   bilin_x                      ! routine called in icbdyn module 
    40    PRIVATE  bilin_e 
    41    PUBLIC   add_new_berg_to_list         ! routine called in icbini.F90, icbclv, icblbc and icbrst modules 
    42    PRIVATE  insert_berg_into_list 
    43    PUBLIC   delete_iceberg_from_list     ! routine called in icblbc, icbthm modules 
    44    PUBLIC   destroy_iceberg              ! routine called in icbrun module 
    45    PUBLIC   track_berg                   ! routine not currently used, retain just in case 
    46    PUBLIC   print_berg                   ! routine called in icbthm module 
    47    PUBLIC   print_bergs                  ! routine called in icbini, icbrun module 
    48    PUBLIC   count_bergs                  ! routine called in icbdia, icbini, icblbc, icbrst modules 
    49    PUBLIC   increment_kounter            ! routine called in icbini, icbclv modules 
    50    PUBLIC   yearday                      ! routine called in icbclv, icbrun module 
    51    PUBLIC   sum_mass                     ! routine called in icbdia module 
    52    PUBLIC   sum_heat                     ! routine called in icbdia module 
    53  
    54    PRIVATE  create_iceberg 
     36   PUBLIC   icb_utl_copy                 ! routine called in icbrun module 
     37   PUBLIC   icb_utl_interp               ! routine called in icbdyn, icbthm modules 
     38   PUBLIC   icb_utl_bilin                ! routine called in icbini, icbdyn modules 
     39   PUBLIC   icb_utl_bilin_x              ! routine called in icbdyn module 
     40   PUBLIC   icb_utl_add                  ! routine called in icbini.F90, icbclv, icblbc and icbrst modules 
     41   PUBLIC   icb_utl_delete     ! routine called in icblbc, icbthm modules 
     42   PUBLIC   icb_utl_destroy              ! routine called in icbrun module 
     43   PUBLIC   icb_utl_track                   ! routine not currently used, retain just in case 
     44   PUBLIC   icb_utl_print_berg                   ! routine called in icbthm module 
     45   PUBLIC   icb_utl_print                  ! routine called in icbini, icbrun module 
     46   PUBLIC   icb_utl_count                  ! routine called in icbdia, icbini, icblbc, icbrst modules 
     47   PUBLIC   icb_utl_incr            ! routine called in icbini, icbclv modules 
     48   PUBLIC   icb_utl_yearday                      ! routine called in icbclv, icbrun module 
     49   PUBLIC   icb_utl_mass                     ! routine called in icbdia module 
     50   PUBLIC   icb_utl_heat                     ! routine called in icbdia module 
    5551 
    5652   !!---------------------------------------------------------------------- 
    … …  
    6258CONTAINS 
    6359 
    64    SUBROUTINE copy_flds() 
    65       !!---------------------------------------------------------------------- 
    66       !!                  ***  ROUTINE copy_flds  *** 
     60   SUBROUTINE icb_utl_copy() 
     61      !!---------------------------------------------------------------------- 
     62      !!                  ***  ROUTINE icb_utl_copy  *** 
    6763      !! 
    6864      !! ** Purpose :   iceberg initialization. 
    … …  
    109105      CALL lbc_lnk_e( ssh_e, 'T', +1._wp, 1, 1 ) 
    110106      ! 
    111    END SUBROUTINE copy_flds 
    112  
    113  
    114    SUBROUTINE interp_flds( pi, pe1, puo, pui, pua, pssh_i,   & 
    115       &                    pj, pe2, pvo, pvi, pva, pssh_j,   & 
     107   END SUBROUTINE icb_utl_copy 
     108 
     109 
     110   SUBROUTINE icb_utl_interp( pi, pe1, puo, pui, pua, pssh_i,   & 
     111      &                       pj, pe2, pvo, pvi, pva, pssh_j,   & 
    116112      &                       psst, pcn, phi, pff            ) 
    117113      !!---------------------------------------------------------------------- 
    118       !!                  ***  ROUTINE interp_flds  *** 
     114      !!                  ***  ROUTINE icb_utl_interp  *** 
    119115      !! 
    120116      !! ** Purpose :   iceberg initialization. 
    … …  
    138134      !!---------------------------------------------------------------------- 
    139135 
    140       pe1 = bilin_e( e1t, e1u, e1v, e1f, pi, pj )                 ! scale factors 
    141       pe2 = bilin_e( e2t, e2u, e2v, e2f, pi, pj ) 
    142       ! 
    143       puo  = bilin( uo_e, pi, pj, 'U', 1, 1 )                     ! ocean velocities 
    144       pvo  = bilin( vo_e, pi, pj, 'V', 1, 1 ) 
    145       psst = bilin( sst_m, pi, pj, 'T', 0, 0 )                    ! SST 
    146       pcn  = bilin( fr_i , pi, pj, 'T', 0, 0 )                    ! ice concentration 
    147       pff  = bilin( ff_e , pi, pj, 'F', 1, 1 )                    ! Coriolis parameter 
    148       ! 
    149       pua  = bilin( ua_e , pi, pj, 'U', 1, 1 )                    ! 10m wind 
    150       pva  = bilin( va_e , pi, pj, 'V', 1, 1 )                    ! here (ua,va) are stress => rough conversion from stress to speed 
     136      pe1 = icb_utl_bilin_e( e1t, e1u, e1v, e1f, pi, pj )         ! scale factors 
     137      pe2 = icb_utl_bilin_e( e2t, e2u, e2v, e2f, pi, pj ) 
     138      ! 
     139      puo  = icb_utl_bilin( uo_e, pi, pj, 'U', 1, 1 )             ! ocean velocities 
     140      pvo  = icb_utl_bilin( vo_e, pi, pj, 'V', 1, 1 ) 
     141      psst = icb_utl_bilin( sst_m, pi, pj, 'T', 0, 0 )            ! SST 
     142      pcn  = icb_utl_bilin( fr_i , pi, pj, 'T', 0, 0 )            ! ice concentration 
     143      pff  = icb_utl_bilin( ff_e , pi, pj, 'F', 1, 1 )            ! Coriolis parameter 
     144      ! 
     145      pua  = icb_utl_bilin( ua_e , pi, pj, 'U', 1, 1 )            ! 10m wind 
     146      pva  = icb_utl_bilin( va_e , pi, pj, 'V', 1, 1 )            ! here (ua,va) are stress => rough conversion from stress to speed 
    151147      zcd  = 1.22_wp * 1.5e-3_wp                                  ! air density * drag coefficient 
    152148      zmod = 1._wp / MAX(  1.e-20, SQRT(  zcd * SQRT( pua*pua + pva*pva)  )  ) 
    … …  
    155151 
    156152#if defined key_lim2 || defined key_lim3 
    157       pui = bilin( ui_e, pi, pj, 'U', 1, 1 )                      ! sea-ice velocities 
    158       pvi = bilin( vi_e, pi, pj, 'V', 1, 1 ) 
    159       phi = bilin( hi  , pi, pj, 'T', 0, 0 )                      ! ice thickness 
     153      pui = icb_utl_bilin( ui_e, pi, pj, 'U', 1, 1 )              ! sea-ice velocities 
     154      pvi = icb_utl_bilin( vi_e, pi, pj, 'V', 1, 1 ) 
     155      phi = icb_utl_bilin( hi  , pi, pj, 'T', 0, 0 )              ! ice thickness 
    160156#else 
    161157      pui = 0._wp 
    … …  
    165161 
    166162      ! Estimate SSH gradient in i- and j-direction (centred evaluation) 
    167       pssh_i = ( bilin( ssh_e, pi+0.1_wp, pj, 'T', 1, 1 ) - bilin( ssh_e, pi-0.1_wp, pj, 'T', 1, 1 )  ) / ( 0.2_wp * pe1 ) 
    168       pssh_j = ( bilin( ssh_e, pi, pj+0.1_wp, 'T', 1, 1 ) - bilin( ssh_e, pi, pj-0.1_wp, 'T', 1, 1 )  ) / ( 0.2_wp * pe2 ) 
    169       ! 
    170    END SUBROUTINE interp_flds 
    171  
    172  
    173    REAL(wp) FUNCTION bilin( pfld, pi, pj, cd_type, kdi, kdj ) 
    174       !!---------------------------------------------------------------------- 
    175       !!                  ***  FUNCTION bilin  *** 
     163      pssh_i = ( icb_utl_bilin( ssh_e, pi+0.1_wp, pj, 'T', 1, 1 ) -   & 
     164          &      icb_utl_bilin( ssh_e, pi-0.1_wp, pj, 'T', 1, 1 )  ) / ( 0.2_wp * pe1 ) 
     165      pssh_j = ( icb_utl_bilin( ssh_e, pi, pj+0.1_wp, 'T', 1, 1 ) -   & 
     166          &      icb_utl_bilin( ssh_e, pi, pj-0.1_wp, 'T', 1, 1 )  ) / ( 0.2_wp * pe2 ) 
     167      ! 
     168   END SUBROUTINE icb_utl_interp 
     169 
     170 
     171   REAL(wp) FUNCTION icb_utl_bilin( pfld, pi, pj, cd_type, kdi, kdj ) 
     172      !!---------------------------------------------------------------------- 
     173      !!                  ***  FUNCTION icb_utl_bilin  *** 
    176174      !! 
    177175      !! ** Purpose :   bilinear interpolation at berg location depending on the grid-point type 
    … …  
    220218      ij = ij - njmpp + 1 
    221219      ! 
    222       bilin = ( pfld(ii,ij  ) * (1.-zi) + pfld(ii+1,ij  ) * zi ) * (1.-zj)   & 
    223          &  + ( pfld(ii,ij+1) * (1.-zi) + pfld(ii+1,ij+1) * zi ) *     zj 
    224       ! 
    225    END FUNCTION bilin 
    226  
    227  
    228    REAL(wp) FUNCTION bilin_x( pfld, pi, pj ) 
    229       !!---------------------------------------------------------------------- 
    230       !!                  ***  FUNCTION bilin_x  *** 
     220      icb_utl_bilin = ( pfld(ii,ij  ) * (1.-zi) + pfld(ii+1,ij  ) * zi ) * (1.-zj)   & 
     221         &          + ( pfld(ii,ij+1) * (1.-zi) + pfld(ii+1,ij+1) * zi ) *     zj 
     222      ! 
     223   END FUNCTION icb_utl_bilin 
     224 
     225 
     226   REAL(wp) FUNCTION icb_utl_bilin_x( pfld, pi, pj ) 
     227      !!---------------------------------------------------------------------- 
     228      !!                  ***  FUNCTION icb_utl_bilin_x  *** 
    231229      !! 
    232230      !! ** Purpose :   bilinear interpolation at berg location depending on the grid-point type 
    … …  
    242240      INTEGER                                  ::   ii, ij   ! local integer 
    243241      REAL(wp)                                 ::   zi, zj   ! local real 
     242      REAL(wp)                                 ::   zret     ! local real 
    244243      REAL(wp), DIMENSION(4)                   ::   z4 
    245244      !!---------------------------------------------------------------------- 
    … …  
    264263      ENDIF 
    265264      ! 
    266       bilin_x = (z4(1) * (1.-zi) + z4(2) * zi) * (1.-zj) + (z4(3) * (1.-zi) + z4(4) * zi) * zj 
    267       IF( bilin_x > 180._wp ) bilin_x = bilin_x - 360._wp 
    268       ! 
    269    END FUNCTION bilin_x 
    270  
    271  
    272    REAL(wp) FUNCTION bilin_e( pet, peu, pev, pef, pi, pj ) 
     265      zret = (z4(1) * (1.-zi) + z4(2) * zi) * (1.-zj) + (z4(3) * (1.-zi) + z4(4) * zi) * zj 
     266      IF( zret > 180._wp ) zret = zret - 360._wp 
     267      icb_utl_bilin_x = zret 
     268      ! 
     269   END FUNCTION icb_utl_bilin_x 
     270 
     271 
     272   REAL(wp) FUNCTION icb_utl_bilin_e( pet, peu, pev, pef, pi, pj ) 
    273273      !!---------------------------------------------------------------------- 
    274274      !!                  ***  FUNCTION dom_init  *** 
    … …  
    336336      ENDIF 
    337337      ! 
    338       bilin_e = ( ze01 * (1.-zi) + ze11 * zi ) *     zj    & 
    339          &    + ( ze00 * (1.-zi) + ze10 * zi ) * (1.-zj) 
    340       ! 
    341    END FUNCTION bilin_e 
    342  
    343  
    344    SUBROUTINE add_new_berg_to_list( bergvals, ptvals ) 
    345       !!---------------------------------------------------------------------- 
    346       !!                ***  ROUTINE add_new_berg_to_list  *** 
     338      icb_utl_bilin_e = ( ze01 * (1.-zi) + ze11 * zi ) *     zj    & 
     339         &            + ( ze00 * (1.-zi) + ze10 * zi ) * (1.-zj) 
     340      ! 
     341   END FUNCTION icb_utl_bilin_e 
     342 
     343 
     344   SUBROUTINE icb_utl_add( bergvals, ptvals ) 
     345      !!---------------------------------------------------------------------- 
     346      !!                ***  ROUTINE icb_utl_add           *** 
    347347      !! 
    348348      !! ** Purpose :   add a new berg to the iceberg list 
    … …  
    357357      ! 
    358358      new => NULL() 
    359       CALL create_iceberg( new, bergvals, ptvals ) 
    360       CALL insert_berg_into_list( new ) 
     359      CALL icb_utl_create( new, bergvals, ptvals ) 
     360      CALL icb_utl_insert( new ) 
    361361      new => NULL()     ! Clear new 
    362362      ! 
    363    END SUBROUTINE add_new_berg_to_list 
    364  
    365  
    366    SUBROUTINE create_iceberg( berg, bergvals, ptvals ) 
    367       !!---------------------------------------------------------------------- 
    368       !!                ***  ROUTINE add_new_berg_to_list  *** 
     363   END SUBROUTINE icb_utl_add          
     364 
     365 
     366   SUBROUTINE icb_utl_create( berg, bergvals, ptvals ) 
     367      !!---------------------------------------------------------------------- 
     368      !!                ***  ROUTINE icb_utl_create  *** 
    369369      !! 
    370370      !! ** Purpose :   add a new berg to the iceberg list 
    … …  
    380380      !!---------------------------------------------------------------------- 
    381381      ! 
    382       IF( ASSOCIATED(berg) )   CALL ctl_stop( 'icebergs, create_iceberg: berg already associated' ) 
     382      IF( ASSOCIATED(berg) )   CALL ctl_stop( 'icebergs, icb_utl_create: berg already associated' ) 
    383383      ALLOCATE(berg, STAT=istat) 
    384384      IF( istat /= 0 ) CALL ctl_stop( 'failed to allocate iceberg' ) 
    … …  
    393393      berg%current_point => pt 
    394394      ! 
    395    END SUBROUTINE create_iceberg 
    396  
    397  
    398    SUBROUTINE insert_berg_into_list( newberg ) 
    399       !!---------------------------------------------------------------------- 
    400       !!                 ***  ROUTINE insert_berg_into_list  *** 
     395   END SUBROUTINE icb_utl_create 
     396 
     397 
     398   SUBROUTINE icb_utl_insert( newberg ) 
     399      !!---------------------------------------------------------------------- 
     400      !!                 ***  ROUTINE icb_utl_insert  *** 
    401401      !! 
    402402      !! ** Purpose :   add a new berg to the iceberg list 
    … …  
    422422      ENDIF 
    423423      ! 
    424    END SUBROUTINE insert_berg_into_list 
    425  
    426  
    427    REAL(wp) FUNCTION yearday(kmon, kday, khr, kmin, ksec) 
    428       !!---------------------------------------------------------------------- 
    429       !!                 ***  FUNCTION yearday  *** 
     424   END SUBROUTINE icb_utl_insert 
     425 
     426 
     427   REAL(wp) FUNCTION icb_utl_yearday(kmon, kday, khr, kmin, ksec) 
     428      !!---------------------------------------------------------------------- 
     429      !!                 ***  FUNCTION icb_utl_yearday  *** 
    430430      !! 
    431431      !! ** Purpose :    
    … …  
    442442      !!---------------------------------------------------------------------- 
    443443      ! 
    444       yearday = FLOAT( SUM( imonths(1:kmon) ) ) 
    445       yearday = yearday + FLOAT(kday-1) + (FLOAT(khr) + (FLOAT(kmin) + FLOAT(ksec)/60.)/60.)/24. 
    446       ! 
    447    END FUNCTION yearday 
     444      icb_utl_yearday = FLOAT( SUM( imonths(1:kmon) ) ) 
     445      icb_utl_yearday = icb_utl_yearday + FLOAT(kday-1) + (FLOAT(khr) + (FLOAT(kmin) + FLOAT(ksec)/60.)/60.)/24. 
     446      ! 
     447   END FUNCTION icb_utl_yearday 
    448448 
    449449   !!------------------------------------------------------------------------- 
    450450 
    451    SUBROUTINE delete_iceberg_from_list( first, berg ) 
    452       !!---------------------------------------------------------------------- 
    453       !!                 ***  ROUTINE delete_iceberg_from_list  *** 
     451   SUBROUTINE icb_utl_delete( first, berg ) 
     452      !!---------------------------------------------------------------------- 
     453      !!                 ***  ROUTINE icb_utl_delete  *** 
    454454      !! 
    455455      !! ** Purpose :    
    … …  
    467467      ! 
    468468      ! Bye-bye berg 
    469       CALL destroy_iceberg(berg) 
    470       ! 
    471    END SUBROUTINE delete_iceberg_from_list 
    472  
    473  
    474    SUBROUTINE destroy_iceberg( berg ) 
    475       !!---------------------------------------------------------------------- 
    476       !!                 ***  ROUTINE destroy_iceberg  *** 
     469      CALL icb_utl_destroy(berg) 
     470      ! 
     471   END SUBROUTINE icb_utl_delete 
     472 
     473 
     474   SUBROUTINE icb_utl_destroy( berg ) 
     475      !!---------------------------------------------------------------------- 
     476      !!                 ***  ROUTINE icb_utl_destroy  *** 
    477477      !! 
    478478      !! ** Purpose :    
    … …  
    488488      DEALLOCATE(berg) 
    489489      ! 
    490    END SUBROUTINE destroy_iceberg 
    491  
    492  
    493    SUBROUTINE track_berg( knum, cd_label, kt ) 
    494       !!---------------------------------------------------------------------- 
    495       !!                 ***  ROUTINE track_berg  *** 
     490   END SUBROUTINE icb_utl_destroy 
     491 
     492 
     493   SUBROUTINE icb_utl_track( knum, cd_label, kt ) 
     494      !!---------------------------------------------------------------------- 
     495      !!                 ***  ROUTINE icb_utl_track  *** 
    496496      !! 
    497497      !! ** Purpose :    
    … …  
    513513            IF( this%number(k) /= knum(k) ) match = .FALSE. 
    514514         END DO 
    515          IF( match )   CALL print_berg(this, kt) 
     515         IF( match )   CALL icb_utl_print_berg(this, kt) 
    516516         this => this%next 
    517517      END DO 
    518518      ! 
    519    END SUBROUTINE track_berg 
    520  
    521  
    522    SUBROUTINE print_berg( berg, kt ) 
    523       !!---------------------------------------------------------------------- 
    524       !!                 ***  ROUTINE print_berg  *** 
     519   END SUBROUTINE icb_utl_track 
     520 
     521 
     522   SUBROUTINE icb_utl_print_berg( berg, kt ) 
     523      !!---------------------------------------------------------------------- 
     524      !!                 ***  ROUTINE icb_utl_print_berg  *** 
    525525      !! 
    526526      !! ** Purpose :    
    … …  
    539539 9200 FORMAT(5x,i5,2x,i10,6(2x,2f10.4)) 
    540540      ! 
    541    END SUBROUTINE print_berg 
    542  
    543  
    544    SUBROUTINE print_bergs( cd_label, kt ) 
    545       !!---------------------------------------------------------------------- 
    546       !!                 ***  ROUTINE print_bergs  *** 
     541   END SUBROUTINE icb_utl_print_berg 
     542 
     543 
     544   SUBROUTINE icb_utl_print( cd_label, kt ) 
     545      !!---------------------------------------------------------------------- 
     546      !!                 ***  ROUTINE icb_utl_print  *** 
    547547      !! 
    548548      !! ** Purpose :    
    … …  
    563563      ENDIF 
    564564      DO WHILE( ASSOCIATED(this) ) 
    565         CALL print_berg(this, kt) 
     565        CALL icb_utl_print_berg(this, kt) 
    566566        this => this%next 
    567567      END DO 
    568       ibergs = count_bergs() 
     568      ibergs = icb_utl_count() 
    569569      inbergs = ibergs 
    570570      IF( lk_mpp )   CALL mpp_sum(inbergs) 
    … …  
    572572         &                                  cd_label, ibergs, inbergs, narea 
    573573      ! 
    574    END SUBROUTINE print_bergs 
    575  
    576  
    577    SUBROUTINE increment_kounter() 
    578       !!---------------------------------------------------------------------- 
    579       !!                 ***  ROUTINE increment_kounter  *** 
     574   END SUBROUTINE icb_utl_print 
     575 
     576 
     577   SUBROUTINE icb_utl_incr() 
     578      !!---------------------------------------------------------------------- 
     579      !!                 ***  ROUTINE icb_utl_incr  *** 
    580580      !! 
    581581      !! ** Purpose :    
    … …  
    607607      ENDIF 
    608608      ! 
    609    END SUBROUTINE increment_kounter 
    610  
    611  
    612    INTEGER FUNCTION count_bergs() 
    613       !!---------------------------------------------------------------------- 
    614       !!                 ***  FUNCTION count_bergs  *** 
     609   END SUBROUTINE icb_utl_incr 
     610 
     611 
     612   INTEGER FUNCTION icb_utl_count() 
     613      !!---------------------------------------------------------------------- 
     614      !!                 ***  FUNCTION icb_utl_count  *** 
    615615      !! 
    616616      !! ** Purpose :    
    … …  
    619619      !!---------------------------------------------------------------------- 
    620620      ! 
    621       count_bergs = 0 
     621      icb_utl_count = 0 
    622622      this => first_berg 
    623623      DO WHILE( ASSOCIATED(this) ) 
    624          count_bergs = count_bergs+1 
     624         icb_utl_count = icb_utl_count+1 
    625625         this => this%next 
    626626      END DO 
    627627      ! 
    628    END FUNCTION count_bergs 
    629  
    630  
    631    REAL(wp) FUNCTION sum_mass( first, justbits, justbergs ) 
    632       !!---------------------------------------------------------------------- 
    633       !!                 ***  FUNCTION sum_mass  *** 
     628   END FUNCTION icb_utl_count 
     629 
     630 
     631   REAL(wp) FUNCTION icb_utl_mass( first, justbits, justbergs ) 
     632      !!---------------------------------------------------------------------- 
     633      !!                 ***  FUNCTION icb_utl_mass  *** 
    634634      !! 
    635635      !! ** Purpose :   compute the mass all iceberg, all bergies or all bergs. 
    … …  
    641641      TYPE(iceberg), POINTER ::   this 
    642642      !!---------------------------------------------------------------------- 
    643       sum_mass = 0._wp 
     643      icb_utl_mass = 0._wp 
    644644      this => first 
    645645      ! 
    … …  
    647647         DO WHILE( ASSOCIATED( this ) ) 
    648648            pt => this%current_point 
    649             sum_mass = sum_mass + pt%mass         * this%mass_scaling 
     649            icb_utl_mass = icb_utl_mass + pt%mass         * this%mass_scaling 
    650650            this => this%next 
    651651         END DO 
    … …  
    653653         DO WHILE( ASSOCIATED( this ) ) 
    654654            pt => this%current_point 
    655             sum_mass = sum_mass + pt%mass_of_bits * this%mass_scaling 
     655            icb_utl_mass = icb_utl_mass + pt%mass_of_bits * this%mass_scaling 
    656656            this => this%next 
    657657         END DO 
    … …  
    659659         DO WHILE( ASSOCIATED( this ) ) 
    660660            pt => this%current_point 
    661             sum_mass = sum_mass + ( pt%mass + pt%mass_of_bits ) * this%mass_scaling 
     661            icb_utl_mass = icb_utl_mass + ( pt%mass + pt%mass_of_bits ) * this%mass_scaling 
    662662            this => this%next 
    663663         END DO 
    664664      ENDIF 
    665665      ! 
    666    END FUNCTION sum_mass 
    667  
    668  
    669    REAL(wp) FUNCTION sum_heat( first, justbits, justbergs ) 
    670       !!---------------------------------------------------------------------- 
    671       !!                 ***  FUNCTION sum_heat  *** 
     666   END FUNCTION icb_utl_mass 
     667 
     668 
     669   REAL(wp) FUNCTION icb_utl_heat( first, justbits, justbergs ) 
     670      !!---------------------------------------------------------------------- 
     671      !!                 ***  FUNCTION icb_utl_heat  *** 
    672672      !! 
    673673      !! ** Purpose :   compute the heat in all iceberg, all bergies or all bergs. 
    … …  
    679679      TYPE(point)        , POINTER  ::   pt 
    680680      !!---------------------------------------------------------------------- 
    681       sum_heat = 0._wp 
     681      icb_utl_heat = 0._wp 
    682682      this => first 
    683683      ! 
    … …  
    685685         DO WHILE( ASSOCIATED( this ) ) 
    686686            pt => this%current_point 
    687             sum_heat = sum_heat + pt%mass         * this%mass_scaling * pt%heat_density 
     687            icb_utl_heat = icb_utl_heat + pt%mass         * this%mass_scaling * pt%heat_density 
    688688            this => this%next 
    689689         END DO 
    … …  
    691691         DO WHILE( ASSOCIATED( this ) ) 
    692692            pt => this%current_point 
    693             sum_heat = sum_heat + pt%mass_of_bits * this%mass_scaling * pt%heat_density 
     693            icb_utl_heat = icb_utl_heat + pt%mass_of_bits * this%mass_scaling * pt%heat_density 
    694694            this => this%next 
    695695         END DO 
    … …  
    697697         DO WHILE( ASSOCIATED( this ) ) 
    698698            pt => this%current_point 
    699             sum_heat = sum_heat + ( pt%mass + pt%mass_of_bits ) * this%mass_scaling * pt%heat_density 
     699            icb_utl_heat = icb_utl_heat + ( pt%mass + pt%mass_of_bits ) * this%mass_scaling * pt%heat_density 
    700700            this => this%next 
    701701         END DO 
    702702      ENDIF 
    703703      ! 
    704    END FUNCTION sum_heat 
     704   END FUNCTION icb_utl_heat 
    705705 
    706706   !!====================================================================== 
Note: See TracChangeset for help on using the changeset viewer.