From 21253b193e759e843947a509d490c45823fa380e Mon Sep 17 00:00:00 2001 From: Alain Hebert Date: Fri, 12 Dec 2025 21:11:16 +0100 Subject: #18: Implement the trival one-calculation case in subroutines *CRTRP.f --- Donjon/src/ACRTRP.f | 11 +++++++++-- Donjon/src/MCRTRP.f | 13 ++++++++++--- Donjon/src/NCRTRP.f | 11 +++++++++-- Donjon/src/PCRTRP.f | 9 ++++++++- Donjon/src/SCRTRP.f | 11 +++++++++-- 5 files changed, 45 insertions(+), 10 deletions(-) (limited to 'Donjon/src') diff --git a/Donjon/src/ACRTRP.f b/Donjon/src/ACRTRP.f index 6a3e875..1091bc4 100644 --- a/Donjon/src/ACRTRP.f +++ b/Donjon/src/ACRTRP.f @@ -62,6 +62,13 @@ REAL, ALLOCATABLE, DIMENSION(:) :: TERPA,VREAL CHARACTER(LEN=80), ALLOCATABLE, DIMENSION(:) :: PARNAM *---- +* TRIVAL CASE WHERE NCAL=1 +*---- + IF(NCAL.EQ.1) THEN + TERP(1)=1.0 + GO TO 110 + ENDIF +*---- * RECOVER TREE INFORMATION *---- CALL hdf5_read_data(IPAPX,"/paramtree/DEBTREE",JDEBAR) @@ -188,11 +195,11 @@ TERP(ICAL)=TERP(ICAL)+TERTMP 100 CONTINUE ENDIF - IF(IMPX.GT.3) THEN + DEALLOCATE(JARBVA,JDEBAR,NVALUE) + 110 IF(IMPX.GT.3) THEN WRITE(IOUT,'(25H ACRTRP: TERP PARAMETERS:/(1X,1P,10E12.4))') 1 (TERP(I),I=1,NCAL) ENDIF - DEALLOCATE(JARBVA,JDEBAR,NVALUE) RETURN *---- * MISSING ELEMENTARY CALCULATION EXCEPTION. diff --git a/Donjon/src/MCRTRP.f b/Donjon/src/MCRTRP.f index 204120d..cf034c2 100644 --- a/Donjon/src/MCRTRP.f +++ b/Donjon/src/MCRTRP.f @@ -65,6 +65,13 @@ REAL, ALLOCATABLE, DIMENSION(:) :: TERPA,VREAL CHARACTER(LEN=80), ALLOCATABLE, DIMENSION(:) :: PARNAM *---- +* TRIVAL CASE WHERE NCAL=1 +*---- + IF(NCAL.EQ.1) THEN + TERP(1)=1.0 + GO TO 110 + ENDIF +*---- * RECOVER TREE INFORMATION *---- IBURN=0 @@ -213,12 +220,12 @@ TERP(ICAL)=TERP(ICAL)+TERTMP 100 CONTINUE ENDIF - IF(IMPX.GT.3) THEN + DEALLOCATE(MUPLE2) + IF(NPAR.GT.0) DEALLOCATE(NVALUE) + 110 IF(IMPX.GT.3) THEN WRITE(IOUT,'(25H MCRTRP: TERP PARAMETERS:/(1X,1P,10E12.4))') 1 (TERP(I),I=1,NCAL) ENDIF - DEALLOCATE(MUPLE2) - IF(NPAR.GT.0) DEALLOCATE(NVALUE) RETURN *---- * MISSING ELEMENTARY CALCULATION EXCEPTION. diff --git a/Donjon/src/NCRTRP.f b/Donjon/src/NCRTRP.f index 9b5203d..2298662 100644 --- a/Donjon/src/NCRTRP.f +++ b/Donjon/src/NCRTRP.f @@ -65,6 +65,13 @@ INTEGER, ALLOCATABLE, DIMENSION(:) :: JDEBAR,JARBVA REAL, ALLOCATABLE, DIMENSION(:) :: TERPA *---- +* TRIVAL CASE WHERE NCAL=1 +*---- + IF(NCAL.EQ.1) THEN + TERP(1)=1.0 + GO TO 110 + ENDIF +*---- * RECOVER TREE INFORMATION *---- JPCPO=LCMGID(IPCPO,'GLOBAL') @@ -205,11 +212,11 @@ TERP(ICAL)=TERP(ICAL)+TERTMP 100 CONTINUE ENDIF - IF(IMPX.GT.3) THEN + DEALLOCATE(JARBVA,JDEBAR) + 110 IF(IMPX.GT.3) THEN WRITE(IOUT,'(35H NCRTRP: TERP PARAMETERS IN MIXTURE,I4,1H:/(1X, 1 1P,10E12.4))') IBMOLD,(TERP(I),I=1,NCAL) ENDIF - DEALLOCATE(JARBVA,JDEBAR) RETURN *---- * MISSING ELEMENTARY CALCULATION EXCEPTION. diff --git a/Donjon/src/PCRTRP.f b/Donjon/src/PCRTRP.f index a19ba85..5e32eb7 100644 --- a/Donjon/src/PCRTRP.f +++ b/Donjon/src/PCRTRP.f @@ -61,6 +61,13 @@ *---- REAL, ALLOCATABLE, DIMENSION(:) :: TERPA *---- +* TRIVAL CASE WHERE NCAL=1 +*---- + IF(NCAL.EQ.1) THEN + TERP(1)=1.0 + GO TO 110 + ENDIF +*---- * COMPUTE TERP FACTORS *---- TERP(:NCAL)=0.0 @@ -172,7 +179,7 @@ TERP(ICAL)=TERP(ICAL)+TERTMP 100 CONTINUE ENDIF - IF(IMPX.GT.3) THEN + 110 IF(IMPX.GT.3) THEN WRITE(IOUT,'(25H PCRTRP: TERP PARAMETERS:/(1X,1P,10E12.4))') 1 (TERP(I),I=1,NCAL) ENDIF diff --git a/Donjon/src/SCRTRP.f b/Donjon/src/SCRTRP.f index 53ef90d..b7a4a5a 100644 --- a/Donjon/src/SCRTRP.f +++ b/Donjon/src/SCRTRP.f @@ -62,6 +62,13 @@ INTEGER, ALLOCATABLE, DIMENSION(:) :: JDEBAR,JARBVA REAL, ALLOCATABLE, DIMENSION(:) :: TERPA *---- +* TRIVAL CASE WHERE NCAL=1 +*---- + IF(NCAL.EQ.1) THEN + TERP(1)=1.0 + GO TO 110 + ENDIF +*---- * RECOVER TREE INFORMATION *---- LPSAP=LCMGID(IPSAP,'paramarbre') @@ -195,11 +202,11 @@ TERP(ICAL)=TERP(ICAL)+TERTMP 100 CONTINUE ENDIF - IF(IMPX.GT.3) THEN + DEALLOCATE(JARBVA,JDEBAR) + 110 IF(IMPX.GT.3) THEN WRITE(IOUT,'(25H SCRTRP: TERP PARAMETERS:/(1X,1P,10E12.4))') 1 (TERP(I),I=1,NCAL) ENDIF - DEALLOCATE(JARBVA,JDEBAR) RETURN *---- * MISSING ELEMENTARY CALCULATION EXCEPTION. -- cgit v1.2.3