1 files changed, 82 insertions, 0 deletions
diff --git a/dfsynthe/repackh2o.for b/dfsynthe/repackh2o.for
new file mode 100644
index 0000000..52cd763
--- /dev/null
+++ b/dfsynthe/repackh2o.for
@@ -0,0 +1,82 @@
+      PROGRAM REPACKH2O
+      IMPLICIT REAL*8 (A-H,O-Z)
+      COMMON /PACK8000/PACK8000(4,2000)
+      INTEGER*2 IELION,IELO,IGFLOG,IGR,IGS,IGW
+      COMMON /IIIIIII/IWL,IELION,IELO,IGFLOG,IGR,IGS,IGW
+      INTEGER*4 IIIIIII(4),PACK8000
+      EQUIVALENCE (IIIIIII(1),IWL)
+      RATIOLOG=LOG(1.D0+1.D0/2000000.D0)
+      RATIOLG=LOG(1.D0+1.D0/500000.D0)
+      WLBEG=8.97666
+      WLEND=10000.
+      IXWLBEG=DLOG(WLBEG)/RATIOLG
+      IF(DEXP(IXWLBEG*RATIOLG).LT.WLBEG)IXWLBEG=IXWLBEG+1
+      IWLSTART=DLOG(WLBEG)/RATIOLOG+.5
+      IWLSTOP=DLOG(WLEND)/RATIOLOG+.5
+      NLINES=0
+      OPEN(UNIT=11,TYPE='OLD',FORM='UNFORMATTED',
+     1RECORDTYPE='FIXED',BLOCKSIZE=8000,RECL=2)
+      OPEN(UNIT=12,TYPE='NEW',FORM='UNFORMATTED',
+     1RECORDTYPE='FIXED',BLOCKSIZE=32000,RECL=8000)
+      DO 5 LINE=1,65912356
+      READ(11)IWL,IELO,IGFLOG
+      IF(IWL.LT.IWLSTART)GO TO 5
+      IF(IWL.GT.IWLSTOP)GO TO 5
+C      ELO=ABS(IELO)
+      KGFLOG=ABS(IGFLOG)
+ 1871 ISO=1
+      IF(IELO.GT.0.AND.IGFLOG.GT.0)GO TO 1819
+      ISO=2
+      IF(IELO.GT.0)GO TO 1819
+      ISO=3
+      IF(IGFLOG.GT.0)GO TO 1819
+      ISO=4
+ 1819 GO TO (1811,1812,1813,1814),ISO
+C     1H1H16O
+ 1811 IGFLOG=MAX(KGFLOG-001,1)
+      GO TO 1816
+C     1H1H17O
+ 1812 IGFLOG=MAX(KGFLOG-3398,1)
+      GO TO 1816
+C     1H1H18O
+ 1813 IGFLOG=MAX(KGFLOG-2690,1)
+      GO TO 1816
+C     1H2H16O
+ 1814 IGFLOG=MAX(KGFLOG-5000,1)
+ 1816 IELION=534
+      IELO=ABS(IELO)
+C     GAMMAS=0.
+      IGS=1
+C     LOG GAMMAW=-7
+      IGW=9384
+CC    il giusto sarebbe 9384 per avere -7. In realta' e' -6.964
+      WLVAC=EXP(IWL*RATIOLOG)
+      IXWL=DLOG(WLVAC)/RATIOLG+.5D0
+      NBUFF=IXWL-IXWLBEG+1
+      IWL=NBUFF
+      GAMMAR=2.223E13/WLVAC**2*.001
+      GR=LOG10(GAMMAR)
+      IGR=GR*1000.+16384.5
+      CALL PACK(IIIIIII)
+      NLINES=NLINES+1
+    5 CONTINUE
+    8 PRINT 1,NLINES
+    1 FORMAT(I10,' LINES FROM H2OFAST')
+      WRITE(12)PACK8000
+      CALL EXIT
+      END
+      SUBROUTINE PACK(IIIIIII)
+      INTEGER*4 PACK8000,IIIIIII(4)
+      COMMON /PACK8000/PACK8000(4,2000)
+      DATA IREC/0/
+      IREC=IREC+1
+      PACK8000(1,IREC)=IIIIIII(1)
+      PACK8000(2,IREC)=IIIIIII(2)
+      PACK8000(3,IREC)=IIIIIII(3)
+      PACK8000(4,IREC)=IIIIIII(4)
+      IF(IREC.EQ.2000)THEN
+      WRITE(12)PACK8000
+      IREC=0
+      ENDIF
+      RETURN
+      END