Resolve "Implement analytic inelastic scattering laws for Draglibs in module LIB:"

1 files changed, 13 insertions, 14 deletions

diff --git a/Dragon/src/LIBDRA.f b/Dragon/src/LIBDRA.f
index 9d23805..51438a9 100644
--- a/Dragon/src/LIBDRA.f
+++ b/Dragon/src/LIBDRA.f
@@ -87,7 +87,7 @@
       ALLOCATE(NFS(NGRO),ITYPRO(NL))
       ALLOCATE(AWR(NBISO),DELTA(NGRO),SIGS(NGRO,NL),SCAT(NGRO,NGRO,NL),
      1 TOTAL(NGRO),SIGF(NGRO,0:MAXDEL),CHI(NGRO,0:MAXDEL),
-     2 SADD(NGRO,NED),GOLD(NGRO),ZNPHI(NGRO))
+     2 SADD(NGRO,NED),ENER(NGRO+1),GOLD(NGRO),ZNPHI(NGRO))
       ALLOCATE(LSCAT(NL),LADD(NED))
 *----
 *  RECOVER THE GROUP STRUCTURE.
@@ -112,7 +112,6 @@
          WRITE (IOUT,'(40H LIBDRA: NUMBER OF ISOTOPES IN MICROLIB=,I6)')
      1   NBISO
       ENDIF
-      ALLOCATE(ENER(NGRO+1))
       CALL LCMLEN(IPDRL,'ENERGY',LENGT,ITYLCM)
       LENGT=LENGT-1
       IF(LENGT.NE.NGRO) CALL XABORT('LIBDRA: INVALID GROUP STRUCTURE.')
@@ -128,7 +127,6 @@
       ENDIF
       CALL LCMPUT(IPLIB,'ENERGY',NGRO+1,2,ENER)
       CALL LCMPUT(IPLIB,'DELTAU',NGRO,2,DELTA)
-      DEALLOCATE(ENER)
       CALL LCMLEN(IPDRL,'CHI-LIMITS',NBESP,ITYLCM)
       IF(NBESP.GT.0) THEN
          NBESP=NBESP-1
@@ -210,11 +208,11 @@
             NDEL=MAX(NDEL,NDEL0)
             IF(NDEL0.GT.MAXDEL) CALL XABORT('LIBDRA: MAXDEL OVERFLOW.')
             IF(NDEL0.GT.0) CALL LCMGET (IPDRL,'LAMBDA-D',ZLAMB)
-            CALL LIBDRB (IPDRL,NGRO,NL,NDEL0,NBESP,SN(1,IMX),SB(1,IMX),
-     1      NED,HVECT,DELTA,LBIN,NFS,EBIN,AWR(IMX),DELECC,IGECCO,IMPX,
-     2      NGF,NGFR,LSCAT,LSIGF,LADD,LGOLD,SIGS(1,1),SCAT(1,1,1),TOTAL,
-     3      ZNPHI,SIGF(1,1),CHI(1,1),CHI4G(1,1),SADD(1,1),GOLD(1),
-     4      BIN(1))
+            CALL LIBDRB (IPDRL,NGRO,NL,NDEL0,NBESP,ENER,SN(1,IMX),
+     1      SB(1,IMX),NED,HVECT,DELTA,LBIN,NFS,EBIN,AWR(IMX),DELECC,
+     2      IGECCO,IMPX,NGF,NGFR,LSCAT,LSIGF,LADD,LGOLD,SIGS(1,1),
+     3      SCAT(1,1,1),TOTAL,ZNPHI,SIGF(1,1),CHI(1,1),CHI4G(1,1),
+     4      SADD(1,1),GOLD(1),BIN(1))
          ELSE
 *----
 *  PERFORM TEMPERATURE LAGRANGIAN INTERPOLATION (ORDER ABS(NOTX)).
@@ -263,10 +261,11 @@
      >      1P,E12.4,18H KELVIN. FACTOR = ,E12.4)') TEMP(ITM),TERPM
             WRITE (CD,'(I4.4)') ITM
             CALL LCMSIX (IPDRL,'SUBTMP'//CD,1)
-            CALL LIBDRB (IPDRL,NGRO,NL,NDEL0,NBESP,SN(1,IMX),SB(1,IMX),
-     1      NED,HVECT,DELTA,LBIN,NFS,EBIN,AWR(IMX),DELECC,IGECCO,IMPX,
-     2      NGF,NGFR,LSCAT,LSIGF,LADD,LGOLD,SIGS2(1),SCAT2(1),TOTAL2,
-     3      ZNPHI2,SIGF2(1),CHI2(1),CHI4G2(1),SADD2(1),GOLD2(1),BIN2(1))
+            CALL LIBDRB (IPDRL,NGRO,NL,NDEL0,NBESP,ENER,SN(1,IMX),
+     1      SB(1,IMX),NED,HVECT,DELTA,LBIN,NFS,EBIN,AWR(IMX),DELECC,
+     2      IGECCO,IMPX,NGF,NGFR,LSCAT,LSIGF,LADD,LGOLD,SIGS2(1),
+     3      SCAT2(1),TOTAL2,ZNPHI2,SIGF2(1),CHI2(1),CHI4G2(1),SADD2(1),
+     4      GOLD2(1),BIN2(1))
             CALL LCMSIX (IPDRL,' ',2)
             DO 130 IG=1,NGRO
               TOTAL(IG)=TOTAL(IG)+TERPM*TOTAL2(IG)
@@ -403,8 +402,8 @@
 *  SCRATCH STORAGE DEALLOCATION
 *----
       DEALLOCATE(LADD,LSCAT)
-      DEALLOCATE(CHI4G,ZNPHI,GOLD,SADD,CHI,SIGF,TOTAL,SCAT,SIGS,DELTA,
-     1 AWR)
+      DEALLOCATE(CHI4G,ZNPHI,GOLD,ENER,SADD,CHI,SIGF,TOTAL,SCAT,SIGS,
+     1 DELTA,AWR)
       DEALLOCATE(ITYPRO,NFS)
       RETURN
 *