ADAS Subroutine dadata
SUBROUTINE DADATA( IUNIT , NDPRT , NDREP , NDLEV , & NDAUG , NDT , & SEQSYM , IZ , IZ0 , IZ1 , & NPRNT , NPRNTI , NPRNTF, BWNP , & IPA , CSTRPA , ISPA , ILPA , XJPA , & WPA , & IL , BWNR , & IA , CSTRGA , ISA , ILA , XJA , & WA , & NREP , IAPRS , CAPRS , IPAUG , & IREPA , NREPA , AUGA , LAUGA , & IPRTI , TPRTI , ISPRTI, DIELR , LDIELR, & IPRTF , TPRTF , ISPRTF, & NSYSF , ISYS , ISPSYS, DIELN , LDIELN, & DIELT , & NTE , TEA & ) C----------------------------------------------------------------------- C C ****************** FORTRAN77 SUBROUTINE: DADATA ********************* C C PURPOSE: TO FETCH DATA FROM INPUT ADF09 DATA SET. C C CALLING PROGRAM: ADAS204/ADAS212/ADAS410 C C C SUBROUTINE: C C INPUT : (I*4) IUNIT = UNIT TO WHICH INPUT FILE IS ALLOCATED C C INPUT : (I*4) NDPRT = MAXIMUM NUMBER OF PARENT STATES C INPUT : (I*4) NDREP = MAX. NUMBER OF REPRESENTATIVE N-SHELLS C INPUT : (I*4) NDLEV = MAXIMUM NUMBER OF RESOLVED LEVELS C INPUT : (I*4) NDAUG = MAXIMUM NUMBER OF AUGER RATE INITIAL AND C FINAL PARENT PAIRS C INPUT : (I*4) NDT = MAX. NUMBER OF ELECTRON TEMPERATURES C C OUTPUT: (C*2) SEQSYM = RECOMBINED ION SEQ C OUTPUT: (I*4) IZ = RECOMBINED ION CHARGE C OUTPUT: (I*4) IZ0 = NUCLEAR CHARGE C OUTPUT: (I*4) IZ1 = RECOMBINING ION CHARGE C OUTPUT: (I*4) NPRNT = TOTAL NUMBER OF PARENTS C OUTPUT: (I*4) NPRNTI = NUMBER OF PARENTS WHICH ARE INITIAL PARENTS C OUTPUT: (I*4) NPRNTF = NUMBER OF PARENTS WHICH ARE FINAL PARENTS C OUTPUT: (R*8) BWNP = BINDING WAVE NO. OF GROUND PARENT (CM-1) C OUTPUT: (I*4) IPA() = NUMBER OF PARENT ENERGY LEVELS C OUTPUT: (C*18) CSTRPA()= NOMENCL./CONFIG. FOR PARENT LEVEL 'IPA()' C OUTPUT: (I*4) ISPA() = MULTIPLICITY FOR PARENT LEVEL 'IPA()' C NOTE: (ISPA-1)/2 = QUANTUM NUMBER (SP) C OUTPUT: (I*4) ILPA() = QUANTUM NUMBER (LP) FOR PARENT LEVEL 'IPA()' C OUTPUT: (R*8) XJPA() = QUANTUM NUMBER (JP) FOR PARENT LEVEL 'IPA()' C NOTE: (2*XJPA)+1 = STATISTICAL WEIGHT C OUTPUT: (R*8) WPA() = ENERGY RELATIVE TO PARENT LEVEL 1 (CM-1) C FOR PARENT LEVEL 'IPA()' C C OUTPUT: (I*4) IL = NUMBER OF ENERGY LEVELS (TERMS) OF C RECOMBINED ION C OUTPUT: (R*8) BWNR = IONISATION POTENTIAL (CM-1) OF LOWEST LEVEL C OF RECOMBINED ION C OUTPUT: (I*4) IA() = RECOMBINED ION ENERGY LEVEL INDEX NUMBER C OUTPUT: (C*18) CSTRGA()= NOMENCL./CONFIG. FOR RECOMBINED ION LEVEL C 'IA()' C OUTPUT: (I*4) ISA() = MULTIPLICITY FOR RECOMBINED LEVEL 'IA()' C NOTE: (ISA-1)/2 = QUANTUM NUMBER (S) C OUTPUT: (I*4) ILA() = QUANTUM NUMBER (L) FOR RECOMBINED LEVEL C 'IA()' C OUTPUT: (R*8) XJA() = QUANTUM NUMBER (J) FOR RECOMBINED LEVEL C 'IA()' C NOTE: (2*XJA)+1 = STATISTICAL WEIGHT C OUTPUT: (R*8) WA() = ENERGY RELATIVE TO RECOMBINED LEVEL 1 (CM-1) C FOR RECOMBINED LEVEL 'IA()' C OUTPUT: (I*4) NREP = NUMBER OF REPRESENTATIVE N-SHELLS C OUTPUT: (I*4) IREPA() = REPRESENTATIVE N-SHELL INDEX NUMBER C OUTPUT: (I*4) NREPA() = REPRESENTATIVE N-SHELLS C OUTPUT: (I*4) IAPRS = NUMBER OF AUGER RATE INITIAL AND FINAL C PARENT PAIRS C OUTPUT: (C*10) CAPRS() = AUGER RATE PARENT PAIR STRING C 1ST.DIM: PARENT PAIR INDEX C OUTPUT: (I*40) IPAUG(,)= INITIAL AND FINAL PARENTS FOR AUGER BREAKUPS C 1ST.DIM: PARENT PAIR INDEX C 2ND.DIM: INITIAL AND FINAL PARENT INDICES C OUTPUT: (R*8) AUGA(,) = AUGER RATES (SEC-1) C 1ST.DIM: REPRESENTATIVE N-SHELL INDEX C 2ND.DIM: PARENT PAIR INDEX C OUTPUT: (L*4) LAUGA(,) = .TRUE. => AUGER RATE PRESENT FOR N-SHELL C .FALSE.=> AUGER RATE NOT PRESENT C 1ST.DIM: REPRESENTATIVE N-SHELL INDEX C 2ND.DIM: PARENT PAIR INDEX C OUTPUT: (I*4) IPRTI() = INITIAL PARENT BLOCK INDEX C OUTPUT: (C*5) TPRTI() = INITIAL PARENT BLOCK TERM C OUTPUT: (I*4) ISPRTI()= INITIAL PARENT BLOCK SPIN MULTIPLICITY C OUTPUT: (R*8) TEA() = ELECTRON TEMPERATURES (K) C OUTPUT: (R*8) DIELR(,,)= TERM SELECTIVE DIELEC. COEFFTS.(CM3 S-1) C 1ST.DIM: LEVEL INDEX C 2ND.DIM: INITIAL PARENT INDEX C 3RD.DIM: TEMPERATURE INDEX C OUTPUT: (L*4) LDIELR(,)= .TRUE. => DIEL. PRESENT FOR LEVEL INDEX C .FALSE.=> DIEL. NOT PRESENT FOR LEVEL INDEX C 1ST.DIM: LEVEL INDEX C 2ND.DIM: INITIAL PARENT INDEX C OUTPUT: (I*4) IPRTF(,) = FINAL PARENT BLOCK INDEX C OUTPUT: (C*5) TPRTF(,) = FINAL PARENT BLOCK TERM C OUTPUT: (I*4) ISPRTF(,)= FINAL PARENT BLOCK SPIN MULTIPLICITY C OUTPUT: (I*4) NSYSF(,) = NO,. OF SPIN SYSTEMS BUILT ON FINAL PARENT C OUTPUT: (I*4) ISYS(,,) = N-SHELL SPIN SYSTEM INDEX FOR FINAL PARENT C OUTPUT: (I*4) ISPSYS(,,)=N-SHELL SPIN SYSTEM FOR FINAL PARENT C OUTPUT: (R*8) DIELN(,,,,) =N-SHELL DIELEC. COEFFTS.(CM3 S-1) C 1ST.DIM: REPR. N-SHELL INDEX C 2ND.DIM: INITIAL PARENT INDEX C 3RD.DIM: FINAL PARENT INDEX C 4TH.DIM: SPIN SYSTEM INDEX C 5TH.DIM: TEMPERATURE INDEX C OUTPUT: (R*8) LDIELN(,)= .TRUE. => DIEL. PRESENT FOR REPR. N-SHELL C .FALSE.=> DIEL. NOT PRESENT FOR N-SHELL C 1ST.DIM: REPR. N-SHELL INDEX C 2ND.DIM: INITIAL PARENT INDEX C 3RD.DIM: FINAL PARENT INDEX C 4TH.DIM: SPIN SYSTEM INDEX C OUTPUT: (R*8) DIELT(,,,) =N-SHELL DIELEC. COEFFTS.(CM3 S-1) C 1ST.DIM: INITIAL PARENT INDEX C 2ND.DIM: FINAL PARENT INDEX C 3RD.DIM: SPIN SYSTEM INDEX C 4TH.DIM: TEMPERATURE INDEX C C (I*4) INDX = GENERAL INDEX C (I*4) INDX1 = GENERAL INDEX C (I*4) II = GENERAL INDEX C (I*4) I = GENERAL INDEX C (I*4) IPI = GENERAL INDEX C (I*4) IPF = GENERAL INDEX C (I*4) IPFS = GENERAL INDEX C (I*4) J = GENERAL INDEX C (I*4) K = GENERAL INDEX C C (L) LDATA = GENERAL READ/DO NOT READ FLAG C (L) LNOPI = FLAG TO DETERMINE WHETHER HAVE PASSED C INTO A NEW INITIAL PARENT BLOCK C C (C*20) C20 = GENERAL CHARACTER STRING C C ROUTINES: C ROUTINE SOURCE BRIEF DESCRIPTION C ------------------------------------------------------------- C I4UNIT ADAS FETCH UNIT NUMBER FOR OUTPUT OF MESSAGES C I4EIZ0 ADAS RETURNS NUCL. CHARGE FROM ELEMENT SYMBOL C R8FCTN ADAS CONVERTS FROM CHARACTER TO REAL VARIABLE C XXWORD ADAS EXTRACT POSITION OF NUMBER IN BUFFER C C AUTHOR: H. P. SUMMERS, UNIVERSITY OF STRATHCLYDE C JA8.08 C TEL. 0141-553-4196 C C DATE: 05/08/97 C C UPDATE: Modified final parent reading block to acount for missing C final parents. (do-while to 130 statements). C Also added END=999 to read statement to avoid EOF error C when there is no data in SYS/SPNSYS block. C Martin O'Mullane, 3-10-97 C C VERSION: 1.1 C C VERSION: 1.2 DATE: 20-02-98 C MODIFIED: MARTIN O'MULLANE C - ERROR IN ASSIGNING NUMBER OF PARENTS IF >= NDPRT. C - ADDED TOTAL DR RATE FOR EACH (INITIAL PARENT, FINAL PARENT, C SPIN SYSTEM) BLOCK BY SUMMING UP AND INTERPOLATING THE C REPRESENTATIVE LEVEL SET. C C----------------------------------------------------------------------- C----------------------------------------------------------------------- CHARACTER*10 CAPRS(NDAUG) CHARACTER*(*) CSTRGA(NDLEV), CSTRPA(NDPRT) CHARACTER*2 SEQSYM CHARACTER*5 TPRTF(NDPRT,NDPRT), TPRTI(NDPRT) INTEGER IA(NDLEV), IAPRS, IL INTEGER ILA(NDLEV), ILPA(NDPRT), IPA(NDPRT) INTEGER IPAUG(NDAUG,2), IPRTF(NDPRT,NDPRT) INTEGER IPRTI(NDPRT), IREPA(NDREP) INTEGER ISA(NDLEV), ISPA(NDPRT), ISPRTF(NDPRT,NDPRT) INTEGER ISPRTI(NDPRT) INTEGER ISPSYS(NDPRT,NDPRT,2), ISYS(NDPRT,NDPRT,2) INTEGER IUNIT, IZ, IZ0, IZ1 INTEGER NDAUG, NDLEV, NDPRT, NDREP INTEGER NDT, NPRNT, NPRNTF, NPRNTI INTEGER NREP, NREPA(NDREP) INTEGER NSYSF(NDPRT,NDPRT), NTE LOGICAL LAUGA(NDREP,NDAUG) LOGICAL LDIELN(NDREP,NDPRT,NDPRT,2) LOGICAL LDIELR(NDLEV,NDPRT) REAL*8 AUGA(NDREP,NDAUG), BWNP, BWNR REAL*8 DIELN(NDREP,NDPRT,NDPRT,2,NDT) REAL*8 DIELR(NDLEV,NDPRT,NDT) REAL*8 DIELT(NDPRT,NDPRT,2,NDT), TEA(NDT) REAL*8 WA(NDLEV), WPA(NDPRT), XJA(NDLEV) REAL*8 XJPA(NDPRT)