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 2715 for trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/sms_lobster.F90 – NEMO

Ignore:
Timestamp:
2011-03-30T17:58:35+02:00 (13 years ago)
Author:
rblod
Message:

First attempt to put dynamic allocation on the trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/sms_lobster.F90

    r2528 r2715  
    44   !! TOP :   LOBSTER 1 Source Minus Sink variables 
    55   !!---------------------------------------------------------------------- 
    6    !! History :    -   !  1999-09 (M. Levy)  original code 
    7    !!              -   !  2000-12 (O. Aumont, E. Kestenare) add sediment  
    8    !!             1.0  !  2005-10 (C. Ethe) F90 
    9    !!             1.0  !  2005-03  (A-S Kremeur) add fphylab, fzoolab, fdetlab, fdbod 
    10    !!              -   !  2005-06  (A-S Kremeur) add sedpocb, sedpocn, sedpoca 
    11    !!             2.0  !  2007-04  (C. Deltel, G. Madec) Free form and modules 
     6   !! History :  OPA  !  1999-09 (M. Levy)  original code 
     7   !!             -   !  2000-12 (O. Aumont, E. Kestenare) add sediment  
     8   !!   NEMO     1.0  !  2005-10 (C. Ethe) F90 
     9   !!             -   !  2005-03  (A-S Kremeur) add fphylab, fzoolab, fdetlab, fdbod 
     10   !!             -   !  2005-06  (A-S Kremeur) add sedpocb, sedpocn, sedpoca 
     11   !!            2.0  !  2007-04  (C. Deltel, G. Madec) Free form and modules 
    1212   !!---------------------------------------------------------------------- 
    13  
    1413#if defined key_lobster 
    1514   !!---------------------------------------------------------------------- 
    1615   !!   'key_lobster'                                         LOBSTER model 
    1716   !!---------------------------------------------------------------------- 
    18    USE par_oce 
    19    USE par_trc 
     17   USE par_oce    ! ocean parameters 
     18   USE par_trc    ! passive tracer parameters 
     19   USE lib_mpp    ! MPP library 
    2020 
    2121   IMPLICIT NONE 
    2222   PUBLIC 
    2323 
    24    !!---------------------------------------------------------------------- 
    25    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    26    !! $Id$  
    27    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    28    !!---------------------------------------------------------------------- 
     24   PUBLIC   sms_lobster_alloc   ! called in trcini_lobster.F90 
    2925 
    3026   !!  biological parameters 
     
    7672   REAL(wp) ::   fdbod    !: zooplankton mortality fraction that goes to detritus 
    7773 
    78    REAL(wp), DIMENSION(jpk,jp_lobster) ::   remdmp   !: depth dependant damping coefficient of passive tracers  
     74   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   remdmp   !: depth dependant damping coefficient of passive tracers  
    7975    
    8076   !! Optical parameters                                 
    8177   !! ------------------                                 
    82    REAL(wp) ::   xkr0       !: water coefficient absorption in red      (NAMELIST) 
    83    REAL(wp) ::   xkg0       !: water coefficient absorption in green    (NAMELIST) 
    84    REAL(wp) ::   xkrp       !: pigment coefficient absorption in red    (NAMELIST) 
    85    REAL(wp) ::   xkgp       !: pigment coefficient absorption in green  (NAMELIST) 
    86    REAL(wp) ::   xlr        !: exposant for pigment absorption in red   (NAMELIST) 
    87    REAL(wp) ::   xlg        !: exposant for pigment absorption in green (NAMELIST) 
    88    REAL(wp) ::   rpig       !: chla/chla+phea ratio                     (NAMELIST) 
     78   REAL(wp) ::   xkr0     !: water coefficient absorption in red      (NAMELIST) 
     79   REAL(wp) ::   xkg0     !: water coefficient absorption in green    (NAMELIST) 
     80   REAL(wp) ::   xkrp     !: pigment coefficient absorption in red    (NAMELIST) 
     81   REAL(wp) ::   xkgp     !: pigment coefficient absorption in green  (NAMELIST) 
     82   REAL(wp) ::   xlr      !: exposant for pigment absorption in red   (NAMELIST) 
     83   REAL(wp) ::   xlg      !: exposant for pigment absorption in green (NAMELIST) 
     84   REAL(wp) ::   rpig     !: chla/chla+phea ratio                     (NAMELIST) 
    8985                                                         
    90    INTEGER , DIMENSION(jpi,jpj)     ::   neln    !: number of levels in the euphotic layer 
    91    REAL(wp), DIMENSION(jpi,jpj)     ::   xze     !: euphotic layer depth 
    92    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xpar    !: par (photosynthetic available radiation) 
     86   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   neln   !: number of levels in the euphotic layer 
     87   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   xze    !: euphotic layer depth 
     88   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xpar   !: par (photosynthetic available radiation) 
    9389 
    9490   !! Sediment parameters                                
     
    9894   REAL(wp) ::   areacot      !: ??? 
    9995                                                         
    100    REAL(wp), DIMENSION(jpi,jpj)     ::   dminl   !: fraction of sinking POC released in sediments 
    101    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   dmin3   !: fraction of sinking POC released at each level 
     96   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dminl     !: fraction of sinking POC released in sediments 
     97   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dmin3     !: fraction of sinking POC released at each level 
    10298                                                         
    103    REAL(wp), DIMENSION(jpi,jpj) ::   sedpocb     !: mass of POC in sediments 
    104    REAL(wp), DIMENSION(jpi,jpj) ::   sedpocn     !: mass of POC in sediments 
    105    REAL(wp), DIMENSION(jpi,jpj) ::   sedpoca     !: mass of POC in sediments 
     99   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sedpocb   !: mass of POC in sediments 
     100   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sedpocn   !: mass of POC in sediments 
     101   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sedpoca   !: mass of POC in sediments 
    106102                                                         
    107    REAL(wp), DIMENSION(jpi,jpj) ::   fbod        !: rapid sinking particles 
    108    REAL(wp), DIMENSION(jpi,jpj) ::   cmask       !: ??? 
     103   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fbod      !: rapid sinking particles 
     104   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   cmask     !: ??? 
     105 
     106   !!---------------------------------------------------------------------- 
     107   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     108   !! $Id$  
     109   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     110   !!---------------------------------------------------------------------- 
     111CONTAINS 
     112 
     113   INTEGER FUNCTION sms_lobster_alloc() 
     114      !!---------------------------------------------------------------------- 
     115      !!        *** ROUTINE sms_lobster_alloc *** 
     116      !!---------------------------------------------------------------------- 
     117      ! 
     118      ALLOCATE(                                                                   & 
     119         !*  Biological parameters 
     120         &      remdmp(jpk,jp_lobster)                                      ,     & 
     121         !*  Optical parameters 
     122         &      neln   (jpi,jpj) , xze    (jpi,jpj)     , xpar(jpi,jpj,jpk) ,     & 
     123         !*  Sediment parameters 
     124         &      dminl  (jpi,jpj) , dmin3  (jpi,jpj,jpk)                     ,     & 
     125         &      sedpocb(jpi,jpj) , sedpocn(jpi,jpj)     , sedpoca(jpi,jpj)  ,     & 
     126         &      fbod   (jpi,jpj) , cmask  (jpi,jpj)                         , STAT=sms_lobster_alloc )  
     127         ! 
     128      IF( lk_mpp                 )   CALL mpp_sum ( sms_lobster_alloc ) 
     129      IF( sms_lobster_alloc /= 0 )   CALL ctl_warn('sms_lobster_alloc: failed to allocate arrays') 
     130      ! 
     131   END FUNCTION sms_lobster_alloc 
    109132 
    110133#else 
Note: See TracChangeset for help on using the changeset viewer.