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 – NEMO

Changeset 7581 for branches/UKMO


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.

Location:
branches/UKMO/dev_r5518_optim_GO6_alloc/NEMOGCM/NEMO
Files:
7 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/dev_r5518_optim_GO6_alloc/NEMOGCM/NEMO/OPA_SRC/SOL/solpcg.F90

    r6486 r7581  
    9393      REAL(wp) ::   zgcad        ! temporary scalars 
    9494      REAL(wp), DIMENSION(2) ::   zsum 
    95       REAL(wp), POINTER, DIMENSION(:,:) ::   zgcr 
     95      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zgcr 
    9696      !!---------------------------------------------------------------------- 
    9797      ! 
    9898      IF( nn_timing == 1 )  CALL timing_start('sol_pcg') 
    9999      ! 
    100       CALL wrk_alloc( jpi, jpj, zgcr ) 
     100      ALLOCATE( zgcr(jpi,jpj) ) 
    101101      ! 
    102102      ! Initialization of the algorithm with standard PCG 
    … …  
    210210      CALL lbc_lnk( gcx, c_solver_pt, 1. )      ! Output in gcx with lateral b.c. applied 
    211211      !  
    212       CALL wrk_dealloc( jpi, jpj, zgcr ) 
     212      DEALLOCATE ( zgcr ) 
    213213      ! 
    214214      IF( nn_timing == 1 )  CALL timing_stop('sol_pcg') 

  • branches/UKMO/dev_r5518_optim_GO6_alloc/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r7061 r7581  
    8080      ! 
    8181      INTEGER ::   jk   ! dummy loop index 
    82       REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn 
    83       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds   ! 3D workspace 
     82      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zun, zvn, zwn 
     83      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds   ! 3D workspace 
    8484      !!---------------------------------------------------------------------- 
    8585      ! 
    8686      IF( nn_timing == 1 )  CALL timing_start('tra_adv') 
    8787      ! 
    88       CALL wrk_alloc( jpi, jpj, jpk, zun, zvn, zwn ) 
     88      ALLOCATE(zun(jpi, jpj, jpk)) 
     89      ALLOCATE(zvn(jpi, jpj, jpk)) 
     90      ALLOCATE(zwn(jpi, jpj, jpk)) 
    8991      !                                          ! set time step 
    9092      IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000 
    … …  
    124126      ! 
    125127      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    126          CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     128         ALLOCATE(ztrdt( jpi, jpj, jpk) ) 
     129         ALLOCATE(ztrds( jpi, jpj, jpk) ) 
    127130         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    128131         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    … …  
    166169         CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt ) 
    167170         CALL trd_tra( kt, 'TRA', jp_sal, jptra_totad, ztrds ) 
    168          CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     171         DEALLOCATE (ztrdt) 
     172         DEALLOCATE (ztrds) 
    169173      ENDIF 
    170174      !                                              ! print mean trends (used for debugging) 
    … …  
    174178      IF( nn_timing == 1 )  CALL timing_stop( 'tra_adv' ) 
    175179      ! 
    176       CALL wrk_dealloc( jpi, jpj, jpk, zun, zvn, zwn ) 
     180      DEALLOCATE(zun) 
     181      DEALLOCATE(zvn) 
     182      DEALLOCATE(zwn) 
    177183      !                                           
    178184   END SUBROUTINE tra_adv 

  • branches/UKMO/dev_r5518_optim_GO6_alloc/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90

    r7179 r7581  
    8282      REAL(wp) ::   zv, z0v, zzwy, z0w        !   -      - 
    8383      REAL(wp) ::   ztra, zbtr, zdt, zalpha   !   -      - 
    84       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zslpx, zslpy   ! 3D workspace 
    85       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx  , zwy     ! -      -  
     84      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zslpx, zslpy   ! 3D workspace 
     85      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zwx  , zwy     ! -      -  
    8686      !!---------------------------------------------------------------------- 
    8787      ! 
    8888      IF( nn_timing == 1 )  CALL timing_start('tra_adv_muscl') 
    8989      ! 
    90       CALL wrk_alloc( jpi, jpj, jpk, zslpx, zslpy, zwx, zwy ) 
     90      ALLOCATE( zslpx(1:jpi, 1:jpj, 1:jpk) ) 
     91      ALLOCATE( zslpy(1:jpi, 1:jpj, 1:jpk) ) 
     92      ALLOCATE( zwx  (1:jpi, 1:jpj, 1:jpk) ) 
     93      ALLOCATE( zwy  (1:jpi, 1:jpj, 1:jpk) ) 
    9194      ! 
    9295      IF( kt == kit000 )  THEN 
    … …  
    288291      END DO 
    289292      ! 
    290       CALL wrk_dealloc( jpi, jpj, jpk, zslpx, zslpy, zwx, zwy ) 
     293      DEALLOCATE( zslpx ) 
     294      DEALLOCATE( zslpy ) 
     295      DEALLOCATE( zwx   ) 
     296      DEALLOCATE( zwy   ) 
    291297      ! 
    292298      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_muscl') 

  • 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') 

  • branches/UKMO/dev_r5518_optim_GO6_alloc/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

    r6486 r7581  
    107107      INTEGER, INTENT( in ) ::   kt   ! ocean time-step 
    108108      ! 
    109       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds 
     109      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  ztrdt, ztrds 
    110110      !!---------------------------------------------------------------------- 
    111111      ! 
    … …  
    113113      ! 
    114114      IF( l_trdtra )   THEN                         !* Save ta and sa trends 
    115          CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     115         ALLOCATE( ztrdt (1:jpi, 1:jpj, 1:jpk)) 
     116         ALLOCATE( ztrds (1:jpi, 1:jpj, 1:jpk)) 
    116117         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    117118         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    … …  
    151152         CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbl, ztrdt ) 
    152153         CALL trd_tra( kt, 'TRA', jp_sal, jptra_bbl, ztrds ) 
    153          CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     154         DEALLOCATE( ztrdt, ztrds ) 
    154155      ENDIF 
    155156      ! 
    … …  
    187188      INTEGER  ::   ik           ! local integers 
    188189      REAL(wp) ::   zbtr         ! local scalars 
    189       REAL(wp), POINTER, DIMENSION(:,:) :: zptb 
     190      REAL(wp), ALLOCATABLE , DIMENSION(:,:) :: zptb 
    190191      !!---------------------------------------------------------------------- 
    191192      ! 
    192193      IF( nn_timing == 1 )  CALL timing_start('tra_bbl_dif') 
    193194      ! 
    194       CALL wrk_alloc( jpi, jpj, zptb ) 
     195      ALLOCATE(zptb(1:jpi, 1:jpj)) 
    195196      ! 
    196197      DO jn = 1, kjpt                                     ! tracer loop 
    … …  
    217218      END DO                                                ! end tracer 
    218219      !                                                     ! =========== 
    219       CALL wrk_dealloc( jpi, jpj, zptb ) 
     220      DEALLOCATE( zptb ) 
    220221      ! 
    221222      IF( nn_timing == 1 )  CALL timing_stop('tra_bbl_dif') 

  • branches/UKMO/dev_r5518_optim_GO6_alloc/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90

    r6486 r7581  
    5353      INTEGER, INTENT( in ) ::   kt   ! ocean time-step  
    5454      CHARACTER (len=22) :: charout 
    55       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd 
     55      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ztrtrd 
    5656      !!---------------------------------------------------------------------- 
    5757      ! 
    … …  
    6464 
    6565      IF( l_trdtrc )  THEN 
    66          CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd ) ! temporary save of trends 
     66         ALLOCATE(ztrtrd( jpi, jpj, jpk, jptra )) ! temporary save of trends 
    6767         ztrtrd(:,:,:,:)  = tra(:,:,:,:) 
    6868      ENDIF 
    … …  
    9595           CALL trd_tra( kt, 'TRC', jn, jptra_bbl, ztrtrd(:,:,:,jn) ) 
    9696        END DO 
    97         CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) ! temporary save of trends 
     97        DEALLOCATE(ztrtrd ) ! temporary save of trends 
    9898      ENDIF 
    9999      ! 

  • branches/UKMO/dev_r5518_optim_GO6_alloc/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90

    r6498 r7581  
    5959      REAL(wp)           :: zdep 
    6060      CHARACTER (len=22) :: charout 
    61       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd 
     61      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ztrtrd 
    6262      !!---------------------------------------------------------------------- 
    6363      ! 
    … …  
    8181      ! 
    8282      IF( l_trdtrc )  THEN 
    83          CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd ) 
     83         ALLOCATE( ztrtrd ( jpi, jpj, jpk, jptra) ) 
    8484         ztrtrd(:,:,:,:)  = tra(:,:,:,:) 
    8585      ENDIF 
    … …  
    120120           CALL trd_tra( kt, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) ) 
    121121        END DO 
    122         CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) 
     122        DEALLOCATE( ztrtrd ) 
    123123      ENDIF 
    124124      !                                          ! print mean trends (used for debugging) 
Note: See TracChangeset for help on using the changeset viewer.