Merge branch '19-depreciate-use-of-version-4-and-5-0-draglibs' into 'main'

Resolve "Depreciate use of Version 4 and 5.0 Draglibs"

See merge request dragon/5.1!40

1 files changed, 31 insertions, 27 deletions

diff --git a/Dragon/src/LIBDRA.f b/Dragon/src/LIBDRA.f
index 51438a9..e846822 100644
--- a/Dragon/src/LIBDRA.f
+++ b/Dragon/src/LIBDRA.f
@@ -63,7 +63,7 @@
 *----
 *  LOCAL VARIABLES
 *----
-      CHARACTER CD*4,HSMG*131,HTITLE*80,HNISOR*12,HNAMIS*12,HNUSIG*12,
+      CHARACTER CD*4,HSMG*131,HVERS*12,HNISOR*12,HNAMIS*12,HNUSIG*12,
      1 HCHI*12
       PARAMETER (IOUT=6,MAXTMP=50,NOTX=3)
       TYPE(C_PTR) KPLIB
@@ -74,13 +74,14 @@
 *----
 *  ALLOCATABLE ARRAYS
 *----
-      INTEGER, ALLOCATABLE, DIMENSION(:) :: NFS,ITYPRO,ITITLE
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: NFS,ITYPRO
       REAL, ALLOCATABLE, DIMENSION(:) :: AWR,DELTA,TOTAL,GOLD,ZNPHI,
      1 ENER,BIN,EBIN,SIGS2,SCAT2,TOTAL2,SIGF2,CHI2,SADD2,GOLD2,BIN2,
      2 ZNPHI2,CHI4G2
       REAL, ALLOCATABLE, DIMENSION(:,:) :: SIGS,SIGF,CHI,SADD,CHI4G
       REAL, ALLOCATABLE, DIMENSION(:,:,:) :: SCAT
       LOGICAL, ALLOCATABLE, DIMENSION(:) :: LSCAT,LADD
+      CHARACTER(LEN=80), ALLOCATABLE, DIMENSION(:) :: HTITLE
 *----
 *  SCRATCH STORAGE ALLOCATION
 *----
@@ -95,20 +96,24 @@
       NGF=NGRO+1
       NGFR=0
       NDEL=0
-      IF(IMPX.GT.0) WRITE (IOUT,900) NAMFIL
+      HVERS='**UNKNOWN**'
+      CALL LCMLEN(IPDRL,'VERSION',LENGT,ITYLCM)
+      IF(LENGT.NE.0) CALL LCMGTC(IPDRL,'VERSION',12,HVERS)
+      IF(IMPX.GT.0) WRITE (IOUT,900) TRIM(NAMFIL),TRIM(HVERS)
+      IF(HVERS.EQ.'RELEASE_2003') THEN
+        WRITE(IOUT,'(46H LIBDRA: ***WARNING*** RELEASE_2003 DRAGLIBS A,
+     1  15HRE DEPRECIATED.)')
+      ENDIF
       CALL LCMLEN(IPDRL,'README',LENGT,ITYLCM)
       IF((IMPX.GT.0).AND.(LENGT.GT.0)) THEN
-         ALLOCATE(ITITLE(LENGT))
-         CALL LCMGET(IPDRL,'README',ITITLE)
+         LENGT=(LENGT-1)/20+1
+         ALLOCATE(HTITLE(LENGT))
+         CALL LCMGTC(IPDRL,'README',80,LENGT,HTITLE)
          WRITE (IOUT,940)
-         I2=0
-         DO 10 J=0,LENGT/20
-         I1=I2+1
-         I2=MIN(I1+19,LENGT)
-         WRITE (HTITLE,'(20A4)') (ITITLE(I),I=I1,I2)
-         WRITE (IOUT,'(1X,A80)') HTITLE
+         DO 10 J=1,LENGT
+         WRITE (IOUT,'(1X,A80)') HTITLE(J)
    10    CONTINUE
-         DEALLOCATE(ITITLE)
+         DEALLOCATE(HTITLE)
          WRITE (IOUT,'(40H LIBDRA: NUMBER OF ISOTOPES IN MICROLIB=,I6)')
      1   NBISO
       ENDIF
@@ -157,18 +162,15 @@
          CALL LCMGET(IPDRL,'AWR',AWR(IMX))
          CALL LCMLEN(IPDRL,'README',LTITLE,ITYLCM)
          IF(LTITLE.GT.0) THEN
-            ALLOCATE(ITITLE(LTITLE))
-            CALL LCMGET(IPDRL,'README',ITITLE)
-            IF(IMPX.GT.0) THEN
-               WRITE (IOUT,930)
-               I2=0
-               DO 20 J=0,LTITLE/20
-               I1=I2+1
-               I2=MIN(I1+19,LTITLE)
-               WRITE (HTITLE,'(20A4)') (ITITLE(I),I=I1,I2)
-               WRITE (IOUT,'(1X,A80)') HTITLE
-   20          CONTINUE
-            ENDIF
+           LTITLE=(LTITLE-1)/20+1
+           ALLOCATE(HTITLE(LTITLE))
+           CALL LCMGTC(IPDRL,'README',80,LTITLE,HTITLE)
+           IF(IMPX.GT.0) THEN
+             WRITE (IOUT,930)
+             DO 20 J=1,LTITLE
+             WRITE (IOUT,'(1X,A80)') HTITLE(J)
+   20        CONTINUE
+           ENDIF
          ENDIF
 *----
 *  RECOVER BIN TYPE INFORMATION (IF AVAILABLE).
@@ -326,8 +328,8 @@
          CALL LCMPTC(KPLIB,'ALIAS',12,HNAMIS)
          CALL LCMPUT(KPLIB,'AWR',1,2,AWR(IMX))
          IF(LTITLE.GT.0) THEN
-            CALL LCMPUT(KPLIB,'README',LTITLE,3,ITITLE)
-            DEALLOCATE(ITITLE)
+            CALL LCMPTC(KPLIB,'README',80,LTITLE,HTITLE)
+            DEALLOCATE(HTITLE)
          ENDIF
          DO 220 IG=1,NGRO
          IF(TOTAL(IG).LT.0.0) THEN
@@ -371,6 +373,8 @@
   260       CONTINUE
          ENDIF
          CALL XDRLGS(KPLIB,1,0,0,NL-1,1,NGRO,SIGS,SCAT,ITYPRO)
+         CALL LCMLEN(KPLIB,'H-FACTOR',LENGT,ITYLCM)
+         IF(LENGT.NE.0) CALL LCMDEL(KPLIB,'H-FACTOR')
          DO 340 IED=1,NED
          IF(LADD(IED).AND.(HVECT(IED)(:3).NE.'CHI')
      1               .AND.(HVECT(IED)(:2).NE.'NU')
@@ -407,7 +411,7 @@
       DEALLOCATE(ITYPRO,NFS)
       RETURN
 *
-  900 FORMAT(/33H PROCESSING DRAGON LIBRARY NAMED ,A12,1H.)
+  900 FORMAT(/33H PROCESSING DRAGON LIBRARY NAMED ,A,9H VERSION ,A,1H.)
   910 FORMAT(26HLIBDRA: MATERIAL/ISOTOPE ',A12,5H' = ',A12,9H' IS MISS,
      1 25HING ON DRAGON FILE NAMED ,A12,10H (ISOTOPE=,I10,2H).)
   920 FORMAT(/30H PROCESSING ISOTOPE/MATERIAL ',A12,11H' (HNISOR=',A12,