Module VALD_FMT ! USE CONFIG USE PHYSAT ! Implicit None ! Private Public :: READ_VALD ! Real :: VALD_lbd_air Real :: VALD_Ei, VALD_Ej Real :: VALD_Ji, VALD_Jj Real :: VALD_loggf Real :: VALD_log_grad, VALD_log_gSta, VALD_log_gVdW Character(len=15) :: VALD_config_i, VALD_config_j Character(len=6) :: VALD_ref ! CONTAINS ! !-------------------------------------------------------------------- ! Subroutine INITIALIZATION_VALD() nan = SET_NAN(zero) VALD_lbd_air = nan VALD_Ei = nan VALD_Ej = nan VALD_Ji = nan VALD_Jj = nan VALD_config_i = '' VALD_config_j = '' VALD_loggf = nan VALD_log_grad = nan VALD_log_gSta = nan VALD_log_gVdW = nan VALD_ref = '' End Subroutine INITIALIZATION_VALD ! !-------------------------------------------------------------------- ! Subroutine READ_VALD(line, end_fin, N) Character(len = *), intent(inout) :: line Logical, intent(out) :: end_fin Integer, intent(out) :: N Character(len=256) :: line2 = '' Integer :: quo1, quo2, blan1, blan2 Integer :: pos1, pos2, pos3, pos4, pos5, pos6, pos7, pos8 Integer :: pos9, pos10, pos11, pos12, pos13 ! for long format Logical :: pb0, pb1, pb2 Logical, parameter :: blabla = .FALSE. ! Call INITIALIZATION() Call INITIALIZATION_VALD() ! Read(10, '(A)', iostat = ios) line If (ios > 0) STOP "IN SUBROUTINE READ_VALD: PB-00." If (ios < 0) Then; end_fin = .TRUE.; RETURN; End If ! ! Second line of long format ! If (.NOT. short_fmt) Read (10, '(A)', iostat = ios) line2 ! ! Normal end of file ! pb0 = ( Index(line, "References") /= 0 .OR. Index(line2, "References") /= 0) If (pb0) Then end_fin = .TRUE. RETURN End If ! ! First line of header ! pb1 = ( Index(line, "Damping") /= 0 ) !IF (pb1) Read (10, '(A)', iostat = ios) line !IF(ios /= 0) STOP "IN SUBROUTINE READ_VALD: PB-01." If (pb1) RETURN ! ! End of header ! pb2 = ( Index(line, "Ion") /= 0 .OR. Index(line2, "Ion") /= 0 ) !IF (pb2) Read (10, '(A)', iostat = ios) line !IF(ios /= 0) STOP "IN SUBROUTINE READ_VALD: PB-03." IF (pb2) RETURN ! ! Damping parameters Lande !Elm Ion WL(A) Excit(eV) log(gf) Rad. Stark Waals factor References !'Ti 1', 4900.0210, 2.6620, -1.108, 7.830,-4.825,-7.613, 0.840,' 1 1 1 1 1 1 1' !| | || | | | | | | | !quo1 quo2 ! blan1 pos1 pos2 pos3 pos4 pos5 pos6 pos7 pos8 ! !'V 1', 4008.6140, 3.0990, -2.322, 8.217,-4.390,-7.296, 1.230,' 7 7 7 7 7 7 7' ! || !blan1 ! blan2 ! quo1 = Index(line( 1 : ), "'") blan1 = Index(line( 1 : ), " ") quo2 = Index(line(quo1 + 1 : ), "'") + quo1 blan2 = Index(line(quo1 : quo2), " ", back = .TRUE.) pos1 = Index(line( 1 : ), ",") pos2 = Index(line(pos1 + 1 : ), ",") + pos1 pos3 = Index(line(pos2 + 1 : ), ",") + pos2 pos4 = Index(line(pos3 + 1 : ), ",") + pos3 pos5 = Index(line(pos4 + 1 : ), ",") + pos4 pos6 = Index(line(pos5 + 1 : ), ",") + pos5 pos7 = Index(line(pos6 + 1 : ), ",") + pos6 pos8 = Index(line(pos7 + 1 : ), ",") + pos7 ! If(.NOT. short_fmt) Then ! Lande factors Damping parameters !Elm Ion WL(A) log(gf) Exc. lo J lo Exc. up J up lower upper mean Rad. Stark Waals !'Tb 2', 4000.0000, -0.440, 0.7900, 6.0, 3.8890, 7.0, 1.400,99.000,99.000, 0.000, 0.000, 0.000, !| | || | | | | | | | | | | | | !quo1 quo2 ! blan1 pos1 pos2 pos3 pos4 pos5 pos6 pos7 pos8 pos9 pos10 pos11 pos12 pos13 ! 'E 0.06 LWCS 7F* 1 1 1 1 1 1 1 1 1' !'Fe 1', 4000.0170, -3.746, 2.8320, 2.0, 5.9300, 2.0, 1.500, 0.470, 0.990, 7.590,-6.030,-7.820, ! '(4P)4s b3P 3Gsp3P w5G* K07 2 2 2 2 2 2 2 2 2' ! pos9 = Index(line(pos8 + 1 : ), ",") + pos8 pos10 = Index(line(pos9 + 1 : ), ",") + pos9 pos11 = Index(line(pos10 + 1 : ), ",") + pos10 pos12 = Index(line(pos11 + 1 : ), ",") + pos11 pos13 = Index(line(pos12 + 1 : ), ",") + pos12 End If ! Read(line(quo1 + 1 : blan1 ), '(A)', iostat = ios) cElt If(ios /= 0) STOP "IN SUBROUTINE READ_VALD: PB-04." Read(line(blan2+1 : quo2-1 ), '(I1)', iostat = ios) Ion If(ios /= 0) STOP "IN SUBROUTINE READ_VALD: PB-05." Read(line(pos1 + 1 : pos2 - 1), * , iostat = ios) VALD_lbd_air If(ios /= 0) STOP "IN SUBROUTINE READ_VALD: PB-06." ! If (short_fmt) Then Read(line(pos2 + 1 : pos3 - 1), * , iostat = ios) VALD_Ei If(ios /= 0) STOP "IN SUBROUTINE READ_VALD: PB-07." Read(line(pos3 + 1 : pos4 - 1), * , iostat = ios) VALD_loggf If(ios /= 0) STOP "IN SUBROUTINE READ_VALD: PB-08." Read(line(pos4 + 1 : pos5 - 1), * , iostat = ios) VALD_log_grad If(ios /= 0) STOP "IN SUBROUTINE READ_VALD: PB-09." Read(line(pos5 + 1 : pos6 - 1), * , iostat = ios) VALD_log_gSta If(ios /= 0) STOP "IN SUBROUTINE READ_VALD: PB-10." Read(line(pos6 + 1 : pos7 - 1), * , iostat = ios) VALD_log_gVdW If(ios /= 0) STOP "IN SUBROUTINE READ_VALD: PB-11." Else Read(line(pos2 + 1 : pos3 - 1), * , iostat = ios) VALD_loggf If(ios /= 0) STOP "IN SUBROUTINE READ_VALD: PB-12." Read(line(pos3 + 1 : pos4 - 1), * , iostat = ios) VALD_Ei If(ios /= 0) STOP "IN SUBROUTINE READ_VALD: PB-13." Read(line(pos4 + 1 : pos5 - 1), * , iostat = ios) VALD_Ji If(ios /= 0) STOP "IN SUBROUTINE READ_VALD: PB-14." Read(line(pos5 + 1 : pos6 - 1), * , iostat = ios) VALD_Ej If(ios /= 0) STOP "IN SUBROUTINE READ_VALD: PB-15." Read(line(pos6 + 1 : pos7 - 1), * , iostat = ios) VALD_Jj If(ios /= 0) STOP "IN SUBROUTINE READ_VALD: PB-16." Read(line(pos10 + 1 : pos11 - 1), * , iostat = ios) VALD_log_grad If(ios /= 0) STOP "IN SUBROUTINE READ_VALD: PB-17." Read(line(pos11 + 1 : pos12 - 1), * , iostat = ios) VALD_log_gSta If(ios /= 0) STOP "IN SUBROUTINE READ_VALD: PB-18." Read(line(pos12 + 1 : pos13 - 1), * , iostat = ios) VALD_log_gVdW If(ios /= 0) STOP "IN SUBROUTINE READ_VALD: PB-19." ! Second line Read(line2(11:21), '(A)', iostat = ios) VALD_config_i If(ios /= 0) STOP "IN SUBROUTINE READ_VALD: PB-20." Read(line2(22:32), '(A)', iostat = ios) VALD_config_j If(ios /= 0) STOP "IN SUBROUTINE READ_VALD: PB-21." Read(line2(33:41), '(A)', iostat = ios) VALD_ref If(ios /= 0) STOP "IN SUBROUTINE READ_VALD: PB-22." ! End If ! Z = NUM_NUCLEUS(cElt) code = Z + ( (Ion-1) / 10. ) Ei_eV = VALD_Ei Ej_eV = VALD_Ej Ei_cm = q_cste/(h_cste * c_cste * 100.) * VALD_Ei Ej_cm = q_cste/(h_cste * c_cste * 100.) * VALD_Ej gi = int(2*VALD_Ji+1) gj = int(2*VALD_Jj+1) config_i = VALD_config_i config_j = VALD_config_j loggf = VALD_loggf ! If (abs(VALD_log_grad) > 0. ) Then gam_rad = 10**VALD_log_grad Else gam_rad = 0. End If ! If (abs(VALD_log_gSta) > 0. ) Then gam_Sta = 10**VALD_log_gSta Else gam_Sta = 0. End If ! If (abs(VALD_log_gVdW) > 0. ) Then gam_VdW = 10**VALD_log_gVdW Else gam_VdW = 0. End If ! lbd_air = VALD_lbd_air lbd_vac = Real(LAMBDA_VAC(Dble(VALD_lbd_air))) ! If (blabla) Then Write(*, *) Trim(line) Write(*, *) quo1, blan1, blan2, quo2, pos1, pos2, pos3, pos4, pos5, pos6, pos7, pos8 If(.NOT. short_fmt) Write(*, *) pos9, pos10, pos11, pos12, pos13 If(short_fmt) Write(*, *) "cElt, Ion, lbd_air, Ei_eV, loggf =", Trim(cElt), Ion, lbd_air, Ei_eV, loggf If(.NOT. short_fmt) Write(*, *) "cElt, Ion, lbd_air, loggf, Ei_cm, Ji, Ej_cm, Jj = ", & Trim(cElt), Ion, lbd_air, loggf, Ei_cm, VALD_Ji, Ej_cm, VALD_Jj If(.NOT. short_fmt) Write(*, *) "gam_rad, gam_Sta, gam_VdW = ", gam_rad, gam_Sta, gam_VdW Write(*, *) "Z, Ion,code", Z, Ion, code Write(*, *) !Read(*, *) End If ! N = N + 1 ! Lines read ! End Subroutine READ_VALD ! End Module VALD_FMT