************************************************************************ * MASTER MECHANISM - ROUTINE NAME bratio * * * * PURPOSE : gives the short name of the species (pchem) given as input * * and update the stack and dictionary arrays if necessary * * * * If the species is already known, the routine just returns its short * * name. If the species is new, then * * 1- a short name is allocated to the species (see naming) * * 2- the species is added to stack for future reactions (see loader)* * 3- the "dictionary" arrays are updated (dict, namlst). * * Species is added in such a way that the tables remain sorted * * * * INPUT: * * - pchem : formula of the species for which a short name * * must be given * * - brtio : used to give the yield of the species, but DOES * * NOT WORK ANYMORE - MORE WORK REQUIRED * * - level : number of levels (stable + radicals) that were * * necessary to produce the parent of "chem" * * - stabl : number of stable levels (no radical) that were * * necessary to produce the parent of "chem" * * - nfn : total nb. of species having a fixed name * * - namfn(i) : table of the fixed names (6 character) * * - chemfn(i) : formula corresponding to the ith species having a * * fixed name * * * * INPUT/OUTPUT * * - dict(j) : dictionary line (name + formula + functional * * group info) of species number j * * - namlst(j) : name (lco=6 characters) of the species already * * used at position number j * * - dbrch : NOT USED - MORE WORK ON THIS * * - nhldvoc : number of (stable) VOC in the stack * * - holdvoc(i) : list of the VOC in the stack * * - nhldrad : number of radicals in the stack * * - holdrad(i) : list of the radicals in the stack * * * * OUTPUT * * - pname : short name assigned to pchem * * - cgen : character string for generation # * ************************************************************************ SUBROUTINE bratio(pchem,brtio,pname, & dbrch,dict,namlst, & nhldvoc,holdvoc,nhldrad,holdrad,level,stabl, & nfn,namfn,chemfn) IMPLICIT NONE INCLUDE 'general.h' INCLUDE 'common.h' * common block to store information required to find isomers INCLUDE 'isomer.h' * input REAL,INTENT(in) :: brtio CHARACTER(LEN=lfo),INTENT(in) :: pchem INTEGER,INTENT(in) :: nfn CHARACTER(LEN=lco),INTENT(in) :: namfn(mfn) CHARACTER(LEN=lfo),INTENT(in) :: chemfn(mfn) * input/output CHARACTER(LEN=ldi),INTENT(inout) :: dict(mni) REAL,INTENT(inout) :: dbrch(mni) CHARACTER(LEN=lco),INTENT(inout) :: namlst(mni) INTEGER,INTENT(inout) :: level INTEGER,INTENT(inout) :: stabl CHARACTER(LEN=lst),INTENT(inout) :: holdvoc(mlv) INTEGER,INTENT(inout) :: nhldvoc CHARACTER(LEN=lst),INTENT(inout) :: holdrad(mra) INTEGER,INTENT(inout) :: nhldrad * output CHARACTER(LEN=lco),INTENT(out) :: pname * local INTEGER :: dicptr,namptr,srch,nca,nc,cnum,onum,chg,i,j,k,ipos !$ INTEGER omp_get_num_threads !$ INTEGER omp_get_thread_num CHARACTER(LEN=lfl) :: fgrp CHARACTER(LEN=3) :: cgen INTEGER :: tplev,tpsta, srh5 INTEGER :: tabinfo(mcri) ! INTEGER iflag IF (wtflag.NE.0) print*,'*bratio*' !print*,pchem * if iflag is equal to 0 then substitution by isomer are not allowed ! iflag=1 * ----------------------------- * INITIALIZE * ----------------------------- pname = ' ' nca = 0 nc = 0 nc = index(pchem,' ') - 1 * return if no species * (line 300 is the 'RETURN' statement outside the critical section) IF (nc.LT.1) GOTO 300 nca = cnum(pchem,nc)+onum(pchem,nc) tabinfo(:)=0 * ------------------------------------------ * FIND IF THE SPECIES IS ALREADY KNOWN * ------------------------------------------ * special name (inorganics, formulae that cannot be held, and C1) * ============================================================= * If the species has no carbon in the formula, check if known in the * list of inorganics or keywords. If the species found then just * return the short name. IF (pchem(1:5).eq.'EXTRA') THEN pname='EXTRA ' GOTO 300 ENDIF IF (pchem(1:2).eq.'HV') THEN pname='HV ' GOTO 300 ENDIF IF (pchem(1:4).eq.'(+M)') THEN pname='(+M) ' GOTO 300 ENDIF IF (pchem(1:6).eq.'OXYGEN') THEN pname='OXYGEN' GOTO 300 ENDIF IF (pchem(1:6).eq.'ISOM ') THEN pname='ISOM ' GOTO 300 ENDIF IF (pchem(1:6).eq.'MEPERO') THEN pname='MEPERO' GOTO 300 ENDIF IF (pchem(1:6).eq.'PERO1 ') THEN pname='PERO1 ' GOTO 300 ENDIF IF (pchem(1:6).eq.'PERO2 ') THEN pname='PERO2 ' GOTO 300 ENDIF IF (pchem(1:6).eq.'PERO3 ') THEN pname='PERO3 ' GOTO 300 ENDIF IF (pchem(1:6).eq.'PERO5 ') THEN pname='PERO5 ' GOTO 300 ENDIF IF (pchem(1:6).eq.'PERO6 ') THEN pname='PERO6 ' GOTO 300 ENDIF IF (pchem(1:6).eq.'PERO9 ') THEN pname='PERO9 ' GOTO 300 ENDIF IF (nca.eq.0) THEN DO i=1,ninorg IF (pchem.EQ.inorglst(i)(10:131)) THEN pname = inorglst(i)(1:lco) GOTO 300 ENDIF ENDDO ENDIF * Then check if the species has a formula that cannot be held by the * generator (for example furanone from hexdienedial photolysis). * Special formulae must start with a '#' and are recorded in C1. If the * species is already known in the dictionary, then just return the * short name (dicptr>0). If unknown, add to the stack at label 100. * If the species is not known in the generator, then stop. * (line 200 'CONTINUE' is just before the end of the critical section) !$OMP CRITICAL (DICT) !$ IF(wtflag.NE.0) print*,'OMP CRITICAL (DICT)',omp_get_thread_num() IF (pchem(1:1).eq.'#') THEN nca=1 ipos=0 dicptr = srch(nrec,pchem,dict) * if already recorded ... IF (dicptr.gt.0) THEN pname = dict(dicptr)(1:lco) dbrch(dicptr) = max(dbrch(dicptr),brtio) c dbrch(dicptr) = dbrch(dicptr)+brtio GOTO 200 ENDIF * If not recorded, then search in the special list and jump to 100 DO i=1,nspsp IF (pchem.eq.dictsp(i)(10:131)) THEN ipos=i pname=dictsp(i)(1:lco) namptr = srh5(pname,namlst,nrec) namptr=-namptr fgrp=dictsp(i)(132:) GOTO 100 ENDIF ENDDO IF (ipos.eq.0) THEN WRITE(6,*)'--error-- from bratio. The following species' WRITE(6,*)'cannot be managed. check formula :' WRITE(6,*) pchem(1:nc) WRITE(99,*) 'bratio',pchem STOP !GOTO 200 !STOP ENDIF ENDIF * If the species is a C1 species, then it must be already known (not * necessary to use the binary search since the list is very short) IF (nca.eq.1) THEN dicptr = srch(nrec,pchem,dict) IF (dicptr.gt.0) THEN pname = dict(dicptr)(1:lco) GOTO 200 ELSE WRITE(6,*)'--error-- from bratio. The following C1 species' WRITE(6,*)'not found in the dictionary :' WRITE(6,*) pchem(1:nc) WRITE(99,*) 'bratio',pchem STOP ! GOTO 200 !STOP ENDIF ENDIF * Now if that point is reached, then pchem must be a regular formula * and must therefore start with a "C". If not then error ! Ludo : This part had to be modified for the ethers. When there's a ! ring with an ether function, sometimes uniqring starts the chemical ! name with -O1-. This change doesn't seem to influence the other routines ! of the generator. IF ((pchem(1:1).NE.'C').AND.(pchem(1:2).NE.'-O') & .AND.(pchem(1:1).NE.'c')) THEN WRITE(6,*)'--error-- from bratio. The following species' WRITE(6,*)'cannot be managed (# or C1 expected).Check formula :' WRITE(6,*) pchem(1:nc) WRITE(99,*) 'bratio',pchem STOP ! GOTO 200 !STOP ENDIF * regular species * =================== * Search if pchem is already recorded. If yes (dicptr>0), then just * return the short name dicptr = srch(nrec,pchem,dict) IF (dicptr.gt.0) THEN pname = dict(dicptr)(1:lco) dbrch(dicptr) = max(dbrch(dicptr),brtio) c dbrch(dicptr) = dbrch(dicptr) + brtio GOTO 200 ENDIF * remove the species if brtio is below threshold yield (if not radical) c IF (brtio.lt.1E-4) THEN c IF (INDEX(pchem,'.').eq.0) THEN c pname='XXXXXX' c GOTO 200 c ENDIF c ENDIF * -------------------------------------- * THE SPECIES IS UNKNOWN * -------------------------------------- * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ * Call subroutine lump_sec to replace products by lumped species already * defined * If chg not equal to 0, then pchem formula has been substituted by a * lump species (which may have less carbon than the input species) c IF (stabl(1).LE.2) CALL lump_sec(pchem,copchem,rdtcopchem,chg) c CALL lump_sec(pchem,copchem,rdtcopchem,chg) c IF (chg.NE.0) THEN c nc = index(pchem,' ') - 1 c nca = cnum (pchem,nc)+onum(pchem,nc) c dicptr = srch(nca,nrec(nca),pchem,dict) c chg = 0 c IF (dicptr.LE.0) THEN c CALL naming(pchem,namlst,nrec,nfn,namfn,chemfn, c & namptr,pname,fgrp) c GOTO 100 c ELSE c dbrch(dicptr) = max(-1., dbrch(dicptr)-brtio) c pname = dict(nca,dicptr)(1:lco) c GOTO 200 c ENDIF c ENDIF * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ * search if an isomer is already known and replace formula * (put the section into comment if replacement not wanted) * If chg not equal 0, then pchem formula has been substituted by an * isomer IF (iflag.eq.0) GOTO 88 IF (nca.le.3) GOTO 88 IF (INDEX(pchem,'.').NE.0) GOTO 88 c WRITE(48,'(a40,16(i3))') ' ' c WRITE(48,'(a6,a40)') 'pchem=',pchem c WRITE(48,'(a10)') 'isomer in' CALL isomer(pchem,dict,nrec,stabl,brtio,dbrch,chg,tabinfo) c WRITE(48,'(a11)') 'isomer out' c WRITE(48,'(a40,16(i3))') pchem, (tabinfo(j),j=1,16) IF (chg.EQ.1) THEN dicptr = srch(nrec,pchem,dict) IF (dicptr.le.0) THEN STOP 'in bratio, no species found' ENDIF dbrch(dicptr) = max(dbrch(dicptr),brtio) c dbrch(dicptr) = dbrch(dicptr)+brtio pname = dict(dicptr)(1:lco) RETURN ENDIF 88 CONTINUE * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ * get the short name for the species (pname) and position after which * it must be added in the namlst table (namptr) CALL naming(pchem,namlst,nrec,nfn,namfn,chemfn, & namptr,pname,fgrp) * entry point to update stack and dictionary array (species may * come from the special dictionary '#') 100 CONTINUE ! if the flag to stop the chemistry is raised, then return without ! adding species to the stack IF (iflost.EQ.1) THEN ! pname='XC' RETURN ENDIF * raise the counters nrectot = nrectot + 1 IF (nrectot.GE.mni) THEN WRITE(*,*) '--error--, in bratio' WRITE(*,*) 'number of species in the dictionary' WRITE(*,*) 'exceed the size of the table (mni)' WRITE(99,*) 'bratio: nspc > mni' STOP ! GOTO 200 !STOP ENDIF nrec = nrec + 1 IF (nrec.GT.mni) THEN WRITE (6,*) 'Warning from bratio' WRITE (6,*) 'more species with ,',nca,' C' WRITE (6,*) 'than mnic' WRITE(99,*) 'bratio: nspc > mnic' STOP ! GOTO 200 !STOP ENDIF * add new name and raise the name array namptr = namptr + 1 namlst(namptr+1:nrec+1)=namlst(namptr:nrec) namlst(namptr) = pname ! define character string for generation number IF(INDEX(pchem,".").NE.0)THEN WRITE(cgen,"(i0.3)")stabl ELSE WRITE(cgen,"(i0.3)")stabl+1 ENDIF * raise upper part of dictionary arrays and branching array * insert new line for the new species dicptr = ABS(dicptr) + 1 dict(dicptr+1:nrec+1)=dict(dicptr:nrec) dbrch(dicptr+1:nrec+1)=dbrch(dicptr:nrec) WRITE(dict(dicptr),'(a6,3x,a120,2x,a15,a3)') & pname,pchem,fgrp,cgen dbrch(dicptr) = brtio * store information required to search for and isomer (info saved in tabinfo) IF (iflag.ne.0) THEN diccri(dicptr+1:nrec+1,:) = diccri(dicptr:nrec,:) diccri(dicptr,:)=tabinfo(:) ENDIF * load species information for future reactions in the stack tplev=level+1 IF (INDEX(pchem,'.').EQ.0) THEN tpsta=stabl+1 ELSE tpsta=stabl ENDIF CALL loader(dicptr,pchem,pname, & tplev,tpsta,nhldvoc,holdvoc,nhldrad,holdrad) 200 CONTINUE !$ IF(wtflag.NE.0) print*,'OMP END CRITICAL (DICT)', !$ & omp_get_thread_num() !$OMP END CRITICAL (DICT) 300 RETURN END