| 1 | C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * |
|---|
| 2 | C |
|---|
| 3 | C LAST MODIF : 07.05.1991 PASSAGE DE 40 MOLECULES A 75 DANS LES COMMON |
|---|
| 4 | C |
|---|
| 5 | C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * |
|---|
| 6 | C |
|---|
| 7 | program sgeisa |
|---|
| 8 | CBB ajout de iuni pour lecture d un autre base que GEISA 29/10/1996 |
|---|
| 9 | CBB namelist/geisa/ pgm,nu1,nu2,dnu,liste,format,mole,isot,nfff, |
|---|
| 10 | CBB & modif,nbclas,trans,trs1,trs2,juni,vers,histo,anal |
|---|
| 11 | namelist/geisa/ pgm,nu1,nu2,dnu,liste,format,mole,isot,nfff, |
|---|
| 12 | &kuni,iuni,modif,nbclas,trans,trs1,trs2,juni,vers,histo,anal |
|---|
| 13 | C Modification from 10.02.2000 by A. Chursin |
|---|
| 14 | &,inmin,inmax |
|---|
| 15 | CBB fin des modifs 29/10/96 |
|---|
| 16 | logical*1 jdh(75),qqq |
|---|
| 17 | integer vers,p(300000),stime,tarray(9) |
|---|
| 18 | integer*2 qmot |
|---|
| 19 | real nu1,nu2 |
|---|
| 20 | real*8 tod1,cput1,reste,tod2,cput2 |
|---|
| 21 | character*132 fnt |
|---|
| 22 | character*112 fml |
|---|
| 23 | character*80 fmc |
|---|
| 24 | c character*8 C,clock_,D,date |
|---|
| 25 | character*24 cdatedeb,cdatefin,ctime |
|---|
| 26 | integer tempsdeb,tempsfin,time |
|---|
| 27 | character*44 fmt |
|---|
| 28 | character*9 trs1,trs2,tabday(7),tabmonth(12) |
|---|
| 29 | character*7 form,bin,format |
|---|
| 30 | character*6 fff |
|---|
| 31 | character*4 inte,base,deux,ctlg,code,mole,histo,blanc |
|---|
| 32 | character*3 pgm,ianl,iext,itrs,ilst,icop,info,icre, |
|---|
| 33 | & iopt,liste,modif,anal,iini,iuti,itri,trans, |
|---|
| 34 | & iasr,remp,supp,ajou,oui,mpgx |
|---|
| 35 | character*2 ikod,icod |
|---|
| 36 | character*1 bl,cara(100) |
|---|
| 37 | C |
|---|
| 38 | equivalence (p(1),cara(1)) |
|---|
| 39 | C |
|---|
| 40 | common/p1/ nu1,nu2,dnu,nbclas,khist,kanal,vers,mode,liste |
|---|
| 41 | common/p2/ mole(75),isot(100),nbi(75),nbt(75),iopt,ctlg,trans, |
|---|
| 42 | & trs1,trs2 |
|---|
| 43 | common/p3/ imole,iran,ival,pgm,ianl,iext,itrs,ilst,icop,info,icre |
|---|
| 44 | common/p4/ nmol,knmol,ksot,kksot,ntab,nhist,kp,lre,form,bin,modif |
|---|
| 45 | common/p5/ code(75),nn(150),nq(150),ikod(18),icod(18),jdeb(75) |
|---|
| 46 | common/p6/ iasr,remp,supp,ajou,imp8,imp9,in40,in41,in42,in43,n97 |
|---|
| 47 | common/p7/ iremp,isupp,iajou |
|---|
| 48 | common/p8/ npgx,nfff,mpgx,qqq(75) |
|---|
| 49 | common/ffff/ fml,fmc,fmt,fnt,fff |
|---|
| 50 | common/inteh/ incr,pas1,pmax |
|---|
| 51 | common/entsor/iuni,juni,kuni,ient,isor,iper,nresv,maxx,blanc,oui |
|---|
| 52 | C |
|---|
| 53 | data inte,base,deux/'inte','base','deux'/ |
|---|
| 54 | data iini,iuti/'ini','uti'/,itri/'tri'/,bl/' '/ |
|---|
| 55 | data tabday/'Sunday ','Monday ','Tuesday ','Wednesday', |
|---|
| 56 | $'Thursday ','Friday ','Saturday '/ |
|---|
| 57 | data tabmonth/'January ','February ','March ','April ', |
|---|
| 58 | $'May ','June ','July ','August ','September', |
|---|
| 59 | $'October ','November ','December '/ |
|---|
| 60 | C |
|---|
| 61 | write(isor,5) |
|---|
| 62 | 5 format(/51x,'input instructions supplied to GEISA software', |
|---|
| 63 | &//26x,82('*')) |
|---|
| 64 | i=0 |
|---|
| 65 | 10 continue |
|---|
| 66 | read (ient,11,end=15)(p(j),j=1,20) |
|---|
| 67 | 11 format(20a4) |
|---|
| 68 | if(cara(1).ne.bl) i=1 |
|---|
| 69 | write(isor,12 )(p(j),j=1,20) |
|---|
| 70 | 12 format(26x,'*',20a4,'*') |
|---|
| 71 | go to 10 |
|---|
| 72 | 15 continue |
|---|
| 73 | write(isor,16) |
|---|
| 74 | 16 format(26x,82('*')) |
|---|
| 75 | if(i.eq.0) go to 6 |
|---|
| 76 | write(isor,1010) |
|---|
| 77 | 1010 format(///' the parameter list begins in column 2', |
|---|
| 78 | &/' verify this parameter list') |
|---|
| 79 | go to 200 |
|---|
| 80 | 6 continue |
|---|
| 81 | rewind ient |
|---|
| 82 | C |
|---|
| 83 | C MODIFICATION DE RAYMOND |
|---|
| 84 | C |
|---|
| 85 | 25 continue |
|---|
| 86 | C INITIALISATION DES PARAMETRES |
|---|
| 87 | vers=97 |
|---|
| 88 | nmol=42 |
|---|
| 89 | copy =0. |
|---|
| 90 | juni=0 |
|---|
| 91 | format=' ' |
|---|
| 92 | npgx=0 |
|---|
| 93 | mpgx=' ' |
|---|
| 94 | nfff=0 |
|---|
| 95 | nu1=-1. |
|---|
| 96 | nu2=-1. |
|---|
| 97 | dnu=0. |
|---|
| 98 | nbclas=10 |
|---|
| 99 | anal=' ' |
|---|
| 100 | histo=' ' |
|---|
| 101 | kanal=0 |
|---|
| 102 | ival=0 |
|---|
| 103 | mode=-1 |
|---|
| 104 | modif=' ' |
|---|
| 105 | trs1=' ' |
|---|
| 106 | trs2=' ' |
|---|
| 107 | trans=' ' |
|---|
| 108 | liste=' ' |
|---|
| 109 | do 30 j=1,nmol |
|---|
| 110 | 30 mole(j)=blanc |
|---|
| 111 | do 31 j=1,ksot |
|---|
| 112 | 31 isot(j)=0 |
|---|
| 113 | read (ient,geisa,end=200) |
|---|
| 114 | jdeb(1)=1 |
|---|
| 115 | kk=1 |
|---|
| 116 | do 20 i=2,nmol |
|---|
| 117 | kk=kk+nn(kk)+1 |
|---|
| 118 | jdeb(i)=kk |
|---|
| 119 | 20 continue |
|---|
| 120 | do 21 j=1,nmol |
|---|
| 121 | qqq(j)=.false. |
|---|
| 122 | 21 continue |
|---|
| 123 | C |
|---|
| 124 | C LA BANQUE COMPLETE EST TOUJOURS STOCKEES SUR JUNGLE |
|---|
| 125 | C |
|---|
| 126 | mpgx=pgm |
|---|
| 127 | CBB initialisation de iuni,kuni |
|---|
| 128 | c print *, 'sgeisa iuni=',iuni |
|---|
| 129 | if(iuni.eq.0) iuni=1 |
|---|
| 130 | if(kuni.eq.0) kuni=2 |
|---|
| 131 | c print *, 'sgeisa2 iuni=',iuni |
|---|
| 132 | CBB fin modif 29/10/96 |
|---|
| 133 | if(juni.eq.0) juni=10 |
|---|
| 134 | if(format.eq.bin) open(unit=juni,form='unformatted') |
|---|
| 135 | if(format.eq.form) open(unit=juni,form='formatted') |
|---|
| 136 | c i1 = mclock() |
|---|
| 137 | tempsdeb=time() |
|---|
| 138 | if(pgm.ne.iini) go to 35 |
|---|
| 139 | if(iarr.eq.1) go to 150 |
|---|
| 140 | call init(iuni,isor,pgm,vers) |
|---|
| 141 | go to 150 |
|---|
| 142 | 35 continue |
|---|
| 143 | if(pgm.ne.iuti) go to 36 |
|---|
| 144 | if(iarr.eq.1) go to 150 |
|---|
| 145 | call utili(p,pgm) |
|---|
| 146 | go to 150 |
|---|
| 147 | 36 continue |
|---|
| 148 | lpgm=10 |
|---|
| 149 | c print *,'pgm=',pgm |
|---|
| 150 | if(pgm.eq.ianl) lpgm=1 |
|---|
| 151 | if(pgm.eq.iext) lpgm=2 |
|---|
| 152 | if(pgm.eq.ilst) lpgm=3 |
|---|
| 153 | if(pgm.eq.itrs) lpgm=4 |
|---|
| 154 | if(pgm.eq.icop) lpgm=5 |
|---|
| 155 | if(pgm.eq.icre) lpgm=6 |
|---|
| 156 | if(pgm.eq.info) lpgm=7 |
|---|
| 157 | if(pgm.eq.itri) lpgm=8 |
|---|
| 158 | npgx=lpgm |
|---|
| 159 | C ANL EXT LST TRS COP CRE INF TRI |
|---|
| 160 | go to (40 ,42 ,42 ,42 ,43 ,42 ,75 , 42 ,140),lpgm |
|---|
| 161 | C OPTION *** ANL *** |
|---|
| 162 | 40 continue |
|---|
| 163 | c print *,'format=',format,' anal=',anal |
|---|
| 164 | if(format.eq.bin) anal=oui |
|---|
| 165 | if(anal.eq.oui) kanal=1 |
|---|
| 166 | khist=0 |
|---|
| 167 | c print *,'histo=',histo |
|---|
| 168 | if(histo.eq.inte) khist=1 |
|---|
| 169 | if(histo.eq.base) khist=2 |
|---|
| 170 | if(histo.eq.deux) khist=-1 |
|---|
| 171 | if(histo.eq.inte.or.histo.eq.deux) nbclas=13 |
|---|
| 172 | c print *,'kanal =',kanal,' anal=',anal,' khist=',khist |
|---|
| 173 | if(kanal.eq.0.and.khist.eq.0) go to 140 |
|---|
| 174 | c print *,'kanal2=',kanal,' khist=',khist |
|---|
| 175 | 42 continue |
|---|
| 176 | if(format.eq.bin) mode=0 |
|---|
| 177 | if(format.eq.form) mode=1 |
|---|
| 178 | if(pgm.eq.itri) go to 133 |
|---|
| 179 | c print *,'modif=',modif |
|---|
| 180 | if(pgm.eq.icre.or.modif.eq.oui) go to 100 |
|---|
| 181 | 43 continue |
|---|
| 182 | c print *,'nu1 =',nu1, 'nu2 =',nu2 |
|---|
| 183 | if(nu1.ge.0..and.nu2.gt.0..and.nu1.lt.nu2) go to 100 |
|---|
| 184 | write(isor,1000) pgm |
|---|
| 185 | 1000 format(///' *',a3,'* you must initialize parameter nu1 or nu2'///) |
|---|
| 186 | go to 150 |
|---|
| 187 | C |
|---|
| 188 | C OPTION *** INF *** |
|---|
| 189 | C |
|---|
| 190 | 75 continue |
|---|
| 191 | mode=1 |
|---|
| 192 | if(anal.eq.oui) pgm=ianl |
|---|
| 193 | if(trans.eq.oui) pgm=itrs |
|---|
| 194 | if(pgm.eq.ianl.or.pgm.eq.itrs) go to 100 |
|---|
| 195 | mode=-1 |
|---|
| 196 | if(liste.eq.ctlg.and.nu1.gt.nu2) go to 42 |
|---|
| 197 | 100 continue |
|---|
| 198 | c print *,'format=',format |
|---|
| 199 | if(format.eq.oui) mode=0 |
|---|
| 200 | knmol=0 |
|---|
| 201 | do 105 i=1,nmol |
|---|
| 202 | if(mole(i).ne.blanc) knmol=knmol+1 |
|---|
| 203 | 105 continue |
|---|
| 204 | c print *,'knmol =',knmol |
|---|
| 205 | kksot=0 |
|---|
| 206 | if(lpgm.gt.3) go to 107 |
|---|
| 207 | do 106 j=1,ksot |
|---|
| 208 | if(isot(j).ne.0) kksot=kksot+1 |
|---|
| 209 | 106 continue |
|---|
| 210 | c print *,'kksot =',kksot |
|---|
| 211 | 107 continue |
|---|
| 212 | go to 130 |
|---|
| 213 | if(dnu.eq.0.) dnu=5. |
|---|
| 214 | do 110 i=1,nmol |
|---|
| 215 | do 109 j=1,nmol |
|---|
| 216 | if(mole(i).eq.code(j)) jdh(j)=.true. |
|---|
| 217 | 109 continue |
|---|
| 218 | 110 continue |
|---|
| 219 | c print *,'sgeisa=',(mole(kl),kl=1,nmol) |
|---|
| 220 | iuni=kuni |
|---|
| 221 | call infor(p,p) |
|---|
| 222 | if(liste.eq.oui) stop 1111 |
|---|
| 223 | go to 150 |
|---|
| 224 | 130 continue |
|---|
| 225 | c print *,'appel MOLIS' |
|---|
| 226 | C |
|---|
| 227 | call molis(p,jdh,*150) |
|---|
| 228 | C |
|---|
| 229 | c print *,'retour MOLIS' |
|---|
| 230 | do 132 j=1,nmol |
|---|
| 231 | qqq(j)=jdh(j) |
|---|
| 232 | 132 continue |
|---|
| 233 | 133 continue |
|---|
| 234 | C |
|---|
| 235 | c print *,'pgm=',pgm |
|---|
| 236 | if(pgm.eq.info) call infor(p,p(1+ntab)) |
|---|
| 237 | if(pgm.eq.icop) call copie(p,*150) |
|---|
| 238 | if(pgm.eq.ianl) |
|---|
| 239 | &call analy(p,p(1+ntab),p(1+2*ntab),p(1+3*ntab),p(1+4*ntab), |
|---|
| 240 | &p(1+5*ntab+nmol),p(1+5*ntab+2*nmol),jdh,*150) |
|---|
| 241 | if(pgm.eq.iext) call extr(p,jdh,*150) |
|---|
| 242 | if(pgm.eq.ilst) call list(p,jdh,*150) |
|---|
| 243 | if(pgm.eq.itrs) call trsi(p,p,p,jdh,*150) |
|---|
| 244 | if(pgm.eq.icre ) call creat(p,*150) |
|---|
| 245 | if(pgm.eq.itri) call trif(juni,isor,pgm,mode,vers,*150) |
|---|
| 246 | go to 150 |
|---|
| 247 | 140 continue |
|---|
| 248 | write(isor,3000) pgm |
|---|
| 249 | 3000 format(///' *',a3, |
|---|
| 250 | &'* invalid order &geisa given. program continue'///) |
|---|
| 251 | 150 continue |
|---|
| 252 | c print *,' retour:',pgm |
|---|
| 253 | c i2 = mclock() |
|---|
| 254 | tempsfin=time() |
|---|
| 255 | c ktt=i2-i1 |
|---|
| 256 | c call ltime_(stime,tarray) |
|---|
| 257 | ktt=tempsfin-tempsdeb |
|---|
| 258 | c D = date() |
|---|
| 259 | c C = clock_() |
|---|
| 260 | cdatedeb=ctime(tempsdeb) |
|---|
| 261 | cdatefin=ctime(tempsfin) |
|---|
| 262 | write(isor,4000) cdatedeb,cdatefin,ktt |
|---|
| 263 | 4000 format(//20x, |
|---|
| 264 | &'Laboratoire de Meteorologie Dynamique : start : ',a24 |
|---|
| 265 | &,/63x,'end : ',a24,/62x,'(Real time =',i6,' seconds)') |
|---|
| 266 | c write(isor,4000) D,C,ktt |
|---|
| 267 | c4000 format(//20x,'Laboratoire de Meteorologie Dynamique le ',a8, |
|---|
| 268 | c & ' a ' ,a8,3x,'/',i6,' csecondes/'/20x,37('*') ) |
|---|
| 269 | C IMPRESSIONS DE LA LISTE DES OPTIONS DISPONIBLES |
|---|
| 270 | if(pgm.eq.info.and.liste.eq.iopt) go to 75 |
|---|
| 271 | c if(pgm.ne.iasr) go to 25 |
|---|
| 272 | 200 continue |
|---|
| 273 | stop |
|---|
| 274 | end |
|---|
