subroutine PROFGEN_JONES c a (lyear,mon,iday,ih,im,tindex,r12,f107a,f107,ap,flat,flon) c c s/r to set up a Dudeney profile for use by the JONES program c written by leo mcnamara 23-mar-87 c----- last modified 2-mar-89 c c note that this is all single precision, except for hooks back c into the calling program c........................................................................ c c--- Requires files ips,layers,dudpro,dudsub,fixpntSP,msis83,ilios c ips loadgp,f2m3,tcon,gyro (single precision) c layers Elayer,solar,foeccir c F1layer,moddip,gdmd_interp,fof1OT c F2layer c dudpro c dudsub dimsol,hmax,ymax c interp (attached here) c fixpntsp c msis83 MSIS83 s/rs GTS4 etc c ilios c c--- required input data:- c lyear year (local time !) c mon month c iday UT day c ih UT hour c im UT minute c tindex ionospheric index, T c r12 12-month smoothed sunspot number c f107a 3-month average 10.7cm flux (for MSIS83) c f107 10.7cm flux for previous day c ap AP index - daily or array (See GTS4 listing) c flat geographic latitude of SKYLOC (negative for south) c flon EAST geographic longitude of SKYLOC c c--- output data c x,pxpr etc in labelled common /XX/ c real m3000 c-------------------------------Jones is real*8----------------- real*8 x,pxpr,r,w0,w,ff,hh,pxpth,pxpph,pxpt,hmax character*8 modx,id common r(6) /ww/ id(10),w0,w(400) common /xx/ modx(2),x,pxpr,pxpth,pxpph,pxpt,hmax c--------------------------------------------------------------- common / iondat / fof2,fof1,foe,hff2,m3000,hme,yme,hmf2, a ymf2,h0,xd,dv character*10 munth(12) dimension nday(12),ap(7) data munth / 'xgp.jan','xgp.feb','xgp.mar','xgp.apr', a 'xgp.may','xgp.jun','xgp.jul','xgp.aug','xgp.sep', a 'xgp.oct','xgp.nov','xgp.dec' / data nday / 31,28,31,30,31,30,31,31,30,31,30,31 / data nday / 31,28,31,30,31,30,31,31,30,31,30,31 / data ipass / 0 / c c...................... ENTRY ELECTX c...................... pi = 3.141592654 radeg = 180./pi ccc type*, r(1)-6370.,r(2)*radeg,r(3)*radeg c c bypass determination of profile parameters on second and subsequent c passes if(ipass.eq.1) go to 100 10 continue write(6,101) 101 format(//' enter UT year,month,day,hour,min -- yymmddhhmm'/) read(5,200) lyear,mon,iday,ih,im 200 format(5i2) if(lyear.eq.0) stop ' all done' c c lunmap logical unit number for IPS grid-point maps of fof2 & M(3000) lunmap = 8 cc open(unit=8,file='xgp.mar',status='old') open (unit=lunmap,file=munth(mon),status='old') c write(6,102) 102 format(//' enter Tindex & R12 -- 2f5.0'/) read(5,201) tindex,r12 write(6,106) 106 format(//' enter hFF2, the minimum value of h"F f5.0'/, a ' PRESS RETURN if no value available'/) read(5,201) hff2 if(hff2.gt.0.) go to 107 write(6,104) 104 format(//' enter f107a,f107 & Ap -- 3f5.0'/) read(5,201) f107a,f107,ap(1) 107 write(6,105) 105 format(//' enter lat & lon - 2f5.0'/) read(5,201)flat,flon 201 format(4f5.0) c c lundip logical unit number for grid-point maps of MODDIP etc lundip = 9 open(unit=9,file='gyro_gp_data.dat',status='old') c UT hour uthour = float(ih) + float(im)/60. c day of year (for MSIS83) idayno = iday if(mon.eq.1) go to 20 mon1 = mon - 1 do 11 i = 1,mon1 11 idayno = idayno + nday(i) if(mod(lyear,4).eq.0.and.mon.ge.3) idayno = idayno + 1 20 continue c c ccir formula relating r12 and flux12 (supp 252) flux12 = 63.7 + 0.728 * r12 + 0.00089 * r12 * r12 c use default values if none supplied if(f107a.le.0.0) f107a = flux12 if(f107 .le.0.0) f107 = flux12 c c calculate the local time (from UT) ndm = nday (mon) if(mod(lyear,4).eq.0.and.mon.eq.2) ndm = 29 lmon = mon time = ih + flon/15. + float(im)/60. lh = time lm = (time - lh) * 60 + 0.5 lday = iday if(lh.ge.24.and.flon.ge.180.) lday = lday - 1 if(lh.ge.24.and.flon.le.180.) lday = lday + 1 if(lday.gt.ndm) lmon = mon + 1 if(lday.gt.ndm) lday = 1 if(lmon.eq.13) lmon = 1 if(lh.ge.24) lh = lh - 24 if(lday.eq.0) lmon = lmon - 1 ndmm = nday(lmon) if(mod(lyear,4).eq.0.and.lmon.eq.2) ndmm = 29 if(lday.eq.0) lday = ndmm if(lmon.eq.0) lmon = 12 reflon = flon type*,' day no. & local time (ddhhmm)',idayno,lday,lh,lm hourlt = float(lh) + float(lm)/60. c c E-layer parameters call Elayer a (flux12,r12,lyear,lmon,lday,lh,lm,flat,flon,reflon, a chi,chi_noon,foe,yme,hme) type*,' E layer ', foe,yme,hme c make the D layer tangential to the E layer at 0.5MHz xd = 0.5 / foe c we don't need a D layer at night if(foe.lt.1.0) xd = 0. c c F1-layer parameters call F1layer ( lundip, a r12,lyear,lmon,lday,lh,lm,flat,flon,reflon, a chi_max,fof1,ymf1,hmf1) type*,' F1 layer ',fof1,ymf1,hmf1 c can't have E-F valley AND F1 layer dv = 0.1 if(fof1.ne.0.) dv = 0. c c F2-layer parameters call F2layer a (lunmap,mon,uthour,hourlt,idayno,flat,flon,foe,tindex,f107a, a f107,ap,fof2,ymf2,hmf2) type*,' F2 layer ', fof2,ymf2,hmf2 c c base of layer - 80km for day;set by DIMSOL to hme-yme if h0=0 h0 = 80. if(xd.le.0.) h0 = 0. c 100 continue ff = w(6) hh = r(1) - w(2) call dudney(ipass,ff,hh) ipass = 1 return end