subroutine rdtamie (iua,njh,nloop,numtot,mspall, 1 iflgaur,ihppem,i0prsz,iblat,isolcn) C 12/94: ~emery/Amie7/rdtamie.f C Read the top part only of the AMIE ascii file on unit iua include 'param.h' include 'qset.h' common/prnt/ipr,iup C BLATPL is the bottom latitude plotted. Is usually 50 degrees. COMMON/BOTLAT/BLATPL COMMON/FXFY/TWOPI,XLONMX,ROT COMMON/HEM/IHSOLN COMMON/INCRLON/DLON REAL MLT COMMON /GRID/ CLATD(0:ITHMX),MLT(0:LONMX) COMMON/QDQ/Q(NQ,0:ITHMX),DQ(NQ,0:ITHMX),ST(0:ITHMX),CT(0:ITHMX), 1 VFMPS(NQS,MXNMX),NS(0:MMX),NMX(0:MMX),NSS(0:MMX),DTH, 2 ZFMPS(NQS,MXNMX),WNT2(NQ),WNP2(NQ),QNORM(NQ) character*40 sundir character*16 flnmgm,flnme(25),flnmc(25),flnmj(25) CHARACTER*8 nmefi(25),CONNAM(25),NMDBI(25) CHARACTER*2 ENM2(25),CNM2(25),EC2,JNM2(25) CHARACTER*1 VECVLOS(25),HEMNSB(25),APEXGE(25),EGNDSAT(25), 1 TOTCON(25),CONAUR(25),APEXGC(25),CGNDSAT(25),vse(25), 2 hmjnsb(25),apexgj(25) dimension nhde(25),nlne(25),nloce(25),minhpe(25),minere(25), 1 tmerre(25,2),errmne(25,2),pcerre(25,2),iunite(25),xwte1(25), 2 xwte2(25),epalat(25),epalon(25),epc(25,2),blate(25) dimension nhdc(25),nlnc(25),nlocc(25),minhpc(25),minerc(25), 1 tmerrc(25,4),errmnc(25,4),pcerrc(25,4),bkgc(4),bkgcer(4), 2 iunitc(25),flxmin(25),cpalat(25),cpalon(25),xwtc(25),xwtk(25), 3 xwtf(25),blatc(25) dimension nhdj(25),nlnj(25),nlocj(25),minhpj(25),minerj(25), 1 tmerrj(25,2),errmnj(25,2),pcerrj(25,2),iunitj(25),xwtj1(25), 2 xwtj2(25),bpalat(25),bpalon(25),bpc(25,2),blatj(25) COMMON /DAYRD/ NTIME, MINSP, IMDAY(300), IHMIN(300) CHARACTER*3 NMON(12) DATA NMON/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP', 1 'OCT','NOV','DEC'/ character*8 tdate character*130 char130 PII=4.*ATAN(1.) RAD = 180./PII TWOPI=2.*PII XLONMX=LONMX DLON = TWOPI/FLOAT(LONMX) C BLATFIT is the bottom latitude trusted in the fit based on ITHTRNS. C Used in QSCLR for DATFMA and as POTM removed (POTM same from C ITHTRNS to ITHMX) BLATFIT = 90. * (1. - FLOAT(ITHTRNS)/FLOAT(ITHMX)) C Find bottom latitude plotted. Make it a multiple of 10 degrees. J10 = (BLATFIT + 4.9999) / 10. BLAT10 = J10 * 10 BLATPL = BLAT10 C Change BLATPL if desired!! if (iblat .ge. 40) BLATPL = iblat WRITE (6,"(1X,'MCOEF ITHMX ITHTRNS J10 BLATFIT,F10,PL =', 1 4I4,3F7.2)") MCOEF,ITHMX,ITHTRNS,J10,BLATFIT,BLAT10,BLATPL C Changed 10/96: read (iua,"(A8,I3,8I2,6I4)") TDATE,IHSOLN,IHPPEM, 1 ISOLCN,I0PRSZ,IFLGAUR,IFNOCM,NOFITA,IRDZ,NLOOP, 2 NUMTOT,MSPALL,JCOEF,JTHMX,JTHTRNS,JONMX DTH = 90./(float(jthmx)*rad) WRITE (6,"(1X,I3,8I2,6I4,F5.2,' AMIE: ihsoln ihppem', 1 ' isolcn i0prsz iflgaur ifnocm nofita irdz nloop numtot', 2 ' mspall mcoef ithtrns lonmx dth(deg)')") 3 IHSOLN,IHPPEM, 4 ISOLCN,I0PRSZ,IFLGAUR,IFNOCM,NOFITA,IRDZ,NLOOP, 5 NUMTOT,MSPALL,JCOEF,JTHMX,JTHTRNS,JONMX,DTH*RAD if (jthtrns .ne. ithtrns .or. 1 jonmx .ne. lonmx .or. 2 jcoef .ne. mcoef) stop read (iua,"(10F6.2)") (CLATD(ITH),ITH=0,ITHMX) C Define DTH, ST, and CT do ith=0,ithmx st(ith) = sin(clatd(ith)/rad) ct(ith) = sin(clatd(ith)/rad) enddo C Make sure the sin(0) at the pole (ith=0) is not 0, but is 1.e-20 st(0) = 1.e-20 dth = (clatd(1)-clatd(0))/rad read (iua,"(10F6.2)") (MLT(LON),LON=0,LONMX) C Changed 10/96: read (iua,"(4i3,4f5.2,1x,4f5.2,1x,3f6.1)") 1 iflgmg,nehem,ncsrc,njh, (bkgc(k1),k1=1,4), 2 (bkgcer(k2),k2=1,4),flxmax,dbymax,dbzmax C Added printout to unit iup if (ipr .eq. 1) then WRITE (iup,"(5I3,5I4,' AMIE ihsoln ihppem i0prsz', 1 ' mspall nloop numtot mcoef ithmx ithtrns lonmx ')") 2 IHSOLN,IHPPEM,I0PRSZ,MSPALL,NLOOP, 3 NUMTOT,MCOEF,ITHMX,ITHTRNS,LONMX WRITE (iup,10006) 10006 FORMAT (1X,3X,'DAY HOUR BY BZ AECL DST HPIN, CALC', 1 ' JULHT EQVI POTI FAC POTDF POTMN POTMX POT1 ', 2 'SMPLJL EMPOW RCPOW MLTX1 LATX1 LATPW EQB0', 3 1X,15X,' NT NT NT NT GW', 4 4X,'GW',5X,'GW KA KA KA KV ', 5 'KV KV KV GW', 6 5X,'GW GW HR DEG DEG DEG') WRITE (iup,"(I3,8I2,6I4,' AMIE: ihsoln ihppem isolcn', 1 ' i0prsz iflgaur ifnocm nofita irdz nloop numtot mspall mcoef', 2 ' ithmx ithtrns lonmx')") IHSOLN,IHPPEM, 3 ISOLCN,I0PRSZ,IFLGAUR,IFNOCM,NOFITA,IRDZ,NLOOP, 4 NUMTOT,MSPALL,JCOEF,JTHMX,JTHTRNS,JONMX WRITE (iup,"(10F6.2,' clatd')")(CLATD(ITH),ITH=0,JTHTRNS) WRITE (iup,"(10F6.2,' mlt')") (MLT(LON),LON=0,LONMX) write (iup,"(4i3,' iflgmg nehem ncsrc njh')") iflgmg,nehem, 1 ncsrc,njh endif C Added 10/96 if (iflgmg .eq. 1) then read (iua,"(i3,i6,3i3,i3,i5,1x,a16,1x,a40)") 1 nmgsta,numgmg,mnspmg,minxy,minz,iungm,nmgfls,flnmgm,sundir if (ipr .eq. 1) 1 write (iup,"(i3,i6,3i3,i3,i5,1x,a16,1x,a40)") 2 nmgsta,numgmg,mnspmg,minxy,minz,iungm,nmgfls,flnmgm,sundir endif do nh=1,nehem C Changed 10/96: read (iua,"(i3,1x,a8,1x,a2,3f6.1,i3,1x,a16,4(1x,a1),i3, 1 i6,i5,2i3,10f5.2)") mh,nmefi(nh),enm2(nh),epalat(nh), 2 epalon(nh),blate(nh),iunite(nh),flnme(nh),vecvlos(nh), 3 hemnsb(nh),egndsat(nh),apexge(NH),nhde(NH),nlne(NH), 4 nloce(NH),minhpe(NH),minere(NH),tmerre(NH,1), 5 tmerre(NH,2),errmne(NH,1),errmne(NH,2),pcerre(NH,1), 6 pcerre(NH,2),epc(nh,1),epc(nh,2),xwte1(nh),xwte2(nh) if (ipr .eq. 1) 1 write (iup,"(i3,1x,a8,1x,a2,3f6.1,i3,1x,a16,4(1x,a1),i3, 2 i6,i5,2i3,10f5.2)") mh,nmefi(nh),enm2(nh),epalat(nh), 3 epalon(nh),blate(nh),iunite(nh),flnme(nh),vecvlos(nh), 4 hemnsb(nh),egndsat(nh),apexge(NH),nhde(NH),nlne(NH), 5 nloce(NH),minhpe(NH),minere(NH),tmerre(NH,1), 6 tmerre(NH,2),errmne(NH,1),errmne(NH,2),pcerre(NH,1), 7 pcerre(NH,2),epc(nh,1),epc(nh,2),xwte1(nh),xwte2(nh) enddo do 3133 n=1,ncsrc C Changed 10/96: read (iua,"(i3,1x,a8,1x,a2,3f6.1,i3,1x,a16,4(1x,a1),i3,i6,i5,2i3 1 ,16f5.2)") m,connam(n),cnm2(n),cpalat(n),cpalon(n),blatc(n), 2 iunitc(n),flnmc(n), 3 totcon(n),conaur(n),cgndsat(n),apexgc(n),nhdc(n),nlnc(n), 4 nlocc(n),minhpc(n),minerc(n),(tmerrc(n,k1),k1=1,4),flxmin(n), 5 (errmnc(n,k2),k2=1,4),(pcerrc(n,k3),k3=1,4),xwtc(n),xwtf(n), 6 xwtk(n) if (ipr .eq. 1) 1 write (iup,"(i3,1x,a8,1x,a2,3f6.1,i3,1x,a16,4(1x,a1),i3,i6,i5,2i3 2 ,16f5.2)") m,connam(n),cnm2(n),cpalat(n),cpalon(n),blatc(n), 3 iunitc(n),flnmc(n), 4 totcon(n),conaur(n),cgndsat(n),apexgc(n),nhdc(n),nlnc(n), 5 nlocc(n),minhpc(n),minerc(n),(tmerrc(n,k1),k1=1,4),flxmin(n), 6 (errmnc(n,k2),k2=1,4),(pcerrc(n,k3),k3=1,4),xwtc(n),xwtf(n), 7 xwtk(n) 3133 continue do 3134 nh=1,njh read (iua,"(i3,1x,a8,1x,a2,3f6.1,i3,1x,a16,2(3x,a1),i3, 1 i6,i5,2i3,6f5.2)") mh,nmdbi(nh),jnm2(nh),bpalat(nh), 2 bpalon(nh),blatj(nh), 2 iunitj(nh),flnmj(nh),hmjnsb(nh), 3 apexgj(NH),nhdj(NH),nlnj(NH),nlocj(NH),minhpj(NH), 4 minerj(NH),tmerrj(NH,1),tmerrj(NH,2),errmnj(NH,1), 5 errmnj(NH,2),xwtj1(nh),xwtj2(nh) if (ipr .eq. 1) 1 write (iup,"(i3,1x,a8,1x,a2,3f6.1,i3,1x,a16,2(3x,a1), 2 i3,i6,i5,2i3,6f5.2)") mh,nmdbi(nh),jnm2(nh),bpalat(nh), 3 bpalon(nh),blatj(nh), 3 iunitj(nh),flnmj(nh),hmjnsb(nh), 4 apexgj(NH),nhdj(NH),nlnj(NH),nlocj(NH),minhpj(NH), 5 minerj(NH),tmerrj(NH,1),tmerrj(NH,2),errmnj(NH,1), 6 errmnj(NH,2),xwtj1(nh),xwtj2(nh) 3134 continue C Skip over descriptive lines C Changed 10/96 do 200 i=1,24 read (iua,"(a130)") char130 200 continue return end ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc subroutine rd1amie (iua,njh,ntm,iyear,imon,ida1,ida,ihr,imin, 1 pppnt,pdifnt,oltxnt,omltxnt,ndst,ierr) include 'param.h' include 'qset.h' C BLATPL is the bottom latitude plotted. Is usually 50 degrees. COMMON/BOTLAT/BLATPL COMMON/FXFY/TWOPI,XLONMX,ROT COMMON/HEM/IHSOLN COMMON/INCRLON/DLON REAL MLT COMMON /GRID/ CLATD(0:ITHMX),MLT(0:LONMX) COMMON/ERR/ERAR(0:LONMX,0:ITHMX),ERRMX,ISOLF,IERRD COMMON/CONDUC/SIGP(0:LONMX,0:ITHMX),SIGH(0:LONMX,0:ITHMX), 1 SIGPA(0:LONMX,0:ITHMX),SIGHA(0:LONMX,0:ITHMX), 2 SIGPS(0:LONMX,0:ITHMX),SIGHS(0:LONMX,0:ITHMX), 3 SIGR(0:LONMX,0:ITHMX) dimension arconduc(0:lonmx,0:ithmx,5) equivalence (sigp,arconduc) COMMON/PARFLUX/EMKEV(0:LONMX,0:ITHMX),WPM2(0:LONMX,0:ITHMX) common /calc/ EE(0:LONMX,0:ITHMX),EN(0:LONMX,0:ITHMX), 1 EPOT(0:LONMX,0:ITHMX),VPOT(0:LONMX,0:ITHMX), 2 PEDRM(0:LONMX,0:ITHMX),HALRM(0:LONMX,0:ITHMX), 3 EVAR(0:LONMX,0:ITHMX),EFER(0:LONMX,0:ITHMX), 4 EFPOT(0:LONMX,0:ITHMX),CPOT(0:LONMX,0:ITHMX), 5 SMQJ(0:LONMX,0:ITHMX),RVQJ(0:LONMX,0:ITHMX), 6 DFAC(0:LONMX,0:ITHMX),EMPR(0:LONMX,0:ITHMX), 7 APEDMDL(0:LONMX,0:ITHMX),AHALMDL(0:LONMX,0:ITHMX), 8 PKVMDL(0:LONMX,0:ITHMX), EMDL(0:LONMX,0:ITHMX), 9 EKVMDL(0:LONMX,0:ITHMX), EFXMDL(0:LONMX,0:ITHMX), 1 SIGPER(0:LONMX,0:ITHMX),SIGHER(0:LONMX,0:ITHMX), 2 ESVP(0:LONMX,0:ITHMX),ZARR(0:LONMX,0:ITHMX), 3 EEERR(0:LONMX,0:ITHMX),ENERR(0:LONMX,0:ITHMX), 4 PSI(0:LONMX,0:ITHMX), CVPOT(0:LONMX,0:ITHMX), 5 DEN(0:LONMX,0:ITHMX),DEE(0:LONMX,0:ITHMX), 6 DEEH(0:LONMX,0:ITHMX),DEEP(0:LONMX,0:ITHMX), 7 DENH(0:LONMX,0:ITHMX),DENP(0:LONMX,0:ITHMX), 8 PSIH(0:LONMX,0:ITHMX),PSIP(0:LONMX,0:ITHMX), 9 EESMDL(0:LONMX,0:ITHMX),ENSMDL(0:LONMX,0:ITHMX), 1 POT1(2,0:ITHMX) common /timval/ bxgsm(mxtime),bygsm(mxtime),bzgsm(mxtime), 1 sandx(mxtime),dstrd(mxtime),aucalc(mxtime),alcalc(mxtime), 2 aecalc(mxtime),almidn(mxtime), 3 POTMAX(MXTIME),POTMIN(MXTIME),POTDIF(MXTIME),EMPOW(MXTIME), 4 PSIDIF(MXTIME),PPP(MXTIME),XLTMAX(MXTIME),POWI(MXTIME), 5 POTMX1(MXTIME),OLTMAX(MXTIME),OMLTMX(MXTIME),TYME(MXTIME), 6 AENDX(MXTIME),HEMPWR(MXTIME),DSTNDX(MXTIME),POTMDL(MXTIME), 7 CONAI(MXTIME),EFAI(MXTIME),CUNDX(MXTIME),TJH(MXTIME), 8 SMPLJL(MXTIME),TAUDIF(MXTIME),TAUMIN(MXTIME),TAUMAX(MXTIME), 9 PSIMAX(MXTIME),PSIMIN(MXTIME), 1 XMLGMX(MXTIME), CLATDMX(MXTIME), XMLGMN(MXTIME), 2 CLATDMN(MXTIME), XMLGCX(MXTIME), CLATDCX (MXTIME), 3 XMLGCN(MXTIME),CLATDCN(MXTIME),XMLGQX(MXTIME), 4 CLATDQX(MXTIME),XMLGQN(MXTIME),CLATDQN(MXTIME), 5 FACINT(MXTIME),FACINTH(MXTIME),FACINTP(MXTIME) 6 ,eqb0(mxtime),swv(mxtime),hpmdl(mxtime) 7 ,potdmdl(mxtime),potnmdl(mxtime),potxmdl(mxtime) character*1 cgs,egs character*2 cplnm2,eplnm2 CHARACTER*8 CONINST,ESINST,EVINST common/conobs/lcon,ist(25,2),cplalat(25),cplalon(25), 1 alatcon(mxdat),aloncon(mxdat),amltcon(mxdat),angc(mxdat), 2 wtcon(mxdat),wtkev(mxdat),wteflx(mxdat),pedobs(mxcon), 3 halobs(mxcon),hprobs(mxcon),eflxobs(mxcon),ekevobs(mxcon), 4 ipc(mxcon),itotcon(mxcon),xwtcon(mxdat), eflxmdl(mxcon), 5 eflxfit(mxcon),erflxln(mxdat),ekevmdl(mxcon),ekevfit(mxcon), 6 erkevln(mxdat),pedmod(mxcon),pedfit(mxcon),erpedln(mxdat), 7 halmod(mxcon),halfit(mxcon),erhalln(mxdat), 8 nconobs, cgs(25), coninst(mxcon),cplnm2(25) COMMON/ESCNT/LLS,SCAOBS COMMON/EVCNT/LLE common/eobs/ lmag,lsat,igt(25,2),eplalat(25),eplalon(25), 1 nesobs,ibas(mxes),alates(mxes),alones(mxes),anges(mxes), 2 esobs(mxes),wtes(mxes),eperp(mxes),esmdl(mxes),esfit(mxes), 3 nevobs,ibav(mxev),alatev(mxev),alonev(mxev),angev(mxev), 4 enobs(mxev),wtn(mxev),eeobs(mxev),wte(mxev),encomp(mxev), 5 eecomp(mxev),enmdl(mxev),eemdl(mxev),xwtes(mxes),xwtev(mxev), 6 amltes(mxes),amltev(mxev),ersiges(mxes),ersigen(mxev), 7 ersigee(mxev),esinst(mxes),evinst(mxev),eplnm2(25),egs(25) C MGCOORD is common block for ground magnetometer data REAL MGLAT,MGLON COMMON/MGCOORD/NMGSTA,MGLAT(MXMGSTA),MGLON(MXMGSTA) 1 ,DECMG(MXMGSTA),NUMGMG,MINXY,MINZ, 2 HGM(MXTIME,MXMGSTA),ERHGM(MXTIME,MXMGSTA),DGM(MXTIME,MXMGSTA), 3 ERDGM(MXTIME,MXMGSTA),ZGM(MXTIME,MXMGSTA),ERZGM(MXTIME,MXMGSTA) 4 ,IFHRLY(MXMGSTA),IFDIG(MXMGSTA),IFSKP(MXMGSTA),NMINMG(MXTIME) CHARACTER*8 STNAME common /magobs/ STNAME(MXMGSTA),H(MXMGSTA),WTH(MXMGSTA), 1 D(MXMGSTA),WTD(MXMGSTA),ZED(MXMGSTA),WTZED(MXMGSTA), 2 hmdl(mxmgsta),hcomp(mxmgsta),dmdl(mxmgsta),dcomp(mxmgsta), 3 zmdl(mxmgsta),zcomp(mxmgsta),xwtm(mxmgsta),amltmg(mxmgsta), 4 ersigh(mxmgsta),ersigd(mxmgsta),ersigz(mxmgsta) character*2 jplnm2 CHARACTER*8 SANAME common /satmobs/ 1 nsaobs,saname(mxsat),alatsa(mxsat),alonsa(MXSAT),amltsa(MXSAT), 2 angsa(mxsat),DBY(MXSAT),WTY(MXSAT),DBZ(MXSAT),WTZ(MXSAT), 3 dbymdl(mxsat),dbycomp(mxsat),dbzmdl(mxsat),dbzcomp(mxsat), 4 ipsm(mxsat),dalatsa(mxsat),dalonsa(mxsat),xwts(mxsat), 5 ersigdby(mxsat),ersigdbz(mxsat), 6 bplalat(25),bplalon(25),jplnm2(25) COMMON/QDQ/Q(NQ,0:ITHMX),DQ(NQ,0:ITHMX),ST(0:ITHMX),CT(0:ITHMX), 1 VFMPS(NQS,MXNMX),NS(0:MMX),NMX(0:MMX),NSS(0:MMX),DTH, 2 ZFMPS(NQS,MXNMX),WNT2(NQ),WNP2(NQ),QNORM(NQ) character*110 char110 CHARACTER*8 SPMESS,LINE4 CHARACTER*35 MESS COMMON /DATTIM/ MESS,SPMESS,LINE4 CHARACTER*3 NMON(12) DATA NMON/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP', 1 'OCT','NOV','DEC'/ data errmx/50./ C Read fields on unit iua read (iua,"(I4,I5,4I3,5I4)") NTM, 1 IYEAR,IMON,IDA,IHR,IMIN,NCONOBS,NESOBS,NEVOBS,NMGSTA,NSAOBS write (6,"(1x,I4,I5,4I3,5I4,' ntime iyear imo ida ihr imin' 1 ' nconobs nesobs nevobs nmgsta nsaobs')") NTM, 2 IYEAR,IMON,IDA,IHR,IMIN,NCONOBS,NESOBS,NEVOBS,NMGSTA,NSAOBS C Can get into trouble here with more than 1 mloop (day) c if (ntm .ne. ntime) stop ntime = ntm IF (NTIME .EQ. 1) IDA1 = IDA UT = FLOAT(IHR)+(FLOAT(IMIN)/60.) TYME(NTIME) = FLOAT(IDA-IDA1)*24. + UT read (iua,"(5I5)") LCON,LLS,LLE,lsat,lmag read (iua,"(5(1X,A1,1X,A2,2F6.1))") 1 (cgs(i),cplnm2(i),cplalat(i),cplalon(i),i=1,lcon) if (cgs(i) .eq. 'S') cplalat(i) = blatpl - 2. read (iua,"(20I5)") (IST(I,1),IST(I,2),I=1,LCON+1) read (iua,"(5(1X,A1,1X,A2,2F6.1))") 1 (egs(i),eplnm2(i),eplalat(i),eplalon(i),i=1,lle) if (egs(i) .eq. 'S') eplalat(i) = blatpl - 2. read (iua,"(5(3X,A2,2F6.1))") 1 (jplnm2(i),bplalat(i),bplalon(i),i=1,njh) read (iua,"(20I5)") (IGT(I,1),IGT(I,2),I=1,lmag+1) C Changed 10/96 c read (iua,"(3F6.1,6F7.1,I3)") BXGSM(NTIME), read (iua,"(F6.0,3F6.1,6F7.1,I3)", iostat = ios) 1 SWV(NTIME),BXGSM(NTIME),BYGSM(NTIME),BZGSM(NTIME), 2 AENDX(NTIME),AECALC(NTIME),AUCALC(NTIME),ALCALC(NTIME), 3 DSTRD(NTIME),DSTNDX(NTIME),NDST if (ios.ne.0) then write(6,*) 'Error in readin sw params, setting to 0' SWV(NTIME) = 0.0 BXGSM(NTIME) = 0.0 ByGSM(NTIME) = 0.0 BzGSM(NTIME) = 0.0 AENDX(NTIME) = 0.0 AECALC(NTIME) = 0.0 AUCALC(NTIME) = 0.0 ALCALC(NTIME) = 0.0 DSTRD(NTIME) = 0.0 DSTNDX(NTIME) = 0.0 NDST = 0 endif read (iua,"(4f6.1,3f5.1)", iostat = ios) 1 eqb0(ntime),hempwr(ntime),hpmdl(ntime),PPP(NTIME), 2 CUNDX(NTIME),EFAI(NTIME),CONAI(NTIME) if (ios.ne.0) then write(6,*) 'Error in readin hp params, setting to 0' eqb0(ntime) = 0.0 hempwr(ntime) = 0.0 hpmdl(ntime) = 0.0 PPP(NTIME) = 0.0 CUNDX(NTIME) = 0.0 EFAI(NTIME) = 0.0 CONAI(NTIME) = 0.0 endif C Added 10/96: read (iua,"(4f7.1)", iostat = ios) 1 SMPLJL(NTIME),TJH(NTIME),EMPOW(NTIME),powi(ntime) if (ios.ne.0) then write(6,*) 'Error in reading smpjl params, setting to 0' SMPLJL(NTIME) = 0.0 TJH(NTIME) = 0.0 EMPOW(NTIME) = 0.0 powi(ntime) = 0.0 endif smpljl(ntime) = smpljl(ntime)*1.e+9 tjh(ntime) = tjh(ntime)*1.e+9 empow(ntime) = empow(ntime)*1.e+9 powi(ntime) = powi(ntime)*1.e+9 pppnt = ppp(ntime) C Added 10/96: read (iua,"(7f6.1,3f7.1)", iostat = ios) 1 potdmdl(ntime),potnmdl(ntime),potxmdl(ntime), 2 potdif(ntime),potmin(ntime),potmax(ntime),potmx1(ntime), 3 facint(ntime),facinth(ntime),facintp(ntime) if (ios.ne.0) then write(6,*) 'Error in reading potdmdl params, setting to 0' potdmdl(ntime) = 0.0 potnmdl(ntime) = 0.0 potxmdl(ntime) = 0.0 potdif(ntime) = 0.0 potmin(ntime) = 0.0 potmax(ntime) = 0.0 potmx1(ntime) = 0.0 facint(ntime) = 0.0 facinth(ntime) = 0.0 facintp(ntime) = 0.0 endif potdif(ntime) = potdif(ntime)*1.e+3 potmin(ntime) = potmin(ntime)*1.e+3 potmax(ntime) = potmax(ntime)*1.e+3 potmx1(ntime) = potmx1(ntime)*1.e+3 facint(ntime) = facint(ntime)*1.e+3 facinth(ntime) = facinth(ntime)*1.e+3 facintp(ntime) = facintp(ntime)*1.e+3 pdifnt = potdif(ntime) C Added 10/96: read (iua,"(7f6.2)", iostat = ios) 1 clatdmn(ntime),xmlgmn(ntime),clatdmx(ntime),xmlgmx(ntime), 2 oltmax(ntime),omltmx(ntime),xltmax(ntime) if (ios.ne.0) then write(6,*) 'Error in reading clatdmn params, setting to 0' clatdmn(ntime) = 0.0 xmlgmn(ntime) = 0.0 clatdmx(ntime) = 0.0 xmlgmx(ntime) = 0.0 oltmax(ntime) = 0.0 omltmx(ntime) = 0.0 xltmax(ntime) = 0.0 endif oltxnt = oltmax(ntime) omltxnt = omltmx(ntime) C Added 10/96: read (iua,"(6f7.1)", iostat = ios) 1 psidif(ntime),psimin(ntime),psimax(ntime), 2 taudif(ntime),taumin(ntime),taumax(ntime) if (ios.ne.0) then write(6,*) 'Error in reading potdmdl params, setting to 0' psidif(ntime) = 0.0 psimin(ntime) = 0.0 psimax(ntime) = 0.0 taudif(ntime) = 0.0 taumin(ntime) = 0.0 taumax(ntime) = 0.0 endif psidif(ntime) = psidif(ntime)*1.e+3 psimin(ntime) = psimin(ntime)*1.e+3 psimax(ntime) = psimax(ntime)*1.e+3 taudif(ntime) = taudif(ntime)*1.e+3 taumin(ntime) = taumin(ntime)*1.e+3 taumax(ntime) = taumax(ntime)*1.e+3 C Added 10/96: read (iua,"(8f6.2)", iostat = ios) 1 clatdqn(ntime),xmlgqn(ntime),clatdqx(ntime),xmlgqx(ntime), 2 clatdcn(ntime),xmlgcn(ntime),clatdcx(ntime),xmlgcx(ntime) C TEMP write (6,"(1x,'sa vsw bx,y,z dst eqb0 hp potdif sqj =',10f8.2)") 1 sandx(ntime),swv(ntime),bxgsm(ntime),bygsm(ntime), 2 bzgsm(ntime),dstrd(ntime),eqb0(ntime),ppp(ntime), 3 potdif(ntime)*1.e-3,smpljl(ntime)*1.e-9 DO I=1,NCONOBS 9894 read (iua,"(A8,I10,8F7.2,F8.3,3E12.4)", iostat = ios) 1 coninst(i),ipc(i),alatcon(i),amltcon(i),aloncon(i),angc(i), 2 pedobs(i),halobs(i),hprobs(i),ekevobs(i),eflxobs(i),wtcon(i), 3 wtkev(i),wteflx(i) read (iua,"(8x,3f7.2,f8.3,3f7.2,f8.3,4e12.4)", iostat = ios) 1 pedmod(i),halmod(i),ekevmdl(i),eflxmdl(i),pedfit(i),halfit(i), 2 ekevfit(i),eflxfit(i),erpedln(i),erhalln(i),erkevln(i), 3 erflxln(i) enddo DO I=1,NESOBS read (iua,"(A8,I10,8F7.2,2E12.4)", iostat = ios) 1 esinst(i),ibas(i),alates(i),amltes(i),alones(i),anges(i), 2 esobs(i),esmdl(i),esfit(i),eperp(i),wtes(i),ersiges(i) enddo DO i=1,NEVOBS read (iua,"(A8,I10,10F7.2,4E12.4)", iostat = ios) 1 evinst(i),ibav(i),alatev(i),amltev(i),alonev(i),angev(i), 2 enobs(i),eeobs(i),enmdl(i),eemdl(i),encomp(i),eecomp(i), 3 wtn(i),wte(i),ersigen(i),ersigee(i) enddo C Changed 10/96 DO I=1,NMGSTA read (iua,"(A8,4F7.2,3(3F7.0,2E12.4))", iostat = ios) 1 stname(i),mglat(i),amltmg(i),mglon(i),decmg(i),h(i), 2 hmdl(i),hcomp(i),wth(i),ersigh(i),d(i),dmdl(i),dcomp(i), 3 wtd(i),ersigd(i),zed(i),zmdl(i),zcomp(i),wtzed(i),ersigz(i) enddo DO I=1,NSAOBS read (iua,"(A8,I10,4F7.2,8F9.2,4E12.4)", iostat = ios) 1 saname(i),ipsm(i),alatsa(i),amltsa(i),alonsa(i),angsa(i), 2 dalatsa(i),dalonsa(i),dby(i),dbz(i),dbymdl(i),dbzmdl(i), 3 dbycomp(i),dbzcomp(i),wty(i),wtz(i),ersigdby(i),ersigdbz(i) enddo read (iua,"(10E12.5)", iostat = ios) (pot1(1,ith),ith=0,ithtrns) read (iua,"(10E12.5)", iostat = ios) (pot1(2,ith),ith=0,ithtrns) DO 9991 ITH=0,ITHTRNS read (iua,"(i3,f7.2)", iostat = ios) jth,clatdjth if (jth .ne. ith) then write (6,"(1x,'ith .ne. jth - stop',2i3,f7.2)") 1 ith,jth,clatdjth stop endif read (iua,"(10E12.4)",iostat = ios) (EKVMDL(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx EKVMDL(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (EFXMDL(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx EFXMDL(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (APEDMDL(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx APEDMDL(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (AHALMDL(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx AHALMDL(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (PEDRM(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx PEDRM(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (HALRM(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx HALRM(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (ESVP(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx ESVP(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (CVPOT(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx CVPOT(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (SIGPA(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx SIGPA(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (SIGP(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx SIGP(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (SIGHA(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx SIGHA(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (SIGH(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx SIGH(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (WPM2(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx WPM2(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (EMKEV(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx EMKEV(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (PKVMDL(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx PKVMDL(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (EESMDL(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx EESMDL(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (ENSMDL(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx ENSMDL(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (EMDL(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx EMDL(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (EVAR(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx EVAR(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (EFER(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx EFER(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (EFPOT(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx EFPOT(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (EE(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx EE(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (EEERR(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx EEERR(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (EN(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx EN(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (ENERR(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx ENERR(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (PSI(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx PSI(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (VPOT(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx VPOT(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (ZARR(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx ZARR(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (CPOT(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx CPOT(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (SIGPS(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx SIGPS(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (SIGHS(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx SIGHS(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (SIGPER(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx SIGPER(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (SIGHER(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx SIGHER(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (SIGR(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx SIGR(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (SMQJ(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx SMQJ(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (ERAR(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx ERAR(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (RVQJ(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx RVQJ(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (DEE(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx DEE(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (DEN(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx DEN(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (DEEP(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx DEEP(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (DENP(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx DENP(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (DEEH(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx DEEH(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (DENH(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx DENH(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (DFAC(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx DFAC(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (PSIP(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx PSIP(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (PSIH(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx PSIH(LON,ITH) = 0.0 enddo endif read (iua,"(10E12.4)",iostat = ios) (EMPR(LON,ITH),LON=0,LONMX) if (ios.ne.0) then do n = 0,lonmx EMPR(LON,ITH) = 0.0 enddo endif 9991 CONTINUE return end