Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.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/SBC/sbcrnf.F90 (modified) (6 diffs)

trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

@@ -19 +19 @@
    USE phycst          ! physical constants
    USE sbc_oce         ! surface boundary condition variables
+   USE closea          ! closed seas
    USE fldread         ! read input field at current time step
+   USE restart         ! restart
    USE in_out_manager  ! I/O manager
    USE iom             ! I/O module
-   USE restart         ! restart
-   USE closea          ! closed seas
+   USE lib_mpp         ! MPP library
 
    IMPLICIT NONE
@@ -30 +31 @@
    PUBLIC   sbc_rnf       ! routine call in sbcmod module
    PUBLIC   sbc_rnf_div   ! routine called in sshwzv module
-
-   !                                                      !!* namsbc_rnf namelist *
+   PUBLIC   sbc_rnf_alloc ! routine call in sbcmod module
+
+   !                                                     !!* namsbc_rnf namelist *
    CHARACTER(len=100), PUBLIC ::   cn_dir       = './'    !: Root directory for location of ssr files
    LOGICAL           , PUBLIC ::   ln_rnf_depth = .false. !: depth       river runoffs attribute specified in a file
@@ -47 +49 @@
    REAL(wp)          , PUBLIC ::   rn_rfact     = 1._wp   !: multiplicative factor for runoff
 
-   INTEGER , PUBLIC                          ::   nkrnf = 0         !: nb of levels over which Kz is increased at river mouths
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)      ::   rnfmsk            !: river mouth mask (hori.)
-   REAL(wp), PUBLIC, DIMENSION(jpk)          ::   rnfmsk_z          !: river mouth mask (vert.)
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)      ::   h_rnf             !: depth of runoff in m
-   INTEGER,  PUBLIC, DIMENSION(jpi,jpj)      ::   nk_rnf            !: depth of runoff in model levels
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpts) :: rnf_tsc_b, rnf_tsc  !: before and now T & S contents of runoffs  [K.m/s & PSU.m/s]
+   INTEGER , PUBLIC  ::   nkrnf = 0         !: nb of levels over which Kz is increased at river mouths
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rnfmsk              !: river mouth mask (hori.)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     ::   rnfmsk_z            !: river mouth mask (vert.)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   h_rnf               !: depth of runoff in m
+   INTEGER,  PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nk_rnf              !: depth of runoff in model levels
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rnf_tsc_b, rnf_tsc  !: before and now T & S runoff contents   [K.m/s & PSU.m/s]
    
    REAL(wp) ::   r1_rau0   ! = 1 / rau0 
@@ -68 +70 @@
    !!----------------------------------------------------------------------
 CONTAINS
+
+   INTEGER FUNCTION sbc_rnf_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE sbc_rnf_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( rnfmsk(jpi,jpj)         , rnfmsk_z(jpk)          ,     &
+         &      h_rnf (jpi,jpj)         , nk_rnf  (jpi,jpj)      ,     &
+         &      rnf_tsc_b(jpi,jpj,jpts) , rnf_tsc (jpi,jpj,jpts) , STAT=sbc_rnf_alloc )
+         !
+      IF( lk_mpp            )   CALL mpp_sum ( sbc_rnf_alloc )
+      IF( sbc_rnf_alloc > 0 )   CALL ctl_warn('sbc_rnf_alloc: allocation of arrays failed')
+   END FUNCTION sbc_rnf_alloc
 
    SUBROUTINE sbc_rnf( kt )
@@ -182 +196 @@
       !! ** Action  :   phdivn   decreased by the runoff inflow
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   phdivn   ! horizontal divergence
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phdivn   ! horizontal divergence
       !!
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -276 +290 @@
       !                                   !   Type of runoff
       !                                   ! ==================
+      !                                         !==  allocate runoff arrays
+      IF( sbc_rnf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_rnf_alloc : unable to allocate arrays' )
       !
       IF( ln_rnf_emp ) THEN                     !==  runoffs directly provided in the precipitations  ==!