Ignore:
Timestamp:
2017-03-09T11:38:31+01:00 (4 years ago)
Author:
frrh
Message:

Apply optimisations to various areas of code replacing the use of
allocated pointers with straightforward direct ALLOCATE and DEALLOCATE
operations.

These optimisations largely have an impact in models featuring MEDUSA,
i.e. those with significant numbers of tracers, although they are
expected to have a small impact in all configurations.

Code developed and tested in NEMO branch branches/UKMO/dev_r5518_optim_GO6_alloc
Tested in stand-alone GO6-GSI8, GO6-GSI8-MEDUSA and UKESM coupled models.
NEMO ticket #1821 documents this change further.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r7560 r7771  
    8686      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk   !   -      - 
    8787      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      - 
    88       REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz 
    89       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz, zptry 
    90       REAL(wp), POINTER, DIMENSION(:,:)   :: z2d 
     88      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zwi, zwz 
     89      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz, zptry 
     90      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   :: z2d 
    9191      !!---------------------------------------------------------------------- 
    9292      ! 
    9393      IF( nn_timing == 1 )  CALL timing_start('tra_adv_tvd') 
    9494      ! 
    95       CALL wrk_alloc( jpi, jpj, jpk, zwi, zwz ) 
     95      ALLOCATE(zwi(1:jpi, 1:jpj, 1:jpk)) 
     96      ALLOCATE(zwz(1:jpi, 1:jpj, 1:jpk)) 
     97 
    9698      ! 
    9799      IF( kt == kit000 )  THEN 
     
    107109      ! 
    108110      IF( l_trd .OR. l_trans )  THEN 
    109          CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
     111         ALLOCATE(ztrdx(1:jpi, 1:jpj, 1:jpk)) 
     112         ALLOCATE(ztrdy(1:jpi, 1:jpj, 1:jpk)) 
     113         ALLOCATE(ztrdz(1:jpi, 1:jpj, 1:jpk)) 
    110114         ztrdx(:,:,:) = 0.e0   ;    ztrdy(:,:,:) = 0.e0   ;   ztrdz(:,:,:) = 0.e0 
    111          CALL wrk_alloc( jpi, jpj, z2d ) 
     115         ALLOCATE(z2d(1:jpi, 1:jpj)) 
    112116      ENDIF 
    113117      ! 
    114118      IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    115          CALL wrk_alloc( jpi, jpj, jpk, zptry ) 
     119         ALLOCATE(zptry(1:jpi, 1:jpj, 1:jpk)) 
    116120         zptry(:,:,:) = 0._wp 
    117121      ENDIF 
     
    304308      END DO 
    305309      ! 
    306       CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz ) 
     310      DEALLOCATE( zwi ) 
     311      DEALLOCATE( zwz ) 
    307312      IF( l_trd .OR. l_trans )  THEN  
    308          CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
    309          CALL wrk_dealloc( jpi, jpj, z2d ) 
     313         DEALLOCATE( ztrdx ) 
     314         DEALLOCATE( ztrdy ) 
     315         DEALLOCATE( ztrdz ) 
     316         DEALLOCATE( z2d ) 
    310317      ENDIF 
    311       IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 
     318      IF( cdtype == 'TRA' .AND. ln_diaptr ) DEALLOCATE( zptry ) 
    312319      ! 
    313320      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_tvd') 
     
    353360      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk   !   -      - 
    354361      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      - 
    355       REAL(wp), POINTER, DIMENSION(:,:  ) :: zwx_sav , zwy_sav 
    356       REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz, zhdiv, zwz_sav, zwzts 
    357       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 
    358       REAL(wp), POINTER, DIMENSION(:,:,:) :: zptry 
    359       REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrs 
     362      REAL(wp), ALLOCATABLE, DIMENSION(:,:  ) :: zwx_sav , zwy_sav 
     363      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zwi, zwz, zhdiv, zwz_sav, zwzts 
     364      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 
     365      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zptry 
     366      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrs 
    360367      !!---------------------------------------------------------------------- 
    361368      ! 
    362369      IF( nn_timing == 1 )  CALL timing_start('tra_adv_tvd_zts') 
    363370      ! 
    364       CALL wrk_alloc( jpi, jpj, zwx_sav, zwy_sav ) 
    365       CALL wrk_alloc( jpi, jpj, jpk, zwi, zwz , zhdiv, zwz_sav, zwzts ) 
    366       CALL wrk_alloc( jpi, jpj, jpk, kjpt+1, ztrs ) 
     371      ALLOCATE(zwx_sav(1:jpi, 1:jpj)) 
     372      ALLOCATE(zwy_sav(1:jpi, 1:jpj)) 
     373      ALLOCATE(zwi(1:jpi, 1:jpj, 1:jpk)) 
     374      ALLOCATE(zwz(1:jpi, 1:jpj, 1:jpk))         
     375      ALLOCATE(zhdiv(1:jpi, 1:jpj, 1:jpk))        
     376      ALLOCATE(zwz_sav(1:jpi, 1:jpj, 1:jpk))        
     377      ALLOCATE(zwzts(1:jpi, 1:jpj, 1:jpk))  
     378      ALLOCATE(ztrs(1:jpi, 1:jpj, 1:jpk, 1:kjpt+1)) 
    367379      ! 
    368380      IF( kt == kit000 )  THEN 
     
    376388      ! 
    377389      IF( l_trd )  THEN 
    378          CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
     390         ALLOCATE(ztrdx(1:jpi, 1:jpj, 1:jpk))        
     391         ALLOCATE(ztrdy(1:jpi, 1:jpj, 1:jpk))        
     392         ALLOCATE(ztrdz(1:jpi, 1:jpj, 1:jpk))        
    379393         ztrdx(:,:,:) = 0._wp  ;    ztrdy(:,:,:) = 0._wp  ;   ztrdz(:,:,:) = 0._wp 
    380394      ENDIF 
    381395      ! 
    382396      IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    383          CALL wrk_alloc( jpi, jpj,jpk, zptry ) 
     397         ALLOCATE(zptry(1:jpi, 1:jpj, 1:jpk))        
    384398         zptry(:,:,:) = 0._wp 
    385399      ENDIF 
     
    603617      END DO 
    604618      ! 
    605                    CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz, zhdiv, zwz_sav, zwzts ) 
    606                    CALL wrk_dealloc( jpi, jpj, jpk, kjpt+1, ztrs ) 
    607                    CALL wrk_dealloc( jpi, jpj, zwx_sav, zwy_sav ) 
    608       IF( l_trd )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
    609       IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 
     619      DEALLOCATE(zwi)  
     620      DEALLOCATE(zwz)  
     621      DEALLOCATE(zhdiv)  
     622      DEALLOCATE(zwz_sav)  
     623      DEALLOCATE(zwzts) 
     624      DEALLOCATE(ztrs ) 
     625      DEALLOCATE(zwx_sav)  
     626      DEALLOCATE(zwy_sav ) 
     627 
     628      IF( l_trd )  THEN 
     629          DEALLOCATE(ztrdx)  
     630          DEALLOCATE(ztrdy)  
     631          DEALLOCATE(ztrdz) 
     632      END IF 
     633 
     634      IF( cdtype == 'TRA' .AND. ln_diaptr ) DEALLOCATE(zptry ) 
    610635      ! 
    611636      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_tvd_zts') 
     
    635660      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt   ! local scalars 
    636661      REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      - 
    637       REAL(wp), POINTER, DIMENSION(:,:,:) :: zbetup, zbetdo, zbup, zbdo 
     662      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zbetup, zbetdo, zbup, zbdo 
    638663      !!---------------------------------------------------------------------- 
    639664      ! 
    640665      IF( nn_timing == 1 )  CALL timing_start('nonosc') 
    641666      ! 
    642       CALL wrk_alloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo ) 
     667      ALLOCATE(zbetup(1:jpi, 1:jpj, 1:jpk)) 
     668      ALLOCATE(zbetdo(1:jpi, 1:jpj, 1:jpk)) 
     669      ALLOCATE(zbup(1:jpi, 1:jpj, 1:jpk)) 
     670      ALLOCATE(zbdo(1:jpi, 1:jpj, 1:jpk)) 
    643671      ! 
    644672      zbig  = 1.e+40_wp 
     
    717745      CALL lbc_lnk( paa, 'U', -1. )   ;   CALL lbc_lnk( pbb, 'V', -1. )   ! lateral boundary condition (changed sign) 
    718746      ! 
    719       CALL wrk_dealloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo ) 
     747      DEALLOCATE(zbetup) 
     748      DEALLOCATE(zbetdo)  
     749      DEALLOCATE(zbup) 
     750      DEALLOCATE(zbdo) 
    720751      ! 
    721752      IF( nn_timing == 1 )  CALL timing_stop('nonosc') 
Note: See TracChangeset for help on using the changeset viewer.