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/OPA_SRC/TRD/trdtra.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/OPA_SRC/TRD/trdtra.F90

    r2528 r2715  
    44   !! Ocean diagnostics:  ocean tracers trends 
    55   !!===================================================================== 
    6    !! History :  9.0  !  2004-08  (C. Talandier) Original code 
    7    !!                 !  2005-04  (C. Deltel)    Add Asselin trend in the ML budget 
    8    !!      NEMO  3.3  !  2010-06  (C. Ethe) merge TRA-TRC  
     6   !! History :  1.0  !  2004-08  (C. Talandier) Original code 
     7   !!            2.0  !  2005-04  (C. Deltel)    Add Asselin trend in the ML budget 
     8   !!            3.3  !  2010-06  (C. Ethe) merge TRA-TRC  
    99   !!---------------------------------------------------------------------- 
    1010#if  defined key_trdtra || defined key_trdmld || defined key_trdmld_trc  
     
    1212   !!   trd_tra      : Call the trend to be computed 
    1313   !!---------------------------------------------------------------------- 
    14    USE dom_oce            ! ocean domain  
    15    USE trdmod_oce         ! ocean active mixed layer tracers trends  
    16    USE trdmod             ! ocean active mixed layer tracers trends  
    17    USE trdmod_trc         ! ocean passive mixed layer tracers trends  
     14   USE dom_oce          ! ocean domain  
     15   USE trdmod_oce       ! ocean active mixed layer tracers trends  
     16   USE trdmod           ! ocean active mixed layer tracers trends  
     17   USE trdmod_trc       ! ocean passive mixed layer tracers trends  
     18   USE in_out_manager   ! I/O manager 
     19   USE lib_mpp          ! MPP library 
    1820 
    1921   IMPLICIT NONE 
    2022   PRIVATE 
    2123 
    22    PUBLIC trd_tra          ! called by all  traXX modules 
     24   PUBLIC   trd_tra          ! called by all  traXX modules 
    2325  
    24    !! * Module declaration 
    25    REAL(wp), DIMENSION(jpi,jpj,jpk), SAVE :: trdtx, trdty, trdt  !: 
     26   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: trdtx, trdty, trdt  !: 
    2627 
    2728   !! * Substitutions 
     
    2930#  include "vectopt_loop_substitute.h90" 
    3031   !!---------------------------------------------------------------------- 
    31    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     32   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    3233   !! $Id$ 
    33    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    34    !!---------------------------------------------------------------------- 
    35  
     34   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     35   !!---------------------------------------------------------------------- 
    3636CONTAINS 
     37 
     38   INTEGER FUNCTION trd_tra_alloc() 
     39      !!---------------------------------------------------------------------------- 
     40      !!                  ***  FUNCTION trd_tra_alloc  *** 
     41      !!---------------------------------------------------------------------------- 
     42      ALLOCATE( trdtx(jpi,jpj,jpk) , trdty(jpi,jpj,jpk) , trdt(jpi,jpj,jpk) , STAT= trd_tra_alloc ) 
     43      ! 
     44      IF( lk_mpp             )   CALL mpp_sum ( trd_tra_alloc ) 
     45      IF( trd_tra_alloc /= 0 )   CALL ctl_warn('trd_tra_alloc: failed to allocate arrays') 
     46   END FUNCTION trd_tra_alloc 
     47 
    3748 
    3849   SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pun, ptra ) 
     
    5061      !!        nn_ctls > 1  : use fixed level surface jk = nn_ctls 
    5162      !!---------------------------------------------------------------------- 
     63      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     64      USE wrk_nemo, ONLY:   ztrds => wrk_3d_10   ! 3D workspace 
     65      ! 
    5266      INTEGER                         , INTENT(in)           ::  kt      ! time step 
    5367      CHARACTER(len=3)                , INTENT(in)           ::  ctype   ! tracers trends type 'TRA'/'TRC' 
     
    5771      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  pun     ! velocity  
    5872      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  ptra    ! Tracer variable  
    59       !! 
    60       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  ztrds    !   
    61       !!---------------------------------------------------------------------- 
    62  
     73      !!---------------------------------------------------------------------- 
     74 
     75      IF( wrk_in_use(3, 10) ) THEN 
     76         CALL ctl_stop('trd_tra: requested workspace array unavailable')   ;   RETURN 
     77      ENDIF 
     78 
     79      IF( .NOT. ALLOCATED( trdtx ) ) THEN       ! allocate trdtra arrays 
     80         IF( trd_tra_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trd_tra : unable to allocate arrays' ) 
     81      ENDIF 
     82       
    6383      ! Control of optional arguments 
    6484      IF( ctype == 'TRA' .AND. ktra == jp_tem ) THEN  
     
    118138      ENDIF 
    119139      ! 
     140      IF( wrk_not_released(3, 10) )   CALL ctl_stop('trd_tra: failed to release workspace array') 
     141      ! 
    120142   END SUBROUTINE trd_tra 
     143 
    121144 
    122145   SUBROUTINE trd_tra_adv( pf, pun, ptn, cdir, ptrd ) 
     
    130153      !!                k-advective trends = -un. di+1[T] = -( dk+1[fi] - tn dk+1[un] ) 
    131154      !!---------------------------------------------------------------------- 
    132       REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk)           ::   pf      ! advective flux in one direction 
    133       REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk)           ::   pun     ! now velocity  in one direction 
    134       REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk)           ::   ptn     ! now or before tracer  
    135       CHARACTER(len=1), INTENT(in )                                   ::   cdir    ! X/Y/Z direction 
    136       REAL(wp)        , INTENT(out), DIMENSION(jpi,jpj,jpk)           ::   ptrd    ! advective trend in one direction 
    137       !! 
    138       INTEGER                          ::   ji, jj, jk   ! dummy loop indices 
    139       INTEGER                          ::   ii, ij, ik   ! index shift function of the direction 
    140       REAL(wp)                         ::   zbtr         ! temporary scalar 
     155      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk) ::   pf      ! advective flux in one direction 
     156      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk) ::   pun     ! now velocity  in one direction 
     157      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk) ::   ptn     ! now or before tracer  
     158      CHARACTER(len=1), INTENT(in )                         ::   cdir    ! X/Y/Z direction 
     159      REAL(wp)        , INTENT(out), DIMENSION(jpi,jpj,jpk) ::   ptrd    ! advective trend in one direction 
     160      ! 
     161      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     162      INTEGER  ::   ii, ij, ik   ! index shift function of the direction 
     163      REAL(wp) ::   zbtr         ! local scalar 
    141164      !!---------------------------------------------------------------------- 
    142165 
     
    167190#   else 
    168191   !!---------------------------------------------------------------------- 
    169    !!   Default case :                                         Empty module 
     192   !!   Default case :          Dummy module           No trend diagnostics 
    170193   !!---------------------------------------------------------------------- 
    171194   USE par_oce      ! ocean variables trends 
    172  
    173195CONTAINS 
    174  
    175196   SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pu, ptra ) 
    176197      !!---------------------------------------------------------------------- 
     
    182203      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  pu      ! velocity  
    183204      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  ptra    ! Tracer variable  
    184       WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd(1,1,1) 
    185       WRITE(*,*) ' "   ": You should not have seen this print! error ?', ptra(1,1,1) 
    186       WRITE(*,*) ' "   ": You should not have seen this print! error ?', pu(1,1,1) 
    187       WRITE(*,*) ' "   ": You should not have seen this print! error ?', ktrd 
    188       WRITE(*,*) ' "   ": You should not have seen this print! error ?', ktra 
    189       WRITE(*,*) ' "   ": You should not have seen this print! error ?', ctype 
    190       WRITE(*,*) ' "   ": You should not have seen this print! error ?', kt 
     205      WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd(1,1,1), ptra(1,1,1), pu(1,1,1),   & 
     206         &                                                               ktrd, ktra, ctype, kt 
    191207   END SUBROUTINE trd_tra 
    192208#   endif 
Note: See TracChangeset for help on using the changeset viewer.