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