[1] | 1 | C CROSS SECTIONS DATA BASE MANAGEMENT PROGRAM |
---|
| 2 | C ** VERSION 2.5 for INTERNET ** |
---|
| 3 | C ** 8 June 1998 ** |
---|
| 4 | C |
---|
| 5 | CHARACTER*180 LINE, Path, Path1 |
---|
| 6 | CHARACTER*255 FMol, Lines(10),LinesCom |
---|
| 7 | Character*27 Str ! 27 for UNIX |
---|
| 8 | CHARACTER*40 B_Name |
---|
| 9 | CHARACTER*30 Idx_Name, Extr_Name,Extr_Idx |
---|
| 10 | CHARACTER*3 CHN,StCode |
---|
| 11 | CHARACTER*10 S10 |
---|
| 12 | INTEGER(2) NmbMol, LeNumerodeMol, MaxMol, NtpCode, ilen,MaxLine |
---|
| 13 | Integer*4 NmIdx,NmLines,NmNewLines,NuLn,Ndc,ExtLn |
---|
| 14 | REAL*4 LowerWn, UpperWn, FromWv, ToWv,Step, Lepremier,Nu1,Nu2 |
---|
| 15 | INTEGER(2) NLines1 |
---|
| 16 | data NLines1 /0/ |
---|
| 17 | TYPE MOLECULES |
---|
| 18 | SEQUENCE |
---|
| 19 | CHARACTER*10 NAME |
---|
| 20 | INTEGER(2) MCODE ! The code of molecule |
---|
| 21 | INTEGER(2) NTP ! Number of data sets |
---|
| 22 | INTEGER(2) N1(4) ! From |
---|
| 23 | INTEGER(2) N2(4) ! TO |
---|
| 24 | END TYPE MOLECULES |
---|
| 25 | Type CONDITIONS |
---|
| 26 | SEQUENCE |
---|
| 27 | REAL*4 Temperature |
---|
| 28 | REAL*4 Pressure |
---|
| 29 | REAL*4 Resolution |
---|
| 30 | END TYPE CONDITIONS |
---|
| 31 | TYPE (MOLECULES) ListofMol(30) |
---|
| 32 | TYPE (CONDITIONS) AllCondit(200) |
---|
| 33 | INTEGER*4 I,J,K, N1(4),N2(4),RR |
---|
| 34 | Integer(2) WhatMol(30), WhatTemp(10),Code,jjj, T_P(250,50) |
---|
| 35 | Integer(2) Mol_Nm(30),NumSel,LeNumero,NmbofMol,NTP(30) |
---|
| 36 | Integer(2) MCode1 |
---|
| 37 | CHARACTER*10 Name, WAIT |
---|
| 38 | Character*10 MolecName |
---|
| 39 | Integer*4 Idx(2500),Idx1(2500) |
---|
| 40 | CHARACTER*3 OPT |
---|
| 41 | CHARACTER*11 MOL(30) !!!! |
---|
| 42 | COMMON /REG1/ RR,MaxLine,NmLines,NmIdx,jjj, Code, WhatTemp |
---|
| 43 | COMMON /REG2/ Idx |
---|
| 44 | COMMON /REG3/ B_Name,Path |
---|
| 45 | COMMON /REG4/ LowerWn,UpperWn,Step |
---|
| 46 | Common /REG5/ NuLn,Ndc,ExtLn |
---|
| 47 | Common /Reg6/ Idx1 |
---|
| 48 | Common /Reg7/ Lepremier,NumSel,NmbofMol |
---|
| 49 | Common /Reg8/ WhatMol,T_P,Mol_Nm |
---|
| 50 | Common /Reg9/ ListofMol |
---|
| 51 | C Common /Reg10/ LowerWn, UpperWn |
---|
| 52 | Common /Reg11/ AllCondit |
---|
| 53 | Common /Reg12/ Path1 |
---|
| 54 | Common /Reg13/ Mol |
---|
| 55 | C ************************************************************ |
---|
| 56 | C MAIN PROGRAM |
---|
| 57 | C ******** **************************************************** |
---|
| 58 | C recl mini=200*16(TPCHAR)+10(NAME)+5(MCODE) pour Subroutine MolCodes |
---|
| 59 | open(unit=6,file='/dev/stdout',recl=3215) |
---|
| 60 | RR=27 ! 27 for the UNIX version! |
---|
| 61 | MaxLine=1150 ! Max number of records contained in a block to be extracted |
---|
| 62 | Step=2.0 ! Step for indexation |
---|
| 63 | C SCommand='clear' ! clear for UNIX |
---|
| 64 | NuLn=0 |
---|
| 65 | Ndc=3 |
---|
| 66 | c CALL System(SCommand) |
---|
| 67 | c Call LaPremiere |
---|
| 68 | c Call System(SCommand) |
---|
| 69 | Path='' |
---|
| 70 | Path1='/usr/local/datageisa/crs97/' |
---|
| 71 | ilen=Index(Path,' ')-1 |
---|
| 72 | ilen1=Index(Path1,' ')-1 |
---|
| 73 | FMol= Path1(1:ilen1)//'molec.dat' |
---|
| 74 | OPEN(10,FILE=FMol,STATUS='OLD', ERR=8888,iostat=iosml) |
---|
| 75 | OPEN(11,FILE=Path1(1:ilen1)//'numbers.dat', |
---|
| 76 | $FORM='FORMATTED',STATUS='OLD',ERR=8888,iostat=iosnm) |
---|
| 77 | C *** Name of the data file and its index file *** |
---|
| 78 | |
---|
| 79 | B_Name='/usr/local/datageisa/data/cross_97.asc' |
---|
| 80 | Idx_Name='cross97.idx' |
---|
| 81 | DO 1666 I20=1,250 |
---|
| 82 | DO 1666 J20=1,50 |
---|
| 83 | 1666 T_P(I20,J20)=0 |
---|
| 84 | DO 1667 I20=1,30 |
---|
| 85 | C NTP(I20)=0 |
---|
| 86 | 1667 Mol(I20)='***' |
---|
| 87 | C READ OF THE PROGRAM PARAMETERS |
---|
| 88 | NmbofMol=1 |
---|
| 89 | 1 READ(10,'(A10,I3,1X,I2,8I3)', IOSTAT=ios,END=2) |
---|
| 90 | $Name, Code,I,N1(1),N2(1),N1(2),N2(2),N1(3),N2(3), |
---|
| 91 | $N1(4),N2(4) |
---|
| 92 | ListofMol(NmbofMol)%Name=Name |
---|
| 93 | ListofMol(NmbofMol)%MCode=Code |
---|
| 94 | ListofMol(NmbofMol)%NTP=I |
---|
| 95 | Mol_Nm(NmbofMol)=Code |
---|
| 96 | DO 40 J=1,I |
---|
| 97 | ListofMol(NmbofMol)%N1(j)=N1(j) |
---|
| 98 | 40 ListofMol(NmbofMol)%N2(j)=N2(j) |
---|
| 99 | NmbofMol=NmbofMol+1 |
---|
| 100 | GO TO 1 |
---|
| 101 | C NmbofMol=NmbofMol-1 ! Attention !!! |
---|
| 102 | |
---|
| 103 | 2 Close(10) |
---|
| 104 | I=1 |
---|
| 105 | 3 READ(11,'(I3,2X,F5.1,F12.2,8X,F6.4)',END=7) J, |
---|
| 106 | $AllCondit(I)%Temperature, AllCondit(I)%Pressure, |
---|
| 107 | $AllCondit(I)%Resolution |
---|
| 108 | i=i+1 |
---|
| 109 | GO TO 3 |
---|
| 110 | c 5 CLOSE(11) |
---|
| 111 | C **** READ OF THE INPUT PARAMETERS ************* |
---|
| 112 | C NLines1=1 |
---|
| 113 | 7 READ (*,'(A255)',end=334) LinesCom !1st line |
---|
| 114 | if (Nlines1.EQ.0) Nlines1=1 |
---|
| 115 | Lines(NLines1)=LinesCom |
---|
| 116 | ill=INDEX(LinesCom,' ')-1 |
---|
| 117 | DO 333 i34=1,ill |
---|
| 118 | 333 if (LinesCom(i34:i34).EQ.'/') go to 334 |
---|
| 119 | C Print *, Nlines1,'&',Lines(NLines1) |
---|
| 120 | NLines1=NLines1+1 |
---|
| 121 | if (NLINES.GT.10) then |
---|
| 122 | Write(0,*) 'Too many input lines (it has to be <=10)' |
---|
| 123 | Call Exit(1) |
---|
| 124 | end if |
---|
| 125 | go to 7 |
---|
| 126 | C ______________________________________________________ |
---|
| 127 | 334 Call LireParam(Lines,NLines1,OPT,Nu1,Nu2) |
---|
| 128 | C Print *,'!! ',Mol(1),'&',Mol(2),'&',Mol(3) |
---|
| 129 | C Print *, '*************** GEISA CROSS-97 ***************' |
---|
| 130 | C Print *, ' ' |
---|
| 131 | C Print *,' The input parameters ' |
---|
| 132 | C Print *, ' ' |
---|
| 133 | C Print *, 'OPT=',opt |
---|
| 134 | C if (OPT.NE.'cal') go to 335 |
---|
| 135 | c |
---|
| 136 | C Print *, 'Selected molecules and (T,P) codes: ' |
---|
| 137 | C DO 188 I20=1, NmbofMol-1 !without 'all' |
---|
| 138 | c if (Mol(i20).NE.'***') then |
---|
| 139 | c Call CodeMol(Mol(I20),MCode1) |
---|
| 140 | c else |
---|
| 141 | c go to 335 |
---|
| 142 | c end if |
---|
| 143 | c |
---|
| 144 | c DO 1888 J20=1,NmbofMol |
---|
| 145 | cc |
---|
| 146 | c if (MCode1.EQ.Mol_Nm(J20)) then |
---|
| 147 | c LN=0 |
---|
| 148 | c DO 999 k20=1,50 |
---|
| 149 | c 999 if (T_P(J20,K20).NE.0) LN=LN+1 |
---|
| 150 | c if (LN.EQ.0) LN=1 |
---|
| 151 | c Print *,Mol(i20),': ',(T_P(J20,KK),KK=1,LN) |
---|
| 152 | c go to 188c |
---|
| 153 | c end if |
---|
| 154 | c 1888 Continue |
---|
| 155 | c 188 Continue |
---|
| 156 | c 335 Print *,'**********************************************' |
---|
| 157 | if (OPT.EQ.'lst') go to 602 |
---|
| 158 | if (OPT.EQ.'mco') then |
---|
| 159 | Call MCodes |
---|
| 160 | Call Exit(0) |
---|
| 161 | end if |
---|
| 162 | if (OPT.EQ.'ltp') then |
---|
| 163 | Call List_TP |
---|
| 164 | Call Exit(0) |
---|
| 165 | end if |
---|
| 166 | |
---|
| 167 | NumSel=0 |
---|
| 168 | FromWv=Nu1 |
---|
| 169 | ToWv=Nu2 |
---|
| 170 | Nglob=0 |
---|
| 171 | if (Mol(1).EQ.'all') then |
---|
| 172 | Code=0 ! Select all the data available |
---|
| 173 | jjj=1 |
---|
| 174 | WhatTemp(1)=0 |
---|
| 175 | go to 602 |
---|
| 176 | end if |
---|
| 177 | 338 NumSel=NumSel+1 |
---|
| 178 | if (Mol(NumSel).EQ.'***') then |
---|
| 179 | NumSel=NumSel-1 |
---|
| 180 | go to 602 |
---|
| 181 | end if |
---|
| 182 | Call CodeMol(Mol(NumSel),Code) |
---|
| 183 | WhatMol(NumSel)=Code |
---|
| 184 | go to 338 |
---|
| 185 | 602 ilen=INDEX(Path,' ')-1 |
---|
| 186 | OPEN(60,File=Path(1:ilen)//B_Name, |
---|
| 187 | $ Status='OLD',Form='UNFORMATTED',Access='DIRECT',Recl=RR, |
---|
| 188 | $ Err=8888, iostat=iosban) |
---|
| 189 | OPEN(66,File=Path1(1:ilen1)//Idx_Name,Status='Old', |
---|
| 190 | $ Err=8888, iostat=iosidx) |
---|
| 191 | Read(66,'(I10)') NmIdx ! Number of index file components |
---|
| 192 | Read(66,'(I10)') NmLines ! Number of the data bank entries |
---|
| 193 | DO 499 i=1,NmIdx-2 |
---|
| 194 | Read(66,'(I10)') Idx(i) |
---|
| 195 | c Print *,'Idx(',i,')=',Idx(i) |
---|
| 196 | 499 Continue |
---|
| 197 | Close(66) |
---|
| 198 | Read(60,Rec=1) Str |
---|
| 199 | S10=Str(1:10) |
---|
| 200 | Read(S10,'(F10.6)') LowerWn |
---|
| 201 | Read(60,Rec=NmLines) Str |
---|
| 202 | S10=Str(1:10) |
---|
| 203 | Read(S10,'(F10.6)') UpperWn |
---|
| 204 | Close(60) |
---|
| 205 | if (OPT.EQ.'lst') then |
---|
| 206 | Call MolCodes |
---|
| 207 | Call Exit(0) |
---|
| 208 | end if |
---|
| 209 | Extr_Name='ex_bnc' |
---|
| 210 | Call Extraction(FromWv,ToWv,Extr_Name) |
---|
| 211 | C Call System('cat '//Extr_Name) |
---|
| 212 | |
---|
| 213 | 9999 Call Exit(0) |
---|
| 214 | 8888 if (iosml.EQ.6) Write(0,*) 'File molec.dat not found!' |
---|
| 215 | if (iosnm.EQ.6) Write(0,*) 'File numbers.dat not found!' |
---|
| 216 | if (iosban.EQ.6) Write(0,*) 'CRS data bank not found!' |
---|
| 217 | if (iosidx.EQ.6) Write(0,*) 'Index file cross97.idx not found!' |
---|
| 218 | Write(0,*) 'The program is stoped' |
---|
| 219 | Call Exit(1) |
---|
| 220 | END |
---|
| 221 | c ** Subroutines ** |
---|
| 222 | c |
---|
| 223 | SUBROUTINE Extraction(From,to1,Out) |
---|
| 224 | Real*4 From,to1,LePremier |
---|
| 225 | Real*4 Freq,LowerWn,UpperWn,Step |
---|
| 226 | Integer(2) MaxLine,jjj,code,MCode,TPCode,WhatTemp(10),WhatMol(30) |
---|
| 227 | Integer(2) Mol_Nm(30),NumSel,LeNumero,NmbofMol,T_P(250,50) |
---|
| 228 | Integer*4 NmIdx,NmLines, BlockLen,ExtLn,NRec,RR,Idx(2500) |
---|
| 229 | Integer*4 NFact,Ninit,Irec,InitRec,NuLn,Ndc, MolLn(250) |
---|
| 230 | Character*40 B_Name |
---|
| 231 | Character*30 Out,Idx_File |
---|
| 232 | Character*3 S3 |
---|
| 233 | Character*10 S10 |
---|
| 234 | Character*11 Mol(30) !!!! |
---|
| 235 | CHARACTER*180 Path,out1 |
---|
| 236 | Integer(2) OutUnit |
---|
| 237 | Character*27 Lines(1150),ExtLines(1150),Str,Line ! 27 for UNIX |
---|
| 238 | COMMON /REG1/ RR,MaxLine,NmLines,NmIdx,jjj, Code, WhatTemp |
---|
| 239 | COMMON /REG2/ Idx |
---|
| 240 | Common /REG3/ B_Name,Path |
---|
| 241 | Common /REG4/ LowerWn,UpperWn,Step |
---|
| 242 | Common /Reg5/ Nuln,Ndc,ExtLn |
---|
| 243 | Common /REG7/ LePremier, NumSel,NmbofMol |
---|
| 244 | Common /Reg8/ WhatMol, T_P ,Mol_Nm |
---|
| 245 | Common /REG13/MOL |
---|
| 246 | c n100=Int((From-LowerWn)/Step)+1 |
---|
| 247 | OutUnit=70 ! Set up output unit |
---|
| 248 | ilen=INDEX(Out,'.') |
---|
| 249 | if (ilen.NE.0) Idx_File=Out(1:ilen)//'idx' |
---|
| 250 | if (ilen.EQ.0) then |
---|
| 251 | ilen=INDEX(Out,' ')-1 |
---|
| 252 | Idx_File=Out(1:ilen)//'.idx' |
---|
| 253 | end if |
---|
| 254 | n100=(Int(From)-Int(LowerWn))/Int(step)+1 |
---|
| 255 | n200=(Int(to1)-Int(LowerWn))/Int(step)+2 |
---|
| 256 | if (N100.GT.NmIdx-2) N100=NmIdx-2 |
---|
| 257 | if (N100.LT.1) N100=1 |
---|
| 258 | if (N200.GT.NmIdx-2) N200=NmIdx-2 |
---|
| 259 | if (N200.LT.1) N200=1 |
---|
| 260 | NInit=Idx(n100) |
---|
| 261 | DO 3131 I=1,250 |
---|
| 262 | 3131 MolLn(i)=0 |
---|
| 263 | C NFact=NmLines-NInit+1 ! old !! |
---|
| 264 | NFact=Idx(n200)-NInit+1 |
---|
| 265 | if (NFact.LE.MaxLine) BlockLen=NFact |
---|
| 266 | if (NFact.GT.MaxLine) BlockLen=MaxLine |
---|
| 267 | ilen=INDEX(Path,' ')-1 |
---|
| 268 | OPEN(60,File=Path(1:ilen)//B_Name, |
---|
| 269 | $ Status='OLD',Form='UNFORMATTED',Access='DIRECT',Recl=BlockLen*rr, |
---|
| 270 | $Err=888) |
---|
| 271 | OPEN(Unit=OutUnit,Form='UNFORMATTED',ACCESS='DIRECT', |
---|
| 272 | $Status='SCRATCH',Recl=MaxLine*rr) |
---|
| 273 | |
---|
| 274 | N=NFact/BlockLen |
---|
| 275 | NN=MOD(NFact,BlockLen) |
---|
| 276 | ExtLn=0 |
---|
| 277 | IFact=0 |
---|
| 278 | Irec=1 |
---|
| 279 | InitRec =NInit/BlockLen+1 |
---|
| 280 | c Print *, 'Scaning the data base from the entry N ', Ninit |
---|
| 281 | c *** Block-by-block reading the data file *** |
---|
| 282 | c |
---|
| 283 | DO 1150 i=1,N |
---|
| 284 | Read(60,Rec=InitRec) Lines |
---|
| 285 | InitRec=InitRec+1 |
---|
| 286 | DO 101 j=1,BlockLen |
---|
| 287 | S10=Lines(j)(1:10) |
---|
| 288 | Read(S10,'(F10.6)')Freq |
---|
| 289 | if (Freq.GT.to1) go to 1250 |
---|
| 290 | if (Freq.LT.From) go to 101 |
---|
| 291 | if (Code.EQ.0) go to 105 |
---|
| 292 | S3=Lines(j)(21:23) |
---|
| 293 | Read(S3,'(I3)') MCode |
---|
| 294 | DO 277 I20=1,NumSel |
---|
| 295 | if (MCode.EQ.WhatMol(i20)) go to 191 ! was: 115 |
---|
| 296 | 277 CONTINUE |
---|
| 297 | go to 101 |
---|
| 298 | C 115 DO 188 I20=1, NmbofMol |
---|
| 299 | c if (MCode.EQ.Mol_Nm(I20)) then |
---|
| 300 | c LeNumero=I20 |
---|
| 301 | c go to 191 |
---|
| 302 | c end if |
---|
| 303 | c 188 Continue |
---|
| 304 | 191 if (T_P(MCode,1).EQ.0) go to 105 |
---|
| 305 | |
---|
| 306 | S3=Lines(j)(24:26) |
---|
| 307 | Read(S3,'(I3)') TPCode |
---|
| 308 | |
---|
| 309 | C if (MCode.NE.Code) go to 109 |
---|
| 310 | C |
---|
| 311 | C 111 if (Freq.GT.to1) go to 1250 |
---|
| 312 | C if (Freq.LT.From) go to 101 |
---|
| 313 | DO 103 jj=1,50 |
---|
| 314 | if (T_P(MCode,jj).EQ.0) go to 101 |
---|
| 315 | 103 if (T_P(MCode,jj).EQ.TPCode) go to 105 |
---|
| 316 | 114 go to 101 |
---|
| 317 | 105 ExtLn=ExtLn+1 |
---|
| 318 | MolLn(Mcode)=MolLn(MCode)+1 |
---|
| 319 | IFact=IFact+1 |
---|
| 320 | ExtLines(IFact)=Lines(j) |
---|
| 321 | if (ExtLn.EQ.1) LePremier=Freq |
---|
| 322 | C Call Index1(Idx_File,1,Freq,Step) |
---|
| 323 | C if (Mod(ExtLn,200).EQ.0) Print *, ExtLn, ' lines rewritten' |
---|
| 324 | if (IFACT.GE.BlockLen) then |
---|
| 325 | Write(OutUnit,Rec=IRec) ExtLines |
---|
| 326 | IRec=Irec+1 |
---|
| 327 | IFact=0 |
---|
| 328 | End if |
---|
| 329 | |
---|
| 330 | C 109 if (Freq.GT.to1) go to 1250 |
---|
| 331 | 101 Continue |
---|
| 332 | 1150 Continue |
---|
| 333 | 1250 Continue |
---|
| 334 | INQUIRE(unit=OutUnit,name=out1) |
---|
| 335 | Call System('cat '//out1) |
---|
| 336 | Close(OutUnit) |
---|
| 337 | |
---|
| 338 | C Open(Unit=OutUnit,File=Out,Status='Old',Form='UNFORMATTED', |
---|
| 339 | C $ACCESS='DIRECT',Recl=rr) |
---|
| 340 | IREC=(IREC-1)*BlockLen+1 |
---|
| 341 | if (N.NE.0) then |
---|
| 342 | DO 1212 i=1,IFact |
---|
| 343 | C Write(OutUnit,Rec=Irec) ExtLines(i) |
---|
| 344 | Write(1,'(A26)') ExtLines(i)(1:26) !(1:27) for PC |
---|
| 345 | 1212 Irec=Irec+1 |
---|
| 346 | end if |
---|
| 347 | Close(60) |
---|
| 348 | C if (Freq.GT.to1) go to 1213 !!! suprimer le 29 mai 1998 |
---|
| 349 | |
---|
| 350 | cc ** Line-by-line reading the data bank file ** |
---|
| 351 | |
---|
| 352 | OPEN(60,File=Path(1:ilen)//B_Name, |
---|
| 353 | $ Status='OLD',Form='UNFORMATTED',Access='DIRECT',Recl=rr, |
---|
| 354 | $Err=888) |
---|
| 355 | InitRec=(InitRec-1)*BlockLen+1 |
---|
| 356 | DO 777 i=1,nn |
---|
| 357 | READ(60,Rec=InitRec) Line |
---|
| 358 | cc ------------------------------------------------------------------ |
---|
| 359 | InitRec=InitRec+1 |
---|
| 360 | S3=Line(21:23) |
---|
| 361 | Read(S3,'(I3)') MCode |
---|
| 362 | S3=Line(24:26) |
---|
| 363 | Read(S3,'(I3)') TPCode |
---|
| 364 | S10=Line(1:10) |
---|
| 365 | Read(S10,'(F10.6)') Freq |
---|
| 366 | if (Code.EQ.0) go to 177 |
---|
| 367 | C if (MCode.NE.Code) go to 777 |
---|
| 368 | DO 377 I20=1,NumSel |
---|
| 369 | if (MCode.EQ.WhatMol(i20)) go to 177 |
---|
| 370 | 377 CONTINUE |
---|
| 371 | Go to 777 |
---|
| 372 | |
---|
| 373 | |
---|
| 374 | 177 if (Freq.GT.to1) go to 1213 |
---|
| 375 | if (Freq.LT.From) go to 777 |
---|
| 376 | |
---|
| 377 | c DO 1888 I20=1, NmbofMol |
---|
| 378 | c if (MCode.EQ.Mol_Nm(I20)) then |
---|
| 379 | c LeNumero=I20 |
---|
| 380 | c go to 991 |
---|
| 381 | c end if |
---|
| 382 | c1888 Continue |
---|
| 383 | |
---|
| 384 | 991 if (T_P(MCode,1).EQ.0) go to 106 |
---|
| 385 | DO 104 jj=1,50 |
---|
| 386 | if (T_P(MCode,jj).EQ.0) go to 666 |
---|
| 387 | 104 if (T_P(MCode,jj).EQ.TPCode) go to 106 |
---|
| 388 | 666 go to 777 |
---|
| 389 | 106 ExtLn=ExtLn+1 |
---|
| 390 | If (ExtLn.EQ.1) then LePremier=Freq |
---|
| 391 | MolLn(MCode)=MolLn(MCode)+1 |
---|
| 392 | C Call INDEX1(Idx_File,1,Freq,Step) |
---|
| 393 | C if (Mod(ExtLn,200).EQ.0) Print *, ExtLn, ' lines rewritten' |
---|
| 394 | C Write(OutUnit,Rec=IRec) Line |
---|
| 395 | Write(6,'(A26)') Line(1:26) ! 26 for Unix, 27 -for PC |
---|
| 396 | IREC=IREC+1 |
---|
| 397 | 777 Continue |
---|
| 398 | cc -------------------------------------------------------------------- |
---|
| 399 | |
---|
| 400 | C1213 Close(OutUnit) |
---|
| 401 | 1213 Print *, 'Selected molecules: ' |
---|
| 402 | DO 1188 I20=1, NmbofMol-1 !without 'all' |
---|
| 403 | if (Mol(1).EQ.'all') then |
---|
| 404 | Print *, 'All molecules have been selected' |
---|
| 405 | go to 1189 |
---|
| 406 | end if |
---|
| 407 | if (Mol(i20).NE.'***') then |
---|
| 408 | Call CodeMol(Mol(i20),mcode) |
---|
| 409 | C Print *,Mol(i20),' ', MolLn(mcode),' lines rewritten' |
---|
| 410 | write(*,'(A10,1X,I8,A17)') |
---|
| 411 | $ Mol(i20),MolLn(mcode),' lines rewritten' |
---|
| 412 | end if |
---|
| 413 | 1188 Continue |
---|
| 414 | 1189 Write(*,7890) 'Spectral range: ', from,' - ',to1 |
---|
| 415 | Print *, 'Total: ',ExtLn, ' lines rewritten' |
---|
| 416 | C if (ExtLn.NE.0) Call Index1(Idx_File,0,0.0,Step) |
---|
| 417 | RETURN |
---|
| 418 | 888 Write(0,*) 'File opening error : ',B_Name |
---|
| 419 | 7890 FORMAT(A16,F10.3,A3,F10.3) |
---|
| 420 | Call Exit(1) |
---|
| 421 | END |
---|
| 422 | |
---|
| 423 | SUBROUTINE INDEX1(Nm_Idx,Last,Freq,Step) |
---|
| 424 | Real*4 Freq,CurrF,Step,LePremier |
---|
| 425 | Integer*4 Idx1(2500),NuLn,Ndc,ExtLn |
---|
| 426 | Character*30 Nm_Idx |
---|
| 427 | Common /Reg5/ Nuln,Ndc,ExtLn |
---|
| 428 | Common /Reg6/Idx1 |
---|
| 429 | Common /Reg7/ CurrF |
---|
| 430 | If (Last.EQ.0) then |
---|
| 431 | Idx1(1)=Ndc ! Total length of *.idx file |
---|
| 432 | Idx1(2)=ExtLn ! Number of entries in the data bank |
---|
| 433 | Idx1(3)=1 ! |
---|
| 434 | OPEN(33,File=Nm_Idx,Status='UNKNOWN') |
---|
| 435 | DO 30 i=1,Ndc |
---|
| 436 | Write(33,'(I10)') Idx1(i) |
---|
| 437 | 30 CONTINUE |
---|
| 438 | Close(33) |
---|
| 439 | Return |
---|
| 440 | end if |
---|
| 441 | MaxIdx=2500 |
---|
| 442 | NuLn=Nuln+1 |
---|
| 443 | if (Int(Freq).GE.Int(CurrF+Step)) then |
---|
| 444 | n1=(Int(Freq)-Int(CurrF))/Int(Step) |
---|
| 445 | do 22 i=0,nl |
---|
| 446 | ndc=ndc+1 |
---|
| 447 | if (ndc.gt.MaxIdx) then |
---|
| 448 | Write(0,*) 'Can not index this file!' |
---|
| 449 | Call Exit(1) |
---|
| 450 | end if |
---|
| 451 | NuLn1=NuLn |
---|
| 452 | if (NuLn1.LT.1) NuLn1=Nuln |
---|
| 453 | Idx1(Ndc)=NuLn1 |
---|
| 454 | 22 CurrF=CurrF+Step |
---|
| 455 | end if |
---|
| 456 | Return |
---|
| 457 | End |
---|
| 458 | |
---|
| 459 | SUBROUTINE CodeMol(Nm,C) |
---|
| 460 | TYPE MOLECULES |
---|
| 461 | SEQUENCE |
---|
| 462 | CHARACTER*10 NAME |
---|
| 463 | INTEGER(2) MCODE ! The code of molecule |
---|
| 464 | INTEGER(2) NTP ! Number of data sets |
---|
| 465 | INTEGER(2) N1(4) ! From |
---|
| 466 | INTEGER(2) N2(4) ! TO |
---|
| 467 | END TYPE MOLECULES |
---|
| 468 | CHARACTER*11 Nm, Nlm !!!! |
---|
| 469 | Integer(2) C, NmbofMol,NumSel |
---|
| 470 | Type (Molecules) ListofMol(30) |
---|
| 471 | Real*4 LePremier |
---|
| 472 | Common /REG9/ ListofMol |
---|
| 473 | Common /Reg7/ Lepremier,NumSel,NmbofMol |
---|
| 474 | ilen=INDEX(Nm,' ')-1 |
---|
| 475 | Nm=Nm(1:ilen) |
---|
| 476 | |
---|
| 477 | DO 16 I=1,NmbofMol |
---|
| 478 | Nlm=ListofMol(i)%Name |
---|
| 479 | ilen=INDEX(Nlm,' ')-1 |
---|
| 480 | Nlm=Nlm(1:ilen) |
---|
| 481 | C Print *, Nlm,'*',Nm,'*' |
---|
| 482 | if (Nlm.EQ.Nm) then |
---|
| 483 | C=ListofMol(I)%MCODE |
---|
| 484 | Return |
---|
| 485 | end if |
---|
| 486 | 16 CONTINUE |
---|
| 487 | Write(0,*) Nm, ' is unknown molecule!' |
---|
| 488 | Call Exit(1) |
---|
| 489 | END |
---|
| 490 | |
---|
| 491 | |
---|
| 492 | SUBROUTINE LireParam(Lines,N,OPT,Nu1,Nu2) |
---|
| 493 | TYPE MOLECULES |
---|
| 494 | SEQUENCE |
---|
| 495 | CHARACTER*10 NAME |
---|
| 496 | INTEGER(2) MCODE ! The code of molecule |
---|
| 497 | INTEGER(2) NTP ! Number of data sets |
---|
| 498 | INTEGER(2) N1(4) ! From |
---|
| 499 | INTEGER(2) N2(4) ! TO |
---|
| 500 | END TYPE MOLECULES |
---|
| 501 | Type (Molecules) ListofMol(30) |
---|
| 502 | Character*255 Lines(5),BufLine |
---|
| 503 | Integer(2) N,I,Ilen(5),Len,TP(50) |
---|
| 504 | Character*3 OPT |
---|
| 505 | Character*10 Nmol |
---|
| 506 | Character*11 Mol(30) !!!! |
---|
| 507 | Character*20 CharTmp |
---|
| 508 | Real*4 Nu1,Nu2,Lepremier |
---|
| 509 | Integer(2) T_P(250,50), Popt,Pmol(5,30),Ptp(5,50) |
---|
| 510 | Integer(2) Lnu1,Lnu2,Pmol1,Pnu1,Pnu2,Code,All_TP(250,50) |
---|
| 511 | Integer(2) WhatMol(30),Mol_Nm(30),NumSel,NmbofMol |
---|
| 512 | Common /Reg7/ Lepremier,NumSel,NmbofMol |
---|
| 513 | Common /Reg8/ WhatMol,T_P,Mol_Nm |
---|
| 514 | Common /Reg9/ ListofMol |
---|
| 515 | Common /Reg13/Mol |
---|
| 516 | C -------------------------------------------- |
---|
| 517 | C ---------- Insere le 26 Mai ------------------ |
---|
| 518 | DO 1 j=1,250 |
---|
| 519 | DO 1 I=1,50 |
---|
| 520 | 1 ALL_TP(J,I)=0 |
---|
| 521 | DO 2 I=1,NmbofMol-1 ! without 'all' |
---|
| 522 | if (ListofMol(I)%Name.EQ.'all') go to 2 |
---|
| 523 | N70=0 |
---|
| 524 | C ALL_TP(1)=0 |
---|
| 525 | DO 5 J=1,ListofMol(I)%NTP |
---|
| 526 | DO 4 K=ListofMol(I)%N1(J),ListofMol(I)%N2(J) |
---|
| 527 | N70=N70+1 |
---|
| 528 | 4 ALL_TP(ListofMol(I)%MCode,N70)=K |
---|
| 529 | 5 CONTINUE |
---|
| 530 | 2 CONTINUE |
---|
| 531 | |
---|
| 532 | |
---|
| 533 | DO 99 I=1,30 |
---|
| 534 | 99 Mol(I)='***' |
---|
| 535 | DO 10 I=1,N |
---|
| 536 | Len=Index(Lines(i),' ')-1 |
---|
| 537 | 10 Ilen(i)=Len |
---|
| 538 | Popt=Index(Lines(1),'opt=') |
---|
| 539 | if (Popt.EQ.0) then |
---|
| 540 | Write(0,*) 'opt not found!' |
---|
| 541 | Call Exit(1) |
---|
| 542 | end if |
---|
| 543 | i1=Popt+5 |
---|
| 544 | i2=Popt+7 |
---|
| 545 | OPT=Lines(1)(i1:i2) |
---|
| 546 | if (OPT.NE.'lst'.AND.OPT.NE.'cal'. |
---|
| 547 | $ AND.OPT.NE.'ltp'.AND.OPT.NE.'mco') then |
---|
| 548 | print *, 'Invalid option !' |
---|
| 549 | Call Exit(1) |
---|
| 550 | end if |
---|
| 551 | if (OPT.EQ.'lst'.OR.OPT.EQ.'mco'.OR.OPT.EQ.'ltp') Return |
---|
| 552 | C |
---|
| 553 | C **** TPL option **** |
---|
| 554 | if (OPT.EQ.'tpl') THEN |
---|
| 555 | Pmol1=Index(Lines(1),'mol=') |
---|
| 556 | if (Pmol1.EQ.0) then |
---|
| 557 | Write(0,*) 'Option tpl : name of molecule is missed' |
---|
| 558 | Call Exit(1) |
---|
| 559 | end if |
---|
| 560 | i1=Pmol1+5 |
---|
| 561 | i2=Pmol1+17 |
---|
| 562 | if (i2.GT.ILEN(1)) i2=ILEN(1) |
---|
| 563 | C print *,i1,'*',i2 |
---|
| 564 | CharTmp=Lines(1)(i1:i2) |
---|
| 565 | i2=Index(CharTmp,'''') |
---|
| 566 | if (i2.EQ.0) then |
---|
| 567 | Write(0,*) 'Option tpl: quote is missed' |
---|
| 568 | Call Exit(1) |
---|
| 569 | end if |
---|
| 570 | i2=i2-1 |
---|
| 571 | mol(1)=CharTmp(1:i2) |
---|
| 572 | Return |
---|
| 573 | end if ! OPT.EQ.'tpl' |
---|
| 574 | C |
---|
| 575 | C *** CAL option ***** |
---|
| 576 | C Search for Nu1 and Nu2 |
---|
| 577 | K=N-1 |
---|
| 578 | If (ILEN(N).GT.4) K=N |
---|
| 579 | C Print *,K,' * ',Lines(K) |
---|
| 580 | Pnu1=Index(Lines(K),'nu1=') |
---|
| 581 | Lnu1=K |
---|
| 582 | Pnu2=Index(Lines(K),'nu2=') |
---|
| 583 | Lnu2=K |
---|
| 584 | if (Pnu1.EQ.0.OR.Pnu2.EQ.0) then |
---|
| 585 | Write(0,*) 'Option cal: nu1 or nu2 missed' |
---|
| 586 | Call Exit(1) |
---|
| 587 | end if |
---|
| 588 | i1=Pnu1+4 |
---|
| 589 | i2=Pnu1+14 |
---|
| 590 | if (i2.GT.ILEN(Lnu1)) i2=ILEN(Lnu1) |
---|
| 591 | CharTmp=Lines(Lnu1)(i1:i2) |
---|
| 592 | icom=INDEX(CharTmp,',') |
---|
| 593 | if (icom.EQ.0) then |
---|
| 594 | Write(0,*) 'Option CAL: comma is missed after nu1' |
---|
| 595 | Call Exit(1) |
---|
| 596 | end if |
---|
| 597 | CharTmp=CharTmp(1:icom-1) |
---|
| 598 | Read(CharTmp,*,iostat=ios1) Nu1 |
---|
| 599 | CharTmp=Lines(Lnu2)(Pnu2+4:ILEN(Lnu2)) |
---|
| 600 | islesh=INDEX(CharTmp,'/') |
---|
| 601 | if (islesh.NE.0) CharTmp=CharTmp(1:islesh-1) |
---|
| 602 | Read(CharTmp,*,iostat=ios2) Nu2 |
---|
| 603 | if (ios1.NE.0.OR.ios2.NE.0) then |
---|
| 604 | Write(0,*) 'Option CAL: invalid format of Nu1 or Nu2' |
---|
| 605 | Call Exit(1) |
---|
| 606 | end if |
---|
| 607 | C |
---|
| 608 | C *** Search for molecules *** |
---|
| 609 | MSel=0 |
---|
| 610 | DO 11 I=1,N |
---|
| 611 | BufLine=Lines(i) |
---|
| 612 | 6 Call SearchMol(BufLine,Nmol) |
---|
| 613 | if (Nmol.EQ.'****') go to 11 |
---|
| 614 | Msel=Msel+1 |
---|
| 615 | Mol(Msel)=Nmol |
---|
| 616 | If (Nmol.EQ.'all') Return |
---|
| 617 | go to 6 |
---|
| 618 | 11 Continue |
---|
| 619 | C |
---|
| 620 | C *** Search for T_P *** |
---|
| 621 | MSel1=0 |
---|
| 622 | DO 22 I=1,N |
---|
| 623 | BufLine=Lines(i) |
---|
| 624 | 7 Call SearchTP(BufLine,TP) |
---|
| 625 | C Print *, '!',(TP(iq),iq=1,6) |
---|
| 626 | if (TP(1).EQ.-1) go to 22 |
---|
| 627 | MSel1=MSel1+1 |
---|
| 628 | C *------ Trouver LeNumero de Mol --------------* |
---|
| 629 | Call CodeMol(Mol(MSel1), Code) |
---|
| 630 | c DO 199 I2=1,NmbofMol |
---|
| 631 | c if (Mol_Nm(I2).EQ.Code) then |
---|
| 632 | c LeNumero=I2 |
---|
| 633 | C Print *,'!! ','Mol_Nm(',I2,')=',Mol_Nm(I2),Lenumero |
---|
| 634 | c go to 201 |
---|
| 635 | c end if |
---|
| 636 | c 199 CONTINUE |
---|
| 637 | |
---|
| 638 | 201 DO 202 I22=1,50 |
---|
| 639 | IF (TP(I22).EQ.0) go to 88 |
---|
| 640 | 202 T_P(Code,i22)=All_TP(Code,TP(I22)) |
---|
| 641 | |
---|
| 642 | 88 go to 7 |
---|
| 643 | 22 CONTINUE |
---|
| 644 | if (MSel1.EQ.0) then |
---|
| 645 | write(0,*) 'Option CAL: tp not found!' |
---|
| 646 | Call Exit(1) |
---|
| 647 | end if |
---|
| 648 | if (Msel1.NE.MSel) then |
---|
| 649 | write(0,*) 'Option CAL: number of tp <> number of mol' |
---|
| 650 | Call Exit(1) |
---|
| 651 | end if |
---|
| 652 | Return |
---|
| 653 | End |
---|
| 654 | |
---|
| 655 | |
---|
| 656 | Subroutine SearchMol(Line,NMol) |
---|
| 657 | CHARACTER*255 Line |
---|
| 658 | CHARACTER*10 NMOL |
---|
| 659 | Character*20 CharTmp |
---|
| 660 | Integer(2) Pmol1 |
---|
| 661 | NMOL='****' |
---|
| 662 | C Print *, 'BLine= ',Line |
---|
| 663 | Pmol1=Index(Line,'mol=') |
---|
| 664 | if (Pmol1.EQ.0) Return |
---|
| 665 | i1=Pmol1+5 |
---|
| 666 | i2=Pmol1+17 |
---|
| 667 | ilen1=INDEX(Line,' ')-1 |
---|
| 668 | if (i2.GT.ILEN1) i2=ILEN1 |
---|
| 669 | C print *,i1,'*',i2 |
---|
| 670 | CharTmp=Line(i1:i2) |
---|
| 671 | i2=Index(CharTmp,'''') |
---|
| 672 | if (i2.EQ.0) then |
---|
| 673 | Write(0,*) 'Option CAL : quote is missed' |
---|
| 674 | Call Exit(1) |
---|
| 675 | end if |
---|
| 676 | i2=i2-1 |
---|
| 677 | C Print *, CharTmp |
---|
| 678 | Nmol=CharTmp(1:i2) |
---|
| 679 | C Print *, Nmol |
---|
| 680 | Line=Line(i1+i2+1:ilen1) |
---|
| 681 | Return |
---|
| 682 | End |
---|
| 683 | |
---|
| 684 | Subroutine SearchTP(Line,TP) |
---|
| 685 | Character*255 Line,CharTmp |
---|
| 686 | Integer(2) TP(50),PTP |
---|
| 687 | Character*4 CHN |
---|
| 688 | C |
---|
| 689 | DO 14 I=1,50 |
---|
| 690 | 14 TP(I)=0 |
---|
| 691 | PTP=INDEX(Line,'tp=') |
---|
| 692 | if (PTP.EQ.0) THEN |
---|
| 693 | TP(1)=-1 |
---|
| 694 | Return |
---|
| 695 | end if |
---|
| 696 | ilen1=INDEX(Line,' ')-1 |
---|
| 697 | CharTmp=Line(PTP+3:ilen1) |
---|
| 698 | i17=INDEX(CharTmp,'mol=') |
---|
| 699 | if (I17.EQ.0) i17=INDEX(CharTmp,'nu') |
---|
| 700 | if (I17.EQ.0) i17=INDEX(CharTmp,' ')-1 |
---|
| 701 | if (CharTmp(i17:i17).EQ.',') then |
---|
| 702 | i17=i17-1 |
---|
| 703 | else |
---|
| 704 | i17=i17-2 |
---|
| 705 | end if |
---|
| 706 | CharTmp=CharTmp(1:i17) |
---|
| 707 | C Print *, CharTmp |
---|
| 708 | Line=Line(PTP+3+i17:ilen1) |
---|
| 709 | C Print *, Line |
---|
| 710 | C => from cross_u.f |
---|
| 711 | jjj=1 |
---|
| 712 | if (CharTmp(1:1).EQ.'0') then |
---|
| 713 | TP(1)=0 |
---|
| 714 | go to 600 |
---|
| 715 | end if |
---|
| 716 | ilen=INDEX(CharTmp,' ')-1 |
---|
| 717 | 333 icomma=INDEX(CharTmp,',') |
---|
| 718 | if (icomma.eq.0) then |
---|
| 719 | CHN=CharTmp(1:ilen) |
---|
| 720 | READ(CHN,'(I3)',IOSTAT= ios) ntpcode |
---|
| 721 | if (ios.NE.0) go to 500 |
---|
| 722 | TP(jjj)=ntpcode |
---|
| 723 | else |
---|
| 724 | CHN=CharTmp(1:icomma-1) |
---|
| 725 | READ(CHN,'(I3)',IOSTAT=ios,ERR=500) ntpcode |
---|
| 726 | if (ios.NE.0) go to 500 |
---|
| 727 | TP(jjj)=ntpcode |
---|
| 728 | jjj=jjj+1 |
---|
| 729 | CharTmp=CharTmp(icomma+1:ilen) |
---|
| 730 | ilen=ilen-icomma |
---|
| 731 | go to 333 |
---|
| 732 | |
---|
| 733 | end if |
---|
| 734 | GO TO 600 |
---|
| 735 | 500 PRINT *, 'Option CAL: TP format is invalid!' |
---|
| 736 | Call Exit(1) |
---|
| 737 | c 600 Print *, '!!',(TP(i),i=1,6) |
---|
| 738 | 600 Return |
---|
| 739 | End |
---|
| 740 | |
---|
| 741 | Subroutine MCodes |
---|
| 742 | CHARACTER*10 MName |
---|
| 743 | Character*3 Mcd |
---|
| 744 | Character*180 Path1 |
---|
| 745 | Common /Reg12/Path1 |
---|
| 746 | ilen1=INDEX(Path1,' ')-1 |
---|
| 747 | OPEN(17,file=Path1(1:ilen1)//'molec.dat',Status='OLD', |
---|
| 748 | $ERR=90,iostat=ios ) |
---|
| 749 | 1 Read(17,'(A10,A3)',end=88) MName,Mcd |
---|
| 750 | C hcfc-225cb |
---|
| 751 | if (MName.EQ.'all ') go to 1 |
---|
| 752 | Write(6,'(A10,2X,A3)') Mname,Mcd |
---|
| 753 | go to 1 |
---|
| 754 | 88 close(17) |
---|
| 755 | Return |
---|
| 756 | 90 if (ios.EQ.6) Write(0,*) 'File molec.dat not found!' |
---|
| 757 | Call Exit(1) |
---|
| 758 | end |
---|
| 759 | |
---|
| 760 | Subroutine List_TP |
---|
| 761 | Character*30 TPL |
---|
| 762 | Character*180 Path1 |
---|
| 763 | Common /Reg12/Path1 |
---|
| 764 | ilen1=INDEX(Path1,' ')-1 |
---|
| 765 | OPEN(17,file=Path1(1:ilen1)//'nmb.dat',Status='OLD', |
---|
| 766 | $Err=90,iostat=ios ) |
---|
| 767 | 1 Read(17,'(A30)',end=40) TPL |
---|
| 768 | Write(6,'(A30)') TPL |
---|
| 769 | go to 1 |
---|
| 770 | 40 close(17) |
---|
| 771 | Return |
---|
| 772 | 90 if (ios.EQ.6) Write(0,*) 'File nmb.dat not found!' |
---|
| 773 | Call Exit(1) |
---|
| 774 | End |
---|
| 775 | |
---|
| 776 | |
---|
| 777 | |
---|
| 778 | Subroutine MolCodes |
---|
| 779 | |
---|
| 780 | TYPE MOLECULES |
---|
| 781 | SEQUENCE |
---|
| 782 | CHARACTER*10 NAME |
---|
| 783 | INTEGER(2) MCODE ! The code of molecule |
---|
| 784 | INTEGER(2) NTP ! Number of data sets |
---|
| 785 | INTEGER(2) N1(4) ! From |
---|
| 786 | INTEGER(2) N2(4) ! TO |
---|
| 787 | END TYPE MOLECULES |
---|
| 788 | Type CONDITIONS |
---|
| 789 | SEQUENCE |
---|
| 790 | REAL*4 Temperature |
---|
| 791 | REAL*4 Pressure |
---|
| 792 | REAL*4 Resolution |
---|
| 793 | END TYPE CONDITIONS |
---|
| 794 | TYPE (CONDITIONS) AllCondit(200) |
---|
| 795 | TYPE (MOLECULES) ListofMol(30) |
---|
| 796 | Integer(2) NumSel,NmbofMol,All_TP(50) |
---|
| 797 | Real*4 Lepremier,WvMin,WvMax,Step |
---|
| 798 | Character*80 SFORM |
---|
| 799 | Character*3 SN |
---|
| 800 | Character*5 S5 |
---|
| 801 | Character*16 TPCHAR(200) |
---|
| 802 | Character*180 Path1 |
---|
| 803 | Common /Reg9/ ListofMol |
---|
| 804 | Common /Reg7/ Lepremier,NumSel,NmbofMol |
---|
| 805 | COMMON /REG4/ WvMin,WvMax,Step |
---|
| 806 | Common /Reg11/ AllCondit |
---|
| 807 | Common /Reg12/Path1 |
---|
| 808 | ilen1=INDEX(Path1,' ')-1 |
---|
| 809 | OPEN(17,file=Path1(1:ilen1)//'nmb.dat',Status='OLD') |
---|
| 810 | INN=1 |
---|
| 811 | 18 Read(17,'(A5,A14)',end=19) S5,TPCHAR(INN) |
---|
| 812 | INN=INN+1 |
---|
| 813 | go to 18 |
---|
| 814 | 19 INN=INN-1 |
---|
| 815 | Close(17) |
---|
| 816 | DO 1 I=1,50 |
---|
| 817 | 1 ALL_TP(I)=0 |
---|
| 818 | C Print *, WvMin,' ',WvMax |
---|
| 819 | Write(6,'(F9.3,1x,F9.3)') WvMin,WvMax |
---|
| 820 | C Print *,'Nmol=',NmbofMol |
---|
| 821 | DO 2 I=1,NmbofMol-1 ! without 'all' |
---|
| 822 | if (ListofMol(I)%Name.EQ.'all') go to 2 |
---|
| 823 | N=0 |
---|
| 824 | C ALL_TP(1)=0 |
---|
| 825 | DO 5 J=1,ListofMol(I)%NTP |
---|
| 826 | DO 4 K=ListofMol(I)%N1(J),ListofMol(I)%N2(J) |
---|
| 827 | N=N+1 |
---|
| 828 | 4 ALL_TP(N)=K |
---|
| 829 | 5 CONTINUE |
---|
| 830 | Write(6,*) ListofMol(I)%Name,' ',ListofMol(i)%Mcode,' ', |
---|
| 831 | $ (TPCHAR(ALL_TP(JJ)),jj=1,N) |
---|
| 832 | 2 Continue |
---|
| 833 | Return |
---|
| 834 | End |
---|
| 835 | |
---|
| 836 | |
---|
| 837 | |
---|
| 838 | |
---|