source: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/ICB/icb_oce.F90 @ 11738

Last change on this file since 11738 was 11738, checked in by marc, 13 months ago

The Dr Hook changes from my perl code.

File size: 14.0 KB
Line 
1MODULE icb_oce
2
3   !!======================================================================
4   !!                       ***  MODULE  icb_oce  ***
5   !! Icebergs:  declare variables for iceberg tracking
6   !!======================================================================
7   !! History :  3.3  !  2010-01  (T. Martin & A. Adcroft)  Original code
8   !!             -   !  2011-03  (G. Madec)  Part conversion to NEMO form
9   !!             -   !                       Removal of mapping from another grid
10   !!             -   !  2011-04  (S. Alderson) Extensive rewrite ; Split into separate modules
11   !!----------------------------------------------------------------------
12   !!
13   !! Track Icebergs as Lagrangian objects within the model domain
14   !! Interaction with the other model variables through 'icebergs_gridded'
15   !!
16   !! A single iceberg is held as an instance of type 'iceberg'
17   !! This type defines a linked list, so each instance contains a pointer
18   !! to the previous and next icebergs in the list
19   !!
20   !! Type 'icebergs' is a convenience container for all relevant arrays
21   !! It contains one pointer to an 'iceberg' instance representing all icebergs in the processor
22   !!
23   !! Each iceberg has a position represented as a real cartesian coordinate which is
24   !! fractional grid cell, centred on T-points; so an iceberg position of (1.0,1.0) lies
25   !! exactly on the first T-point and the T-cell spans 0.5 to 1.5 in each direction
26   !!
27   !! Each iceberg is assigned a unique id even in MPI
28   !! This consists of an array of integers: the first element is used to label, the second
29   !! and subsequent elements are used to count the number of times the first element wraps
30   !! around all possible values within the valid size for this datatype.
31   !! Labelling is done by starting the first label in each processor (even when only one)
32   !! as narea, and then incrementing by jpnij (i.e. the total number of processors.
33   !! This means that the source processor for each iceberg can be identified by arithmetic
34   !! modulo jpnij.
35   !!
36   !!----------------------------------------------------------------------
37   USE par_oce   ! ocean parameters
38   USE lib_mpp   ! MPP library
39
40   USE yomhook, ONLY: lhook, dr_hook
41   USE parkind1, ONLY: jprb, jpim
42
43   IMPLICIT NONE
44   PUBLIC
45
46   PUBLIC   icb_alloc   ! routine called by icb_init in icbini.F90 module
47
48INTEGER, PUBLIC, PARAMETER ::   nclasses = 10   !: Number of icebergs classes   
49   INTEGER, PUBLIC, PARAMETER ::   nkounts  =  3   !: Number of integers combined for unique naming
50
51   TYPE, PUBLIC ::   icebergs_gridded   !: various icebergs properties on model grid
52      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   calving         ! Calving mass rate  (into stored ice)         [kg/s]
53      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   calving_hflx    ! Calving heat flux [heat content of calving]  [W/m2]
54      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   floating_melt   ! Net melting rate to icebergs + bits      [kg/s/m^2]
55      INTEGER , DIMENSION(:,:)  , ALLOCATABLE ::   maxclass        ! maximum class number at calving source point
56      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   tmp             ! Temporary work space
57      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   stored_ice      ! Accumulated ice mass flux at calving locations [kg]
58      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   stored_heat     ! Heat content of stored ice                      [J]
59   END TYPE icebergs_gridded
60
61   TYPE, PUBLIC ::   point              !: properties of an individual iceberg (position, mass, size, etc...)
62      INTEGER  ::   year
63      REAL(wp) ::   xi , yj                                              ! iceberg coordinates in the (i,j) referential (global)
64      REAL(wp) ::   e1 , e2                                              ! horizontal scale factors at the iceberg position
65      REAL(wp) ::   lon, lat, day                                        ! geographic position
66      REAL(wp) ::   mass, thickness, width, length, uvel, vvel           ! iceberg physical properties
67      REAL(wp) ::   uo, vo, ui, vi, ua, va, ssh_x, ssh_y, sst, cn, hi    ! properties of iceberg environment
68      REAL(wp) ::   mass_of_bits, heat_density
69   END TYPE point
70
71   TYPE, PUBLIC ::   iceberg            !: linked list defining all the icebergs present in the model domain
72      TYPE(iceberg), POINTER      ::   prev=>NULL(), next=>NULL()   ! pointers to previous and next unique icebergs in linked list
73      INTEGER, DIMENSION(nkounts) ::   number                       ! variables which do not change for this iceberg
74      REAL(wp)                    ::   mass_scaling                 !    -        -            -                - 
75      TYPE(point), POINTER        ::   current_point => NULL()      ! variables which change with time are held in a separate type
76   END TYPE iceberg
77
78
79   TYPE(icebergs_gridded), POINTER ::   berg_grid                 !: master instance of gridded iceberg type
80   TYPE(iceberg)         , POINTER ::   first_berg => NULL()      !: master instance of linked list iceberg type
81
82   !                                                             !!! parameters controlling iceberg characteristics and modelling
83   REAL(wp)                            ::   berg_dt                   !: Time-step between iceberg CALLs (should make adaptive?)
84   REAL(wp), DIMENSION(:), ALLOCATABLE ::   first_width, first_length !:
85   LOGICAL                             ::   l_restarted_bergs=.FALSE.  ! Indicate whether we read state from a restart or not
86   !                                                               ! arbitrary numbers for diawri entry
87   REAL(wp), DIMENSION(nclasses), PUBLIC ::   class_num=(/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 /)
88
89   ! Extra arrays with bigger halo, needed when interpolating forcing onto iceberg position
90   ! particularly for MPP when iceberg can lie inside T grid but outside U, V, or f grid
91   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   uo_e, vo_e
92   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ff_e, tt_e, fr_e, hicth
93   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ua_e, va_e
94   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ssh_e
95#if defined key_lim2 || defined key_lim3 || defined key_cice
96   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ui_e, vi_e
97#endif
98
99   !!gm almost all those PARAM ARE defined in NEMO
100   REAL(wp), PUBLIC, PARAMETER :: pp_rho_ice      = 916.7_wp   !: Density of fresh ice   @ 0oC [kg/m^3]
101   REAL(wp), PUBLIC, PARAMETER :: pp_rho_water    = 999.8_wp   !: Density of fresh water @ 0oC [kg/m^3]
102   REAL(wp), PUBLIC, PARAMETER :: pp_rho_air      = 1.1_wp     !: Density of air         @ 0oC [kg/m^3]
103   REAL(wp), PUBLIC, PARAMETER :: pp_rho_seawater = 1025._wp   !: Approx. density of surface sea water @ 0oC [kg/m^3]
104   !!gm end
105   REAL(wp), PUBLIC, PARAMETER :: pp_Cd_av = 1.3_wp      !: (Vertical) Drag coefficient between bergs and atmos
106   REAL(wp), PUBLIC, PARAMETER :: pp_Cd_ah = 0.0055_wp   !: (lateral ) Drag coefficient between bergs and atmos
107   REAL(wp), PUBLIC, PARAMETER :: pp_Cd_wv = 0.9_wp      !: (Vertical) Drag coefficient between bergs and ocean
108   REAL(wp), PUBLIC, PARAMETER :: pp_Cd_wh = 0.0012_wp   !: (lateral ) Drag coefficient between bergs and ocean
109   REAL(wp), PUBLIC, PARAMETER :: pp_Cd_iv = 0.9_wp      !: (Vertical) Drag coefficient between bergs and sea-ice
110!TOM> no horizontal drag for sea ice! real, PARAMETER :: pp_Cd_ih=0.0012 ! (lateral) Drag coeff. between bergs and sea-ice
111
112   !                                                         !!* namberg namelist parameters (and defaults) **
113   LOGICAL , PUBLIC ::   ln_bergdia                      !: Calculate budgets
114   INTEGER , PUBLIC ::   nn_verbose_level                !: Turn on debugging when level > 0
115   INTEGER , PUBLIC ::   nn_test_icebergs                !: Create icebergs in absence of a restart file from the supplied class nb
116   REAL(wp), PUBLIC, DIMENSION(4) ::   rn_test_box       !: lon1,lon2,lat1,lat2 box to create them in
117   INTEGER , PUBLIC ::   nn_sample_rate                  !: Timesteps between sampling of position for trajectory storage
118   INTEGER , PUBLIC ::   nn_verbose_write                !: timesteps between verbose messages
119   REAL(wp), PUBLIC ::   rn_rho_bergs                    !: Density of icebergs
120   REAL(wp), PUBLIC ::   rn_LoW_ratio                    !: Initial ratio L/W for newly calved icebergs
121   REAL(wp), PUBLIC ::   rn_bits_erosion_fraction        !: Fraction of erosion melt flux to divert to bergy bits
122   REAL(wp), PUBLIC ::   rn_sicn_shift                   !: Shift of sea-ice concentration in erosion flux modulation (0<sicn_shift<1)
123   LOGICAL , PUBLIC ::   ln_operator_splitting           !: Use first order operator splitting for thermodynamics
124   LOGICAL , PUBLIC ::   ln_passive_mode                 !: iceberg - ocean decoupling
125   LOGICAL , PUBLIC ::   ln_time_average_weight          !: Time average the weight on the ocean    !!gm I don't understand that !
126   REAL(wp), PUBLIC ::   rn_speed_limit                  !: CFL speed limit for a berg
127   !
128   !                                     ! Mass thresholds between iceberg classes [kg]
129   REAL(wp), DIMENSION(nclasses), PUBLIC ::   rn_initial_mass      ! Fraction of calving to apply to this class [non-dim]
130   REAL(wp), DIMENSION(nclasses), PUBLIC ::   rn_distribution      ! Ratio between effective and real iceberg mass (non-dim)
131   REAL(wp), DIMENSION(nclasses), PUBLIC ::   rn_mass_scaling      ! Total thickness of newly calved bergs [m]
132   REAL(wp), DIMENSION(nclasses), PUBLIC ::   rn_initial_thickness !  Single instance of an icebergs type initialised in icebergs_init and updated in icebergs_run
133   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   src_calving, src_calving_hflx    !: accumulate input ice
134   INTEGER , PUBLIC             , SAVE                     ::   numicb                           !: iceberg IO
135   INTEGER , PUBLIC             , SAVE, DIMENSION(nkounts) ::   num_bergs                        !: iceberg counter
136   INTEGER , PUBLIC             , SAVE                     ::   nicbdi, nicbei, nicbdj, nicbej   !: processor bounds
137   REAL(wp), PUBLIC             , SAVE                     ::   ricb_left, ricb_right            !: cyclical bounds
138   INTEGER , PUBLIC             , SAVE                     ::   nicbpack                         !: packing integer
139   INTEGER , PUBLIC             , SAVE                     ::   nktberg, nknberg                 !: helpers
140   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   nicbfldpts                       !: nfold packed points
141   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   nicbflddest                      !: nfold destination proc
142   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   nicbfldproc                      !: nfold destination proc
143   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   nicbfldnsend                     !: nfold number of bergs to send to nfold neighbour
144   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   nicbfldexpect                    !: nfold expected number of bergs
145   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   nicbfldreq                       !: nfold message handle (immediate send)
146
147   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: griddata                           !: work array for icbrst
148
149   !!----------------------------------------------------------------------
150   !! NEMO/OPA 3.3 , NEMO Consortium (2011)
151   !! $Id$
152   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
153   !!----------------------------------------------------------------------
154CONTAINS
155   
156   INTEGER FUNCTION icb_alloc()
157      !!----------------------------------------------------------------------
158      !!                ***  ROUTINE icb_alloc  ***
159      !!----------------------------------------------------------------------
160      INTEGER ::   ill
161      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
162      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
163      REAL(KIND=jprb)               :: zhook_handle
164
165      CHARACTER(LEN=*), PARAMETER :: RoutineName='ICB_ALLOC'
166
167      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
168
169      !!----------------------------------------------------------------------
170      !
171      icb_alloc = 0
172      ALLOCATE( berg_grid, STAT=ill )
173      icb_alloc = icb_alloc + ill
174      ALLOCATE( berg_grid%calving    (jpi,jpj) , berg_grid%calving_hflx (jpi,jpj)          ,   &
175         &      berg_grid%stored_heat(jpi,jpj) , berg_grid%floating_melt(jpi,jpj)          ,   &
176         &      berg_grid%maxclass   (jpi,jpj) , berg_grid%stored_ice   (jpi,jpj,nclasses) ,   &
177         &      berg_grid%tmp        (jpi,jpj) , STAT=ill)
178      icb_alloc = icb_alloc + ill
179      !
180      ! expanded arrays for bilinear interpolation
181      ALLOCATE( uo_e(0:jpi+1,0:jpj+1) , ua_e(0:jpi+1,0:jpj+1) ,   &
182         &      vo_e(0:jpi+1,0:jpj+1) , va_e(0:jpi+1,0:jpj+1) ,   &
183#if defined key_lim2 || defined key_lim3 || defined key_cice
184         &      ui_e(0:jpi+1,0:jpj+1) ,                            &
185         &      vi_e(0:jpi+1,0:jpj+1) ,                            &
186#endif
187         &      ff_e(0:jpi+1,0:jpj+1) , fr_e(0:jpi+1,0:jpj+1)  ,   &
188         &      tt_e(0:jpi+1,0:jpj+1) , ssh_e(0:jpi+1,0:jpj+1) ,   &
189         &      hicth(0:jpi+1,0:jpj+1),                            &
190         &      first_width(nclasses) , first_length(nclasses) ,   &
191         &      src_calving (jpi,jpj) ,                            &
192         &      src_calving_hflx(jpi,jpj) , STAT=ill)
193      icb_alloc = icb_alloc + ill
194
195      ALLOCATE( nicbfldpts(jpi) , nicbflddest(jpi) , nicbfldproc(jpni) , &
196         &      nicbfldnsend(jpni), nicbfldexpect(jpni) , nicbfldreq(jpni), STAT=ill)
197      icb_alloc = icb_alloc + ill
198
199      ALLOCATE( griddata(jpi,jpj,1), STAT=ill )
200      icb_alloc = icb_alloc + ill
201
202      IF( lk_mpp        )   CALL mpp_sum ( icb_alloc )
203      IF( icb_alloc > 0 )   CALL ctl_warn('icb_alloc: allocation of arrays failed')
204      !
205      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
206   END FUNCTION icb_alloc
207
208   !!======================================================================
209END MODULE icb_oce
Note: See TracBrowser for help on using the repository browser.