memory.F

Go to the documentation of this file.

#include "cppdefs.h"
      SUBROUTINE memory
!
!git $Id$
!================================================== Hernan G. Arango ===
!  Copyright (c) 2002-2025 The ROMS Group                              !
!    Licensed under a MIT/X style license                              !
!    See License_ROMS.md                                               !
!=======================================================================
!                                                                      !
!  This routine computes and report estimates of dynamic memory and    !
!  automatic memory requirements for current application.              !
!                                                                      !
!  The dynamical memory is that associated with the ocean state arrays,!
!  and it is allocated at runtime, and it is persistent until the ROMS !
!  termination of the execution.                                       !
!                                                                      !
!  The automatic arrays appear in subroutines and functions for        !
!  temporary local computations. They are created on entry to the      !
!  subroutine for intermediate computations and disappear on exit.     !
!  The automatic arrays (meaning non-static) are either allocated on   !
!  heap or stack memory.                                               !
!                                                                      !
!=======================================================================
!
      USE mod_param
      USE mod_parallel
      USE mod_iounits
!
#ifdef DISTRIBUTE
      USE distribute_mod, ONLY : mp_collect
#endif
      USE mod_netcdf,     ONLY : matts, mdims, mvars, nvard, nvara
      USE mod_scalars,    ONLY : lallocatedmemory
!
      implicit none
!
!  Local variable declarations.
!
      integer :: ng, tile
      integer :: IminS, ImaxS, JminS, JmaxS
      integer :: Nlevels, Ntiles
!
      real(r8) :: Avalue, bytefac, megabytefac, size1d, size2d
      real(r8) :: sumAsize, sumBsize, sumDsize
      real(r8) :: totalAsize, totalBsize, totalDsize
!
      real(r8), parameter :: spv = 0.0_r8
!
#ifdef DISTRIBUTE
      real(r8), allocatable ::  Bwrk(:), Dwrk(:)
!
#endif
      real(r8), allocatable ::  Asize(:,:)      ! automatic arrays
      real(r8), allocatable ::  Bsize(:,:)      ! automatic mpi-buffers
      real(r8), allocatable ::  Dsize(:,:)      ! dynamic array
      real(r8), allocatable ::  IOsize(:,:)     ! NetCDF I/O
!
!-----------------------------------------------------------------------
!  Report estimate of dynamic memory and automatic memory requirements.
!-----------------------------------------------------------------------
!
!  If ROMS array have not been allocated, skip report.
 
      IF (.not.lallocatedmemory) RETURN
!
!  Allocate and initialize.
!
!$OMP MASTER
      ntiles=maxval(ntilei)*maxval(ntilej)-1
      IF (.not.allocated(asize)) THEN
        allocate ( asize(0:ntiles,ngrids) )
        asize=spv
      END IF
      IF (.not.allocated(bsize)) THEN
        allocate ( bsize(0:ntiles,ngrids) )
        bsize=spv
      END IF
      IF (.not.allocated(dsize)) THEN
        allocate ( dsize(0:ntiles,ngrids) )
        dsize=spv
      END IF
      IF (.not.allocated(iosize)) THEN
        allocate ( iosize(0:ntiles,ngrids) )
        iosize=spv
      END IF
#ifdef DISTRIBUTE
      IF (.not.allocated(bwrk)) THEN
        allocate ( bwrk(ntiles+1) )
      END IF
      IF (.not.allocated(dwrk)) THEN
        allocate ( dwrk(ntiles+1) )
      END IF
#endif
!
!  Determine size floating-point arrays in bytes.  We could use the
!  Fortran 2008 standard function STORAGE_SIZE.  However since ROMS
!  is double-precision by default, we just set its value to 64 bits
!  or 8 bytes (1 byte = 8 bits).  The number of array elements is
!  multiplied by the megabytes factor.
!
      bytefac=real(kind(bytefac),r8)    ! r8 kind in bytes
      megabytefac=bytefac*1.0e-6_r8     ! 1 Mb = 1.0E+6 bytes (SI units)
!
!  Add static memory requirements for processing NetCDF data.  The
!  variables are declared in "mod_netcdf".  Notice that a single
!  character has a size of eight bits (1 byte).
!
      dmem(1)=dmem(1)+real(matts,r8)               ! att_kind
      dmem(1)=dmem(1)+2.0_r8*real(mdims,r8)        ! dim_id,dim_size
      dmem(1)=dmem(1)+5.0_r8*real(mvars,r8)        ! var_*
      dmem(1)=dmem(1)+real(nvard*mvars,r8)         ! var_dim
      dmem(1)=dmem(1)+2.0_r8*real(nvard,r8)        ! var_Dids,var_Dsize
      dmem(1)=dmem(1)+2.0_r8*real(nvara,r8)        ! var_Aint,var_Afloat
      dmem(1)=dmem(1)+0.125_r8*real(40*matts,r8)   ! att_name
      dmem(1)=dmem(1)+0.125_r8*real(40*mdims,r8)   ! dim_name
      dmem(1)=dmem(1)+0.125_r8*real(40*mvars,r8)   ! dim_name
      dmem(1)=dmem(1)+0.125_r8*real(40*nvara,r8)   ! var_Aname
      dmem(1)=dmem(1)+0.125_r8*real(40*nvard,r8)   ! var_Dname
      dmem(1)=dmem(1)+0.125_r8*real(1024*nvara,r8) ! var_Achar
!
!  Estimate automatic memory requirements (megabytes) by looking at the
!  routines that use it most, like step2d, step3d_t, or NetCDF I/O.
!  (see memory.txt for more information).
!
      DO ng=1,ngrids
        DO tile=0,ntilei(ng)*ntilej(ng)-1
#ifdef NESTING
          imins=bounds(ng)%Istr(tile)-4
          imaxs=bounds(ng)%Iend(tile)+3
          jmins=bounds(ng)%Jstr(tile)-4
          jmaxs=bounds(ng)%Jend(tile)+3
#else
          imins=bounds(ng)%Istr(tile)-3
          imaxs=bounds(ng)%Iend(tile)+3
          jmins=bounds(ng)%Jstr(tile)-3
          jmaxs=bounds(ng)%Jend(tile)+3
#endif
          size1d=real((imaxs-imins+1),r8)
          size2d=real((imaxs-imins+1)*(jmaxs-jmins+1),r8)
#ifdef SOLVE3D
          asize(tile,ng)=megabytefac*                                   &
     &                   (4.0_r8*size1d*real(n(ng)+1,r8)+               &
     &                    7.0_r8*size2d+                                &
     &                    5.0_r8*size2d*real(n(ng),r8)+                 &
     &                    1.0_r8*size2d*real(n(ng)*nt(ng),r8))
# if !(defined PARALLEL_IO && defined DISTRIBUTE)
#  ifdef INLINE_2DIO
          nlevels=1
#  else
          nlevels=n(ng)+1
#  endif
          iosize(tile,ng)=megabytefac*2.0_r8*                           &
     &                    real(2+(lm(ng)+2)*(mm(ng)+2)*(nlevels),r8)
# else
          iosize(tile,ng)=megabytefac*                                  &
     &                    real(2+(lm(ng)+2)*(mm(ng)+2)*(n(ng)+1),r8)
# endif
#else
          asize(tile,ng)=megabytefac*                                   &
     &                   (38.0_r8*size2d)
          iosize(tile,ng)=megabytefac*                                  &
     &                    real(2+(lm(ng)+2)*(mm(ng)+2),r8)
#endif
        END DO
      END DO
!
!  Determine total maximum value of dynamic-memory and automatic-memory
!  requirements, and convert number of array elements to megabytes.
!
#ifdef DISTRIBUTE
      bwrk=spv
      dwrk=spv
      DO ng=1,ngrids
        bwrk(myrank+1)=bmemmax(ng)*1.0e-6_r8        ! already in bytes
        dwrk(myrank+1)=megabytefac*dmem(ng)
        CALL mp_collect (ng, inlm, numthreads, spv, bwrk)
        CALL mp_collect (ng, inlm, numthreads, spv, dwrk)
        bsize(myrank,ng)=bwrk(myrank+1)
        dsize(myrank,ng)=dwrk(myrank+1)
        bwrk=spv
        dwrk=spv
      END DO
#else
      dsize(0:numthreads-1,1:ngrids)=spv
      DO ng=1,ngrids
        dsize(0,ng)=megabytefac*dmem(ng)
      END DO
#endif
!
!  Report dynamic and automatic memory requirements.
!
      IF (master) THEN
        WRITE (stdout,"(/,80('>'))")
        totalasize=0.0_r8
        totalbsize=0.0_r8
        totaldsize=0.0_r8
        DO ng=1,ngrids
          sumasize=0.0_r8
          sumbsize=0.0_r8
          sumdsize=0.0_r8
#ifdef SOLVE3D
          WRITE (stdout,10) ng, lm(ng), mm(ng), n(ng),                  &
     &                      ntilei(ng), ntilej(ng)
#else
          WRITE (stdout,10) ng, lm(ng), mm(ng),                         &
     &                      ntilei(ng), ntilej(ng)
#endif
          DO tile=0,ntilei(ng)*ntilej(ng)-1
            avalue=max(asize(tile,ng), bsize(tile,ng), iosize(tile,ng))
            sumasize=sumasize+avalue
            sumbsize=sumbsize+bsize(tile,ng)
            sumdsize=sumdsize+dsize(tile,ng)
            WRITE (stdout,20) tile, dsize(tile,ng), avalue,             &
#ifdef DISTRIBUTE
     &                        dsize(tile,ng)+avalue, bsize(tile,ng)
#else
     &                        dsize(tile,ng)+avalue
#endif
          END DO
          totalasize=totalasize+sumasize
          totalbsize=totalbsize+sumbsize
          totaldsize=totaldsize+sumdsize
          IF (ngrids.gt.1) THEN
            WRITE (stdout,30) '  SUM', sumdsize, sumasize,              &
#ifdef DISTRIBUTE
     &                                 sumasize+sumdsize, sumbsize
#else
     &                                 sumasize+sumdsize
#endif
          ELSE
            WRITE (stdout,30) 'TOTAL', sumdsize, sumasize,              &
#ifdef DISTRIBUTE
     &                                 sumasize+sumdsize, sumbsize
#else
     &                                 sumasize+sumdsize
#endif
          END IF
        END DO
        IF (ngrids.gt.1) THEN
            WRITE (stdout,30) 'TOTAL', totaldsize, totalasize,          &
#ifdef DISTRIBUTE
     &                                 totalasize+totaldsize, totalbsize
#else
     &                                 totalasize+totaldsize
#endif
        END IF
        WRITE (stdout,"(/,80('<'))")
      END IF
!
!  Deallocate dynamic and automatic memory local arrays.
!
      IF (allocated(asize))  deallocate ( asize )
      IF (allocated(bsize))  deallocate ( bsize )
      IF (allocated(dsize))  deallocate ( dsize )
      IF (allocated(iosize)) deallocate ( iosize )
!$OMP END MASTER
!$OMP BARRIER
!
#ifdef SOLVE3D
 10   FORMAT (/,' Dynamic and Automatic memory (MB) usage for Grid ',   &
     &          i2.2,':',2x,i0,'x',i0,'x',i0,2x,'tiling: ',i0,'x',i0,   &
     &          /,/,5x,'tile',10x,'Dynamic',8x,'Automatic',             &
     &          12x,'USAGE',                                            &
# ifdef DISTRIBUTE
     &          6x,'MPI-Buffers',                                       &
# endif
     &          /)
#else
 10   FORMAT (/,' Dynamic and Automatic memory (MB) usage for Grid ',   &
     &          i2.2,':',2x,i0,'x',i0,2x,'tiling: ',i0,'x',i0,          &
     &          /,/,5x,'tile',10x,'Dynamic',8x,'Automatic',             &
     &          12x,'USAGE',                                            &
# ifdef DISTRIBUTE
     &          6x,'MPI-Buffers',                                       &
# endif
     &          /)
#endif
 20   FORMAT (4x,i5,4(4x,f13.2))
 30   FORMAT (/,4x,a,4(4x,f13.2))
!
      RETURN
      END SUBROUTINE memory