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 7581 for branches/UKMO/dev_r5518_optim_GO6_alloc/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90 – NEMO

Ignore:
Timestamp:
2017-01-19T13:20:22+01:00 (7 years ago)
Author:
frrh
Message:

#1821. Commit optimisations to replace pointers with allocatable
work arrays. This is based on MG's initial work, but I've added
traadv_tvd.F90 since this will be applicable more generally to NEMO
whilst traadv_muscl.F90 only applies if MEDUSA is active.
I've not bothered with fldread.F90 since this is only called a
handful of times in any given run so I don't want to increase
the potential risk of code clashes with other branches for no
measurable gain.

File:
1 edited

Legend:

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

    r7560 r7581  
    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(jpi, jpj)) 
     372      ALLOCATE(zwy_sav(jpi, jpj)) 
     373      ALLOCATE(zwi(jpi, jpj, jpk)) 
     374      ALLOCATE(zwz(jpi, jpj, jpk))         
     375      ALLOCATE(zhdiv(jpi, jpj, jpk))        
     376      ALLOCATE(zwz_sav(jpi, jpj, jpk))        
     377      ALLOCATE(zwzts(jpi, jpj, jpk))  
     378      ALLOCATE(ztrs(jpi, jpj, jpk, 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(jpi, jpj, jpk))        
     391         ALLOCATE(ztrdy(jpi, jpj, jpk))        
     392         ALLOCATE(ztrdz(jpi, jpj, 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(jpi, jpj, 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(jpi, jpj, jpk)) 
     668      ALLOCATE(zbetdo(jpi, jpj, jpk)) 
     669      ALLOCATE(zbup(jpi, jpj, jpk)) 
     670      ALLOCATE(zbdo(jpi, jpj, 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.