module idea_composition
!-------------------------------------------------------------------------
! hold composition of O O2 N2
! Apr 06 2012 Henry Juang, initial implement into NEMS
! Mar 08 2012 Jun Wang, add fields for restart
! Oct 20 2015 Weiyu Yang, move f107 and kp to atmos/phys/wam_f107_kp_mod.
!-------------------------------------------------------------------------
implicit none
!hmhj save
real , parameter:: amo =15.9994 ! molecular wght of O ! (g/mol)
real , parameter:: amn2=28.013 ! molecular wght of N2
real , parameter:: amno=30.0061 ! molecular wght of N0
real , parameter:: bz=1.3806505e-23! Boltzmann constant
real prlog150(150),h2ora150(80),o3ra150(80)
real amgm(150),amgms(150) ! global mean wght of mix (g/mol)
real, allocatable:: pr_idea(:), prlog(:), ef(:)
real, allocatable:: h2ora(:),o3ra(:)
real, allocatable:: gg(:), prsilvl(:)
integer nlev_h2o,nlevc_h2o,nlev_co2,k41,k71,k110,k105,k100,k43
integer k91,k47,k64,k81,k87
!
data prlog150/-.010495013621173093,-.0047796645053569788, &
&.0017317939011674947, &
&.0091445549523354423,.017575964483718530,.027156409259219756, &
&.038029776798164390,.050354098813263921,.064301975566456532, &
&.080060604331725002,.097831430661753094,.11782928094771801, &
&.1402811398792534,.16542406580956714,.19350235130401269, &
&.22476418567991183,.25945740055444533,.29782445285326098, &
&.34009706723024435,.38649056296119455,.43719785635654262, &
&.49238384410129205,.55218040859471984,.61668213110539583, &
&.68594338857491133,.75997679704427235,.83875307597091064, &
&.92220240072958426,1.0102172332720634,1.1026563113455261, &
&1.1993493125965171,1.3001020446943199,1.4047022170280321, &
&1.5129293855161694,1.6245648325694693,1.7393953508635152, &
&1.8572172092097674,1.9778421006194884,2.1011027392385673, &
&2.2268591758946630,2.3550060174351386,2.4854802051244675, &
&2.6182709767607482,2.7534197208872264,2.8909811818384683, &
&3.0309947994264324,3.1734952229335223,3.3185141840359855, &
&3.4660806887940865,3.6162208681691572,3.7689579941351727, &
&3.9243126000728270,4.0823023952198705,4.2429421890712113, &
&4.4062440367083493,4.5722171074490712,4.7408678113152334, &
&4.9121997598293738,5.0862136813095233,5.2629074813405223, &
&5.4422762630064341,5.6243123514382578,5.8090052129405310, &
&5.9963414712632250,6.1863048973029393,6.3788765414713984, &
&6.5740346053768723,6.7717544276443897,6.9720085218050194, &
&7.1747665967259380,7.3799955384809381,7.5876594664001917, &
&7.7977196240960511,8.0101343615235372,8.2248592986929712, &
&8.4418472650864640,8.6610481622066615,8.8824091352082579, &
&9.1058744786331118,9.3313856279708016,9.5588812882688448, &
&9.7882972917212427,10.019566564224711,10.252619320659370, &
&10.487382934517129,10.723781889667228,10.961737871454984, &
&11.201169705433793,11.441993457513469,11.684122340664617, &
&11.927466717621803,12.171934093143912,12.417429143544323, &
&12.663853787366328,12.911107059366048,13.159085134752051, &
&13.407681405572704,13.656786420959016,13.906287867607862, &
&14.156070558238182,14.406016545469104,14.656016536601980, &
&14.906016520565826,15.156016549153117,15.406016561713120, &
&15.656016540294088,15.906016534936020,16.156016568807406, &
&16.406016534338949,16.656016529668964,16.906016577452895, &
&17.156016561083050,17.406016546123016,17.656016537621376, &
&17.906016506464592,18.156016518186942,18.406016541248878, &
&18.656016561606052,18.906016537947128,19.156016514271940, &
&19.406016513968229,19.656016519436953,19.906016540106812, &
&20.156016505341348,20.406016517771079,20.656016529319292, &
&20.906016501516998,21.156016508903946,21.406016525111486, &
&21.656016521424860,21.906016510407873,22.156016517462234, &
&22.406016507059238,22.656016506270586,22.906016547648477, &
&23.156016547534154,23.406016516157738,23.656016508155140, &
&23.906016513141179,24.156016519666711,24.406016497318937, &
&24.656016492779738,24.906016503952380,25.156016485200560, &
&25.406016484453687,25.656016491410533,25.906016498929535, &
&26.156016525642059,26.406016533196180,27.231955945328760/
! 71-150 in levs=150
data h2ora150/4.15074772E-06,4.13699000E-06,4.11797890E-06, &
&4.09487986E-06, &
&4.06858733E-06, 4.03597828E-06, 3.99688515E-06, 3.95067808E-06, &
&3.89717454E-06, 3.83486354E-06, 3.76154928E-06, 3.67776509E-06, &
&3.57952092E-06, 3.45696758E-06, 3.30616948E-06, 3.13086436E-06, &
&2.91936568E-06, 2.64976784E-06, 2.33136751E-06, 1.97812350E-06, &
&1.56715103E-06, 1.18281856E-06, 8.41511396E-07, 5.69260876E-07, &
&3.88780697E-07, 2.50438515E-07,1.54300660E-07, 1.02009581E-07, &
&6.65450034E-08, 4.17382808E-08, 2.82805186E-08, 2.01512556E-08, &
&1.41564448E-08, 1.02806445E-08, 7.94408149E-09, 6.32637731E-09, &
&5.12551203E-09, 4.27811892E-09, 3.70565449E-09, 3.31366890E-09, &
&3.03512593E-09, 2.86004858E-09, 3.14079315E-09, 3.43411317E-09, &
&3.75162719E-09, 4.09541203E-09, 4.46698364E-09, 4.86779007E-09, &
&5.29913960E-09,5.76212751E-09, 6.25754557E-09, 6.78577268E-09, &
&7.34664587E-09, 7.93931252E-09, 8.56206704E-09, 9.21217910E-09, &
&9.88572497E-09, 1.05774394E-08, 1.12806111E-08, 1.19870504E-08, &
&1.26871579E-08, 1.33701220E-08, 1.40242598E-08, 1.46374975E-08, &
&1.51979607E-08, 1.56946171E-08, 1.61178886E-08, 1.64601425E-08, &
&1.67159770E-08, 1.68822374E-08, 1.69577319E-08,1.69426375E-08, &
&1.68375826E-08, 1.66423366E-08, 1.63538713E-08, 1.59631314E-08, &
&1.54486221E-08, 1.47606491E-08, 1.37697900E-08, 6.83803988E-09/
!
! o3(71-150)
data o3ra150/4.10541952E-06,3.47100766E-06,2.87068966E-06, &
&2.35683753E-06, &
&1.96476323E-06,1.68001584E-06,1.46059012E-06,1.28086944E-06, &
& 1.12287103E-06,9.73440677E-07,8.31057093E-07,6.96823493E-07, &
& 5.70485075E-07,4.54900920E-07,3.51380290E-07,2.59055385E-07, &
& 1.83987938E-07,1.33985182E-07,9.93050813E-08,8.12517455E-08, &
& 1.04879335E-07,1.96984693E-07,3.40876799E-07,5.63920720E-07, &
& 8.83452184E-07,1.23309195E-06,1.61560931E-06,1.90510281E-06, &
& 2.00312741E-06,1.98334669E-06,1.75853471E-06,1.44161553E-06, &
& 1.11576928E-06,7.89776361E-07,5.25719302E-07,3.33307290E-07, &
& 1.90201852E-07,9.50490959E-08,4.25181927E-08,1.71517381E-08, &
& 6.31168787E-09,2.32353325E-09,2.00874504E-09,1.66279638E-09, &
& 1.36930561E-09,1.12419760E-09,9.19829659E-10,7.49814512E-10, &
& 6.08729657E-10,4.91976560E-10,3.95658450E-10,3.16475520E-10, &
& 2.51635148E-10,1.98775150E-10,1.55898314E-10,1.21316667E-10, &
& 9.36041570E-11,7.15566049E-11,5.41579312E-11,4.05517867E-11, &
& 3.00178145E-11,2.19518467E-11,1.58493829E-11,1.12917456E-11, &
& 7.93434889E-12,5.49657616E-12,3.75284443E-12,2.52454277E-12, &
& 1.67265129E-12,1.09096239E-12,6.99914181E-13,4.41092526E-13, &
& 2.72463151E-13,1.64366989E-13,9.62680762E-14,5.41996795E-14, &
& 2.88221148E-14,1.39894852E-14,5.72118432E-15,4.70438733E-16/
!
end module idea_composition
!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
! contains
!hmhj subroutine idea_composition_init(levs,ak,bk)
subroutine idea_composition_init(levs,plyr)
!-------------------------------------------------------------------------
! get O O2 N2 composition in idea_composition
!-------------------------------------------------------------------------
use idea_composition
implicit none
! Argument
integer, intent(in) :: levs ! number of pressure levels
real, intent(in) :: plyr(levs)
!hmhj real, intent(in) :: ak(levs+1),bk(levs+1) ! hyb levels
! local
integer k
!
if (.not.allocated(pr_idea)) then
print *,' plyr idea_composition_init ',(plyr(k),k=1,levs)
allocate (pr_idea(levs))
do k=1,levs
pr_idea(k) = plyr(k)/100. ! mb
enddo
endif
!
allocate (prlog(levs))
!
do k=1,levs
prlog (k) = log(1000./pr_idea(k))
print *,' idea_composition_init: k pr_idea prlog ',k,
& pr_idea(k),prlog(k)
enddo
!
allocate (h2ora(levs))
allocate (o3ra(levs))
!
! init h2o rad
if(levs.eq.150) then
k41=41
k110=110
k71=71
k105=105
k100=100
! co2
k43=43
! ion
k91=91
! merge
k47=47
k64=64
k81=81
k87=87
else
k71=levs
k81=levs
k87=levs
k91=levs
k100=levs
k105=levs
k110=levs
do k=3,levs-2
if(prlog(k).ge.prlog150(41).and.prlog(k-1).lt.prlog150(41)) &
& k41=k
if(prlog(k).ge.prlog150(71).and.prlog(k-1).lt.prlog150(71)) &
& k71=k
if(prlog(k).le.prlog150(110).and.prlog(k+1).gt.prlog150(110)) &
& k110=k
if(prlog(k).ge.prlog150(100).and.prlog(k-1).lt.prlog150(100)) &
& k100=k
if(prlog(k).le.prlog150(105).and.prlog(k+1).gt.prlog150(105)) &
& k105=k
if(prlog(k).ge.prlog150(43).and.prlog(k-1).lt.prlog150(43)) &
& k43=k
if(prlog(k).ge.prlog150(91).and.prlog(k-1).lt.prlog150(91)) &
& k91=k
if(prlog(k).ge.prlog150(47).and.prlog(k-1).lt.prlog150(47)) &
& k47=k
if(prlog(k).ge.prlog150(64).and.prlog(k-1).lt.prlog150(64)) &
& k64=k
if(prlog(k).ge.prlog150(81).and.prlog(k-1).lt.prlog150(81)) &
& k81=k
if(prlog(k).ge.prlog150(87).and.prlog(k-1).lt.prlog150(87)) &
& k87=k
enddo
endif
nlev_h2o=k110-k41+1
nlevc_h2o=levs-k71+1
nlev_co2=levs-k43+1
if(levs.eq.150) then
h2ora(k71:levs)=h2ora150
h2ora(1:k71-1)=0.
o3ra(k71:levs)=o3ra150
o3ra(1:k71-1)=0.
else
call idea_interp(h2ora150,71,150,80,h2ora,levs)
call idea_interp(o3ra150,71,150,80,o3ra,levs)
endif
return
end subroutine idea_composition_init
!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
subroutine idea_interp(ain,nps,npn,np,aout,levs)
use idea_composition
implicit none
real ain(np),aout(levs),z(np),z1(levs),dz
integer nps,npn,np,levs,kref,k,i
z(1:np)=prlog150(nps:npn)
z1=prlog
do k=1,levs
kref=0
do i=1,np-1
if(z1(k).ge.z(i).and.z1(k).le.z(i+1)) then
kref=i
dz=(z1(k)-z(i))/(z(i+1)-z(i))
endif
enddo
if(kref.ne.0) aout(k)=dz*ain(kref+1)+(1.-dz)*ain(kref)
enddo
return
end subroutine idea_interp