ADAS Subroutine d7exps
SUBROUTINE D7EXPS( NDMET , NDCONF , NDTHET , NDORB , NDLEV , & ndtrn , ndqdn , LTADJ , & IZ , IZ0 , IZ1 , & il , ia , isa , ila , xja , & cstrga , wa , bwno , iorb , qdorb , & ipl , ipa , ipsa , ipla , xpja , & cstrgpa , wpa , bwnop , & icnte2 , ie1a2 , ie2a2 , aval2 , & NTHETA , THETA , ITSELA , NPMET , IPMETR , & ISPRT , ISPSYS , NSYS , INPAR , ILPAR , & ENPAR , TRMPRT , SPNFAC , & NORB , VORB , LEICHR , & CI4 , EIONA , IZETA4 , NZETA , SAO , & IONLEV , XITRUE , NCUT , N0A , PARMR , & ALFRA , ALFRA0 , ALFRAR , NCONFG , & WVMIN , WVMAX , & ECF , FCF , PCF , WCF , W , & NCF , LCF , NDCF , LDCF , NDMIN , & E , DE0 , DE , FM0 , FM , & IINAA , IIPNAA , NCTAA , NCTAAC , ECTAA , & NTRANS , ITYPEA , N1A , NCUTT , PARMD , & EDISGP , SCALGP , ADIELO , ALFDA , ALFPART , & LLINK , ILINK , LEISS , NMET , IMETR & ) C----------------------------------------------------------------------- C C ****************** FORTRAN77 SUBROUTINE: D7EXPS ********************* C C C PURPOSE: C (1) GENERATES APPROXIMATE FORM PARAMETERS AND NUMERICAL C VALUES FOR IONISATION AND RECOMBINATION RATES FROM C SPECIFIC ION FILES C (2) RETURNS DATA REQUIRED FOR A MAINCL INPUT FILE RESOLVED C INTO PARENT/SPIN SYSTEM COMPONENTS. C (3) RETURNS PARAMETERS REQUIRED FOR AN ATOMPARS FILE C C CALLING PROGRAM: ADAS407 C C SUBROUTINE: C C INPUT : (I*4) IUNIT = UNIT NUMBER FOR SPECIFIC ION FILE FOR C RECOMBINED ION C INPUT : (I*4) IUNIT1 = UNIT NUMBER FOR SPECIFIC ION FILE FOR C RECOMBINING ION C INPUT : (I*4) NDMET = MAXIMUM NUMBER OF METASTABLES ALLOWED C INPUT : (I*4) NDTHET = MAXIMUM NUMBER OF TEMPS. FOR MAINCL FILE C INPUT : (I*4) NDCONF = MAXIMUM NUMBER OF CONFIGURATIONS ALLOWED C INPUT : (I*4) NDORB = MAXIMUM NUMBER OF ELECTRON ORBITALS C C INPUT : (L*4) LTADJ = .TRUE. => ADJUST PARMS FROM SPECIAL TABLES C .FALSE.=> DO NOT ADJUST PARMS FROM TABLES C C INPUT : (I*4) IZ = RECOMBINED ION CHARGE C INPUT : (I*4) IZ1 = RECOMBINING ION CHARGE C C INPUT : (I*4) NTHETA = NUMBER OF TEMPERATURES FOR MAINCL FILE C INPUT : (R*8) THETA() = Z-SCALED TEMPERATURES FOR MAINCL FILE C INPUT : (I*4) ITSELA() = TEMPERATURE INDEX FOR POWER MATCHING C 1ST IND: RECOMBINED ION METASTABLE INDEX C C INPUT : (I*4) NPMET = NO. OF RECOMBINING ION (PARENT) METASTABLES C INPUT : (I*4) IPMETR() = INDICES OF RECOMBINING ION (PARENT) C METASTABLES IN LEVEL LIST C INPUT : (L*4) LLINK(,,) = .TRUE. => LINK EXISTS C .FALSE. => NO LINK EXISTS C 1ST DIM: METASTABLE INDEX C 2ND DIM: PARENT METASTABLE INDEX C 3RD DIM: SPEN SYSTEM INDEX C INPUT : (L*4) ILINK(,,) = DECIMAL ORBITAL INDEX FOR RECOMBINED C ION ORBITAL DIFFERENCE WITH PARENT C 1ST DIM: METASTABLE INDEX C 2ND DIM: PARENT METASTABLE INDEX C 3RD DIM: SPEN SYSTEM INDEX C INPUT : (L*4) LEISS = .TRUE. => PARENTS AND METASTABLES FOUND C TO HAVE EISSNER CONFIG. FORMS C .FALSE => NOT EISSNER CONFIG. FORMS C INPUT : (I*4) NMET = NUMBER OF METASTABLES (1 <= NMET <= 'NDMET') C INPUT : (I*4) IMETR() = INDEX OF METASTABLE IN COMPLETE LEVEL LIST C (ARRAY SIZE = 'NDMET' ) C C OUTPUT: (I*4) ISPRT() = RECOMBINING ION (PARENT) SPIN C 1ST DIM: PARENT INDEX C OUTPUT: (I*4) ISPSYS(,)= RECOMBINED ION SPIN C 1ST DIM: PARENT INDEX C 2ND IND: SPIN SYSTEM INDEX C OUTPUT: (I*4) NSYS() = NUMBER OF SPIN SYSTEMS FOR RECOMBINED ION C 1ST DIM: PARENT INDEX C OUTPUT: (I*4) INPAR() = N QUANTUM NO. SUM FOR ELECTRONS OF PARENT C 1ST DIM: PARENT INDEX C OUTPUT: (I*4) ILPAR() = L QUANTUM NO. SUM FOR ELECTRONS OF PARENT C 1ST DIM: PARENT INDEX C OUTPUT: (R*8) ENPAR() = RECOMBINING ION (PARENT) ENERGY C 1ST DIM: PARENT INDEX C OUTPUT: (C*2) TRMPRT() = RECOMBINING ION METASTABLE (PARENT) TERM C 1ST DIM: PARENT INDEX C OUTPUT: (I*4) NCUT() = N-SHELL AUTOIONISATION CUT-OFF FOR PARENT C 1ST DIM: PARENT INDEX C OUTPUT: (I*4) N0A(,) = LOWEST ALLOWED N-SHELL C 1ST DIM: PARENT INDEX C 2ND DIM: SPIN SYSTEM INDEX C OUTPUT: (R*4) PARMR(,,)= PARAMETERS OF RADIATIVE RECOMBINATION C APPROXIMATE FORMS C 1ST DIM: PARENT INDEX C 2ND DIM: SPIN SYSTEM INDEX C 3RD DIM: PARMS. 1: EFF. N FOR LOWEST LEVEL C 2: PHASE SPACE FACTOR C 3: ENERGY DISPLACEMENT C 4: SCALING MULTIPLIER C C (I*4) ITDIMD = PARAMETER = LIMIT NUMBER OF TEMPERATURES C INTRINSIC TO ROUTINE C (I*4) IMDIMD = PARAMETER = LIMIT NUMBER OF METASTABLES C INTRINSIC TO ROUTINE C (I*4) IODIMD = PARAMETER = LIMIT NUMBER OF ELEC. ORBITALS C (R*8) SPNFAC(,)= SPIN WEIGHT FRACTION FOR PARENT/SPIN SYSTEM C 1ST DIM: PARENT INDEX C 2ND DIM: RECOMBINED ION SPIN SYSTEM INDEX C (R*8) SPNSUM() = SPIN SYSTEM WEIGHT SUM BASED ON PARENT C 1ST DIM: PARENT INDEX C (I*4) IGRPA() = NUMBER OF ELECTRONS ALLOWED IN EACH SHELL C 1ST DIM: SHELL INDEX (1=1S, 2=2S ETC) C (C*1) EICHR() = EISSNER NOTATION CHARACTER FOR ORBITAL C 1ST DIM: ORBITAL INDEX C (L*4) LEICHR() = .TRUE. => EISSNER ORBITAL USED C .FALSE => EISSNER ORBITAL NOT USED C (I*4) KGRPA() = NUMBER OF ELECTRONS IN EACH SHELL C 1ST DIM: SHELL INDEX (1=1S, 2=2S ETC) C (R*8) VORB() = EFFECT. PRINC. QUANT. NO. FOR ORBITAL C 1ST DIM: SHELL INDEX (1=1S, 2=2S ETC) C (R*8) EPSIL() = ENERGY OF ORBITAL (RYDBERG) C 1ST DIM: SHELL INDEX (1=1S, 2=2S ETC) C (R*8) SAO(,,) = BEST EXTIMATE OF METASTABLE AVERAGED C IONISATION RATE C 1ST DIM: PARENT INDEX C 2ND IND: SPIN SYSTEM INDEX C 3RD IND: TEMPERATURE INDEX C (C*1) CHLA() = CONVERTS NUMERICAL VALUE FOR L QUANTUM C TO CHARACTER VALUE (CAPITAL). NOTE C THAT L+1 (<11) IS THE CALL PARAMETER. C (I*4) ILPRT() = RECOMBINING ION (PARENT) TOTAL ORBITAL C ANGULAR MOMENTUM C 1ST DIM: PARENT INDEX C C NOTE: C C ROUTINES: C ROUTINE SOURCE BRIEF DESCRIPTION C ------------------------------------------------------------ C D7AUTS ADAS ANALYSES FOR IONISATION RATE PARAMETERS C D7ALFS ADAS ANALYSES FOR RECOMBINATION PARAMETERS C C AUTHOR: H. P. SUMMERS, JET C K1/1/57 C JET EXT. 4941 C C DATE: 27/06/94 C C UPDATE: 04/07/95 - HPS CORRECTED ERROR BARE NUCLEUS CASE TO ENSURE C NSHEL=1, NEL=1 CHEISA(1)='1' SET. C NOTE: INSUM, ILSUM ARE NOT SATISFACTORY IN C THE BARE NUCLEUS CASE. STILL TO RECONSIDER C THE ALGORITM FOR DECIDING INNER CLOSED SHELLS C BARE NUCLEUS MAKES A FALSE ASSUMPTION BUT C WITHOUT SERIOUS CONSEQUENCE. C UPDATE: 07/03/96 - HPS REMOVED VALUE ASSIGNMENT OF NTHETA C REMOVED VALUE ASSIGNMENT OF MAXDTA C C UNIX-IDL PORT: C WILLIAM OSBORN, TESSELLA SUPPORT SERVICES PLC. C C DATE: 22ND APRIL 1996 C C VERSION: 1.1 DATE: 22-04-96 C MODIFIED: WILLIAM OSBORN C - FIRST VERSION. C C VERSION: 1.2 DATE: 14-05-96 C MODIFIED: WILLIAM OSBORN C REARRANGED ARGUMENTS TO STAY UNDER C LIMIT OF 20 CONTINUATION CHARACTERS AT ARCETRI AND GARCHING C VERSION: 1.3 DATE: 20-08-96 C MODIFIED: HUGH SUMMERS + WILLIAM OSBORN C - CORRECTED ASSIGNMENT OF 'TRMPRT' C - ADDED FOLLOWING TO CALL PARAMETERS C LLINK,ILINK,LEISS,NMET AND IMETR C VERSION: 1.4 DATE: 24-09-96 C MODIFIED: HUGH SUMMERS + WILLIAM OSBORN C - INTRODUCED ILPRT AND CORRECT OUTPUT TRMPRT C C C VERSION : 1.5 C DATE : 23-05-2003 C MODIFIED: Martin O'Mullane C - Pass through adf04 data for d7alfs and d7auts. C - Do not rewind files to get parent data; use C the new arguments. C - Make implicit none. C - Remove all unused variables and reduced length of C parameter list. C - Remove redundant code and format statements. C C VERSION : 1.6 C DATE : 04-11-2003 C MODIFIED: Hugh Summers C - checked iodimd consistency with passed ndorb. C - Extended igrpa eichr,chla C - corrected array indexing error in applying corrad C to parmd(ipar,6,j) C C VERSION : 1.7 C DATE : 06-01-2004 C MODIFIED: Martin O'Mullane C - Remove redundant nia, lia, wia, nja, lja and wja C variables. C - Pre-process configuration string with a new C routine (ceprep) to account for leading d10 and C f10-f14 terms. C - Add error trapping code to check for overruns C and index=0 errors. C C----------------------------------------------------------------------- CHARACTER*18 CSTRGA(NDLEV), CSTRGPA(NDLEV) CHARACTER*2 TRMPRT(NDMET) INTEGER IA(NDLEV), ICNTE2, IE1A2(NDTRN) INTEGER IE2A2(NDTRN), IINAA(NDMET,NDCONF) INTEGER IIPNAA(NDMET,NDCONF), IL INTEGER ILA(NDLEV), ILINK(NDMET,NDMET,2) INTEGER ILPAR(NDMET), IMETR(NDMET) INTEGER INPAR(NDMET), IONLEV(NDMET,2) INTEGER IORB, IPA(NDLEV), IPL INTEGER IPLA(NDLEV), IPMETR(NDMET) INTEGER IPSA(NDLEV), ISA(NDLEV), ISPRT(NDMET) INTEGER ISPSYS(NDMET,2), ITSELA(NDMET) INTEGER ITYPEA(NDMET,NDCONF), IZ, IZ0 INTEGER IZ1, IZETA4(NDMET,2,NDORB) INTEGER LCF(NDMET,NDCONF), LDCF(NDMET,NDCONF) INTEGER N0A(NDMET,2), N1A(NDMET,NDCONF) INTEGER NCF(NDMET,NDCONF), NCONFG INTEGER NCTAA(NDMET,NDCONF), NCTAAC(NDMET,NDCONF) INTEGER NCUT(NDMET), NCUTT(NDMET,NDCONF) INTEGER NDCF(NDMET,NDCONF), NDCONF, NDLEV INTEGER NDMET, NDMIN(NDMET), NDORB INTEGER NDQDN, NDTHET, NDTRN, NMET INTEGER NORB, NPMET, NSYS(NDMET), NTHETA INTEGER NTRANS(NDMET), NZETA(NDMET,2) LOGICAL LEICHR(NDORB), LEISS LOGICAL LLINK(NDMET,NDMET,2), LTADJ REAL*8 ADIELO(NDMET,2,NDTHET), ALFDA(NDMET,NDTHET) REAL*8 ALFPART(NDMET,NDCONF,NDTHET) REAL*8 ALFRA(NDMET,2,NDTHET) REAL*8 ALFRA0(NDMET,2,NDTHET) REAL*8 ALFRAR(NDMET,2,NDTHET), AVAL2(NDTRN) REAL*8 BWNO, BWNOP, CI4 REAL*8 DE(NDMET), DE0(NDMET), E(NDMET) REAL*8 ECF(NDMET,NDCONF), ECTAA(NDMET,NDCONF) REAL*8 EDISGP, EIONA(NDMET,2,NDORB) REAL*8 ENPAR(NDMET), FCF(NDMET,NDCONF) REAL*8 FM(NDMET), FM0(NDMET) REAL*8 PARMD(NDMET,10,NDCONF), PARMR(NDMET,2,4) REAL*8 PCF(NDMET,NDCONF) REAL*8 QDORB((NDQDN*(NDQDN+1))/2) REAL*8 SAO(NDMET,2,NDTHET), SCALGP REAL*8 SPNFAC(NDMET,2), THETA(NDTHET) REAL*8 VORB(NDORB), W(NDMET), WA(NDLEV) REAL*8 WCF(NDMET,NDCONF), WPA(NDLEV) REAL*8 WVMAX(NDMET,NDCONF), WVMIN(NDMET,NDCONF) REAL*8 XITRUE(NDMET,2), XJA(NDLEV) REAL*8 XPJA(NDLEV)