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/trdmld.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/trdmld.F90

    r2528 r2715  
    1515   !!   'key_trdmld'                          mixed layer trend diagnostics 
    1616   !!---------------------------------------------------------------------- 
    17    !!---------------------------------------------------------------------- 
    1817   !!   trd_mld          : T and S cumulated trends averaged over the mixed layer 
    1918   !!   trd_mld_zint     : T and S trends vertical integration 
     
    2322   USE dom_oce         ! ocean space and time domain variables 
    2423   USE trdmod_oce      ! ocean variables trends 
     24   USE trdmld_oce      ! ocean variables trends 
    2525   USE ldftra_oce      ! ocean active tracers lateral physics 
    2626   USE zdf_oce         ! ocean vertical physics 
     
    3737   USE prtctl          ! Print control 
    3838   USE restart         ! for lrst_oce 
     39   USE lib_mpp         ! MPP library 
    3940 
    4041   IMPLICIT NONE 
     
    4748   CHARACTER (LEN=40) ::  clhstnam         ! name of the trends NetCDF file 
    4849   INTEGER ::   nh_t, nmoymltrd 
    49    INTEGER ::   nidtrd, ndextrd1(jpi*jpj) 
     50   INTEGER ::   nidtrd 
     51   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) ::   ndextrd1 
    5052   INTEGER ::   ndimtrd1                         
    5153   INTEGER ::   ionce, icount                    
     
    5860   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    5961   !! $Id$  
    60    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     62   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6163   !!---------------------------------------------------------------------- 
    62  
    6364CONTAINS 
     65 
     66   INTEGER FUNCTION trd_mld_alloc() 
     67      !!---------------------------------------------------------------------- 
     68      !!                  ***  ROUTINE trd_mld_alloc  *** 
     69      !!---------------------------------------------------------------------- 
     70      ALLOCATE( ndextrd1(jpi*jpj) , STAT=trd_mld_alloc ) 
     71      ! 
     72      IF( lk_mpp             )   CALL mpp_sum ( trd_mld_alloc ) 
     73      IF( trd_mld_alloc /= 0 )   CALL ctl_warn('trd_mld_alloc: failed to allocate array ndextrd1') 
     74   END FUNCTION trd_mld_alloc 
     75 
    6476 
    6577   SUBROUTINE trd_mld_zint( pttrdmld, pstrdmld, ktrd, ctype ) 
     
    8193      !!            surface and the control surface is called "mixed-layer" 
    8294      !!---------------------------------------------------------------------- 
    83       INTEGER, INTENT( in ) ::   ktrd                             ! ocean trend index 
    84       CHARACTER(len=2), INTENT( in ) :: ctype                     ! surface/bottom (2D arrays) or 
    85       !                                                           ! interior (3D arrays) physics 
    86       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::  pttrdmld ! temperature trend  
    87       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::  pstrdmld ! salinity trend  
     95      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     96      USE wrk_nemo, ONLY:   zvlmsk => wrk_2d_10     ! 2D workspace 
     97      ! 
     98      INTEGER                         , INTENT( in ) ::   ktrd       ! ocean trend index 
     99      CHARACTER(len=2)                , INTENT( in ) ::   ctype      ! 2D surface/bottom or 3D interior physics 
     100      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   pttrdmld   ! temperature trend  
     101      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   pstrdmld   ! salinity trend  
     102      ! 
    88103      INTEGER ::   ji, jj, jk, isum 
    89       REAL(wp), DIMENSION(jpi,jpj) ::  zvlmsk 
    90       !!---------------------------------------------------------------------- 
     104      !!---------------------------------------------------------------------- 
     105 
     106      IF( wrk_in_use(2, 10) ) THEN 
     107         CALL ctl_stop('trd_mld_zint : requested workspace arrays unavailable')   ;   RETURN 
     108      ENDIF 
    91109 
    92110      ! I. Definition of control surface and associated fields 
     
    176194         smltrd(:,:,ktrd) = smltrd(:,:,ktrd) + pstrdmld(:,:,1) * wkx(:,:,1)             
    177195      END SELECT 
     196      ! 
     197      IF( wrk_not_released(2, 10) )   CALL ctl_stop('trd_mld_zint: failed to release workspace arrays') 
    178198      ! 
    179199   END SUBROUTINE trd_mld_zint 
     
    227247      !!       - See NEMO documentation (in preparation) 
    228248      !!---------------------------------------------------------------------- 
     249      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     250      USE wrk_nemo, ONLY: ztmltot => wrk_2d_1,  zsmltot => wrk_2d_2 ! dT/dt over the anlysis window (including Asselin) 
     251      USE wrk_nemo, ONLY: ztmlres => wrk_2d_3,  zsmlres => wrk_2d_4 ! residual = dh/dt entrainment term 
     252      USE wrk_nemo, ONLY: ztmlatf => wrk_2d_5,  zsmlatf => wrk_2d_6 ! needed for storage only 
     253      USE wrk_nemo, ONLY: ztmltot2 => wrk_2d_7, ztmlres2 => wrk_2d_8, ztmltrdm2 => wrk_2d_9    ! \  working arrays to diagnose the trends 
     254      USE wrk_nemo, ONLY: zsmltot2 => wrk_2d_10, zsmlres2 => wrk_2d_11, zsmltrdm2 => wrk_2d_12 !  > associated with the time meaned ML T & S 
     255      USE wrk_nemo, ONLY: ztmlatf2 => wrk_2d_13, zsmlatf2 => wrk_2d_14     
     256      USE wrk_nemo, ONLY: wrk_3d_1, wrk_3d_2                     ! / 
     257      ! 
    229258      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    230       !! 
     259      ! 
    231260      INTEGER :: ji, jj, jk, jl, ik, it, itmod 
    232261      LOGICAL :: lldebug = .TRUE. 
    233262      REAL(wp) :: zavt, zfn, zfn2 
    234       REAL(wp) ,DIMENSION(jpi,jpj) ::     & 
    235            ztmltot,  zsmltot,             & ! dT/dt over the anlysis window (including Asselin) 
    236            ztmlres,  zsmlres,             & ! residual = dh/dt entrainment term 
    237            ztmlatf,  zsmlatf,             & ! needed for storage only 
    238            ztmltot2, ztmlres2, ztmltrdm2, & ! \  working arrays to diagnose the trends 
    239            zsmltot2, zsmlres2, zsmltrdm2, & !  > associated with the time meaned ML T & S 
    240            ztmlatf2, zsmlatf2               ! / 
    241       REAL(wp), DIMENSION(jpi,jpj,jpltrd) ::  & 
    242            ztmltrd2, zsmltrd2               ! only needed for mean diagnostics 
     263      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztmltrd2, zsmltrd2   ! only needed for mean diagnostics 
    243264#if defined key_dimgout 
    244265      INTEGER ::  iyear,imon,iday 
     
    247268      !!---------------------------------------------------------------------- 
    248269       
     270      ! Check that the workspace arrays are all OK to be used 
     271      IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14)  .OR. & 
     272          wrk_in_use(3, 1,2)                                 ) THEN 
     273         CALL ctl_stop('trd_mld : requested workspace arrays unavailable')   ;   RETURN 
     274      ELSE IF(jpltrd > jpk) THEN 
     275         ! ARPDBG, is this reasonable or will this cause trouble in the future? 
     276         CALL ctl_stop('trd_mld : no. of mixed-layer trends (jpltrd) exceeds no. of model levels so cannot use 3D workspaces.') 
     277         RETURN          
     278      END IF 
     279      ! Set-up pointers into sub-arrays of 3d-workspaces 
     280      ztmltrd2 => wrk_3d_1(1:,:,1:jpltrd) 
     281      zsmltrd2 => wrk_3d_2(1:,:,1:jpltrd) 
    249282 
    250283      ! ====================================================================== 
     
    707740      IF( lrst_oce )   CALL trd_mld_rst_write( kt )  
    708741 
     742      IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14)  .OR. & 
     743          wrk_not_released(3, 1,2)                                )   & 
     744          CALL ctl_stop('trd_mld : failed to release workspace arrays.') 
     745      ! 
    709746   END SUBROUTINE trd_mld 
    710747 
     
    716753      !! ** Purpose :   computation of vertically integrated T and S budgets 
    717754      !!      from ocean surface down to control surface (NetCDF output) 
    718       !! 
    719       !!---------------------------------------------------------------------- 
    720       !! * Local declarations 
     755      !!---------------------------------------------------------------------- 
    721756      INTEGER :: jl 
    722757      INTEGER :: inum   ! logical unit 
    723  
    724758      REAL(wp) ::   zjulian, zsto, zout 
    725  
    726759      CHARACTER (LEN=40) ::   clop 
    727760      CHARACTER (LEN=12) ::   clmxl, cltu, clsu 
    728  
    729761      !!---------------------------------------------------------------------- 
    730762 
     
    763795         nwarn = nwarn + 1 
    764796      END IF 
     797 
     798      !                                   ! allocate trdmld arrays 
     799      IF( trd_mld_alloc()    /= 0 )   CALL ctl_stop( 'STOP', 'trd_mld_init : unable to allocate trdmld     arrays' ) 
     800      IF( trdmld_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trd_mld_init : unable to allocate trdmld_oce arrays' ) 
    765801 
    766802      ! I.2 Initialize arrays to zero or read a restart file 
Note: See TracChangeset for help on using the changeset viewer.