Merge branch '18-implement-the-trival-one-calculation-case-in-subroutines-crtrp-f' into 'main'

#18: Implement the trival one-calculation case in subroutines *CRTRP.f

See merge request dragon/5.1!33

5 files changed, 45 insertions, 10 deletions

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.