Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/oce.F90

Timestamp:

2011-03-30T17:58:35+02:00 (13 years ago)

Author:

rblod

Message:

First attempt to put dynamic allocation on the trunk

File:

• trunk/NEMOGCM/NEMO/OPA_SRC/oce.F90 (modified) (1 diff)

trunk/NEMOGCM/NEMO/OPA_SRC/oce.F90

@@ -8 +8 @@
    !!            3.3  !  2010-09  (C. Ethe) TRA-TRC merge: add ts, gtsu, gtsv 4D arrays
    !!----------------------------------------------------------------------
-   USE par_oce      ! ocean parameters
+   USE par_oce        ! ocean parameters
+   USE lib_mpp        ! MPP library
 
    IMPLICIT NONE
    PRIVATE
 
-   LOGICAL         , PUBLIC ::   l_traldf_rot = .FALSE.  !: rotated laplacian operator for lateral diffusion
+   PUBLIC oce_alloc ! routine called by nemo_init in nemogcm.F90
 
-   !! dynamics and tracer fields                  ! before ! now    ! after   ! the after trends becomes the fields
-   !! --------------------------                  ! fields ! fields ! trends  ! only after tra_zdf and dyn_spg
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::   ub   ,  un    , ua      !: i-horizontal velocity        [m/s]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::   vb   ,  vn    , va      !: j-horizontal velocity        [m/s]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::           wn              !: vertical velocity            [m/s]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::   rotb ,  rotn            !: relative vorticity           [s-1]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::   hdivb,  hdivn           !: horizontal divergence        [s-1]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::   tb   ,  tn    , ta      !: potential temperature    [Celcius]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::   sb   ,  sn    , sa      !: salinity                     [psu]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jpts) ::   tsb  ,  tsn   , tsa     !: 4D T-S fields        [Celcius,psu] 
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::   rn2b ,  rn2             !: brunt-vaisala frequency**2   [s-2]
+   LOGICAL, PUBLIC ::   l_traldf_rot = .FALSE.  !: rotated laplacian operator for lateral diffusion
+
+   !! dynamics and tracer fields                            ! before ! now    ! after  ! the after trends becomes the fields
+   !! --------------------------                            ! fields ! fields ! trends ! only after tra_zdf and dyn_spg
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   ub   ,  un    , ua     !: i-horizontal velocity        [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   vb   ,  vn    , va     !: j-horizontal velocity        [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           wn             !: vertical velocity            [m/s]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   rotb ,  rotn           !: relative vorticity           [s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   hdivb,  hdivn          !: horizontal divergence        [s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   tb   ,  tn    , ta     !: potential temperature    [Celcius]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sb   ,  sn    , sa     !: salinity                     [psu]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tsb  ,  tsn   , tsa    !: 4D T-S fields        [Celcius,psu] 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   rn2b ,  rn2            !: brunt-vaisala frequency**2   [s-2]
    !
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   rhd    !: in situ density anomalie rhd=(rho-rau0)/rau0  [no units]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   rhop   !: potential volumic mass                           [kg/m3]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhd    !: in situ density anomalie rhd=(rho-rau0)/rau0  [no units]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhop   !: potential volumic mass                           [kg/m3]
 
-   !! free surface                       !  before  !  now     !  after   !
-   !! ------------                       !  fields  !  fields  !  trends  !
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sshb   ,  sshn    ,  ssha    !: sea surface height at t-point [m]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sshu_b ,  sshu_n  ,  sshu_a  !: sea surface height at u-point [m]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sshv_b ,  sshv_n  ,  sshv_a  !: sea surface height at u-point [m]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::             sshf_n             !: sea surface height at f-point [m]
+   !! free surface                                      !  before  ! now    ! after  !
+   !! ------------                                      !  fields  ! fields ! trends !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshb   , sshn   , ssha   !: sea surface height at t-point [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshu_b , sshu_n , sshu_a !: sea surface height at u-point [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshv_b , sshv_n , sshv_a !: sea surface height at u-point [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::            sshf_n          !: sea surface height at f-point [m]
    !
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   spgu, spgv                   !: horizontal surface pressure gradient
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   spgu, spgv               !: horizontal surface pressure gradient
 
    !! interpolated gradient (only used in zps case)
    !! ---------------------
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpts) ::   gtsu, gtsv   !: horizontal gradient of T, S bottom u-point
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)      ::   gru , grv    !: horizontal gradient of rd at bottom u-point
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gtsu, gtsv   !: horizontal gradient of T, S bottom u-point 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gru , grv    !: horizontal gradient of rd at bottom u-point
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION oce_alloc()
+      !!----------------------------------------------------------------------
+      !!                   ***  FUNCTION oce_alloc  ***
+      !!----------------------------------------------------------------------
+      INTEGER :: ierr(2)
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( ub   (jpi,jpj,jpk)      , un   (jpi,jpj,jpk)      , ua(jpi,jpj,jpk)       ,     &
+         &      vb   (jpi,jpj,jpk)      , vn   (jpi,jpj,jpk)      , va(jpi,jpj,jpk)       ,     &      
+         &      wn   (jpi,jpj,jpk)      ,                                                       &
+         &      rotb (jpi,jpj,jpk)      , rotn (jpi,jpj,jpk)      ,                             &   
+         &      hdivb(jpi,jpj,jpk)      , hdivn(jpi,jpj,jpk)      ,                             &
+         &      tb   (jpi,jpj,jpk)      , tn   (jpi,jpj,jpk)      , ta(jpi,jpj,jpk)       ,     &
+         &      sb   (jpi,jpj,jpk)      , sn   (jpi,jpj,jpk)      , sa (jpi,jpj,jpk)      ,     &      
+         &      tsb  (jpi,jpj,jpk,jpts) , tsn  (jpi,jpj,jpk,jpts) , tsa(jpi,jpj,jpk,jpts) ,     &
+         &      rn2b (jpi,jpj,jpk)      , rn2  (jpi,jpj,jpk)                              , STAT=ierr(1) )
+         !
+      ALLOCATE(rhd (jpi,jpj,jpk) ,                                         &
+         &     rhop(jpi,jpj,jpk) ,                                         &
+         &     sshb  (jpi,jpj)   , sshn  (jpi,jpj) , ssha  (jpi,jpj) ,     &
+         &     sshu_b(jpi,jpj)   , sshu_n(jpi,jpj) , sshu_a(jpi,jpj) ,     &
+         &     sshv_b(jpi,jpj)   , sshv_n(jpi,jpj) , sshv_a(jpi,jpj) ,     &
+         &                         sshf_n(jpi,jpj) ,                       &
+         &     spgu  (jpi,jpj)   , spgv(jpi,jpj)   ,                       &
+         &     gtsu(jpi,jpj,jpts), gtsv(jpi,jpj,jpts),                     &
+         &     gru(jpi,jpj)      , grv(jpi,jpj)                      , STAT=ierr(2) )
+         !
+      oce_alloc = MAXVAL( ierr )
+      IF( oce_alloc /= 0 )   CALL ctl_warn('oce_alloc: failed to allocate arrays')
+      !
+   END FUNCTION oce_alloc
+
    !!======================================================================
 END MODULE oce