From 7dfcc480ba1e19bd3232349fc733caef94034292 Mon Sep 17 00:00:00 2001 From: stainer_t Date: Mon, 8 Sep 2025 13:48:49 +0200 Subject: Initial commit from Polytechnique Montreal --- Donjon/src/MCRCAL.f90 | 45 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) create mode 100644 Donjon/src/MCRCAL.f90 (limited to 'Donjon/src/MCRCAL.f90') diff --git a/Donjon/src/MCRCAL.f90 b/Donjon/src/MCRCAL.f90 new file mode 100644 index 0000000..ca0eb30 --- /dev/null +++ b/Donjon/src/MCRCAL.f90 @@ -0,0 +1,45 @@ +INTEGER FUNCTION MCRCAL(NPAR,NCAL,MUPLET,MUBASE) RESULT(ICAL) +! +!----------------------------------------------------------------------- +! +!Purpose: +! find the position of an elementary calculation in a MPO file. +! +!Copyright: +! Copyright (C) 2022 Ecole Polytechnique de Montreal +! +!Author(s): A. Hebert +! +!Parameters: input +! NPAR number of parameters. +! NCAL number of elementary calculations in the PMAXS file. +! MUPLET tuple used to identify an elementary calculation. +! +!Parameters: output +! ICAL position of the elementary calculation (=0 if does not exist; +! =-1 if more than one exists). +! +!----------------------------------------------------------------------- +! + IMPLICIT NONE + !---- + ! FUNCTION ARGUMENTS + !---- + INTEGER NPAR,NCAL,MUPLET(NPAR),MUBASE(NPAR,NCAL) + !---- + ! LOCAL VARIABLES + !---- + INTEGER I,J,NFIND + ! + ICAL=0 + NFIND=0 + DO I=1,NCAL + DO J=1,NPAR + IF(MUPLET(J).NE.MUBASE(J,I)) GO TO 10 + ENDDO + ICAL=I + NFIND=NFIND+1 + 10 CONTINUE + ENDDO + IF(NFIND.GT.1) ICAL=-1 +END FUNCTION MCRCAL -- cgit v1.2.3