Commit b3a8a11d authored by Claus Kleinwort's avatar Claus Kleinwort
Browse files

Partially dynamic memory allocation for internal histograms

git-svn-id: http://svnsrv.desy.de/public/MillepedeII/trunk@212 3547b9b0-65b8-46d3-b95d-921b3f43af62
parent 288a37b5
...@@ -9,7 +9,7 @@ ...@@ -9,7 +9,7 @@
!! \author Claus Kleinwort, DESY (maintenance and developement) !! \author Claus Kleinwort, DESY (maintenance and developement)
!! !!
!! \copyright !! \copyright
!! Copyright (c) 2009 - 2015 Deutsches Elektronen-Synchroton, !! Copyright (c) 2009 - 2021 Deutsches Elektronen-Synchroton,
!! Member of the Helmholtz Association, (DESY), HAMBURG, GERMANY \n\n !! Member of the Helmholtz Association, (DESY), HAMBURG, GERMANY \n\n
!! This library is free software; you can redistribute it and/or modify !! This library is free software; you can redistribute it and/or modify
!! it under the terms of the GNU Library General Public License as !! it under the terms of the GNU Library General Public License as
...@@ -71,7 +71,7 @@ ...@@ -71,7 +71,7 @@
!! !!
!! Storage manager for GMP... !! Storage manager for GMP...
!! !!
!! CALL STMARS !! init/reset storage manager !! CALL STMARS(NDIM) !! init/reset storage manager, partially dynamic
!! !!
!! CALL STMAPR(JFLC,X,Y) !! store pair (X,Y) !! CALL STMAPR(JFLC,X,Y) !! store pair (X,Y)
!! !!
...@@ -612,7 +612,7 @@ SUBROUTINE gmpdef(ig,ityp,text) ! book, reset XY storage ...@@ -612,7 +612,7 @@ SUBROUTINE gmpdef(ig,ityp,text) ! book, reset XY storage
REAL(mps) ::four(4) REAL(mps) ::four(4)
EQUIVALENCE (array(1,1),array4(1,1),array1(1)) EQUIVALENCE (array(1,1),array4(1,1),array1(1))
INTEGER(mpi), PARAMETER :: numgxy=10 INTEGER(mpi), PARAMETER :: numgxy=10
INTEGER(mpi), PARAMETER :: nlimit=500 INTEGER(mpi) :: nlimit=500
INTEGER(mpi) :: nstr(numgxy) INTEGER(mpi) :: nstr(numgxy)
INTEGER(mpi) ::igtp(numgxy) INTEGER(mpi) ::igtp(numgxy)
INTEGER(mpi) ::lvers(numgxy) INTEGER(mpi) ::lvers(numgxy)
...@@ -634,7 +634,9 @@ SUBROUTINE gmpdef(ig,ityp,text) ! book, reset XY storage ...@@ -634,7 +634,9 @@ SUBROUTINE gmpdef(ig,ityp,text) ! book, reset XY storage
! ... ! ...
IF(start) THEN IF(start) THEN
start=.FALSE. start=.FALSE.
CALL stmars ! initialize storage ! dummy call to increase nlimit ?
if(ig == 0) nlimit = max(nlimit, ityp)
CALL stmars(nlimit*numgxy) ! initialize storage
DO i=1,numgxy DO i=1,numgxy
DO j=1,5 DO j=1,5
jflc(j,i)=0 jflc(j,i)=0
...@@ -907,7 +909,7 @@ SUBROUTINE gmpdef(ig,ityp,text) ! book, reset XY storage ...@@ -907,7 +909,7 @@ SUBROUTINE gmpdef(ig,ityp,text) ! book, reset XY storage
END SUBROUTINE gmpdef END SUBROUTINE gmpdef
SUBROUTINE stmars ! init/reset storage SUBROUTINE stmars(ndim) ! init/reset storage
USE mpdef USE mpdef
IMPLICIT NONE IMPLICIT NONE
...@@ -920,9 +922,9 @@ SUBROUTINE stmars ! init/reset storage ...@@ -920,9 +922,9 @@ SUBROUTINE stmars ! init/reset storage
INTEGER(mpi) :: n INTEGER(mpi) :: n
REAL(mps) :: x REAL(mps) :: x
REAL(mps) :: y REAL(mps) :: y
INTEGER(mpi), PARAMETER :: ndim=5000 ! storage dimension, should be NUMGXY*NLIMIT INTEGER(mpi) :: ndim ! storage dimension, should be NUMGXY*NLIMIT
REAL(mps) :: tk(2,ndim) ! pair storage for data pairs REAL(mps), DIMENSION(:,:), ALLOCATABLE :: tk ! pair storage for data pairs
INTEGER(mpi) :: next(ndim) ! pointer INTEGER(mpi), DIMENSION(:), ALLOCATABLE :: next ! pointer
INTEGER(mpi) :: iflc1 ! first and last index of free pairs INTEGER(mpi) :: iflc1 ! first and last index of free pairs
INTEGER(mpi) ::iflc2 ! first and last index of free pairs INTEGER(mpi) ::iflc2 ! first and last index of free pairs
SAVE SAVE
...@@ -936,6 +938,10 @@ SUBROUTINE stmars ! init/reset storage ...@@ -936,6 +938,10 @@ SUBROUTINE stmars ! init/reset storage
! JFLC(4) = counter of ignored ! JFLC(4) = counter of ignored
! JFLC(5) = limit for JFLC(3) ! JFLC(5) = limit for JFLC(3)
! ... ! ...
!print *, ' stmars ndim ', ndim
ALLOCATE (tk(2,ndim))
ALLOCATE (next(ndim))
DO i=1,ndim DO i=1,ndim
next(i)=i+1 ! pointer to next free location next(i)=i+1 ! pointer to next free location
tk(1,i)=0.0 ! reset tk(1,i)=0.0 ! reset
......
...@@ -51,7 +51,7 @@ ...@@ -51,7 +51,7 @@
!! 1. Download the software package from the DESY \c svn server to !! 1. Download the software package from the DESY \c svn server to
!! \a target directory, e.g.: !! \a target directory, e.g.:
!! !!
!! svn checkout http://svnsrv.desy.de/public/MillepedeII/tags/V04-09-02 target !! svn checkout http://svnsrv.desy.de/public/MillepedeII/tags/V04-09-03 target
!! !!
!! 2. Create **Pede** executable (in \a target directory): !! 2. Create **Pede** executable (in \a target directory):
!! !!
...@@ -724,6 +724,8 @@ PROGRAM mptwo ...@@ -724,6 +724,8 @@ PROGRAM mptwo
CALL filetc ! command line and steering file analysis CALL filetc ! command line and steering file analysis
CALL filetx ! read text files CALL filetx ! read text files
! dummy call for dynamic memory allocation
CALL gmpdef(0,nfilb,'dummy call')
IF (icheck > 0) THEN IF (icheck > 0) THEN
WRITE(*,*) '!!! Checking input only, no calculation of a solution !!!' WRITE(*,*) '!!! Checking input only, no calculation of a solution !!!'
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment