diff options
Diffstat (limited to 'Dragon/src/LIBDRA.f')
| -rw-r--r-- | Dragon/src/LIBDRA.f | 58 |
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, |