Module KALD_FMT ! USE CONFIG USE PHYSAT ! Implicit None ! Private Public :: READ_KALD_FIX ! Real :: KALD_code Real :: KALD_lbd_air, KALD_lbd_vac ! wavelength in nm Real :: KALD_loggf, KALD_Aji Real :: KALD_Ei, KALD_Ej ! lower and upper energy Real :: KALD_Ji, KALD_Jj ! Real :: KALD_log_grad, KALD_log_gSta, KALD_log_gVdW Character(len=15) :: KALD_config_i, KALD_config_j ! CONTAINS ! !-------------------------------------------------------------------- ! Subroutine INITIALIZATION_KALD() nan = SET_NAN(zero) KALD_code = nan KALD_lbd_air = nan KALD_lbd_vac = nan KALD_loggf = nan KALD_Aji = nan KALD_Ei = nan KALD_Ej = nan KALD_Ji = nan KALD_Jj = nan KALD_config_i = '' KALD_config_j = '' KALD_log_grad = nan KALD_log_gSta = nan KALD_log_gVdW = nan End Subroutine INITIALIZATION_KALD ! !-------------------------------------------------------------------- ! Subroutine READ_KALD(line, end_fin, N) Character(len = *), intent(inout) :: line Logical, intent(out) :: end_fin Integer, intent(out) :: N ! Integer, parameter :: Nfield = 12 Integer, dimension(Nfield) :: pos, blan Integer :: I Logical :: pb0, pb1, pb2, pb3 Logical :: lambda_in_air Logical, parameter :: blabla = .TRUE. ! Call INITIALIZATION() Call INITIALIZATION_KALD() ! pos = int(zero) blan = int(zero) lambda_in_air = .TRUE. ! IF(blabla) Write(*,*) pos, blan, nan ! Read(10, '(A)', iostat = ios) line If (ios > 0) STOP "IN SUBROUTINE READ_KALD: PB-00." If (ios < 0) Then; end_fin = .TRUE.; RETURN; End If ! ! Normal end of file ! pb0 = Trim(line) == "" If (pb0) Then end_fin = .TRUE. RETURN End If ! ! Begin of header ! pb1 = ( Index(line, "----------") /= 0 ) IF (pb1) Read (10, '(A)', iostat = ios) line If(ios /= 0) STOP "IN SUBROUTINE READ_KALD: PB-01." ! ! First line of header ! pb2 = ( Index(line, "Damping") /= 0 ) IF (pb2) Read (10, '(A)', iostat = ios) line If(ios /= 0) STOP "IN SUBROUTINE READ_KALD: PB-03." ! ! End of header ! pb3 = ( Index(line, "Code") /= 0 ) If (pb3) Then Read (10, '(A)', iostat = ios) line Read (10, '(A)', iostat = ios) line If(ios /= 0) STOP "IN SUBROUTINE READ_KALD: PB-03." End If ! !----------------------------------------------------------------------------------------------------- ! Wl_vac Wl_air log_gf Elem. E_lower_lev. J E_upper_lev. J Gamma (Damping) Ref. ! / nm / nm (Code) / cm^(-1) lower / cm^(-1) upper R S W !----------------------------------------------------------------------------------------------------- ! 24.8866 -5.620 12.05 0.000 1.5 401822.000 0.5 0.00 0.00 0.00 KP ! 400.1147 400.0016 -3.018 26.00 22838.318 2.0 47831.150 2.0 7.69 -6.11 -7.79 K88 ! | | | | | | | | | | | | ! pos1 pos2 pos3 pos4 pos5 pos6 pos7 pos8 pos9 pos10 pos11 pos12 ! | | | | | | | | | | | | ! blan1 blan2 blan3 blan4 blan5 blan6 blan7 blan8 blan9 blan10 blan11 blan12 ! ! 193.2266 193.1629 0.301 13.00 0.000 0.5 51752.710 0.5 11.98-16.30-14.88 ROIG ! | | | | | | | | | | | | ! pos1 pos2 pos3 pos4 pos5 pos6 pos7 pos8 pos9 pos10 pos11 pos12 ! | | | | | | | | | | | | ! blan1 blan2 blan3 blan4 blan5 blan6 blan7 blan8 blan9 blan10 blan11 blan12 ! pos(1) = Scan(line(1:), "-1234567890") ! Do I = 1, Nfield-1 blan(I) = Scan(line( pos(I)+1:), " -") + pos(I) pos(I+1) = Scan(line(blan(I):), "-1234567890ABCDEFGHIKJKLMNOPQRSTUVWXYZ") + blan(I) - 1 End Do ! ! For lambda < 2000 A lambda in air is not given ! If ( pos(2)-blan(1) >= 11) Then pos(3:) = pos(2:Nfield-1) blan(2:) = blan(1:Nfield-1) lambda_in_air = .FALSE. End If ! If (blabla) Then Write(*, *) Trim(line) Write(*, *) (pos(I), blan(I), I=1, Nfield) End If ! blan(12) = Scan(line( pos(12):), " ") + pos(12) - 1 ! Read(line(pos(1) : blan(1) - 1), * , iostat = ios) KALD_lbd_vac If(ios /= 0) STOP "IN SUBROUTINE READ_KALD: PB-04." If(lambda_in_air) Read(line(pos(2) : blan(2) - 1), * , iostat = ios) KALD_lbd_air If(ios /= 0) STOP "IN SUBROUTINE READ_KALD: PB-05." Read(line(pos(3) : blan(3) - 1), * , iostat = ios) KALD_loggf If(ios /= 0) STOP "IN SUBROUTINE READ_KALD: PB-06." Read(line(pos(4) : blan(4) - 1), * , iostat = ios) KALD_code If(ios /= 0) STOP "IN SUBROUTINE READ_KALD: PB-07." Read(line(pos(5) : blan(5) - 1), * , iostat = ios) KALD_Ei If(ios /= 0) STOP "IN SUBROUTINE READ_KALD: PB-08." Read(line(pos(6) : blan(6) - 1), * , iostat = ios) KALD_Ji If(ios /= 0) STOP "IN SUBROUTINE READ_KALD: PB-09." Read(line(pos(7) : blan(7) - 1), * , iostat = ios) KALD_Ej If(ios /= 0) STOP "IN SUBROUTINE READ_KALD: PB-10." Read(line(pos(8) : blan(8) - 1), * , iostat = ios) KALD_Jj If(ios /= 0) STOP "IN SUBROUTINE READ_KALD: PB-11." Read(line(pos(9) : blan(9) - 1), * , iostat = ios) KALD_log_grad If(ios /= 0) STOP "IN SUBROUTINE READ_KALD: PB-12." Read(line(pos(10) : blan(10) - 1), * , iostat = ios) KALD_log_gSta If(ios /= 0) STOP "IN SUBROUTINE READ_KALD: PB-13." Read(line(pos(11) : blan(11) - 1), * , iostat = ios) KALD_log_gVdW If(ios /= 0) STOP "IN SUBROUTINE READ_KALD: PB-14." Read(line(pos(12) : blan(12) - 1), '(A)', iostat = ios) ref If(ios /= 0) STOP "IN SUBROUTINE READ_KALD: PB-09." ! Z = Floor(KALD_code) Ion = Int( ( KALD_code - Z)*100. ) + 1 code = ( KALD_code - Z )*10. + Z ! lbd_vac = KALD_lbd_vac * 10. ! If (lambda_in_air) Then lbd_air = KALD_lbd_air * 10. Else lbd_air = Real(LAMBDA_AIR(Dble(KALD_lbd_vac*10.))) End If ! Ei_cm = KALD_Ei Ej_cm = KALD_Ej Ei_eV = h_cste * c_cste / q_cste * 100. * KALD_Ei Ej_eV = h_cste * c_cste / q_cste * 100. * KALD_Ej gi = int(2*KALD_Ji+1) gj = int(2*KALD_Jj+1) loggf = KALD_loggf gam_rad = 10**KALD_log_grad ! If (KALD_log_gSta - 10.e-6 >= 0. ) Then gam_Sta = 10**KALD_log_gSta Else gam_Sta = 0. End If ! If (blabla) Then Write(*, *) lbd_vac, lbd_air, loggf, code, Ei_cm, gi, Ej_cm, gj, gam_rad, gam_Sta, gam_VdW, Trim(ref) Write(*, *) Z, Ion, Ei_eV Write(*, *) End If ! N = N + 1 ! Lines read ! End Subroutine READ_KALD ! !---------------------------------------------------------------------------- ! Subroutine READ_KALD_FIX(line, end_fin, N) Character(len = *), intent(inout) :: line Logical, intent(out) :: end_fin Integer, intent(out) :: N ! Logical :: pb0, pb1, pb2, pb3 Logical, parameter :: blabla = .FALSE. ! Call INITIALIZATION() Call INITIALIZATION_KALD() ! Read(10, '(A)', iostat = ios) line If (ios > 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-00." If (ios < 0) Then; end_fin = .TRUE.; RETURN; End If ! ! Normal end of file ! pb0 = Trim(line) == "" If (pb0) Then end_fin = .TRUE. RETURN End If ! ! Begin of header ! pb1 = ( Index(line, "----------") /= 0 ) IF (pb1) Read (10, '(A)', iostat = ios) line If(ios /= 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-01." ! ! First line of header ! pb2 = ( Index(line, "Damping") /= 0 ) IF (pb2) Read (10, '(A)', iostat = ios) line If(ios /= 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-03." ! ! End of header ! pb3 = ( Index(line, "Code") /= 0 ) If (pb3) Then Read (10, '(A)', iostat = ios) line Read (10, '(A)', iostat = ios) line If(ios /= 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-03." End If ! If (short_fmt) Then !----------------------------------------------------------------------------------------------------- ! Wl_vac Wl_air log_gf Elem. E_lower_lev. J E_upper_lev. J Gamma (Damping) Ref. ! / nm / nm (Code) / cm^(-1) lower / cm^(-1) upper R S W !----------------------------------------------------------------------------------------------------- ! 24.8866 -5.620 12.05 0.000 1.5 401822.000 0.5 0.00 0.00 0.00 KP ! 735.0888 734.8863 -3.959 30.02 220006.600 1.0 233610.400 2.0 0.00 0.00 0.00 KP ! !0 1 2 3 4 5 6 7 8 9 1 !1...5....0....5....0....5....0....5....0....5....0....5....0....5....0....5....0....5....0....5....0 ! Read(line(1:11), * , iostat = ios) KALD_lbd_vac If(ios /= 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-04." Read(line(12:23), * , iostat = ios) KALD_lbd_air If(ios /= 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-05." Read(line(24:31), * , iostat = ios) KALD_loggf If(ios /= 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-06." Read(line(32:38), * , iostat = ios) KALD_code If(ios /= 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-07." Read(line(39:51), * , iostat = ios) KALD_Ei If(ios /= 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-08." Read(line(52:57), * , iostat = ios) KALD_Ji If(ios /= 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-09." Read(line(58:70), * , iostat = ios) KALD_Ej If(ios /= 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-10." Read(line(71:76), * , iostat = ios) KALD_Jj If(ios /= 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-11." Read(line(77:83), * , iostat = ios) KALD_log_grad If(ios /= 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-12." Read(line(84:89), * , iostat = ios) KALD_log_gSta If(ios /= 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-13." Read(line(90:95), * , iostat = ios) KALD_log_gVdW If(ios /= 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-14." Read(line(96:), '(A)', iostat = ios) ref If(ios /= 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-09." Else !--------------------------------------------------------------------------------------------------------------------------- ! Wl_vac Wl_air log_gf Elem. E_lower_lev. J Config. E_upper_lev. J Config. Gamma (Damping) Ref. ! / nm / nm (Code) / cm^(-1) lower lower / cm^(-1) upper upper R S W !--------------------------------------------------------------------------------------------------------------------------- ! 24.8866 -5.620 12.05 0.000 1.5 2p3 *4S 401822.000 0.5 s2p4 2S 0.00 0.00 0.00 KP ! 245.2152 245.1410 -3.404 24.03 118571.500 2.5 (1D)4s 2D 159352.000 3.5 (3F)4p 4F 9.44 -6.73 -7.99 K88 ! 245.3171 245.2428 -3.389 26.01 50075.910 1.5 (3F)4s c4F 90839.486 0.5 (3P)4p 4P 8.22 -5.83 -7.68 K88 ! !0 1 2 3 4 5 6 7 8 9 1 1 1 !1...5....0....5....0....5....0....5....0....5....0....5....0....5....0....5....0....5....0....5....0.........1.........2 ! 0....5....0....5....0 Read(line(1:11), * , iostat = ios) KALD_lbd_vac If(ios /= 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-10." Read(line(12:23), * , iostat = ios) KALD_lbd_air If(ios > 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-11." Read(line(24:31), * , iostat = ios) KALD_loggf If(ios /= 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-12." Read(line(32:38), * , iostat = ios) KALD_code If(ios /= 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-13." Read(line(39:51), * , iostat = ios) KALD_Ei If(ios /= 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-14." Read(line(52:57), * , iostat = ios) KALD_Ji If(ios /= 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-15." Read(line(58:69), '(A)', iostat = ios) KALD_config_i If(ios /= 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-16." Read(line(70:81), * , iostat = ios) KALD_Ej If(ios /= 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-17." Read(line(82:87), * , iostat = ios) KALD_Jj If(ios /= 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-18." Read(line(88:99), '(A)', iostat = ios) KALD_config_j If(ios /= 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-19." Read(line(100:105), * , iostat = ios) KALD_log_grad If(ios /= 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-20." Read(line(106:111), * , iostat = ios) KALD_log_gSta If(ios /= 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-21." Read(line(112:117), * , iostat = ios) KALD_log_gVdW If(ios /= 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-22." Read(line(118:), '(A)', iostat = ios) ref If(ios /= 0) STOP "IN SUBROUTINE READ_KALD_FIX: PB-23." End If ! Z = Floor(KALD_code) Ion = Int( ( KALD_code - Z)*100. ) + 1 code = ( KALD_code - Z )*10. + Z ! lbd_vac = KALD_lbd_vac * 10. ! If (KALD_lbd_air == KALD_lbd_air) Then lbd_air = KALD_lbd_air * 10. Else lbd_air = Real(LAMBDA_AIR(Dble(KALD_lbd_vac*10.))) End If ! Ei_cm = KALD_Ei Ej_cm = KALD_Ej Ei_eV = h_cste * c_cste / q_cste * 100. * KALD_Ei Ej_eV = h_cste * c_cste / q_cste * 100. * KALD_Ej gi = int(2*KALD_Ji+1) gj = int(2*KALD_Jj+1) config_i = KALD_config_i config_j = KALD_config_j loggf = KALD_loggf ! If (abs(KALD_log_grad) > 0. ) Then gam_rad = 10**KALD_log_grad Else gam_rad = 0. End If ! If (abs(KALD_log_gSta) > 0.) Then gam_Sta = 10**KALD_log_gSta Else gam_Sta = 0. End If ! If (abs(KALD_log_gVdW) > 0. ) Then gam_VdW = 10**KALD_log_gVdW Else gam_VdW = 0. End If ! If (blabla) Then Write(*, *) lbd_vac, lbd_air, loggf, code, Ei_cm, gi, config_i, Ej_cm, gj, config_j, gam_rad, gam_Sta, gam_VdW, Trim(ref) Write(*, *) Z, Ion, Ei_eV Write(*, *) End If ! N = N + 1 ! Lines read ! End Subroutine READ_KALD_FIX End module KALD_FMT