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

Changeset 3371


Ignore:
Timestamp:
2012-04-30T10:38:26+02:00 (12 years ago)
Author:
sga
Message:

NEMO branch dev_r3337_NOCS10_ICB: move icb_alloc function into icb_oce to be next to declarations

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

Legend:

Unmodified
Added
Removed

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

    r3370 r3371  
    3535   !!  
    3636   !!---------------------------------------------------------------------- 
    37  
    38    USE par_oce         ! ocean parameters 
    39    USE fldread 
     37   USE par_oce   ! ocean parameters 
     38   USE lib_mpp   ! MPP library 
     39   USE fldread   ! read input fields (FLD type) 
    4040 
    4141   IMPLICIT NONE 
    4242   PUBLIC 
    4343 
    44    ! Global constants 
    45    INTEGER, PUBLIC, PARAMETER :: nclasses = 10 ! Number of ice bergs classes 
    46    INTEGER, PUBLIC, PARAMETER :: nkounts  =  3 ! Number of integers combined for unique naming 
     44   PUBLIC   icb_alloc   ! routine called by icb_init in icbini.F90 module 
    4745 
    48    !! icebergs_gridded type allows for interaction between the set of icebergs and the model grid 
    49    TYPE, PUBLIC :: icebergs_gridded 
    50       REAL(wp), DIMENSION(:,:)  , POINTER :: calving => NULL()     ! Calving mass rate [frozen runoff] (kg/s) (into stored ice) 
    51       REAL(wp), DIMENSION(:,:)  , POINTER :: calving_hflx=>NULL()  ! Calving heat flux [heat content of calving] (W/m2) 
    52       REAL(wp), DIMENSION(:,:)  , POINTER :: floating_melt=>NULL() ! Net melting rate to icebergs + bits (kg/s/m^2) 
    53       INTEGER , DIMENSION(:,:)  , POINTER :: maxclass=>NULL()      ! maximum class number at calving source point 
    54       REAL(wp), DIMENSION(:,:)  , POINTER :: tmp=>NULL()           ! Temporary work space 
    55       REAL(wp), DIMENSION(:,:,:), POINTER :: stored_ice=>NULL()    ! Accumulated ice mass flux at calving locations (kg) 
    56       REAL(wp), DIMENSION(:,:)  , POINTER :: stored_heat=>NULL()   ! Heat content of stored ice (J) 
     46   INTEGER, PUBLIC, PARAMETER ::   nclasses = 10   !: Number of ice bergs classes 
     47   INTEGER, PUBLIC, PARAMETER ::   nkounts  =  3   !: Number of integers combined for unique naming 
     48 
     49   TYPE, PUBLIC ::   icebergs_gridded   !: various icebergs properties on model grid 
     50      REAL(wp), DIMENSION(:,:)  , POINTER ::   calving       => NULL()   ! Calving mass rate  (into stored ice)         [kg/s] 
     51      REAL(wp), DIMENSION(:,:)  , POINTER ::   calving_hflx  => NULL()   ! Calving heat flux [heat content of calving]  [W/m2] 
     52      REAL(wp), DIMENSION(:,:)  , POINTER ::   floating_melt => NULL()   ! Net melting rate to icebergs + bits      [kg/s/m^2] 
     53      INTEGER , DIMENSION(:,:)  , POINTER ::   maxclass      => NULL()   ! maximum class number at calving source point 
     54      REAL(wp), DIMENSION(:,:)  , POINTER ::   tmp           => NULL()   ! Temporary work space 
     55      REAL(wp), DIMENSION(:,:,:), POINTER ::   stored_ice    => NULL()   ! Accumulated ice mass flux at calving locations [kg] 
     56      REAL(wp), DIMENSION(:,:)  , POINTER ::   stored_heat   => NULL()   ! Heat content of stored ice                      [J] 
    5757   END TYPE icebergs_gridded 
    5858 
    … …  
    153153   TYPE(FLD), ALLOCATABLE, PUBLIC     , DIMENSION(:)       ::   sf_icb   !: structure: file information, fields read 
    154154 
     155   !!---------------------------------------------------------------------- 
     156   !! NEMO/OPA 3.3 , NEMO Consortium (2011) 
     157   !! $Id: sbc_oce.F90 3340 2012-04-02 11:05:35Z sga $ 
     158   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     159   !!---------------------------------------------------------------------- 
     160CONTAINS 
     161    
     162   INTEGER FUNCTION icb_alloc() 
     163      !!---------------------------------------------------------------------- 
     164      !!                ***  ROUTINE icb_alloc  *** 
     165      !!---------------------------------------------------------------------- 
     166      INTEGER ::   ill 
     167      !!---------------------------------------------------------------------- 
     168      ! 
     169      icb_alloc = 0 
     170      ALLOCATE( berg_grid                      ,                                               & 
     171         &      berg_grid%calving    (jpi,jpj) , berg_grid%calving_hflx (jpi,jpj)          ,   & 
     172         &      berg_grid%stored_heat(jpi,jpj) , berg_grid%floating_melt(jpi,jpj)          ,   & 
     173         &      berg_grid%maxclass   (jpi,jpj) , berg_grid%stored_ice   (jpi,jpj,nclasses) ,   & 
     174         &      berg_grid%tmp        (jpi,jpj) , STAT=ill) 
     175      icb_alloc = icb_alloc + ill 
     176      ! 
     177      ! expanded arrays for bilinear interpolation 
     178      ALLOCATE( uo_e(0:jpi+1,0:jpj+1) , ua_e(0:jpi+1,0:jpj+1) ,   & 
     179         &      vo_e(0:jpi+1,0:jpj+1) , va_e(0:jpi+1,0:jpj+1) ,   & 
     180#if defined key_lim2 || defined key_lim3 
     181         &      ui_e(0:jpi+1,0:jpj+1) ,                            & 
     182         &      vi_e(0:jpi+1,0:jpj+1) ,                            & 
     183#endif 
     184         &      ff_e(0:jpi+1,0:jpj+1) , ssh_e(0:jpi+1,0:jpj+1) ,   & 
     185         &      first_width(nclasses) , first_length(nclasses) ,   & 
     186         &      src_calving (jpi,jpj) ,                            & 
     187         &      src_calving_hflx(jpi,jpj) , STAT=ill) 
     188      icb_alloc = icb_alloc + ill 
     189 
     190      ALLOCATE( nicbfldpts(jpi) , nicbflddest(jpi) , nicbfldproc(jpni) , STAT=ill) 
     191      icb_alloc = icb_alloc + ill 
     192 
     193      IF( lk_mpp        )   CALL mpp_sum ( icb_alloc ) 
     194      IF( icb_alloc > 0 )   CALL ctl_warn('icb_alloc: allocation of arrays failed') 
     195      ! 
     196   END FUNCTION icb_alloc 
     197 
     198   !!====================================================================== 
    155199END MODULE icb_oce 

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

    r3370 r3371  
    4545   !!---------------------------------------------------------------------- 
    4646CONTAINS 
    47  
    48    INTEGER FUNCTION icb_alloc() 
    49       !!---------------------------------------------------------------------- 
    50       !!                ***  ROUTINE icb_alloc  *** 
    51       !!---------------------------------------------------------------------- 
    52       ! 
    53       INTEGER                              ::   ill 
    54  
    55       icb_alloc = 0 
    56       ALLOCATE(berg_grid, STAT=ill) 
    57       icb_alloc = icb_alloc + ill 
    58       ! 
    59       ALLOCATE( berg_grid%calving      (jpi,jpj)   , STAT=ill) 
    60       icb_alloc = icb_alloc + ill 
    61       ALLOCATE( berg_grid%calving_hflx (jpi,jpj)   , STAT=ill) 
    62       icb_alloc = icb_alloc + ill 
    63       ALLOCATE( berg_grid%stored_heat  (jpi,jpj)   , STAT=ill) 
    64       icb_alloc = icb_alloc + ill 
    65       ALLOCATE( berg_grid%floating_melt(jpi,jpj)   , STAT=ill) 
    66       icb_alloc = icb_alloc + ill 
    67       ALLOCATE( berg_grid%maxclass(jpi,jpj)        , STAT=ill) 
    68       icb_alloc = icb_alloc + ill 
    69       ! 
    70       ALLOCATE( berg_grid%stored_ice   (jpi,jpj,nclasses) , STAT=ill) 
    71       icb_alloc = icb_alloc + ill 
    72       ! 
    73       ALLOCATE( berg_grid%tmp (jpi,jpj) , STAT=ill) 
    74       icb_alloc = icb_alloc + ill 
    75       ! 
    76       ! expanded arrays for bilinear interpolation 
    77       ALLOCATE( uo_e(0:jpi+1,0:jpj+1) , STAT=ill) 
    78       icb_alloc = icb_alloc + ill 
    79       ALLOCATE( vo_e(0:jpi+1,0:jpj+1) , STAT=ill) 
    80       icb_alloc = icb_alloc + ill 
    81       ALLOCATE( ff_e(0:jpi+1,0:jpj+1) , STAT=ill) 
    82       icb_alloc = icb_alloc + ill 
    83       ALLOCATE( ua_e(0:jpi+1,0:jpj+1) , STAT=ill) 
    84       icb_alloc = icb_alloc + ill 
    85       ALLOCATE( va_e(0:jpi+1,0:jpj+1) , STAT=ill) 
    86       icb_alloc = icb_alloc + ill 
    87 #if defined key_lim2 || defined key_lim3 
    88       ALLOCATE( ui_e(0:jpi+1,0:jpj+1) , STAT=ill) 
    89       icb_alloc = icb_alloc + ill 
    90       ALLOCATE( vi_e(0:jpi+1,0:jpj+1) , STAT=ill) 
    91       icb_alloc = icb_alloc + ill 
    92 #endif 
    93       ALLOCATE( ssh_e(0:jpi+1,0:jpj+1) , STAT=ill) 
    94       icb_alloc = icb_alloc + ill 
    95       ALLOCATE( first_width    (nclasses) , STAT=ill) 
    96       icb_alloc = icb_alloc + ill 
    97       ALLOCATE( first_length   (nclasses) , STAT=ill) 
    98       icb_alloc = icb_alloc + ill 
    99       ALLOCATE( src_calving(jpi,jpj) , STAT=ill) 
    100       icb_alloc = icb_alloc + ill 
    101       ALLOCATE( src_calving_hflx(jpi,jpj) , STAT=ill) 
    102       icb_alloc = icb_alloc + ill 
    103  
    104       ALLOCATE( nicbfldpts(jpi) , STAT=ill) 
    105       icb_alloc = icb_alloc + ill 
    106       ALLOCATE( nicbflddest(jpi) , STAT=ill) 
    107       icb_alloc = icb_alloc + ill 
    108       ALLOCATE( nicbfldproc(jpni) , STAT=ill) 
    109       icb_alloc = icb_alloc + ill 
    110  
    111       IF( lk_mpp        )   CALL mpp_sum ( icb_alloc ) 
    112       IF( icb_alloc > 0 )   CALL ctl_warn('icb_alloc: allocation of arrays failed') 
    113  
    114    END FUNCTION icb_alloc 
    11547 
    11648   SUBROUTINE icb_init( pdt, kt ) 
Note: See TracChangeset for help on using the changeset viewer.