ADAS Subroutine d7link
C UNIX-IDL PORT - SCCS INFO: MODULE @(#)d7link.for 1.2 DATE 02/27/98
SUBROUTINE D7LINK( NDLEV , NDMET ,
& NMET , IMETR , NPMET , IPMETR ,
& CSTRGA , ISA , ILA , NALCM , IALCM ,
& ISALCM ,
& CSTRGPA , IPSA , IPLA , NALCP , IALCP ,
& ISALCP ,
& LLINK , ILINK , LEISS
& )
C---------------------------------------------------------------------
C ********
C ****************** FORTRAN 77 SUBROUTINE: D7LINK ****************************
C
C PURPOSE: RETURNS A TRUTH TABLE OF LINKS BETWEEN PARENTS AND
C RECOMBINED ION METASTABLES FOR RADIATIVE RECOMBINATION
C AND IONISATION. ALSO SUPPLIES THE DECIMAL ORBITAL NUMBER
C FOR THE POSITION OF THE SHELL OF THE RECOMBINED ELECTRON.
C
C CALLING PROGRAM: ADAS407
C
C SUBROUTINE:
C
C INPUT : (I*4) NDLEV = MAX. NUMBER OF LEVELS ALLOWED
C INPUT : (I*4) NDMET = MAX. NO. OF METASTABLES ALLOWED
C INPUT : (I*4) NMET = NUMBER OF METASTABLES (1<=NMET<=NDMET)
C INPUT : (I*4) IMETR() = INDEX OF METASTABLE IN COMPLETE LEVEL
C LIST (ARRAY SIZE = 'NDMET' )
C INPUT : (I*4) NPMET = NUMBER OF PARENT METASTABLES
C (1<=NPMET<=NDMET)
C INPUT : (I*4) IPMETR() = INDEX OF PARENT METASTABLES IN LEVEL
C LIST (ARRAY SIZE = 'NDMET' )
C INPUT : (C*18) CSTRGA() = CONFIGURATION (EISSNER FORM) FOR
C RECOMBINED ION LEVELS
C INPUT : (I*4) ILA() = QUANTUM NUMBER (L) FOR LEVELS
C (RECOMNBINED ION COPASE FILE)
C INPUT : (I*4) ISA() = MULTIPLICITY FOR LEVELS
C (RECOMBINED ION COPASE FILE)
C NOTE: (ISA-1)/2 = QUANTUM NUMBER (S)
C INPUT : (C*18) CSTRGPA()= CONFIGURATION (EISSNER FORM) FOR
C RECOMBINING ION LEVELS
C INPUT : (I*4) IPLA() = QUANTUM NUMBER (L) FOR LEVELS
C (RECOMBINING ION COPASE FILE)
C INPUT : (I*4) IPSA() = MULTIPLICITY FOR LEVEL 'IA2()'
C (RECOMBINING ION COPASE FILE)
C NOTE: (IPSA-1)/2 = QUANTUM NUMBER (S)
C
C OUTPUT : (I*4) NALCM = NUMBER OF SPIN DISTINGUISED
C METASTABLES
C OUTPUT : (I*4) IALCM() = INDEX OF ENERGY ORDERED SPIN
C DISTINQUISHED METASTABLE
C 1ST. DIM: METASTABLE INDEX
C OUTPUT : (I*4) ISALCM() = SPIN OF ENERGY ORDERED SPIN
C DISTINQUISHED METASTABLE
C 1ST. DIM: DISTINQUISHED METASTABLE INDEX
C OUTPUT : (I*4) NALCP NUMBER OF SPIN DISTINQUISHED
C PARENTS
C OUTPUT : (I*4) IALCP() = INDEX FOR ENERGY ORDERED SPIN
C DISTINQUISHED PARENT
C 1ST. DIM: PARENT INDEX
C OUTPUT : (I*4) ISALCP() = SPIN OF ENERGY ORDERED SPIN
C DISTINQUISHED PARENT
C 1ST. DIM: DISTINQUISHED PARENT INDEX
C OUTPUT : (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 OUTPUT : (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 OUTPUT : (L*4) LEISS = .TRUE. => ALL CONFIGS. EISSNER FORM
C .FALSE. => NOT ALL CONFIGS. EISSNER
C
C (I*4) NOCCUM() = OCCUPANCY FOR EACH DECIMAL ORBITAL
C INDEX 1-15 OF METASTABLE
C (I*4) NOCCUP() = OCCUPANCY FOR EACH DECIMAL ORBITAL
C INDEX 1-15 OF PARENT
C
C (I*4) I = GENERAL INDEX
C (I*4) J = GENERAL INDEX
C (I*4) IM = GENERAL INDEX
C (I*4) IPAR = GENERAL INDEX
C (I*4) IORBIT = CURRENT ORBITAL INDEX
C (L*4) LMATCH = GENERAL LOGICAL VARIABLE
C (L*4) LTYPE = .TRUE. => CONFIG. EISSNER FORM
C .FALSE. => CONFIG. NOT EISSNER FORM
C
C ROUTINES:
C ROUTINE SOURCE BRIEF DESCRIPTION
C ------------------------------------------------------------
C DXEXCF ADAS EXPAND EISSNER CONFIG. INTO SHELL OCCUP.
C DXCOMP ADAS COMPARE TWO OCCUPANCY VECTORS
C I4UNIT ADAS FETCH UNIT NUMBER FOR OUTPUT OF MESSAGES
C
C AUTHOR: H. P. SUMMERS, UNIVERSITY OF STRATHCLYDE
C JA8.08
C TEL. 0141-553-4196
C
C DATE: 05/06/96
C
C UPDATE: 24/07/96 - PEB - ADDED THIRD 'LTYPE' ARGUMENT TO 3RD AND 4TH
C CALLS TO ROUTINE DXEXCF. (IT HAD BEEN LEFT
C OFF.)
C
C UNIX-IDL PORT:
C WILLIAM OSBORN, TESSELLA SUPPORT SERVICES PLC.
C
C DATE: 20TH AUGUST 1996
C
C VERSION: 1.1 DATE: 20-08-96
C MODIFIED: WILLIAM OSBORN
C - FIRST VERSION
C
C VERSION: 1.2 DATE: 14-08-97
C MODIFIED: HUGH SUMMERS
C - ADDED SPIN DISTINQUISHED PARENT AND METASTABLE
C IDENTIFICATION, COUNTERS AND POINTERS
C
C VERSION: 1.3 DATE: 22-11-2003
C MODIFIED: Martin O'Mullane
C - Pass configurations through ceprep before acting on them.
C - Extend dimensions of orbital arrays.
C
C-------------------------------------------------------------------------------
CHARACTER*18 CSTRGA(NDLEV), CSTRGPA(NDLEV)
INTEGER IALCM(NDMET), IALCP(NDMET)
INTEGER ILA(NDLEV), ILINK(NDMET,NDMET,2)
INTEGER IMETR(NDMET), IPLA(NDLEV)
INTEGER IPMETR(NDMET), IPSA(NDLEV)
INTEGER ISA(NDLEV), ISALCM(NDMET)
INTEGER ISALCP(NDMET), NALCM, NALCP
INTEGER NDLEV, NDMET, NMET, NPMET
LOGICAL LEISS, LLINK(NDMET,NDMET,2)