Resolve "Depreciate use of Version 4 and 5.0 Draglibs"

1 files changed, 49 insertions, 10 deletions

diff --git a/Dragon/src/LIBA30.f b/Dragon/src/LIBA30.f
index 8f5043f..f90461c 100644
--- a/Dragon/src/LIBA30.f
+++ b/Dragon/src/LIBA30.f
@@ -65,7 +65,7 @@
       TYPE(C_PTR) KPLIB
       CHARACTER RECNAM*80,RECNA2*80,TEXT80*80,HNAMIS*12,HNISOR*12,
      1 HSMG*131,TEXT12*12,CFILNA1*64,CFILNA2*64
-      LOGICAL L104,LSIGS,LABSO,LFISS,LDIF
+      LOGICAL L104,LSIGS,LABSO,LFISS,LDIF,LH
       INTEGER RANK,TYPE,NBYTE,DIMSR(5)
       DOUBLE PRECISION XDRCST,DSUM
       REAL TKT(5)
@@ -75,7 +75,7 @@
       INTEGER, ALLOCATABLE, DIMENSION(:) :: ITYPRO,ORANIS,ENRANG,
      1 FSTTMP,TMPMON,ADDTMP,ITEMPA,ISPAOF,IAFAG,IFAGR,FLXADD
       INTEGER, ALLOCATABLE, DIMENSION(:,:) :: IPR
-      REAL, ALLOCATABLE, DIMENSION(:) :: ENERG,DELTA,SECT,XSTOT,TAUX,
+      REAL, ALLOCATABLE, DIMENSION(:) :: ENERG,DELTA,SECT,HFACT,TAUX,
      1 AMASS,TEMP,TEMPM,XS,WGTFLX,BGXS,ABSOXS,DIFFXS,FISSXS,DK104
       REAL, ALLOCATABLE, DIMENSION(:,:) :: SIGS
       REAL, ALLOCATABLE, DIMENSION(:,:,:) :: SCAT
@@ -84,7 +84,7 @@
 *  SCRATCH STORAGE ALLOCATION
 *----
       ALLOCATE(IPR(2,NBISO),ITYPRO(NL))
-      ALLOCATE(SECT(NGRO),SIGS(NGRO,NL),SCAT(NGRO,NGRO,NL),XSTOT(NGRO))
+      ALLOCATE(SECT(NGRO),SIGS(NGRO,NL),SCAT(NGRO,NGRO,NL),HFACT(NGRO))
 *
       ANEUT=REAL(XDRCST('Neutron mass','amu'))
       NGF=NGRO+1
@@ -419,7 +419,7 @@
       LABSO=.TRUE.
       LDIF=.TRUE.
       CALL KDRCPU(TK1)
-      DO 600 IMX=1,NBISO
+      DO 570 IMX=1,NBISO
       KISEG=IPR(2,IMX)
       IF(KISEG.GT.0) THEN
         WRITE(HNISOR,'(3A4)') (ISONRF(I0,IMX),I0=1,3)
@@ -482,27 +482,66 @@
         ENDDO
         DEALLOCATE(TAUX,DK104,FISSXS,DIFFXS,ABSOXS,BGXS,TEMP)
       ENDIF
-  600 CONTINUE
+  570 CONTINUE
       CALL KDRCPU(TK2)
       TKT(3)=TK2-TK1
 *----
+*  PROCESS H-FACTOR INFORMATION
+*----
+      CALL KDRCPU(TK1)
+      DO 580 IMX=1,NBISO
+      IF(MASKI(IMX)) THEN
+        KPLIB=IPISO(IMX) ! set IMX-th isotope
+        CALL LCMLEN(KPLIB,'H-FACTOR',ILENG,ITYLCM)
+        IF(ILENG.NE.0) CALL LCMDEL(KPLIB,'H-FACTOR')
+        HFACT(:NGRO)=0.0
+        WRITE(HNISOR,'(3A4)') (ISONRF(I0,IMX),I0=1,3)
+        WRITE(RECNAM,'(10HIsotopeXS/,A,8H/Energy/)') TRIM(HNISOR)
+        IF(hdf5_group_exists(IPAP1,TRIM(RECNAM))) THEN
+          LH=.FALSE.
+          VALUE=0.0
+          IF(hdf5_group_exists(IPAP1,TRIM(RECNAM)//'/FISS')) THEN
+            WRITE(RECNA2,'(A,16HFISS/EnergyValue)') TRIM(RECNAM)
+            CALL hdf5_read_data(IPAP1,TRIM(RECNA2),VALUE)
+            IF(VALUE.NE.0.0) THEN
+              CALL LCMGET(KPLIB,'NFTOT',SECT)
+              HFACT(:NGRO)=HFACT(:NGRO)+SECT(:NGRO)*VALUE*1.0E6
+              LH=.TRUE.
+            ENDIF
+          ENDIF
+          IF(hdf5_group_exists(IPAP1,TRIM(RECNAM)//'/MT-102')) THEN
+            WRITE(RECNA2,'(A,18HMT-102/EnergyValue)') TRIM(RECNAM)
+            CALL hdf5_read_data(IPAP1,TRIM(RECNA2),VALUE)
+            IF(VALUE.NE.0.0) THEN
+              CALL LCMGET(KPLIB,'NG',SECT)
+              HFACT(:NGRO)=HFACT(:NGRO)+SECT(:NGRO)*VALUE*1.0E6
+              LH=.TRUE.
+            ENDIF
+          ENDIF
+          IF(LH) CALL LCMPUT(KPLIB,'H-FACTOR',NGRO,2,HFACT)
+        ENDIF
+      ENDIF
+  580 CONTINUE
+      CALL KDRCPU(TK2)
+      TKT(2)=TKT(2)+TK2-TK1
+*----
 *  CHECK IF ALL REACTIONS HAVE BEEN PROCESSED.
 *----
-      DO 575 IMX=1,NBISO
-      DO 570 I=1,2
+      DO 600 IMX=1,NBISO
+      DO 590 I=1,2
       IF(IPR(I,IMX).NE.0) THEN
          WRITE(HSMG,950) I,(ISONAM(I0,IMX),I0=1,3)
          CALL XABORT(HSMG)
       ENDIF
-  570 CONTINUE
-  575 CONTINUE
+  590 CONTINUE
+  600 CONTINUE
       IF(IMPX.GT.2) WRITE(IOUT,940) (TKT(I),I=1,3)
 *----
 *  SCRATCH STORAGE DEALLOCATION
 *----
       IF(NBFLX.GT.0) DEALLOCATE(WGTFLX,FLXADD)
       DEALLOCATE(DELTA,ENERG)
-      DEALLOCATE(XSTOT,SCAT,SIGS,SECT)
+      DEALLOCATE(HFACT,SCAT,SIGS,SECT)
       DEALLOCATE(ITYPRO,IPR)
       RETURN
 *