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/NCRCAL.f90 | 62 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 62 insertions(+) create mode 100644 Donjon/src/NCRCAL.f90 (limited to 'Donjon/src/NCRCAL.f90') diff --git a/Donjon/src/NCRCAL.f90 b/Donjon/src/NCRCAL.f90 new file mode 100644 index 0000000..a080b73 --- /dev/null +++ b/Donjon/src/NCRCAL.f90 @@ -0,0 +1,62 @@ +RECURSIVE INTEGER FUNCTION NCRCAL(II,NVP,NPTOT,DEBARB,ARBVAL,MUPLET) RESULT(ICAL) +! +!----------------------------------------------------------------------- +! +!Purpose: +! find the position of an elementary calculation in the multicompo, Apex +! file or in the Saphyb. +! +!Copyright: +! Copyright (C) 2012 Ecole Polytechnique de Montreal +! +!Author(s): +! A. Hebert +! +!Parameters: input +! II position in DEBARB. Must be set to 1 in the first call. +! NVP number of nodes in the parameter tree. +! NPTOT number of parameters. +! DEBARB tree information +! ARBVAL tree information +! 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 + !---- + ! SUBROUTINE ARGUMENTS + !---- + INTEGER IKEEP, I, JICAL, NBOK + INTEGER II,NVP,NPTOT,DEBARB(NVP+1),ARBVAL(NVP),MUPLET(NPTOT) + ! + IF(NPTOT==0) THEN + ICAL=DEBARB(II+1) + RETURN + ENDIF + NBOK=0 + IKEEP=0 + DO I=DEBARB(II),DEBARB(II+1)-1 + IF((MUPLET(1)==0).OR.(MUPLET(1)==ARBVAL(I))) THEN + JICAL=NCRCAL(I,NVP,NPTOT-1,DEBARB,ARBVAL,MUPLET(2)) + IF(JICAL > 0) THEN + IKEEP=JICAL + NBOK=NBOK+1 + ELSE IF(JICAL==-1) THEN + NBOK=2 + ENDIF + ENDIF + ENDDO + IF(NBOK > 1) THEN + ! Many elementary calculation exist for this tuple. + ICAL=-1 + ELSE IF(NBOK==0) THEN + ! No elementary calculation exists for this tuple. + ICAL=0 + ELSE + ICAL=IKEEP + ENDIF +END FUNCTION NCRCAL -- cgit v1.2.3