Changeset 7771 for branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

Timestamp:

2017-03-09T11:38:31+01:00 (7 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:

• branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90 (modified) (8 diffs)

branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

@@ -86 +86 @@
       REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk   !   -      -
       REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz, zptry
-      REAL(wp), POINTER, DIMENSION(:,:)   :: z2d
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zwi, zwz
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz, zptry
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   :: z2d
       !!----------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('tra_adv_tvd')
       !
-      CALL wrk_alloc( jpi, jpj, jpk, zwi, zwz )
+      ALLOCATE(zwi(1:jpi, 1:jpj, 1:jpk))
+      ALLOCATE(zwz(1:jpi, 1:jpj, 1:jpk))
+
       !
       IF( kt == kit000 )  THEN
@@ -107 +109 @@
       !
       IF( l_trd .OR. l_trans )  THEN
-         CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
+         ALLOCATE(ztrdx(1:jpi, 1:jpj, 1:jpk))
+         ALLOCATE(ztrdy(1:jpi, 1:jpj, 1:jpk))
+         ALLOCATE(ztrdz(1:jpi, 1:jpj, 1:jpk))
          ztrdx(:,:,:) = 0.e0   ;    ztrdy(:,:,:) = 0.e0   ;   ztrdz(:,:,:) = 0.e0
-         CALL wrk_alloc( jpi, jpj, z2d )
+         ALLOCATE(z2d(1:jpi, 1:jpj))
       ENDIF
       !
       IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
-         CALL wrk_alloc( jpi, jpj, jpk, zptry )
+         ALLOCATE(zptry(1:jpi, 1:jpj, 1:jpk))
          zptry(:,:,:) = 0._wp
       ENDIF
@@ -304 +308 @@
       END DO
       !
-      CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz )
+      DEALLOCATE( zwi )
+      DEALLOCATE( zwz )
       IF( l_trd .OR. l_trans )  THEN 
-         CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
-         CALL wrk_dealloc( jpi, jpj, z2d )
+         DEALLOCATE( ztrdx )
+         DEALLOCATE( ztrdy )
+         DEALLOCATE( ztrdz )
+         DEALLOCATE( z2d )
       ENDIF
-      IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry )
+      IF( cdtype == 'TRA' .AND. ln_diaptr ) DEALLOCATE( zptry )
       !
       IF( nn_timing == 1 )  CALL timing_stop('tra_adv_tvd')
@@ -353 +360 @@
       REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk   !   -      -
       REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zwx_sav , zwy_sav
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz, zhdiv, zwz_sav, zwzts
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zptry
-      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrs
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:  ) :: zwx_sav , zwy_sav
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zwi, zwz, zhdiv, zwz_sav, zwzts
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zptry
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrs
       !!----------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('tra_adv_tvd_zts')
       !
-      CALL wrk_alloc( jpi, jpj, zwx_sav, zwy_sav )
-      CALL wrk_alloc( jpi, jpj, jpk, zwi, zwz , zhdiv, zwz_sav, zwzts )
-      CALL wrk_alloc( jpi, jpj, jpk, kjpt+1, ztrs )
+      ALLOCATE(zwx_sav(1:jpi, 1:jpj))
+      ALLOCATE(zwy_sav(1:jpi, 1:jpj))
+      ALLOCATE(zwi(1:jpi, 1:jpj, 1:jpk))
+      ALLOCATE(zwz(1:jpi, 1:jpj, 1:jpk))        
+      ALLOCATE(zhdiv(1:jpi, 1:jpj, 1:jpk))       
+      ALLOCATE(zwz_sav(1:jpi, 1:jpj, 1:jpk))       
+      ALLOCATE(zwzts(1:jpi, 1:jpj, 1:jpk)) 
+      ALLOCATE(ztrs(1:jpi, 1:jpj, 1:jpk, 1:kjpt+1))
       !
       IF( kt == kit000 )  THEN
@@ -376 +388 @@
       !
       IF( l_trd )  THEN
-         CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
+         ALLOCATE(ztrdx(1:jpi, 1:jpj, 1:jpk))       
+         ALLOCATE(ztrdy(1:jpi, 1:jpj, 1:jpk))       
+         ALLOCATE(ztrdz(1:jpi, 1:jpj, 1:jpk))       
          ztrdx(:,:,:) = 0._wp  ;    ztrdy(:,:,:) = 0._wp  ;   ztrdz(:,:,:) = 0._wp
       ENDIF
       !
       IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN  
-         CALL wrk_alloc( jpi, jpj,jpk, zptry )
+         ALLOCATE(zptry(1:jpi, 1:jpj, 1:jpk))       
          zptry(:,:,:) = 0._wp
       ENDIF
@@ -603 +617 @@
       END DO
       !
-                   CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz, zhdiv, zwz_sav, zwzts )
-                   CALL wrk_dealloc( jpi, jpj, jpk, kjpt+1, ztrs )
-                   CALL wrk_dealloc( jpi, jpj, zwx_sav, zwy_sav )
-      IF( l_trd )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
-      IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry )
+      DEALLOCATE(zwi) 
+      DEALLOCATE(zwz) 
+      DEALLOCATE(zhdiv) 
+      DEALLOCATE(zwz_sav) 
+      DEALLOCATE(zwzts)
+      DEALLOCATE(ztrs )
+      DEALLOCATE(zwx_sav) 
+      DEALLOCATE(zwy_sav )
+
+      IF( l_trd )  THEN
+          DEALLOCATE(ztrdx) 
+          DEALLOCATE(ztrdy) 
+          DEALLOCATE(ztrdz)
+      END IF
+
+      IF( cdtype == 'TRA' .AND. ln_diaptr ) DEALLOCATE(zptry )
       !
       IF( nn_timing == 1 )  CALL timing_stop('tra_adv_tvd_zts')
@@ -635 +660 @@
       REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt   ! local scalars
       REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zbetup, zbetdo, zbup, zbdo
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zbetup, zbetdo, zbup, zbdo
       !!----------------------------------------------------------------------
       !
       IF( nn_timing == 1 )  CALL timing_start('nonosc')
       !
-      CALL wrk_alloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo )
+      ALLOCATE(zbetup(1:jpi, 1:jpj, 1:jpk))
+      ALLOCATE(zbetdo(1:jpi, 1:jpj, 1:jpk))
+      ALLOCATE(zbup(1:jpi, 1:jpj, 1:jpk))
+      ALLOCATE(zbdo(1:jpi, 1:jpj, 1:jpk))
       !
       zbig  = 1.e+40_wp
@@ -717 +745 @@
       CALL lbc_lnk( paa, 'U', -1. )   ;   CALL lbc_lnk( pbb, 'V', -1. )   ! lateral boundary condition (changed sign)
       !
-      CALL wrk_dealloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo )
+      DEALLOCATE(zbetup)
+      DEALLOCATE(zbetdo) 
+      DEALLOCATE(zbup)
+      DEALLOCATE(zbdo)
       !
       IF( nn_timing == 1 )  CALL timing_stop('nonosc')