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 1-apr-87

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

	dimension nday(12),ap(7)

	data nday / 31,28,31,30,31,30,31,31,30,31,30,31 /

	data ipass / 0 /

c

c......................

	ENTRY ELECTX

c......................

c

c	bypass determination of profile parameters on second and subsequent

c	passes

	if(ipass.eq.1) go to 100

10	continue

c

c	ionospheric input is via unit 4

	open (unit=4,file='profxjon.dat',status='old')

c

c	write(6,101)

101	format(//' enter UT year,month,day,hour,min  --  yymmddhhmm'/)

	read(4,200) lyear,mon,iday,ih,im

	print*,' local time',lyear,mon,iday,ih,im

200	format(5i2)

	if(lyear.eq.0) stop ' all done'

c	write(6,102)

102	format(//' enter Tindex & R12  --  2f5.0'/)

	read(4,201) tindex,r12

c	write(6,106)

106	format(//' enter hFF2, the minimum value of h"F f5.0'/,

     a  '  PRESS RETURN if no value available'/)

c	read(4,201) hff2

c	if(hff2.gt.0.) go to 107

c	write(6,104)

104	format(//' enter f107a,f107 & Ap  --  3f5.0'/)

	read(4,201) hff2,f107a,f107,ap(1)

107	continue

c107	write(6,105)

105	format(//' enter lat & lon - 2f5.0'/)

	read(4,201)flat,flon

201	format(4f5.0)

	print*, ' IONOSPHERIC INPUT ', tindex,r12,f107a,f107

c

c	lunmap	logical unit number for IPS grid-point maps of fof2 & M(3000)

	lunmap = 8

	open(unit=8,file='xgp.oct',status='old')

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

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

	print*,' 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,foe,yme,hme)

	print*,' 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,fof1,ymf1,hmf1)

	print*,' 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)

	print*,' 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