diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..f7060dd --- /dev/null +++ b/.gitignore @@ -0,0 +1,42 @@ +#build and run directories +build/* +stdout/* +exec/* + + +## Compiled Object files +*.slo +*.lo +*.o +*.obj +*.pyc +*__genmod.f90 + +# Compiled Dynamic libraries +*.so +*.dylib +*.dll + +# Fortran module files +*.mod +*.smod + +# Compiled Static libraries +*.lai +*.la +*.a +*.lib + +# Executables +*.exe +*.out +*.app +*.x + +# Data files +*.mp4 +*.h5 +*.xmf +*.hdf +*.png +*.h5part \ No newline at end of file diff --git a/doc/description/jouleheat.tex b/doc/description/jouleheat.tex old mode 100755 new mode 100644 diff --git a/src/apex.F90 b/src/apex.F90 index 721b319..410412b 100644 --- a/src/apex.F90 +++ b/src/apex.F90 @@ -1881,19 +1881,19 @@ subroutine cofrm(date) integer,parameter :: n1=120, n2=195, isv=0 integer,parameter :: & ncn1=19, & ! number of coefficients dimensioned n1 - ncn2=7 ! number of coefficients dimensioned n2: increase with each IGRF update + ncn2=8 ! number of coefficients dimensioned n2: increase with each IGRF update integer,parameter :: ngh = n1*ncn1 + n2*ncn2 + 1 ! not sure why the extra +1 real,save :: g1(n1,ncn1), g2(n2,ncn2), gh(ngh) real,parameter :: alt = 0. - if (date < 1900. .or. date > 2030.) then - write(6,"('>>> cofrm: date=',f8.2,' Date must be >= 1900 and <= 2030')") date + if (date < 1900. .or. date > 2035.) then + write(6,"('>>> cofrm: date=',f8.2,' Date must be >= 1900 and <= 2035')") date stop 'cofrm' endif - if (date > 2025.) then + if (date > 2030.) then write(6,"('>>> WARNING cofrm:')") write(6,"(/,' This version of IGRF is intended for use up to ')") - write(6,"(' 2025. Values for ',f9.3,' will be computed but')") date + write(6,"(' 2030. Values for ',f9.3,' will be computed but')") date write(6,"(' may be of reduced accuracy.',/)") endif @@ -2377,56 +2377,92 @@ subroutine cofrm(date) -0.43, -0.36, -0.71/) g2(:,6) = (/ & ! 2020 - -29404.8, -1450.9, 4652.5, -2499.6, 2982.0, -2991.6, & - 1676.9, -734.6, 1363.2, -2381.2, -82.1, 1236.2, & - 241.9, 525.7, -543.4, 903.0, 809.5, 281.9, & - 86.3, -158.4, -309.4, 199.7, 48.0, -349.7, & - -234.3, 363.2, 47.7, 187.8, 208.3, -140.6, & - -121.2, -151.2, 32.3, 13.5, 98.8, 66.0, & - 65.5, -19.1, 72.9, 25.1, -121.5, 52.8, & - -36.2, -64.5, 13.5, 8.9, -64.7, 68.1, & - 80.6, -76.7, -51.5, -8.2, -16.9, 56.5, & - 2.2, 15.8, 23.5, 6.4, -2.2, -7.2, & - -27.2, 9.8, -1.8, 23.7, 9.7, 8.4, & - -17.5, -15.3, -0.5, 12.8, -21.1, -11.7, & - 15.3, 14.9, 13.7, 3.6, -16.5, -6.9, & - -0.3, 2.8, 5.0, 8.4, -23.4, 2.9, & - 11.0, -1.5, 9.8, -1.1, -5.1, -13.2, & - -6.3, 1.1, 7.8, 8.8, 0.4, -9.3, & - -1.4, -11.9, 9.6, -1.9, -6.2, 3.4, & - -0.1, -0.2, 1.7, 3.5, -0.9, 4.8, & + -29403.4, -1451.4, 4653.4, -2499.8, 2982.0, -2991.7, & + 1676.8, -734.6, 1363.0, -2380.8, -82.0, 1236.1, & + 241.8, 525.6, -542.5, 902.8, 809.5, 282.1, & + 86.2, -158.5, -309.5, 199.8, 47.4, -350.3, & + -234.4, 363.3, 47.5, 187.9, 208.4, -140.7, & + -121.4, -151.2, 32.1, 14.0, 99.1, 66.0, & + 65.6, -19.2, 73.0, 25.0, -121.6, 52.8, & + -36.1, -64.4, 13.6, 9.0, -64.8, 68.0, & + 80.5, -76.6, -51.5, -8.2, -16.9, 56.5, & + 2.4, 15.8, 23.6, 6.3, -2.2, -7.2, & + -27.2, 9.8, -1.9, 23.7, 9.7, 8.4, & + -17.5, -15.2, -0.5, 12.8, -21.1, -11.8, & + 15.3, 14.9, 13.7, 3.6, -16.6, -6.9, & + -0.3, 2.9, 5.0, 8.4, -23.4, 2.8, & + 11.0, -1.5, 9.9, -1.1, -5.1, -13.2, & + -6.2, 1.1, 7.8, 8.8, 0.4, -9.2, & + -1.4, -11.9, 9.6, -1.8, -6.2, 3.4, & + -0.1, -0.2, 1.7, 3.5, -0.9, 4.9, & 0.7, -8.6, -0.9, -0.1, 1.9, -4.3, & 1.4, -3.4, -2.4, -0.1, -3.8, -8.8, & - 3.0, -1.4, 0.0, -2.5, 2.5, 2.3, & - -0.6, -0.9, -0.4, 0.3, 0.6, -0.7, & + 3.0, -1.4, -0.0, -2.5, 2.5, 2.3, & + -0.6, -0.8, -0.4, 0.3, 0.6, -0.7, & -0.2, -0.1, -1.7, 1.4, -1.6, -0.6, & -3.0, 0.2, -2.0, 3.1, -2.5, -2.0, & - -0.1, -1.2, 0.4, 0.5, 1.3, 1.4, & - -1.1, -1.8, 0.7, 0.1, 0.3, 0.8, & - 0.5, -0.2, -0.3, 0.6, -0.5, 0.2, & - 0.1, -0.9, -1.1, -0.0, -0.3, 0.5, & - 0.1, -0.9, -0.9, 0.5, 0.6, 0.7, & + -0.1, -1.1, 0.4, 0.5, 1.3, 1.4, & + -1.1, -1.8, 0.7, 0.1, 0.3, 0.7, & + 0.5, -0.1, -0.3, 0.6, -0.5, 0.2, & + 0.1, -0.9, -1.1, -0.0, -0.3, 0.5, & + 0.1, -0.9, -0.9, 0.5, 0.6, 0.7, & 1.4, -0.3, -0.4, 0.8, -1.3, -0.0, & - -0.1, 0.8, 0.3, -0.0, -0.1, 0.4, & + -0.1, 0.8, 0.3, -0.1, -0.1, 0.4, & 0.5, 0.1, 0.5, 0.5, -0.4, -0.5, & - -0.3, -0.4, -0.6/) -! - g2(1:80,7) = (/ & ! 2022 - 5.7, 7.4, -25.9, -11.0, -7.0, -30.2, & - -2.1, -22.4, 2.2, -5.9, 6.0, 3.1, & - -1.1, -12.0, 0.5, -1.2, -1.5, -0.1, & - -5.9, 6.5, 5.2, 3.5, -5.1, -5.0, & - -0.3, 0.5, -0.0, -0.6, 2.5, 0.2, & - -0.6, 1.3, 3.0, 0.9, 0.3, -0.5, & - -0.3, 0.0, 0.4, -1.6, 1.3, -1.3, & - -1.4, 0.8, -0.0, 0.0, 0.9, 1.0, & - -0.1, -0.2, 0.6, -0.0, 0.6, 0.7, & - -0.8, 0.1, -0.2, -0.5, -1.1, -0.8, & - 0.1, 0.8, 0.3, -0.0, 0.1, -0.2, & - -0.1, 0.6, 0.4, -0.2, -0.1, 0.5, & - 0.4, -0.3, 0.3, -0.4, -0.1, 0.5, & - 0.4, 0.0/) - g2(81:n2,7) = 0.0 + -0.4, -0.4, -0.6/) + + g2(:,7) = (/ & ! 2025 + -29350.0, -1410.3, 4545.5, -2556.2, 2950.9, -3133.6, & + 1648.7, -814.2, 1360.9, -2404.2, -56.9, 1243.8, & + 237.6, 453.4, -549.6, 894.7, 799.6, 278.6, & + 55.8, -134.0, -281.1, 212.0, 12.0, -375.4, & + -232.9, 369.0, 45.3, 187.2, 220.0, -138.7, & + -122.9, -141.9, 42.9, 20.9, 106.2, 64.3, & + 63.8, -18.4, 76.7, 16.8, -115.7, 48.9, & + -40.9, -59.8, 14.9, 10.9, -60.8, 72.8, & + 79.6, -76.9, -48.9, -8.8, -14.4, 59.3, & + -1.0, 15.8, 23.5, 2.5, -7.4, -11.2, & + -25.1, 14.3, -2.2, 23.1, 10.9, 7.2, & + -17.5, -12.6, 2.0, 11.5, -21.8, -9.7, & + 16.9, 12.7, 14.9, 0.7, -16.8, -5.2, & + 1.0, 3.9, 4.7, 8.0, -24.8, 3.0, & + 12.1, -0.2, 8.3, -2.5, -3.4, -13.1, & + -5.3, 2.4, 7.2, 8.6, -0.6, -8.7, & + 0.8, -12.8, 9.8, -1.3, -6.4, 3.3, & + 0.2, 0.1, 2.0, 2.5, -1.0, 5.4, & + -0.5, -9.0, -0.9, 0.4, 1.5, -4.2, & + 0.9, -3.8, -2.6, 0.9, -3.9, -9.0, & + 3.0, -1.4, 0.0, -2.5, 2.8, 2.4, & + -0.6, -0.6, 0.1, 0.0, 0.5, -0.6, & + -0.3, -0.1, -1.2, 1.1, -1.7, -1.0, & + -2.9, -0.1, -1.8, 2.6, -2.3, -2.0, & + -0.1, -1.2, 0.4, 0.6, 1.2, 1.0, & + -1.2, -1.5, 0.6, 0.0, 0.5, 0.6, & + 0.5, -0.2, -0.1, 0.8, -0.5, 0.1, & + -0.2, -0.9, -1.2, 0.1, -0.7, 0.2, & + 0.2, -0.9, -0.9, 0.6, 0.7, 0.7, & + 1.2, -0.2, -0.3, 0.5, -1.3, 0.1, & + -0.1, 0.7, 0.2, 0.0, -0.2, 0.3, & + 0.5, 0.2, 0.6, 0.4, -0.6, -0.5, & + -0.3, -0.4, -0.5/) + +! + g2(1:80,8) = (/ & ! 2026 + 12.6, 10.0, -21.5, -11.2, -5.3, -27.3, & + -8.3, -11.1, -1.5, -4.4, 3.8, 0.4, & + -0.2, -15.6, -3.9, -1.7, -2.3, -1.3, & + -5.8, 4.1, 5.4, 1.6, -6.8, -4.1, & + 0.6, 1.3, -0.5, 0.0, 2.1, 0.7, & + 0.5, 2.3, 1.7, 1.0, 1.9, -0.2, & + -0.3, 0.3, 0.8, -1.6, 1.2, -0.4, & + -0.8, 0.8, 0.4, 0.7, 0.9, 0.9, & + -0.1, -0.1, 0.6, -0.1, 0.5, 0.5, & + -0.7, -0.1, 0.0, -0.8, -0.9, -0.8, & + 0.5, 0.9, -0.3, -0.1, 0.2, -0.3, & + 0.0, 0.4, 0.4, -0.3, -0.1, 0.4, & + 0.3, -0.5, 0.1, -0.6, 0.0, 0.3, & + 0.3, 0.2/) + g2(81:n2,8) = 0.0 ! ! Set gh from g1,g2: ! @@ -2442,7 +2478,7 @@ subroutine cofrm(date) enddo gh(ngh) = 0. ! not sure why gh is dimensioned with the extra element, so set it to 0. - if (date < 2020.) then + if (date < 2025.) then t = 0.2*(date - 1900.) ll = t one = ll @@ -2464,18 +2500,18 @@ subroutine cofrm(date) tc = -0.2 t = 0.2 endif - else ! date >= 2020 - t = date - 2020.0 + else ! date >= 2025 + t = date - 2025.0 tc = 1.0 if (isv.eq.1) then t = 1.0 tc = 0.0 end if - ll = 3255 + ll = 3450 nmx = 13 nc = nmx*(nmx+2) kmx = (nmx+1)*(nmx+2)/2 - endif ! date < 2020 + endif ! date < 2025 r = alt l = 1 m = 1 diff --git a/src/aurora.F b/src/aurora.F index 46093f1..59adc8a 100644 --- a/src/aurora.F +++ b/src/aurora.F @@ -458,6 +458,7 @@ subroutine aurora(o2,o1,he,n2,xnmbar,scht, use amie_module,only: amie_aurbound=>aurbound use subaur_module,only: subaur_drift use fields_module,only: ui,vi + use addfld_module,only: addfld ! ! Args: integer,intent(in) :: @@ -479,14 +480,13 @@ subroutine aurora(o2,o1,he,n2,xnmbar,scht, | s20 = .34906585, | pi_cusp = 3.1415927, ! hard-wired by tgcm15 | s10 = 0.174532925 - integer :: i,lat,im2 + integer :: i,lat,im2,k real :: aurlat ! boundary lat below which auroral is not calculated ! (32.5 degrees at 5 degree resolution) real :: ofda,cosofa,sinofa,aslona,skp,vns,ves,vvs, | aurbound, ! equatorward auroral boundary for SAPS calculation | smlt, ! magnetic local time for SAPS calculation | smlat, ! latitude of the equatorward boundary of aurora - | sui,svi,swi, ! SAPS ion drifts | sinlat, coslat, ! sin,cos of dlat_aur (rlatm) magnetic latitude | coslon, sinlon, ! sin,cos of dlon_aur+offset | cusplon, ! longitude of cusp @@ -497,11 +497,16 @@ subroutine aurora(o2,o1,he,n2,xnmbar,scht, | dtheta, ! latitudinal variation (Gaussian) | aurspread, ! Gaussian spread: exp(-(dtheta/halfwidth)**2) | clat + real,dimension(lon0:lon1,lat0:lat1) :: sui,svi,swi ! SAPS ion drifts ! #ifdef VT ! code = 130 ; state = 'aurora' ; activity='ModelCode' call vtbegin(130,ier) #endif +! + sui = 0. + svi = 0. + swi = 0. ! do lat=lat0,lat1 do i=lon0,lon1 @@ -651,28 +656,44 @@ subroutine aurora(o2,o1,he,n2,xnmbar,scht, else skp = kp endif - if (saps .and. skp>=1. .and. skp<=9) then - sui = 0. - svi = 0. - swi = 0. + if (saps .and. skp>=0 .and. skp<=9) then if (smlat>0. .and. smlat<10.) then call subaur_drift(smlt,smlat,skp,vns,ves,vvs) if (ihem == 1) then ! southern hemisphere, ihem=1 - sui = -ves*csdec(i,lat) - vns*sndec(i,lat) - svi = ves*sndec(i,lat) - vns*csdec(i,lat) + sui(i,lat) = -ves*csdec(i,lat) - vns*sndec(i,lat) + svi(i,lat) = ves*sndec(i,lat) - vns*csdec(i,lat) else ! northern hemisphere, ihem=2 - sui = -ves*csdec(i,lat) + vns*sndec(i,lat) - svi = ves*sndec(i,lat) + vns*csdec(i,lat) + sui(i,lat) = -ves*csdec(i,lat) + vns*sndec(i,lat) + svi(i,lat) = ves*sndec(i,lat) + vns*csdec(i,lat) endif - swi = vvs + swi(i,lat) = vvs endif -! Add SAPS drift to ion velocities (m/s to cm/s) - ui(lev0:lev1,i,lat) = ui(lev0:lev1,i,lat)+sui*100. - vi(lev0:lev1,i,lat) = vi(lev0:lev1,i,lat)+svi*100. -! wi(lev0:lev1,i,lat) = wi(lev0:lev1,i,lat)+swi*100. endif enddo enddo +! +! Add SAPS drift to ion velocities (m/s to cm/s) + if (saps) then + do lat=lat0,lat1 + call addfld('UI_wo_SAPS','ion drift without SAPS','cm/s', + | ui(:,lon0:lon1,lat),'lev',lev0,lev1,'lon',lon0,lon1,lat) + call addfld('VI_wo_SAPS','ion drift without SAPS','cm/s', + | vi(:,lon0:lon1,lat),'lev',lev0,lev1,'lon',lon0,lon1,lat) + do i=lon0,lon1 + do k=lev0,lev1 + ui(k,i,lat) = ui(k,i,lat)+sui(i,lat)*100. + vi(k,i,lat) = vi(k,i,lat)+svi(i,lat)*100. +! wi(k,i,lat) = wi(k,i,lat)+swi(i,lat)*100. + enddo + enddo + enddo + call addfld('UI_SAPS','SAPS ion drift','m/s',sui, + | 'lon',lon0,lon1,'lat',lat0,lat1,0) + call addfld('VI_SAPS','SAPS ion drift','m/s',svi, + | 'lon',lon0,lon1,'lat',lat0,lat1,0) + call addfld('WI_SAPS','SAPS ion drift','m/s',swi, + | 'lon',lon0,lon1,'lat',lat0,lat1,0) + endif ! do lat=lat0,lat1 ! diff --git a/src/chemrates.F b/src/chemrates.F index 03d2c54..6c3d355 100644 --- a/src/chemrates.F +++ b/src/chemrates.F @@ -44,7 +44,7 @@ module chemrates_module | rk27 = 7.7E-5, ! ! Neutral chemistry: - | beta2 = 5.0E-12, ! N2D + O2 -> NO + O1D + 1.84 eV +! | beta2 = 5.0E-12, ! N2D + O2 -> NO + O1D + 1.84 eV | beta4 = 7.0E-13, ! N2D + O -> N4S + O + 2.38 eV | beta6 = 7.0E-11, ! N2D + NO -> N2 + O + 5.63 eV | beta7 = 1.06E-5 ! N2D -> N4S + hv @@ -66,6 +66,7 @@ module chemrates_module ! ! Neutral chemistry: | beta1, ! N4S + O2 -> NO + O + 1.4 eV + | beta2, ! N2D + O2 -> NO + O1D + 1.84 eV | beta3, ! N4S + NO -> N2 + O + 3.25 eV | beta5, ! N2D + e -> N4S + e + 2.38 eV | beta8, ! NO + hv -> N4S + O @@ -113,6 +114,9 @@ subroutine alloc_tdep allocate(beta1(nlevp1,lon0:lon1,lat0:lat1),stat=istat) if (istat /= 0) write(6,"('>>> alloc_tdep: error allocating', | ' beta1: stat=',i3)") istat + allocate(beta2(nlevp1,lon0:lon1,lat0:lat1),stat=istat) + if (istat /= 0) write(6,"('>>> alloc_tdep: error allocating', + | ' beta2: stat=',i3)") istat allocate(beta3(nlevp1,lon0:lon1,lat0:lat1),stat=istat) if (istat /= 0) write(6,"('>>> alloc_tdep: error allocating', | ' beta3: stat=',i3)") istat @@ -158,7 +162,7 @@ subroutine chemrates_tdep(tn,te,ti,fno2,fnvo2,lev0,lev1,lon0,lon1, ! ! Calculate temperature-dependent reaction rates (called at each latitude) ! - use input_module,only: f107 ! 10.7 cm flux (from input and/or gpi) + use input_module,only: duff,f107 ! 10.7 cm flux (from input and/or gpi) use init_module,only: sfeps ! flux variation from orbital excentricity use cons_module,only: check_exp ! @@ -253,6 +257,13 @@ subroutine chemrates_tdep(tn,te,ti,fno2,fnvo2,lev0,lev1,lon0,lon1, ! beta1: N4S + O2 -> NO + O + 1.4 eV beta1(k,i,lat) = 1.5E-11*exp(-3600./tn(k,i)) ! +! New reaction rate from Duff et al. (2003), suggested by Sheng et al. (2017) + if (duff) then + beta2(k,i,lat) = 6.2e-12*tn(k,i)/300. + else + beta2(k,i,lat) = 5e-12 + endif +! ! beta3: N4S + NO -> N2 + O + 3.25 eV beta3(k,i,lat) =3.4e-11*sqrt(tn(k,i)/300.) ! diff --git a/src/colath.F b/src/colath.F index e6d64e7..8932e3d 100644 --- a/src/colath.F +++ b/src/colath.F @@ -13,39 +13,60 @@ subroutine colath | crit, ! critical colatitudes crit(2) | ylonm,ylatm ! magnetic grid lons, lats use pdynamo_module,only: nmlat0,pfrac ! pfrac is output - use params_module,only: nmlonp1 + use params_module,only: nmlonp1,rp use mage_coupling_module,only: aurllbN,aurllbS ! colat in degrees implicit none ! ! Local: integer :: i,j - real :: sinlat,coslat,aslonc,ofdc,cosofc,sinofc,crit1deg - real,dimension(nmlonp1,nmlat0) :: colatc + real(rp) :: sinlat,coslat,aslonc,ofdc,cosofc,sinofc,crit1deg + real(rp),dimension(nmlonp1,nmlat0) :: colatc #ifdef GAMERA ! Lin, 09/2021: Use dynamic auroral boundary defined by the lowest lat where numflux<1e6 - crit(1) = (max(aurllbN,aurllbS)+5.)/rtd + !crit(1) = (max(aurllbN,aurllbS)+5._rp)/rtd ! Lin, 10/2021: using 5 deg wide merging zone tends to ! produce artificial eastward wind and drift bands at mid latitudes - crit(2) = crit(1)+10./rtd + !crit(2) = crit(1)+10._rp/rtd + crit1deg = max(aurllbN,aurllbS) + ! at low colat, the merge zone is 10deg wide and is offset 5 deg from aurbc + ! at high colat, the merge zone is 5 deg wide and starts at aurbc + ! starts at 15 degree + !crit(1) = crit1deg+max(7.5_rp+crit1deg*(-5._rp/30._rp),-5._rp) + crit(1) = crit1deg + 5._rp + !crit(1) = crit1deg + crit(1) = max(crit(1),15._rp)/rtd + ! starts at 25 degree + !crit(2) = crit1deg+max(20._rp+crit1deg*(-10._rp/30._rp),5._rp) + !crit(2) = max(crit(2),25._rp)/rtd + crit(2) = crit(1) + 10._rp/rtd +! crit1deg = max(aurllbN,aurllbS) +! if (crit1deg .le. 45._rp) then +! crit(1) = crit1deg+max(7.5_rp+ +! | crit1deg*(-5._rp/30._rp),-5._rp) +! crit(2) = crit(1) + 10._rp/rtd +! else +! crit(1) = 45._rp/rtd +! crit(2) = crit(1) + (crit1deg*0.5_rp-12.5_rp)/rtd +! endif #else ! 01/11 bae: Revise crit in rad so crit(1)=theta0(=crad in rad)+5deg, crit(2)=crit(1)+15deg - crit1deg = max(15.,0.5*(theta0(1)+theta0(2))*rtd + 5.) - crit1deg = min(30.,crit1deg) + crit1deg = max(15._rp,0.5_rp*(theta0(1)+theta0(2))*rtd + 5._rp) + crit1deg = min(30._rp,crit1deg) ! To make the same as in cons.F, comment out next line crit(1) = crit1deg/rtd - crit(2) = crit(1) + 15./rtd + crit(2) = crit(1) + 15._rp/rtd #endif ! ! offc(2), dskofc(2) are for northern hemisphere aurora (see aurora.F) ! 01/11 bae: Revised so that use average of both hemispheres instead of NH only ! ofdc = sqrt(offc(2)**2+dskofc(2)**2) - ofdc = sqrt((0.5*(offc(1)+offc(2)))**2 + - | (0.5*(dskofc(1)+dskofc(2)))**2) + ofdc = sqrt((0.5_rp*(offc(1)+offc(2)))**2 + + | (0.5_rp*(dskofc(1)+dskofc(2)))**2) cosofc = cos(ofdc) sinofc = sin(ofdc) - aslonc = asin(0.5*(dskofc(1)+dskofc(2))/ofdc) + aslonc = asin(0.5_rp*(dskofc(1)+dskofc(2))/ofdc) ! TEMP ! write (6,"(1x,'COLATH: crit1,2 dskofc offc deg=',6e12.4)") ! | crit(1)*rtd,crit(2)*rtd,dskofc(1)*rtd,offc(1)*rtd, @@ -70,8 +91,8 @@ subroutine colath ! do i=1,nmlonp1 pfrac(i,j) = (colatc(i,j)-crit(1))/(crit(2)-crit(1)) - if (pfrac(i,j) < 0.) pfrac(i,j) = 0. - if (pfrac(i,j) >= 1.) pfrac(i,j) = 1. + if (pfrac(i,j) < 0._rp) pfrac(i,j) = 0._rp + if (pfrac(i,j) >= 1._rp) pfrac(i,j) = 1._rp enddo ! i=1,nmlonp1 ! write(6,"('colath: j=',i3,' colatc(:,j)=',/,(6e12.4))") diff --git a/src/comp_n2d.F b/src/comp_n2d.F index 1b4da69..f185184 100644 --- a/src/comp_n2d.F +++ b/src/comp_n2d.F @@ -108,7 +108,7 @@ subroutine comp_n2d(o2,o1,no,ne,op,n2p,nop,xnmbar,xnmbari, n2d_lbc(i,3,lat) = -rmass_n2d/xnmbari(lev0,i)* | qtef(lev0,i,lat)*brn2d/ | (xnmbari(lev0,i)* - | (beta2*o2(lev0,i)*rmassinv_o2+ + | (beta2(lev0,i,lat)*o2(lev0,i)*rmassinv_o2+ | beta4*o1(lev0,i)*rmassinv_o1+ | beta6*no(lev0,i)*rmassinv_no)+ | beta7+beta5(lev0,i,lat)*ne(lev0,i)) @@ -127,7 +127,7 @@ subroutine comp_n2d(o2,o1,no,ne,op,n2p,nop,xnmbar,xnmbari, ! ! Total loss of N2D: n2d_loss(k,i,lat) = -(xnmbar(k,i)* - | (beta2*o2(k,i)*rmassinv_o2+ + | (beta2(k,i,lat)*o2(k,i)*rmassinv_o2+ | beta4*o1(k,i)*rmassinv_o1+ | beta6*no(k,i)*rmassinv_no)+ | beta7+beta5(k,i,lat)*sqrt(ne(k,i)*ne(k+1,i))+ diff --git a/src/comp_no.F b/src/comp_no.F index 28a1f0c..65a9492 100644 --- a/src/comp_no.F +++ b/src/comp_no.F @@ -104,8 +104,8 @@ subroutine comp_no(o2,o1,n2,xnmbar,xnmbari,n4s,n2d,o2p, do k=lev0,lev1-1 ! no_prod(k,i,lat) = xnmbar(k,i)**2*o2(k,i)*rmassinv_o2* - | (beta1(k,i,lat)*n4s(k,i)*rmassinv_n4s+beta2*n2d(k,i)* - | rmassinv_n2d) + | (beta1(k,i,lat)*n4s(k,i)*rmassinv_n4s+ + | beta2(k,i,lat)*n2d(k,i)*rmassinv_n2d) ! no_prod(k,i,lat) = no_prod(k,i,lat)+xnmbar(k,i)**3* | beta17(k,i,lat)*o1(k,i)*rmassinv_o1*n2(k,i)* diff --git a/src/comp_o2o.F b/src/comp_o2o.F index 70c37f6..f30fd19 100644 --- a/src/comp_o2o.F +++ b/src/comp_o2o.F @@ -94,7 +94,7 @@ subroutine comp_o2o(o1,mbar,xnmbar,op,no,n4s,n2d,o2p,ne, | sqrt(ne(k,i)*ne(k+1,i)) ! s2 pox2(k,i) = xnmbar(k,i)*(beta1(k,i,lat)*n4s(k,i)/rmass_n4s+ - | beta2*n2d(k,i)/rmass_n2d)+rk1(k,i,lat)*op(k,i)+rk7* + | beta2(k,i,lat)*n2d(k,i)/rmass_n2d)+rk1(k,i,lat)*op(k,i)+rk7* | nplus(k,i)+2.*rji(k,i) ! ! OX loss: @@ -110,8 +110,8 @@ subroutine comp_o2o(o1,mbar,xnmbar,op,no,n4s,n2d,o2p,ne, ! ! O2 loss: lo21(k,i) = xnmbar(k,i)*(beta1(k,i,lat)*n4s(k,i)/rmass_n4s+ - | beta2*n2d(k,i)/rmass_n2d)+rk1(k,i,lat)*op(k,i)+(rk6+rk7)* - | nplus(k,i)+rk9*n2p(k,i)+rji(k,i) + | beta2(k,i,lat)*n2d(k,i)/rmass_n2d)+rk1(k,i,lat)*op(k,i)+ + | (rk6+rk7)*nplus(k,i)+rk9*n2p(k,i)+rji(k,i) ! lo22(k,i) = qo2pi(k,i) ! diff --git a/src/cons.F b/src/cons.F index 9d8c58d..3d10690 100644 --- a/src/cons.F +++ b/src/cons.F @@ -340,20 +340,31 @@ subroutine init_cons chunk_array = (/3,3,9,9,18,18,36,36,72,72/) elseif (nlat==144 .and. nlon==288) then default_step = 10.0_rp - nlat_filter = 21 + nlat_filter = 21 !15 allocate(chunk_array(nlat_filter)) chunk_array = (/3,3,3,9,9,9,18,18,18, | 36,36,36,72,72,72,72,144,144,144,144,144/) +! chunk_array = (/9,18,18, +! | 36,36,36, +! | 72,72,72, +! | 144,144,144,144,144,144/) elseif (nlat==288 .and. nlon==576) then default_step = 5.0_rp - nlat_filter = 40 +! nlat_filter = 40 +! allocate(chunk_array(nlat_filter)) +! chunk_array = (/3,3,3,3,3,9,9,9,9,9, +! | 18,18,18,18,18,18,36,36,36,36,36,36,72,72,72,72,72,72, +! | 144,144,144,144,144,144,288,288,288,288,288,288/) + nlat_filter = 34 allocate(chunk_array(nlat_filter)) - chunk_array = (/3,3,3,3,3,9,9,9,9,9, - | 18,18,18,18,18,18,36,36,36,36,36,36,72,72,72,72,72,72, + chunk_array = (/3,3,3,9,9,9, + | 18,18,18,36,36,36,36,36, + | 72,72,72,72,72,72,72,72, | 144,144,144,144,144,144,288,288,288,288,288,288/) else call shutdown('Unknown combination of lat x lon') endif + write(*,*) "CHUNK_ARRAY: ",chunk_array ! ! shapiro = dt/def*smooth_fac smooth_fac = 3.e-3_rp diff --git a/src/dt.F b/src/dt.F index e76583e..5ccde70 100644 --- a/src/dt.F +++ b/src/dt.F @@ -368,7 +368,7 @@ subroutine dt(tn,tn_nm,un,vn,o1,mbar,xnmbar,scht,schti, | dt_joule(lev0:lev1-1,:),'lev',lev0,lev1-1,'lon',lon0,lon1,lat) call addfld('DT_MOLDIF','Molecular diffusive heating','erg/g/s', | dt_moldif(lev0:lev1-1,:),'lev',lev0,lev1-1,'lon',lon0,lon1,lat) - call addfld('DT_COOL','Newtonian cooling','K/s', + call addfld('DT_COOL','Radiative cooling','K/s', | dt_cool(lev0:lev1-1,:),'lev',lev0,lev1-1,'lon',lon0,lon1,lat) call addfld('DT_HORADV','Horizontal advective heating','K/s', | -horadv_tn(lev0:lev1-1,:,lat), diff --git a/src/duv.F b/src/duv.F old mode 100755 new mode 100644 diff --git a/src/dynamics.F b/src/dynamics.F index bc70ae2..3f41701 100644 --- a/src/dynamics.F +++ b/src/dynamics.F @@ -19,7 +19,8 @@ subroutine dynamics(nstep,istep) ! change call to qjoule_tn to include vertical velocity ! use fields_module - use mpi_module,only: lon0,lon1,lat0,lat1,distribute_1d,mp_close + use mpi_module,only: lon0,lon1,lat0,lat1,distribute_1d,mp_close, + | mp_polelats_f3d,mp_bndlats_f3d,mp_bndlons_f3d use chemrates_module,only: chemrates_tdep use qrj_module,only: qrj,qtotal,qop,qo2p,qn2p,qnp,qnop use chapman_module,only: chapman @@ -36,7 +37,7 @@ subroutine dynamics(nstep,istep) use qjoule,only: qjoule_tn,qjoule_ti use diags_module,only: mkdiag_CUSP,mkdiag_DRIZZLE,mkdiag_ALFA, | mkdiag_NFLUX,mkdiag_EFLUX,mkdiag_TEC,mkdiag_HNMF2, - | mkdiag_QJOULE_INTEG + | mkdiag_QJOULE_INTEG,mkdiag_UI,mkdiag_VI,mkdiag_WI use dyndiag_module,only: dyndiag implicit none @@ -51,7 +52,7 @@ subroutine dynamics(nstep,istep) #endif ! ! Local: - integer :: lat,ier,itp_sub,itc_sub,istep_sub,itmp + integer :: lat,ier integer :: i0,i1,nk,nkm1,nlats,k0,k1 logical,parameter :: debug=.false. ! add prints to stdout ! @@ -68,8 +69,6 @@ subroutine dynamics(nstep,istep) ! logical,parameter :: diags=.true. ! put fields on sec hist real :: time0,time1,time1_qrj,time1_cmpminor,time1_cmpmajor - real,dimension(levd0:levd1,lond0:lond1,latd0:latd1,2) :: - | op_i,op_nm_i real,dimension(lon0:lon1,lat0:lat1) :: | tec ! diagnostic total electron content logical,external :: time2print @@ -293,6 +292,14 @@ subroutine dynamics(nstep,istep) | write(6,"('Time in QRJ = ', | f12.2,' Dynamics: step ',i5)") time1_qrj,istep ! +! Save ion drifts if requested: + call mkdiag_UI('UI_ExB',ui(:,lon0:lon1,lat0:lat1), + | 1,nlevp1,lon0,lon1,lat0,lat1) + call mkdiag_VI('VI_ExB',vi(:,lon0:lon1,lat0:lat1), + | 1,nlevp1,lon0,lon1,lat0,lat1) + call mkdiag_WI('WI_ExB',wi(:,lon0:lon1,lat0:lat1), + | 1,nlevp1,lon0,lon1,lat0,lat1) +! #ifdef VT ! code = 122 ; state = 'ions' ; activity='ModelCode' call vtend(122,ier) @@ -304,47 +311,44 @@ subroutine dynamics(nstep,istep) ! Full task subdomains (including ghost cells) are passed. ! call timer(time0,time1,'OPLUS',0,0) ! start oplus timing - itp_sub = itp - itc_sub = itc - op_i = op - op_nm_i = op_nm -! O+ sub-cycling, Dang, 2017 - do istep_sub=1,nstep_sub - call oplus( - | tn (levd0,lond0,latd0,itp), - | te (levd0,lond0,latd0,itp), - | ti (levd0,lond0,latd0,itp), - | o2 (levd0,lond0,latd0,itp), - | o1 (levd0,lond0,latd0,itp), - | he (levd0,lond0,latd0,itp), - | n2 (levd0,lond0,latd0), - | n2d (levd0,lond0,latd0,itp), - | ne (levd0,lond0,latd0,itp), - | un (levd0,lond0,latd0,itp), - | vn (levd0,lond0,latd0,itp), - | w (levd0,lond0,latd0,itp), - | ui (levd0,lond0,latd0), - | vi (levd0,lond0,latd0), - | wi (levd0,lond0,latd0), - | xnmbar(levd0,lond0,latd0,itp), - | scht (levd0,lond0,latd0,itp), - | op_i (levd0,lond0,latd0,itp_sub), - | op_nm_i(levd0,lond0,latd0,itp_sub), - | op_i (levd0,lond0,latd0,itc_sub), ! out - | op_nm_i(levd0,lond0,latd0,itc_sub), ! out - | xiop2p(levd0,lond0,latd0), ! out - | xiop2d(levd0,lond0,latd0), ! out - | Fe (levd0,lond0,latd0), ! out - | Fn (levd0,lond0,latd0), ! out - | 1,nlevp1,lon0,lon1,lat0,lat1) - if (istep_sub /= nstep_sub) then - itmp = itp_sub - itp_sub = itc_sub - itc_sub = itmp - endif - enddo - op(:,:,:,itc) = op_i(:,:,:,itc_sub) - op_nm(:,:,:,itc) = op_nm_i(:,:,:,itc_sub) +! +! Make latitudes j=-1,0 from j=2,1, and j=nlat+1,nlat+2 from nlat-1,nlat for n2, +! then define 2d halos points. Note that mp_geo_halos_f3d and mp_polelats_f3d +! do not define "outside corner" halo points, but this should be ok since +! cross-derivatives are not performed. +! + call mp_polelats_f3d(n2(:,lon0:lon1,:), ! 3rd dim is lat0-2:lat1+2 + | 1,nlevp1,lon0,lon1,lat0,lat1,1,(/1./)) ! last arg means no change in polesign + call mp_bndlats_f3d(n2,nk,lon0,lon1,lat0,lat1,1) + call mp_bndlons_f3d(n2,nk,lon0,lon1,lat0,lat1,1,0) +! + call oplus( + | tn (levd0,lond0,latd0,itp), + | te (levd0,lond0,latd0,itp), + | ti (levd0,lond0,latd0,itp), + | o2 (levd0,lond0,latd0,itp), + | o1 (levd0,lond0,latd0,itp), + | he (levd0,lond0,latd0,itp), + | n2 (levd0,lond0,latd0), + | n2d (levd0,lond0,latd0,itp), + | ne (levd0,lond0,latd0,itp), + | un (levd0,lond0,latd0,itp), + | vn (levd0,lond0,latd0,itp), + | w (levd0,lond0,latd0,itp), + | ui (levd0,lond0,latd0), + | vi (levd0,lond0,latd0), + | wi (levd0,lond0,latd0), + | xnmbar(levd0,lond0,latd0,itp), + | scht (levd0,lond0,latd0,itp), + | op (levd0,lond0,latd0,itp), + | op_nm (levd0,lond0,latd0,itp), + | op (levd0,lond0,latd0,itc), ! out + | op_nm (levd0,lond0,latd0,itc), ! out + | xiop2p(levd0,lond0,latd0), ! out + | xiop2d(levd0,lond0,latd0), ! out + | Fe (levd0,lond0,latd0), + | Fn (levd0,lond0,latd0), + | 1,nlevp1,lon0,lon1,lat0,lat1) if (debug) write(6,"('dynamics after oplus')") call timer(time0,time1,'OPLUS',1,0) ! end oplus timing if (timing%level >= 2.and.time2print(nstep,istep)) diff --git a/src/elden.F b/src/elden.F index c56887a..2f05387 100644 --- a/src/elden.F +++ b/src/elden.F @@ -15,13 +15,14 @@ subroutine elden(xnmbar,op,op_upd,o2,o1,n2,n2d,no,n4s,xiop2p, | rk9,rk10,rk16,rk23,rk26,beta9,ra1,ra2,ra3 use qrj_module,only: qnp,qnop,qo2p,qn2p use addfld_module,only: addfld + use params_module,only: rp implicit none ! ! Args: integer,intent(in) :: lev0,lev1,lon0,lon1,lat ! ! Input args: press vs longitude input fields (2d (k,i)): - real,dimension(lev0:lev1,lon0-2:lon1+2),intent(in) :: + real(rp),dimension(lev0:lev1,lon0-2:lon1+2),intent(in) :: | xnmbar,! for conversion from mmr to cm3 | op, ! O+ ion (current time-step) | op_upd,! O+ ion (updated, from sub oplus) @@ -35,7 +36,7 @@ subroutine elden(xnmbar,op,op_upd,o2,o1,n2,n2d,no,n4s,xiop2p, | xiop2d ! from oplus ! ! Output args (particles/cm3): - real,dimension(lev0:lev1,lon0-2:lon1+2),intent(out) :: + real(rp),dimension(lev0:lev1,lon0-2:lon1+2),intent(out) :: | nplus, ! N+ output | n2p, ! N2+ output | nop, ! NO+ output @@ -44,12 +45,14 @@ subroutine elden(xnmbar,op,op_upd,o2,o1,n2,n2d,no,n4s,xiop2p, ! ! Local: integer :: k,i,i0,i1 - real,dimension(lev0:lev1,lon0:lon1) :: + real(rp),dimension(lev0:lev1,lon0:lon1) :: | a0,a1,a2,a3,a4, ! coefficients for quartic solver | a,b,c,d,e,fg,h, ! terms for quartic coefficients | root, ! output from quartic solver | o2_cm3,o1_cm3 + real(rp) :: nelimit = 100._rp + ! write(6,"('enter elden: lat=',i2)") lat i0 = lon0 ; i1 = lon1 ! @@ -82,8 +85,8 @@ subroutine elden(xnmbar,op,op_upd,o2,o1,n2,n2d,no,n4s,xiop2p, ! Cap minimum O1 number density here to prevent N+ explosion. o2_cm3(k,i) = o2(k,i)*rmassinv_o2*xnmbar(k,i) o1_cm3(k,i) = o1(k,i)*rmassinv_o1*xnmbar(k,i) - if (o1_cm3(k,i) < 1e6) o1_cm3(k,i) = 1e6 - nplus(k,i) = (0.5*(qnp(k,i,lat)+qnp(k+1,i,lat))+ + if (o1_cm3(k,i) < 1e6_rp) o1_cm3(k,i) = 1e6_rp + nplus(k,i) = (0.5_rp*(qnp(k,i,lat)+qnp(k+1,i,lat))+ | rk10*op(k,i)*n2d(k,i)*xnmbar(k,i)*rmassinv_n2d) / | ((rk6+rk7)*o2_cm3(k,i)+rk8*o1_cm3(k,i)) ! @@ -91,15 +94,15 @@ subroutine elden(xnmbar,op,op_upd,o2,o1,n2,n2d,no,n4s,xiop2p, ! ! A = QI(NO+)+K2*N(O+)*N(N2)+K7*N(N+)*N(02)+B9*N(NO) (s10) ! - a(k,i) = .5*(qnop(k,i,lat)+qnop(k+1,i,lat))+xnmbar(k,i)* + a(k,i) = .5_rp*(qnop(k,i,lat)+qnop(k+1,i,lat))+xnmbar(k,i)* | (rk2(k,i,lat)*op_upd(k,i)*n2(k,i)*rmassinv_n2+ - | rk7*nplus(k,i)*o2(k,i)*rmassinv_o2+ - | .5*(beta9(k,i,lat)+beta9(k+1,i,lat))*no(k,i)*rmassinv_no) + | rk7*nplus(k,i)*o2(k,i)*rmassinv_o2+ + | .5_rp*(beta9(k,i,lat)+beta9(k+1,i,lat))*no(k,i)*rmassinv_no) ! ! B = QI(O2+)+K1*N(O+)*N(O2)+K6*N(N+)*N(02) (s9) ! (very small "diamond diffs" with tgcm15 due to op_upd) ! - b(k,i) = .5*(qo2p(k,i,lat)+qo2p(k+1,i,lat))+xnmbar(k,i)* + b(k,i) = .5_rp*(qo2p(k,i,lat)+qo2p(k+1,i,lat))+xnmbar(k,i)* | (rk1(k,i,lat)*op_upd(k,i)+rk6*nplus(k,i))*o2(k,i)* | rmassinv_o2+rk26*xiop2d(k,i)*o2(k,i)*rmassinv_o2 ! @@ -110,7 +113,8 @@ subroutine elden(xnmbar,op,op_upd,o2,o1,n2,n2d,no,n4s,xiop2p, ! ! D = QI(N2+) (s7) ! - d(k,i) = .5*(qn2p(k,i,lat)+qn2p(k+1,i,lat))+(rk16*xiop2p(k,i)+ + d(k,i) = .5_rp*(qn2p(k,i,lat)+qn2p(k+1,i,lat))+ + | (rk16*xiop2p(k,i)+ | rk23*xiop2d(k,i))*n2(k,i)*rmassinv_n2 ! ! E =K3*N(O)+K9*N(O2) (s6) @@ -139,7 +143,7 @@ subroutine elden(xnmbar,op,op_upd,o2,o1,n2,n2d,no,n4s,xiop2p, a1(k,i) = -(ra1(k,i,lat)*(e(k,i)*(c(k,i)*fg(k,i)+b(k,i))+ | d(k,i)*(c(k,i)+h(k,i)))+ra2(k,i,lat)*(e(k,i)*(a(k,i)+ | d(k,i))-h(k,i)*d(k,i))+ra3(k,i,lat)*c(k,i)*(a(k,i)+b(k,i)))/ - | 4. + | 4._rp ! ! A2 = (ra1*(e*c-(ra2*e+ra3*c)*fg-ra2*d-ra3*b)-ra2*ra3*a)/6. (s13) ! @@ -194,7 +198,7 @@ subroutine elden(xnmbar,op,op_upd,o2,o1,n2,n2d,no,n4s,xiop2p, ! do i=lon0,lon1 do k=lev0,lev1-1 - if (root(k,i) < 1.) root(k,i) = 1.0 ! insure positive Ne from solver + if (root(k,i) < 1._rp) root(k,i) = 1.0_rp ! insure positive Ne from solver ! in case there is a problem n2p(k,i) = d(k,i)/(e(k,i)+ra3(k,i,lat)*root(k,i)) o2p(k,i) = (b(k,i)+h(k,i)*d(k,i)/(e(k,i)+ra3(k,i,lat)* @@ -222,11 +226,17 @@ subroutine elden(xnmbar,op,op_upd,o2,o1,n2,n2d,no,n4s,xiop2p, do i=lon0,lon1 do k=lev0,lev1-2 electrons(k+1,i) = sqrt(root(k,i)*root(k+1,i)) + if (electrons(k+1,i) .lt. nelimit) + | electrons(k+1,i) = nelimit enddo ! k=lev0,lev1-2 ! ! Lower and upper boundaries: electrons(lev0,i) = sqrt(root(lev0 ,i)**3/root(lev0+1,i)) electrons(lev1,i) = sqrt(root(lev1-1,i)**3/root(lev1-2,i)) + if (electrons(lev0,i) .lt. nelimit) + | electrons(lev0,i) = nelimit + if (electrons(lev1,i) .lt. nelimit) + | electrons(lev1,i) = nelimit enddo ! i=lon0,lon1 ! call addfld('NE_ELDEN',' ',' ',electrons(:,i0:i1), ! | 'lev',lev0,lev1,'lon',i0,i1,lat) @@ -235,6 +245,7 @@ end subroutine elden !----------------------------------------------------------------------- subroutine vquart(a0,a1,a2,a3,a4,root,lev0,lev1,lon0,lon1) use addfld_module,only: addfld + use params_module,only: rp implicit none ! ! Determines five roots of the equation: @@ -261,40 +272,41 @@ subroutine vquart(a0,a1,a2,a3,a4,root,lev0,lev1,lon0,lon1) do k=lev0,lev1-1 ! ! w1 = ch - w1(k,i) = -(a4(k,i)*a0(k,i)-4.*a3(k,i)*a1(k,i)+3.*a2(k,i)**2)/ - | 12. + w1(k,i) = -(a4(k,i)*a0(k,i)-4._rp*a3(k,i)*a1(k,i)+ + | 3._rp*a2(k,i)**2)/12._rp ! ! w2 = cg w2(k,i) = (a4(k,i)*(a2(k,i)*a0(k,i)-a1(k,i)**2)- | a3(k,i)*(a3(k,i)*a0(k,i)-a1(k,i)*a2(k,i))+ - | a2(k,i)*(a3(k,i)*a1(k,i)-a2(k,i)**2))/4. + | a2(k,i)*(a3(k,i)*a1(k,i)-a2(k,i)**2))/4._rp ! ! root=rlam=-2.*real((.5*(cg+sqrt(cmplx(cg**2+4.*ch**3))))**(1./3.)) ! - root(k,i) = -2.*real((.5*(w2(k,i)+ - | sqrt(cmplx(w2(k,i)**2+4.*w1(k,i)**3))))**(1./3.)) + root(k,i) = -2._rp*real((.5*(w2(k,i)+ + | sqrt(cmplx(w2(k,i)**2+4._rp*w1(k,i)**3))))**(1./3._rp)) ! ! W1=P=SQRT(A(5)*RLAM+A(4)**2-A(5)*A(3)) ! delta = a4(k,i)*root(k,i)+a3(k,i)**2-a4(k,i)*a2(k,i) - if (delta <= 0.) then - w1(k,i) = 0. + if (delta <= 0._rp) then + w1(k,i) = 0._rp else w1(k,i) = sqrt(delta) endif ! ! W2=Q=SQRT((2.*RLAM+A(3))**2-A(5)*A(1)) ! - delta = (2.*root(k,i)+a2(k,i))**2-a4(k,i)*a0(k,i) - if (delta <= 0.) then - w2(k,i) = 0. + delta = (2._rp*root(k,i)+a2(k,i))**2-a4(k,i)*a0(k,i) + if (delta <= 0._rp) then + w2(k,i) = 0._rp else w2(k,i) = sqrt(delta) endif ! ! W3=PQ=2.*A(4)*RLAM+A(4)*A(3)-A(5)*A(2) ! - w3(k,i) = 2.*a3(k,i)*root(k,i)+a3(k,i)*a2(k,i)-a4(k,i)*a1(k,i) + w3(k,i) = 2._rp*a3(k,i)*root(k,i)+a3(k,i)*a2(k,i)- + | a4(k,i)*a1(k,i) ! ! W1=P=SIGN(P,Q*PQ) ! @@ -306,8 +318,8 @@ subroutine vquart(a0,a1,a2,a3,a4,root,lev0,lev1,lon0,lon1) ! ! Final evaluation of root: ! - delta = w3(k,i)**2-a4(k,i)*(a2(k,i)+2.*root(k,i)-w2(k,i)) - if (delta <= 0.) then + delta = w3(k,i)**2-a4(k,i)*(a2(k,i)+2._rp*root(k,i)-w2(k,i)) + if (delta <= 0._rp) then root(k,i) = w3(k,i)/a4(k,i) else root(k,i) = (w3(k,i)+sqrt(delta))/a4(k,i) diff --git a/src/fields.F b/src/fields.F index ae6e5a8..b0eb03c 100644 --- a/src/fields.F +++ b/src/fields.F @@ -175,7 +175,7 @@ module fields_module | tlbc, ulbc, vlbc, ! subdomains (lond0:lond1,latd0:latd1) | tlbc_nm, ulbc_nm, vlbc_nm, ! subdomains (lond0:lond1,latd0:latd1) | gzigm1, gzigm2, gnsrhs, - ! zigm1, zigm2, nsrhs + ! azigm1, azigm2, nsrhs ! ! Full 3d grid with all primary history fields for writing to netcdf ! history files. This will be allocated only on the root task diff --git a/src/input.F b/src/input.F index 04decba..f86432d 100644 --- a/src/input.F +++ b/src/input.F @@ -7,7 +7,7 @@ module input_module ! use params_module,only: mxhvols,mxseries,mxseries_sech,mxfsech, | nlat,nlon,nlev,glat1,dlat,glon1,dlon,tgcm_version,tgcm_name, - | spval,ispval,nlonp4,mxind_time,nmlat,nmlonp1 + | spval,ispval,nlonp4,mxind_time,nmlat,nmlonp1,rp use mk_hvols,only: mkhvols implicit none ! @@ -62,7 +62,7 @@ module input_module | ntask_maglon, ! number of tasks in mag longitude dimension (not namelist) | calc_helium, ! calculate helium if calc_helium=1, otherwise set he=0. | electron_heating - real :: + real(rp) :: | tide(10), ! semidiurnal tide amplitudes and phases | tide2(2), ! diurnal tide amplitude and phase | tide3m3(2), ! 2-day wave amplitude and phase @@ -70,10 +70,17 @@ module input_module | f107a, ! 10.7 cm average (81-day) solar flux | colfac, ! collision factor | joulefac, ! joule heating factor (see sub qjoule_tn (qjoule.F)) - | opdiffcap ! Maximum O+ diffusion (see sub rrk in oplus.F) + | opdiffcap, ! Maximum O+ diffusion (see sub rrk in oplus.F) + | opdiffrate, ! vertical decaying rate of O+ diffusion cap + | opdifflev, ! transition altitude of O+ diffusion cap + | opfloor, ! minimum O+ + | oprate, ! vertical decaying rate of O+ floor + | oplev, ! transition altitude of O+ floor + | oplatwidth, ! latitude band to apply O+ floor + | te_cap,ti_cap ! ! Input parameters that can be either constant or time-dependent: - real :: + real(rp) :: | power, ! hemispheric power (gw) (hpower on histories) | ctpoten, ! cross-cap potential (volts) | bximf, ! BX component of IMF @@ -83,7 +90,7 @@ module input_module | swden, ! Solar wind density in #/cm3 | al, ! AL lower magnetic auroral activity index in nT | kp ! Kp index - real,dimension(5,mxind_time) :: power_time,ctpoten_time, + real(rp),dimension(5,mxind_time) :: power_time,ctpoten_time, | bximf_time,byimf_time,bzimf_time,swvel_time,swden_time,al_time, | kp_time,f107_time,f107a_time integer :: @@ -95,11 +102,12 @@ module input_module | et, ! logical to calculate electron turbulent heating | saps, ! logical to include empirical SAPS | doEclipse, ! logical to do eclipse mask or not - | oneway ! logical to use oneway mix reader + | oneway, ! logical to use oneway mix reader + | duff ! logical to choose reaction rate for N(2D)+O2->NO+O ! ! Parameters as read from namelist: - real :: rd_power,rd_ctpoten,rd_f107,rd_f107a,rd_bximf,rd_byimf, - | rd_bzimf,rd_swvel,rd_swden,rd_kp + real(rp) :: rd_power,rd_ctpoten,rd_f107,rd_f107a,rd_bximf, + | rd_byimf,rd_bzimf,rd_swvel,rd_swden,rd_kp ! ! If indices_interp==1, time-dependent indices (power_time, ctpoten_time, etc) ! will be interpolated to model time, otherwise they will change only @@ -175,8 +183,8 @@ module input_module logical,dimension(mxfsech) :: nudge_lbc,nudge_f4d logical :: nudge_use_refdate integer,dimension(2) :: nudge_refdate - real,dimension(2) :: nudge_sponge,nudge_delta,nudge_power - real :: nudge_alpha + real(rp),dimension(2) :: nudge_sponge,nudge_delta,nudge_power + real(rp) :: nudge_alpha ! ! Namelist for read: namelist/tgcm_input/ @@ -193,12 +201,14 @@ module input_module | kp_time,al_time,swden_time,swvel_time,indices_interp, | imf_ncfile,saber_ncfile,tidi_ncfile,sech_nbyte,f107_time, | f107a_time,hpss_path,current_pg,current_kq,calc_helium, - | bgrddata_ncfile,ctmt_ncfile,opdiffcap,electron_heating, + | bgrddata_ncfile,ctmt_ncfile,electron_heating,duff, | amienh,amiesh,amie_ibkg,he_coefs_ncfile,enforce_n2,et,saps, | subaur_data,doEclipse,eclipse_list,oneway,mixfile, | nudge_ncpre,nudge_ncfile,nudge_ncpost,nudge_flds, | nudge_lbc,nudge_f4d,nudge_use_refdate,nudge_refdate, - | nudge_sponge,nudge_delta,nudge_power,nudge_alpha + | nudge_sponge,nudge_delta,nudge_power,nudge_alpha, + | opdiffcap,opdiffrate,opdifflev,opfloor,oprate,oplev,oplatwidth, + | te_cap,ti_cap ! ! List of fields that are always written to secondary histories: character(len=16) :: secflds_mandatory(6) = @@ -305,13 +315,23 @@ subroutine inp_init colfac = spval joulefac= spval calc_helium = ispval - opdiffcap = spval + te_cap = 10000._rp + ti_cap = 10000._rp electron_heating = ispval enforce_n2 = .false. et = .false. saps = .false. doEclipse = .false. oneway = .false. + duff = .false. + + opdiffcap = spval + opdiffrate = spval + opdifflev = spval + opfloor = spval + oprate = spval + oplev = spval + oplatwidth = spval f107 = spval f107a = spval @@ -615,6 +635,51 @@ subroutine inp_model(ntask) write(6,"('Input: O+ diffusion maximum (opdiffcap)=',es12.4)") | opdiffcap endif + if (opdiffrate==spval) then + opdiffrate = 0. ! default is off + write(6,"('Input: default diffusion decaying rate (opdiffrate)', + | ' is turned off by default.')") + else + write(6,"('Input: O+ diffusion decaying rate (opdiffrate)=' + | ,es12.4)") opdiffrate + endif + if (opdifflev==spval) then + write(6,"('Input: default diffusion capping level (opdifflev)', + | ' is turned off by default.')") + else + write(6,"('Input: O+ diffusion capping level (opdifflev)=' + | ,es12.4)") opdifflev + endif +! +! O+ floor: + if (opfloor==spval) then + opfloor = 0. ! default is off + write(6,"('Input: default O+ minimum (opfloor) is', + | ' turned off by default.')") + else + write(6,"('Input: O+ minimum (opfloor)=',es12.4)") opfloor + endif + if (oprate==spval) then + oprate = 0. ! default is off + write(6,"('Input: default O+ decaying rate (oprate)', + | ' is turned off by default.')") + else + write(6,"('Input: O+ decaying rate (oprate)=',es12.4)") oprate + endif + if (oplev==spval) then + write(6,"('Input: default O+ flooring level (oplev)', + | ' is turned off by default.')") + else + write(6,"('Input: O+ flooring level (oplev)=',es12.4)") oplev + endif + if (oplatwidth==spval) then + oplatwidth = 0. ! default is off + write(6,"('Input: default O+ flooring latitude band', + | ' (oplatwidth) is turned off by default.')") + else + write(6,"('Input: O+ flooring latitude band (oplatwidth)=', + | es12.4)") oplatwidth + endif if (electron_heating == ispval) electron_heating = 6 if (electron_heating == 4) then @@ -1815,7 +1880,7 @@ subroutine validate_timedep(constant,timedep,mxtimes,ntimes,name) ! Validate times and values in user provided time series. ! ! Args: - real,intent(in) :: constant,timedep(5,mxtimes) + real(rp),intent(in) :: constant,timedep(5,mxtimes) integer,intent(in) :: mxtimes integer,intent(out) :: ntimes character(len=*),intent(in) :: name diff --git a/src/ionvel.F b/src/ionvel.F index 958c654..6c67dbc 100644 --- a/src/ionvel.F +++ b/src/ionvel.F @@ -15,7 +15,6 @@ subroutine ionvel(z,ui,vi,wi,Etot,lev0,lev1,lon0,lon1,lat0,lat1) use magfield_module,only: rjac,xb,yb,zb,bmod use addfld_module,only: addfld - use diags_module,only: mkdiag_UI,mkdiag_VI,mkdiag_WI use mpi_module,only: mp_periodic_f3d implicit none ! @@ -146,14 +145,6 @@ subroutine ionvel(z,ui,vi,wi,Etot,lev0,lev1,lon0,lon1,lat0,lat1) ! | minval(wi(:,lon0:lon1,lat0:lat1)), ! | maxval(wi(:,lon0:lon1,lat0:lat1)) ! -! Save ion drifts if requested: - call mkdiag_UI('UI_ExB',ui(:,lon0:lon1,lat0:lat1), - | lev0,lev1,lon0,lon1,lat0,lat1) - call mkdiag_VI('VI_ExB',vi(:,lon0:lon1,lat0:lat1), - | lev0,lev1,lon0,lon1,lat0,lat1) - call mkdiag_WI('WI_ExB',wi(:,lon0:lon1,lat0:lat1), - | lev0,lev1,lon0,lon1,lat0,lat1) -! #ifdef VT ! code = 121 ; state = 'ionvel' ; activity='ModelCode' call vtend(121,ier) diff --git a/src/lamdas.F b/src/lamdas.F index dbcf48e..4e96acb 100644 --- a/src/lamdas.F +++ b/src/lamdas.F @@ -12,9 +12,8 @@ subroutine lamdas(tn,xnmbar,o2,o1,he,n2,ti,te,o2p,op,nplus, ! in magnetic direction lamda1 [1/s] (full levels) ! Pedersen/ Hall conductivities [S/m] (half levels) ! - use params_module,only: nlonp4 use magfield_module,only: bmod2,sn2dec,csdec,sndec - use cons_module,only: dipmin,avo,rtd, + use cons_module,only: dipmin,avo,rtd,boltz, | rmass_o2,rmass_o1,rmass_he,rmass_n2,rmass_no,rmass_n4s, | rmassinv_o2,rmassinv_o1,rmassinv_he,rmassinv_n2, | rmassinv_no,rmassinv_n4s @@ -56,26 +55,46 @@ subroutine lamdas(tn,xnmbar,o2,o1,he,n2,ti,te,o2p,op,nplus, | Q2 ! electrojet turbulent heating ! ! Local: - integer :: k,i,lonbeg,lonend,i0,i1 - real :: sqrt_te ! sqrt(te) - real,parameter :: qe=1.602e-19, ! electron charge (coulomb) - | qeomeo10 = 1.7588028E7, ! qe/m_e/10 [C/g] - | qeoNao10 = 9.6489E3, ! qe/N_a/10 [C/mol] - | Me = 9.109E-31, ! electron mass [kg] - | Mp = 1.6726E-27, ! proton mass [kg] - | Kb = 1.38E-23 ! Boltzmann's constant [J/K] + real,parameter :: + | qe = 1.602e-19, ! electron charge (coulomb) + | me = qe/1.7588028E7/10, ! electron mass [g] + | mp = qe/9.6489E3/10, ! proton mass [g] +! +! Ion-neutral momentum transfer collision frequencies (non-resonant): +! 2024/03/21 Haonan Wu: There used to be only O2+, O+, and NO+ in the calculation. +! To be more self-consistent, include N+ and N2+ in the calculation as well. +! + | nu_op_o2 = 6.64E-10, ! O+ ~ O2 + | nu_np_o2 = 7.25E-10, ! N+ ~ O2 + | nu_n2p_o2 = 4.49E-10, ! N2+ ~ O2 + | nu_nop_o2 = 4.27E-10, ! NO+ ~ O2 + | nu_o2p_o = 2.31E-10, ! O2+ ~ O + | nu_np_o = 4.42E-10, ! N+ ~ O + | nu_n2p_o = 4.42E-10, ! N2+ ~ O + | nu_nop_o = 2.44E-10, ! NO+ ~ O + | nu_o2p_he = 0.70E-10, ! O2+ ~ He + | nu_op_he = 1.32E-10, ! O+ ~ He + | nu_np_he = 1.49E-10, ! N+ ~ He + | nu_n2p_he = 0.79E-10, ! N2+ ~ He + | nu_nop_he = 0.74E-10, ! NO+ ~ He + | nu_o2p_n2 = 4.13E-10, ! O2+ ~ N2 + | nu_op_n2 = 6.82E-10, ! O+ ~ N2 + | nu_np_n2 = 7.47E-10, ! N+ ~ N2 + | nu_nop_n2 = 4.34E-10 ! NO+ ~ N2 +! + integer :: k,i + real :: sqrt_te, ! sqrt(te) + | E1,E2 ! turbulent eletric field ! ! Local (lon): real,dimension(lon0:lon1) :: - | bgauss, qe_fac, sindip, cosdip, cos2dip, sin2dip, cos2dec, - | omega_o2p ,omega_op ,omega_np , - | omega_n2p ,omega_nop ,omega_e , - | omega_o2p_inv,omega_op_inv ,omega_np_inv , - | omega_n2p_inv,omega_nop_inv,omega_e_inv + | dip,rot_xx,rot_yy,rot_xy, + | omega_o2p,omega_op ,omega_np, + | omega_n2p,omega_nop,omega_e ! ! Local (lev,lon): real,dimension(lev0:lev1,lon0:lon1) :: - | tnti, ! average of tn and ti + | tr, ! average of tn and ti | o2_cm3, o1_cm3, he_cm3, n2_cm3, ! major species number densities (cm3) | sigma_ped, ! pedersen conductivity (siemens/m) | sigma_hall, ! hall conductivity (siemens/m) @@ -83,135 +102,53 @@ subroutine lamdas(tn,xnmbar,o2,o1,he,n2,ti,te,o2p,op,nplus, | lamda2, ! sighal*b**2/rho | lamda1tmp, ! temporary lamda1 | lamda2tmp, ! temporary lamda2 - | lxxnorot, ! XX before rotation - | lyynorot, ! YY before rotation - | lxynorot, ! XY before rotation - | lyxnorot, ! YX before rotation ! ! Ion-neutral momentum transfer collision frequencies: -! 2024/03/21 Haonan Wu: There used to be only O2+, O+, and NO+ in the calculation. -! To be more self-consistent, include N+ and N2+ in the calculation as well. -! - | rnu_o2p_o2, ! O2+ ~ O2 collision freq (resonant, temperature dependent) - | rnu_op_o2 , ! O+ ~ O2 collision freq (non-resonant) - | rnu_np_o2 , ! N+ ~ O2 collision freq (non-resonant) - | rnu_n2p_o2, ! N2+ ~ O2 collision freq (non-resonant) - | rnu_nop_o2, ! NO+ ~ O2 collision freq (non-resonant) -! - | rnu_o2p_o, ! O2+ ~ O collision freq (non-resonant) - | rnu_op_o , ! O+ ~ O collision freq (resonant, temperature dependent) - | rnu_np_o , ! N+ ~ O collision freq (non-resonant) - | rnu_n2p_o, ! N2+ ~ O collision freq (non-resonant) - | rnu_nop_o, ! NO+ ~ O collision freq (non-resonant) -! - | rnu_o2p_he, ! O2+ ~ He collision freq (non-resonant) - | rnu_op_he , ! O+ ~ He collision freq (non-resonant) - | rnu_np_he , ! N+ ~ He collision freq (non-resonant) - | rnu_n2p_he, ! N2+ ~ He collision freq (non-resonant) - | rnu_nop_he, ! NO+ ~ He collision freq (non-resonant) -! - | rnu_o2p_n2, ! O2+ ~ N2 collision freq (non-resonant) - | rnu_op_n2 , ! O+ ~ N2 collision freq (non-resonant) - | rnu_np_n2 , ! N+ ~ N2 collision freq (non-resonant) - | rnu_n2p_n2, ! N2+ ~ N2 collision freq (resonant, temperature dependent) - | rnu_nop_n2, ! NO+ ~ N2 collision freq (non-resonant) -! - | rnu_o2p, ! [[o2p~o2]n(o2)+[o2p~o]n(o)+[o2p~he]n(he)+[o2p~n2]n(n2)]/w(o2p) - | rnu_op, ! [[op ~o2]n(o2)+[op ~o]n(o)+[op ~he]n(he)+[op ~n2]n(n2)]/w(op ) - | rnu_np, ! [[np ~o2]n(o2)+[np ~o]n(o)+[np ~he]n(he)+[np ~n2]n(n2)]/w(np ) - | rnu_n2p, ! [[n2p~o2]n(o2)+[n2p~o]n(o)+[n2p~he]n(he)+[n2p~n2]n(n2)]/w(n2p) - | rnu_nop, ! [[nop~o2]n(o2)+[nop~o]n(o)+[nop~he]n(he)+[nop~n2]n(n2)]/w(nop) -! - | rnu_ne, ! electron~neutral - | Ki, ! ratio between ion gyro frequency and ion-neutral collision frequency - | Mi, ! mean ion molecular mass - | E1 -! -! Save input args to secondary history: -! real,dimension(lev0:lev1,lon0-2:lon1+2),intent(in) :: -! | tn, ! neutral temperature (deg K) -! | o2, ! molecular oxygen (mmr) -! | o1, ! atomic oxygen (mmr) -! | he, ! helium (mmr) -! | n2, ! molecular nitrogen (mmr) -! | ti, ! ion temperature (deg K) -! | te, ! electron temperature (deg K) -! | o2p, ! O2+ number density (1/cm3) -! | op, ! O+ number density (1/cm3) -! | nop ! NO+ number density (1/cm3) - - i0 = lon0 ; i1 = lon1 - -! call addfld('TN_lam',' ',' ',tn(:,i0:i1), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('O2_lam',' ',' ',o2(:,i0:i1), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('O1_lam',' ',' ',o1(:,i0:i1), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('He_lam',' ',' ',he(:,i0:i1), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('N2_lam',' ',' ',n2(:,i0:i1), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('TI_lam',' ',' ',ti(:,i0:i1), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('TE_lam',' ',' ',te(:,i0:i1), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) +! (resonant, temperature dependent) ! -! Save input ions to secondary history: + | nu_o2p_o2, ! O2+ ~ O2 + | nu_op_o, ! O+ ~ O + | nu_n2p_n2, ! N2+ ~ N2 ! -! call addfld('O2P_LAM',' ',' ',o2p(:,i0:i1), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('OP_LAM' ,' ',' ',op (:,i0:i1), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('NOP_LAM',' ',' ',nop(:,i0:i1), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) + | nu_o2p, ! [o2p~o2]n(o2)+[o2p~o]n(o)+[o2p~he]n(he)+[o2p~n2]n(n2) + | nu_op, ! [op ~o2]n(o2)+[op ~o]n(o)+[op ~he]n(he)+[op ~n2]n(n2) + | nu_np, ! [np ~o2]n(o2)+[np ~o]n(o)+[np ~he]n(he)+[np ~n2]n(n2) + | nu_n2p, ! [n2p~o2]n(o2)+[n2p~o]n(o)+[n2p~he]n(he)+[n2p~n2]n(n2) + | nu_nop, ! [nop~o2]n(o2)+[nop~o]n(o)+[nop~he]n(he)+[nop~n2]n(n2) +! + | nu_e, ! electron~neutral + | nu_i, ! ion~neutral + | mi, ! mean ion molecular mass + | ke,ki ! ratio between gyro frequency and neutral collision frequency ! ! Set local needs: do i=lon0,lon1 - bgauss(i) = bmod2(i,lat) ! magnetic field strength [Gauss] ! ! e/B [C/T 10^6 cm^3/m^3] ! 1.e10 for SI units = 1.e6 (cm3->m3) * 1.e4 (gauss->tesla) ! - qe_fac(i) = qe*1.e10/bgauss(i) -! ! gyrofrequencies: omega_i = eB/m_i [1/s] ! omega_e = eB/m_e [1/s] -! with qeoNao10 = e/Na [C/mol T/kg g/Gauss] -! qeomeo10 = e/m_e [C/g T/kg g/Gauss] -! 1/10 in qeoNao10 and qeomeo10 for conversion from Gauss/g to T/kg -! - omega_op (i) = qeoNao10*bgauss(i)*rmassinv_o1 - omega_o2p(i) = qeoNao10*bgauss(i)*rmassinv_o2 - omega_np (i) = qeoNao10*bgauss(i)*rmassinv_n4s - omega_n2p(i) = qeoNao10*bgauss(i)*rmassinv_n2 - omega_nop(i) = qeoNao10*bgauss(i)*rmassinv_no - omega_op_inv (i)= 1./omega_op(i) - omega_o2p_inv(i)= 1./omega_o2p(i) - omega_np_inv (i)= 1./omega_np(i) - omega_n2p_inv(i)= 1./omega_n2p(i) - omega_nop_inv(i)= 1./omega_nop(i) - omega_e(i) = qeomeo10*bgauss(i) - omega_e_inv(i) = 1./omega_e(i) +! 1/10 for conversion from Gauss/g to T/kg +! + omega_op (i) = qe*bmod2(i,lat)*rmassinv_o1 /(mp*10) + omega_o2p(i) = qe*bmod2(i,lat)*rmassinv_o2 /(mp*10) + omega_np (i) = qe*bmod2(i,lat)*rmassinv_n4s/(mp*10) + omega_n2p(i) = qe*bmod2(i,lat)*rmassinv_n2 /(mp*10) + omega_nop(i) = qe*bmod2(i,lat)*rmassinv_no /(mp*10) + omega_e(i) = qe*bmod2(i,lat)/(me*10) ! ! Sin and cos for rotation of lamdas: ! dipmag (magnetic dip angle) is in magfield module (magfield.F), ! dipmin (minimum dip angle) is in cons module (cons.F) approx. 10 deg. if (abs(dipmag(i,lat)) >= dipmin) then - sindip(i) = sin(dipmag(i,lat)) - cosdip(i) = cos(dipmag(i,lat)) + dip(i) = dipmag(i,lat) else - if (dipmag(i,lat) >= 0.) then - sindip(i) = sin(dipmin) - cosdip(i) = cos(dipmin) - else - sindip(i) = sin(-dipmin) - cosdip(i) = cos(-dipmin) - endif + dip(i) = sign(dipmin,dipmag(i,lat)) endif - cos2dip(i) = cosdip(i)**2 - sin2dip(i) = sindip(i)**2 - cos2dec(i) = csdec(i,lat)**2 + rot_xx(i) = csdec(i,lat)**2+sin(dip(i))**2*sn2dec(i,lat) + rot_yy(i) = sn2dec(i,lat) +sin(dip(i))**2*csdec(i,lat)**2 + rot_xy(i) = cos(dip(i))**2*sndec(i,lat)*csdec(i,lat) enddo ! i=lon0,lon1 ! ! Ion-neutral momentum transfer collision frequencies [cm^3/s]: @@ -219,38 +156,13 @@ subroutine lamdas(tn,xnmbar,o2,o1,he,n2,ti,te,o2p,op,nplus, ! do i=lon0,lon1 do k=lev0,lev1-1 - tnti(k,i) = 0.5*(ti(k,i)+tn(k,i)) ! ave of tn & ti -! -! O2 collision frequencies: - rnu_o2p_o2(k,i) = 2.59E-11*sqrt(tnti(k,i))* ! O2+ ~ O2 (resonant) - | (1.-0.073*alog10(tnti(k,i)))**2 - rnu_op_o2 (k,i) = 6.64E-10 ! O+ ~ O2 - rnu_np_o2 (k,i) = 7.25E-10 ! N+ ~ O2 - rnu_n2p_o2(k,i) = 4.49E-10 ! N2+ ~ O2 - rnu_nop_o2(k,i) = 4.27E-10 ! NO+ ~ O2 -! -! O collision frequencies: - rnu_o2p_o(k,i) = 2.31E-10 ! O2+ ~ O - rnu_op_o (k,i) = 3.67e-11*sqrt(tnti(k,i))* ! O+ ~ O (resonant) - | (1.-0.064*alog10(tnti(k,i)))**2*colfac - rnu_np_o (k,i) = 4.42E-10 ! N+ ~ O - rnu_n2p_o(k,i) = 2.58E-10 ! N2+ ~ O - rnu_nop_o(k,i) = 2.44E-10 ! NO+ ~ O -! -! He collision frequencies: - rnu_o2p_he(k,i) = 0.70E-10 ! O2+ ~ He - rnu_op_he (k,i) = 1.32E-10 ! O+ ~ He - rnu_np_he (k,i) = 1.49E-10 ! N+ ~ He - rnu_n2p_he(k,i) = 0.79E-10 ! N2+ ~ He - rnu_nop_he(k,i) = 0.74E-10 ! NO+ ~ He -! -! N2 collision frequencies: - rnu_o2p_n2(k,i) = 4.13E-10 ! O2+ ~ N2 - rnu_op_n2 (k,i) = 6.82E-10 ! O+ ~ N2 - rnu_np_n2 (k,i) = 7.47E-10 ! N+ ~ N2 - rnu_n2p_n2(k,i) = 5.14E-11*sqrt(tnti(k,i))* ! N2+ ~ N2 (resonant) - | (1.-0.069*alog10(tnti(k,i)))**2 - rnu_nop_n2(k,i) = 4.34E-10 ! NO+ ~ N2 + tr(k,i) = 0.5*(ti(k,i)+tn(k,i)) ! ave of tn & ti + nu_o2p_o2(k,i) = 2.59E-11*sqrt(tr(k,i))* ! O2+ ~ O2 (resonant) + | (1.-0.073*log10(tr(k,i)))**2 + nu_op_o (k,i) = 3.67e-11*sqrt(tr(k,i))* ! O+ ~ O (resonant) + | (1.-0.064*log10(tr(k,i)))**2*colfac + nu_n2p_n2(k,i) = 5.14E-11*sqrt(tr(k,i))* ! N2+ ~ N2 (resonant) + | (1.-0.069*log10(tr(k,i)))**2 enddo ! k=lev0,lev1-1 enddo ! i=lon0,lon1 ! @@ -275,79 +187,74 @@ subroutine lamdas(tn,xnmbar,o2,o1,he,n2,ti,te,o2p,op,nplus, ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) ! call addfld('O_CM3' ,' ',' ',o1_cm3, ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('HE_CM3' ,' ',' ',he_cm3, +! call addfld('HE_CM3',' ',' ',he_cm3, ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) ! call addfld('N2_CM3',' ',' ',n2_cm3, ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) ! ! collision frequency nu_in for each ion [1/s] ! by multiplying with neutral number density [1/cm^3] and sum over neutrals -! nu_in is divided by gyrofrequency omega_i -! nu_in/omega_i [-]: -! rnu_o2p = [[o2p~o2]n(o2)+[o2p~o]n(o)+[o2p~he]n(he)+[o2p~n2]n(n2)]/w(o2p) -! rnu_op = [[op ~o2]n(o2)+[op ~o]n(o)+[op ~he]n(he)+[op ~n2]n(n2)]/w(op ) -! rnu_nop = [[nop~o2]n(o2)+[nop~o]n(o)+[nop~he]n(he)+[nop~n2]n(n2)]/w(nop) +! nu_o2p = [o2p~o2]n(o2)+[o2p~o]n(o)+[o2p~he]n(he)+[o2p~n2]n(n2) +! nu_op = [op ~o2]n(o2)+[op ~o]n(o)+[op ~he]n(he)+[op ~n2]n(n2) +! nu_nop = [nop~o2]n(o2)+[nop~o]n(o)+[nop~he]n(he)+[nop~n2]n(n2) ! do i=lon0,lon1 do k=lev0,lev1-1 - rnu_o2p(k,i) = (rnu_o2p_o2(k,i)*o2_cm3(k,i) + - | rnu_o2p_o (k,i)*o1_cm3(k,i) + - | rnu_o2p_he(k,i)*he_cm3(k,i) + - | rnu_o2p_n2(k,i)*n2_cm3(k,i))*omega_o2p_inv(i) - rnu_op (k,i) = (rnu_op_o2 (k,i)*o2_cm3(k,i) + - | rnu_op_o (k,i)*o1_cm3(k,i) + - | rnu_op_he (k,i)*he_cm3(k,i) + - | rnu_op_n2 (k,i)*n2_cm3(k,i))*omega_op_inv(i) - rnu_np (k,i) = (rnu_np_o2 (k,i)*o2_cm3(k,i) + - | rnu_np_o (k,i)*o1_cm3(k,i) + - | rnu_np_he (k,i)*he_cm3(k,i) + - | rnu_np_n2 (k,i)*n2_cm3(k,i))*omega_np_inv(i) - rnu_n2p(k,i) = (rnu_n2p_o2(k,i)*o2_cm3(k,i) + - | rnu_n2p_o (k,i)*o1_cm3(k,i) + - | rnu_n2p_he(k,i)*he_cm3(k,i) + - | rnu_n2p_n2(k,i)*n2_cm3(k,i))*omega_n2p_inv(i) - rnu_nop(k,i) = (rnu_nop_o2(k,i)*o2_cm3(k,i) + - | rnu_nop_o (k,i)*o1_cm3(k,i) + - | rnu_nop_he(k,i)*he_cm3(k,i) + - | rnu_nop_n2(k,i)*n2_cm3(k,i))*omega_nop_inv(i) + nu_o2p(k,i) = nu_o2p_o2(k,i)*o2_cm3(k,i) + + | nu_o2p_o *o1_cm3(k,i) + + | nu_o2p_he *he_cm3(k,i) + + | nu_o2p_n2 *n2_cm3(k,i) + nu_op (k,i) = nu_op_o2 *o2_cm3(k,i) + + | nu_op_o (k,i)*o1_cm3(k,i) + + | nu_op_he *he_cm3(k,i) + + | nu_op_n2 *n2_cm3(k,i) + nu_np (k,i) = nu_np_o2 *o2_cm3(k,i) + + | nu_np_o *o1_cm3(k,i) + + | nu_np_he *he_cm3(k,i) + + | nu_np_n2 *n2_cm3(k,i) + nu_n2p(k,i) = nu_n2p_o2 *o2_cm3(k,i) + + | nu_n2p_o *o1_cm3(k,i) + + | nu_n2p_he *he_cm3(k,i) + + | nu_n2p_n2(k,i)*n2_cm3(k,i) + nu_nop(k,i) = nu_nop_o2 *o2_cm3(k,i) + + | nu_nop_o *o1_cm3(k,i) + + | nu_nop_he *he_cm3(k,i) + + | nu_nop_n2 *n2_cm3(k,i) ! ! neutral~electron collision frequency (from Banks & Kockards) nu_en -! divided by gyrofrequency omega_2: -! nu_en/omega_e [-] ! sqrt_te = sqrt(te(k,i)) - rnu_ne(k,i) = - | (1.82e-10*o2_cm3(k,i)*sqrt_te*(1.+3.60e-2*sqrt_te)+ - | 8.90e-11*o1_cm3(k,i)*sqrt_te*(1.+5.70e-4*te(k,i))+ - | 4.60e-10*he_cm3(k,i)*sqrt_te+ - | 2.33e-11*n2_cm3(k,i)*te(k,i)*(1.-1.21e-4*te(k,i)))* - | omega_e_inv(i) -! -! 6/2/06 btf: Multiply rnu_ne by 4, as per Richmond: + nu_e(k,i) = + | 1.82e-10*o2_cm3(k,i)*(sqrt_te+3.60e-2*te(k,i))+ + | 8.90e-11*o1_cm3(k,i)*sqrt_te*(1.+5.70e-4*te(k,i))+ + | 4.60e-10*he_cm3(k,i)*sqrt_te+ + | 2.33e-11*n2_cm3(k,i)*te(k,i)*(1.-1.21e-4*te(k,i)) +! +! 6/2/06 btf: Multiply nu_e by 4, as per Richmond: ! The effective electron-neutral collision frequency is increased in ! an an hoc manner by a factor of 4 in order for the model to produce ! electric fields and currents below 105 km that agree better with ! observations, as recommended by Gagnepain et al. (J. Atmos. Terr. ! Phys., 39, 1119-1124, 1977). ! - rnu_ne(k,i) = rnu_ne(k,i)*4. + nu_e(k,i) = nu_e(k,i)*4. ! write(6,"('lamdas: lat=',i3,' k=',i3,' i=',i3,' te=', ! | e12.4,' o2=',e12.4,' o1=',e12.4,' he=',e12.4,' n2=',e12.4, -! | ' omega_e_inv=',e12.4,' rnu_ne=',e12.4)") lat,k,i,te(k,i), +! | ' omega_e=',e12.4,' nu_e=',e12.4)") lat,k,i,te(k,i), ! | o2_cm3(k,i),o1_cm3(k,i),he_cm3(k,i),n2_cm3(k,i), -! | omega_e_inv(i),rnu_ne(k,i) +! | omega_e(i),nu_e(k,i) enddo ! k=lev0,lev1-1 enddo ! i=lon0,lon1 -! call addfld('RNU_O2P',' ',' ',rnu_o2p, +! call addfld('NU_O2P',' ',' ',nu_o2p, ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('RNU_OP' ,' ',' ',rnu_op , +! call addfld('NU_OP' ,' ',' ',nu_op , ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('RNU_NOP',' ',' ',rnu_nop, +! call addfld('NU_NOP',' ',' ',nu_nop, ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('RNU_NE' ,' ',' ',rnu_ne , +! call addfld('NU_NE' ,' ',' ',nu_e , ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) ! ! Pedersen and Hall conductivities (siemens/m): @@ -363,22 +270,34 @@ subroutine lamdas(tn,xnmbar,o2,o1,he,n2,ti,te,o2p,op,nplus, ne(k,i) = op(k,i)+o2p(k,i)+nplus(k,i)+n2p(k,i)+nop(k,i) ! ! Pedersen conductivity [S/m] (half level): - sigma_ped(k,i) = qe_fac(i)* - | ((op (k,i)*rnu_op (k,i)/(1.+rnu_op (k,i)**2))+ - | (o2p(k,i)*rnu_o2p(k,i)/(1.+rnu_o2p(k,i)**2))+ - | (nplus(k,i)*rnu_np(k,i)/(1.+rnu_np(k,i)**2))+ - | (n2p(k,i)*rnu_n2p(k,i)/(1.+rnu_n2p(k,i)**2))+ - | (nop(k,i)*rnu_nop(k,i)/(1.+rnu_nop(k,i)**2))+ - | (ne (k,i)*rnu_ne (k,i)/(1.+rnu_ne (k,i)**2))) + sigma_ped(k,i) = qe*1.e10/bmod2(i,lat)* + | (ne (k,i)*omega_e (i)*nu_e (k,i)/ + | (omega_e (i)**2+nu_e (k,i)**2)+ + | op (k,i)*omega_op (i)*nu_op (k,i)/ + | (omega_op (i)**2+nu_op (k,i)**2)+ + | o2p (k,i)*omega_o2p(i)*nu_o2p(k,i)/ + | (omega_o2p(i)**2+nu_o2p(k,i)**2)+ + | nplus(k,i)*omega_np (i)*nu_np(k,i)/ + | (omega_np (i)**2+nu_np (k,i)**2)+ + | n2p (k,i)*omega_n2p(i)*nu_n2p(k,i)/ + | (omega_n2p(i)**2+nu_n2p(k,i)**2)+ + | nop (k,i)*omega_nop(i)*nu_nop(k,i)/ + | (omega_nop(i)**2+nu_nop(k,i)**2)) ! ! Hall conductivity [S/m] (half level): - sigma_hall(k,i) = qe_fac(i)* - | (ne (k,i)/(1.+rnu_ne (k,i)**2)- - | op (k,i)/(1.+rnu_op (k,i)**2)- - | o2p(k,i)/(1.+rnu_o2p(k,i)**2)- - | nplus(k,i)/(1.+rnu_np(k,i)**2)- - | n2p(k,i)/(1.+rnu_n2p(k,i)**2)- - | nop(k,i)/(1.+rnu_nop(k,i)**2)) + sigma_hall(k,i) = qe*1.e10/bmod2(i,lat)* + | (ne (k,i)*omega_e (i)**2/ + | (omega_e (i)**2+nu_e (k,i)**2)- + | op (k,i)*omega_op (i)**2/ + | (omega_op (i)**2+nu_op (k,i)**2)- + | o2p (k,i)*omega_o2p(i)**2/ + | (omega_o2p(i)**2+nu_o2p(k,i)**2)- + | nplus(k,i)*omega_np (i)**2/ + | (omega_np (i)**2+nu_np (k,i)**2)- + | n2p (k,i)*omega_n2p(i)**2/ + | (omega_n2p(i)**2+nu_n2p(k,i)**2)- + | nop (k,i)*omega_nop(i)**2/ + | (omega_nop(i)**2+nu_nop(k,i)**2)) if (sigma_hall(k,i) < 1e-20) sigma_hall(k,i) = 1e-20 enddo ! k=lev0,lev1-1 @@ -386,10 +305,6 @@ subroutine lamdas(tn,xnmbar,o2,o1,he,n2,ti,te,o2p,op,nplus, ! call addfld('ELECDEN' ,' ',' ',ne, ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('SIGPEDin',' ',' ',sigma_ped(lev0:lev1-1,:), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! call addfld('SIGHALin',' ',' ',sigma_hall(lev0:lev1-1,:), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) ! ! ion drag coefficients lamda1,2 [1/s] (full level) ! Pedersen/ Hall conductivity [S/m]: sigma_ped, sigma_hall (half level) @@ -401,9 +316,9 @@ subroutine lamdas(tn,xnmbar,o2,o1,he,n2,ti,te,o2p,op,nplus, ! do i=lon0,lon1 do k=lev0,lev1-1 - lamda1tmp(k,i) = (sigma_ped(k,i)*(1.e-4*bgauss(i))**2)*avo/ + lamda1tmp(k,i) = sigma_ped (k,i)*(1.e-4*bmod2(i,lat))**2*avo/ | (1.e3*xnmbar(k,i)) - lamda2tmp(k,i) = (sigma_hall(k,i)*(1.e-4*bgauss(i))**2)*avo/ + lamda2tmp(k,i) = sigma_hall(k,i)*(1.e-4*bmod2(i,lat))**2*avo/ | (1.e3*xnmbar(k,i)) enddo ! k=lev0,lev1-1 ! @@ -425,14 +340,6 @@ subroutine lamdas(tn,xnmbar,o2,o1,he,n2,ti,te,o2p,op,nplus, ! Top boundary: lamda1(lev1,i)= sqrt(lamda1tmp(lev1-1,i)**3/lamda1tmp(lev1-2,i)) lamda2(lev1,i)= sqrt(lamda2tmp(lev1-1,i)**3/lamda2tmp(lev1-2,i)) -! -! Non-rotated lamdas: - do k=lev0,lev1 - lxxnorot(k,i) = lamda1(k,i) - lyynorot(k,i) = lamda1(k,i)*sin2dip(i) - lxynorot(k,i) = lamda2(k,i)*sindip(i) - lyxnorot(k,i) = lxynorot(k,i) - enddo ! k=lev0,lev1-1 enddo ! i=lon0,lon1 ! ! Save diagnostic ion drag coefficients: @@ -440,50 +347,21 @@ subroutine lamdas(tn,xnmbar,o2,o1,he,n2,ti,te,o2p,op,nplus, | lev0,lev1,lon0,lon1,lat) call mkdiag_LAMDAHAL('LAMDA_HAL',lamda2(:,lon0:lon1), | lev0,lev1,lon0,lon1,lat) - -! call addfld('LAMDA1',' ',' ',lamda1, -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('LAMDA2',' ',' ',lamda2, -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('LXXNOROT',' ',' ',lxxnorot, -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('LYYNOROT',' ',' ',lyynorot, -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('LXYNOROT',' ',' ',lxynorot, -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('LYXNOROT',' ',' ',lyxnorot, -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) ! ! Rotate lamdas for displacement of geomagnetic and geographic poles: ! (full levels) ! do i=lon0,lon1 do k=lev0,lev1 - lxx(k,i)= lxxnorot(k,i)*cos2dec(i)+lyynorot(k,i)*sn2dec(i,lat) - lyy(k,i)= lyynorot(k,i)*cos2dec(i)+lxxnorot(k,i)*sn2dec(i,lat) - lyx(k,i)= lxynorot(k,i)-(lyynorot(k,i)-lxxnorot(k,i))* - | sndec(i,lat)*csdec(i,lat) - lxy(k,i)= lxynorot(k,i)+(lyynorot(k,i)-lxxnorot(k,i))* - | sndec(i,lat)*csdec(i,lat) + lxx(k,i)= lamda1(k,i)*rot_xx(i) + lyy(k,i)= lamda1(k,i)*rot_yy(i) + lyx(k,i)= lamda2(k,i)*sin(dip(i))+lamda1(k,i)*rot_xy(i) + lxy(k,i)= lamda2(k,i)*sin(dip(i))-lamda1(k,i)*rot_xy(i) enddo ! k=lev0,lev1-1 enddo ! i=lon0,lon1 - -! call addfld('LXX','LXX','Hz',lxx(:,i0:i1), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('LYY','LYY','Hz',lyy(:,i0:i1), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('LXY','LXY','Hz',lxy(:,i0:i1), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('LYX','LYX','Hz',lyx(:,i0:i1), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) - - lonbeg = lon0 - if (lon0==1) lonbeg = 3 - lonend = lon1 - if (lon1==nlonp4) lonend = nlonp4-2 ! ! Output conductivities [S/m] (half levels): - do i=lonbeg,lonend + do i=lon0,lon1 do k=lev0,lev1 ped_out(k,i) = sigma_ped(k,i) hall_out(k,i) = sigma_hall(k,i) @@ -494,50 +372,62 @@ subroutine lamdas(tn,xnmbar,o2,o1,he,n2,ti,te,o2p,op,nplus, call mkdiag_SIGMAPED('SIGMA_PED',ped_out,lev0,lev1,lon0,lon1,lat) call mkdiag_SIGMAHAL('SIGMA_HAL',hall_out,lev0,lev1,lon0,lon1,lat) -! ratio between ion gyro frequency and ion-neutral collision frequency - Ki = 1/ne*(op(:,lon0:lon1)/rnu_op+ - | o2p(:,lon0:lon1)/rnu_o2p+ - | nplus(:,lon0:lon1)/rnu_np+ - | n2p(:,lon0:lon1)/rnu_n2p+ - | nop(:,lon0:lon1)/rnu_nop) + Q1 = 0.0 + Q2 = 0.0 + + do i=lon0,lon1 + do k=lev0,lev1-1 + +! mean ion-neutral collision frequency + nu_i(k,i) = + | op (k,i)*nu_op (k,i)+ + | o2p (k,i)*nu_o2p(k,i)+ + | nplus(k,i)*nu_np (k,i)+ + | n2p (k,i)*nu_n2p(k,i)+ + | nop (k,i)*nu_nop(k,i) + +! ratio between gyro frequency and neutral collision frequency + ke(k,i) = omega_e(i)/nu_e(k,i) + ki(k,i) = 1/ne(k,i)* + | (op (k,i)*omega_op (i)/nu_op (k,i)+ + | o2p (k,i)*omega_o2p(i)/nu_o2p(k,i)+ + | nplus(k,i)*omega_np (i)/nu_np (k,i)+ + | n2p (k,i)*omega_n2p(i)/nu_n2p(k,i)+ + | nop (k,i)*omega_nop(i)/nu_nop(k,i)) ! mean ion molecular mass [g/mol] - Mi = 1/ne*(op(:,lon0:lon1)*rmass_o1+ - | o2p(:,lon0:lon1)*rmass_o2+ - | nplus(:,lon0:lon1)*rmass_n4s+ - | n2p(:,lon0:lon1)*rmass_n2+ - | nop(:,lon0:lon1)*rmass_no) + mi(k,i) = 1/ne(k,i)* + | (op (k,i)*rmass_o1+ + | o2p (k,i)*rmass_o2+ + | nplus(k,i)*rmass_n4s+ + | n2p (k,i)*rmass_n2+ + | nop (k,i)*rmass_no) ! Calculate electrojet turbulent heating, added by Jing Liu ! ne: 1/cm^3*1E6 -> 1/m^3 ! bmod2: G*1E-4 -> T ! Q1,Q2: J*1E-7 -> erg - E1 = (1.0+rnu_ne/Ki)*sqrt(Kb*(1.0+Ki**2)/(1.0-Ki**2)* - | (te(:,lon0:lon1)+ti(:,lon0:lon1))/(Mi*Mp)) - do i = lon0,lon1 - E1(:,i) = E1(:,i)*bmod2(i,lat)*1E-4 - enddo + if (abs(rlatm(i,lat))*rtd>50.0 .and. ki(k,i)<1.0) then + E2 = 1E-2*sqrt(boltz*(te(k,i)+ti(k,i))*(1.0+ki(k,i)**2)/ + | (mp*mi(k,i)*(1.0-ki(k,i)**2)))*bmod2(i,lat)*1E-4 + E1 = E2*(1.0+1.0/(ke(k,i)*ki(k,i))) - Q1 = 0.0 - Q2 = 0.0 - do i = lon0,lon1 - if (abs(rlatm(i,lat))*rtd > 50.0) then - do k = lev0,lev1 - if (Ki(k,i)<1.0 .and. Etot(k,i)>E1(k,i)) then - Q1(k,i) = Me*ne(k,i)*1E6*Etot(k,i)**2/ - | (bmod2(i,lat)*1E-4)**2*rnu_ne(k,i)/omega_e_inv(i) - Q2(k,i) = Mi(k,i)*Mp*1E6* - | Ki(k,i)**2*(Etot(k,i)-E1(k,i))**2/(1.0+Ki(k,i)**2)* - | (Etot(k,i)/E1(k,i)*(1.0+rnu_ne(k,i)/Ki(k,i))-1.0)/ - | (bmod2(i,lat)*1E-4)**2* - | (op(k,i)*rnu_op(k,i)/omega_op_inv(i)+ - | o2p(k,i)*rnu_o2p(k,i)/omega_o2p_inv(i)+ - | nplus(k,i)*rnu_np(k,i)/omega_np_inv(i)+ - | n2p(k,i)*rnu_n2p(k,i)/omega_n2p_inv(i)+ - | nop(k,i)*rnu_nop(k,i)/omega_nop_inv(i)) + if (E1 < Etot(k,i)) then + Q1(k,i) = me*ne(k,i)*1E3*nu_e(k,i)* + | (Etot(k,i)/(bmod2(i,lat)*1E-4))**2 + Q2(k,i) = mp*mi(k,i)*1E3*nu_i(k,i)* + | ((Etot(k,i)-E1)/(bmod2(i,lat)*1E-4))**2* + | (Etot(k,i)/E2-1.0)*ki(k,i)**2/(1.0+ki(k,i)**2) endif - enddo - endif + endif + enddo enddo + call addfld('Q1','Electron Ohmic Heating',' ', + | Q1(lev0:lev1-1,lon0:lon1), + | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) + call addfld('Q2','Electrojet Turbulent Heating',' ', + | Q2(lev0:lev1-1,lon0:lon1), + | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) + end subroutine lamdas diff --git a/src/mage_coupling.F b/src/mage_coupling.F index f805d9c..7f056cc 100644 --- a/src/mage_coupling.F +++ b/src/mage_coupling.F @@ -12,7 +12,7 @@ module mage_coupling_module !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !----------------------------------------------------------------------- use params_module,only: nlonp4,nlat,nlatp1, - | nmlatp1,nmlonp1,nmlat,nmlon + | nmlatp1,nmlonp1,nmlat,nmlon,rp use input_module,only: oneway !use pdynamo_module,only: phihm #ifdef GAMERA @@ -20,7 +20,7 @@ module mage_coupling_module #endif implicit none - real,dimension(nlonp4,nlat) :: + real(rp),dimension(nlonp4,nlat) :: | geng, ! energy in geographic coordinates, periodic boundary | gflx, ! flux in geographic coordinates, periodic boundary | gpot ! potential in geographic coordinates, periodic boundary @@ -31,11 +31,12 @@ module mage_coupling_module ! Potential in geographic coordinates from M-I coupler ! Note: gpotm latitude dimension is defined to match mag2geo specifications - real,dimension(nlonp4,0:nlatp1) :: gpotm + real(rp),dimension(nlonp4,0:nlatp1) :: gpotm ! Values on APEX grid - real,dimension(nmlonp1,nmlat) :: apotm,aflxm + real(rp),dimension(nmlonp1,nmlat) :: apotm,aflxm, + | grad_x,grad_y,grad_mag - real :: aurllbN,aurllbS ! all are co-lats in radians + real(rp) :: aurllbN,aurllbS ! all are co-lats in radians ! Change the following parameters if adding more variables integer,parameter :: @@ -46,7 +47,7 @@ module mage_coupling_module | nhoutvar = 9, ! TN, UN, VN, OMEGA, O2, O1, NO, Z, HE | nhinvar = 0 ! - real*8,dimension(nmlonp1,2) :: aurorabc1d + real(rp),dimension(nmlonp1,2) :: aurorabc1d contains !----------------------------------------------------------------------- @@ -64,26 +65,26 @@ subroutine initialize_coupling | mytid integer :: ierr,i - real,dimension(nlatp2) :: glatp2 - real,dimension(nlonp1) :: glonp1 + real(rp),dimension(nlatp2) :: glatp2 + real(rp),dimension(nlonp1) :: glonp1 !gpot = 0 - geng = 0.5 - gflx = 0 - gpotm = 0 - apotm = 0 - aflxm = 0 + geng = 0.5_rp + gflx = 0.0_rp + gpotm = 0.0_rp + apotm = 0.0_rp + aflxm = 0.0_rp !aurllbN = 10*dtr !aurllbS = 10*dtr ! Hard code the poles glatp2(2:nlatp2-1) = glat - glatp2(1) = -90 - glatp2(nlatp2) = 90 + glatp2(1) = -90.0_rp + glatp2(nlatp2) = 90.0_rp ! Periodic boundary glonp1(1:nlonp1-1) = glon - glonp1(nlonp1) = glon(1)+360 + glonp1(nlonp1) = glon(1)+360.0_rp #if defined (GAMERA) || defined (HIDRA) do i=1,CplCommSize @@ -132,13 +133,13 @@ subroutine import_mage use mpi integer :: ierr,i,j - real*8,dimension(nlatp2,nlonp1,nmixingeo) :: gvar2d - real*8,dimension(nmlat,nmlonp1,nmixinapex) :: avar2d + real(rp),dimension(nlatp2,nlonp1,nmixingeo) :: gvar2d + real(rp),dimension(nmlat,nmlonp1,nmixinapex) :: avar2d ! write(6,"('TIEGCM (',i3,'): inside receive')") mytid - avar2d = 0. - gvar2d = 0. + avar2d = 0.0_rp + gvar2d = 0.0_rp #ifdef GAMERA if (.not. oneway) then @@ -146,8 +147,8 @@ subroutine import_mage call import_remix(avar2d,gvar2d) ! Unit conversion - avar2d(:,:,1) = avar2d(:,:,1)*1e3 ! potential: kV -> V - gvar2d(:,:,1) = gvar2d(:,:,1)*0.5 ! mean energy -> characteristic energy + avar2d(:,:,1) = avar2d(:,:,1)*1e3_rp ! potential: kV -> V + gvar2d(:,:,1) = gvar2d(:,:,1)*0.5_rp ! mean energy -> characteristic energy endif call mpi_bcast(avar2d, nmlat*nmlonp1*nmixinapex, @@ -191,15 +192,17 @@ subroutine process_import #ifdef GAMERA use params_module,only: nlatp2,nlon,nlonp1,nlonp2,gmlat,gmlon use input_module,only: ctpoten - use cons_module,only: pi + use cons_module,only: pi,dlatm,dlonm use mpi_module,only: mytid,handle_mpi_err,TIEGCM_WORLD use mpi integer :: v,ierr,i,j,js,jn - real :: polev1,polev2, - | cpmaxsh,cpminsh,cpmaxnh,cpminnh - real*8 :: nfluxllb = 1.0e7 - real*8,dimension(nlon) :: aurllbj + real(rp) :: polev1,polev2, + | cpmaxsh,cpminsh,cpmaxnh,cpminnh, + | temp + real(rp) :: nfluxllb = 1.0e7_rp + real(rp) :: potllb = 5000._rp ! 1 kV + real(rp),dimension(nlon) :: aurllbj ! Dynamo solver requires pole values for gpotm @@ -285,15 +288,15 @@ subroutine process_import ! real*8,dimension(nlonp1,2) :: aurorabc1d - aurllbN = 0.D0 - aurllbS = 0.D0 - aurorabc1d = 0.D0 + aurllbN = 0.0_rp + aurllbS = 0.0_rp + aurorabc1d = 0.0_rp do j=1,nmlonp1 ! NORTH do i=nmlat/2+1,nmlat if(aflxm(j,i)>=nfluxllb) exit ! Find the lowest lat where numflux is above 1e6/cm^2/s enddo i = min(i,nmlat) - aurorabc1d(j,1) = max(90.-gmlat(i),15.) ! aurllbj is co-lat. + aurorabc1d(j,1) = max(90.0_rp-gmlat(i),15._rp) ! aurllbj is co-lat. enddo !!! aurllbN = maxval(aurllbj) @@ -302,12 +305,62 @@ subroutine process_import if(aflxm(j,i)>=nfluxllb) exit ! Find the lowest lat where numflux is above 1e6/cm^2/s enddo i = max(i,1) - aurorabc1d(j,2) = max(90.+gmlat(i),15.) ! aurllbj is co-lat from south pole! Backwards. + aurorabc1d(j,2) = max(90._rp+gmlat(i),15._rp) ! aurllbj is co-lat from south pole! Backwards. enddo !!! aurllbS = maxval(aurllbj) - aurllbN = maxval(aurorabc1d(:,1)) - aurllbS = maxval(aurorabc1d(:,2)) - !write(*,*) "TGCMCPL: aurora: ",aurllbN,aurllbS + aurllbN = maxval(aurorabc1d(:,1)) + aurllbS = maxval(aurorabc1d(:,2)) + !write(*,*) "TGCMCPL: aurora: ",aurllbN,aurllbS + +! ! Let's try a new method +! aurorabc1d = 0.0_rp +! grad_x = 0.0_rp +! grad_y = 0.0_rp +! grad_mag = 0.0_rp +! +! ! dumb gradient +! do j = 2,nmlon +! do i=nmlat/2+2,nmlat-1 +! grad_x(j,i) = (apotm(j+1,i) - apotm(j-1,i))/(2.0_rp)!*dlonm) +! grad_y(j,i) = (apotm(j,i+1) - apotm(j,i-1))/(2.0_rp)!*dlatm) +! end do +! do i=nmlat/2-1,2,-1 +! grad_x(j,i) = (apotm(j+1,i) - apotm(j-1,i))/(2.0_rp)!*dlonm) +! grad_y(j,i) = (apotm(j,i-1) - apotm(j,i+1))/(2.0_rp)!*dlatm) +! end do +! end do +! +! ! Compute the magnitude of the gradient +! do j = 2, nmlon +! do i = nmlat/2+2,nmlat-1 +! grad_mag(i,j) = sqrt(grad_x(j,i)**2 + grad_y(j,i)**2) +! end do +! end do +! +! ! Calculate gradient boundary +! do j=1,nmlonp1 ! NORTH +! do i=nmlat/2+1,nmlat +! if(grad_mag(j,i)>=potllb) exit ! Find the lowest lat where numflux is above 1e6/cm^2/s +! enddo +! i = min(i,nmlat) +! aurorabc1d(j,1) = max(90.0_rp-gmlat(i),15._rp) ! aurllbj is co-lat. +! enddo +!!!! aurllbN = maxval(aurllbj) +! +! do j=1,nmlonp1 ! SOUTH +! do i=nmlat/2,1,-1 +! if(grad_mag(j,i)>=potllb) exit ! Find the lowest lat where numflux is above 1e6/cm^2/s +! enddo +! i = max(i,1) +! aurorabc1d(j,2) = max(90._rp+gmlat(i),15._rp) ! aurllbj is co-lat from south pole! Backwards. +! enddo +! +! ! Keep the higher latitude between auroral and pot boundary +! temp = maxval(aurorabc1d(:,1)) +! aurllbN = min(temp,aurllbN) +! temp = maxval(aurorabc1d(:,2)) +! aurllbS = min(temp,aurllbS) + #endif @@ -323,15 +376,15 @@ subroutine export_mage(modeltime) integer,dimension(4),intent(in) :: modeltime logical :: hidra_prep - real,dimension(:,:,:), allocatable :: mixgeoout,mixapexout - real,dimension(:,:,:,:), allocatable :: hidraout + real(rp),dimension(:,:,:), allocatable :: mixgeoout,mixapexout + real(rp),dimension(:,:,:,:), allocatable :: hidraout integer :: nreq,i #if defined (GAMERA) || defined (HIDRA) ! Prepare the export data hidra_prep = .false. nreq = 0 - if (mytid == 0) write(*,*) "T Starting Export Prep" + !if (mytid == 0) write(*,*) "T Starting Export Prep" do i=1,CplCommSize ! Skip Self if (i == CplRank+1) continue @@ -457,7 +510,8 @@ subroutine prep_export_hidra(modeltime,hidra_out) ! ... Local variables .................................................. integer :: i,j,v,k,ierr, ilist(nhoutvar) - real,dimension(:,:,:,:),allocatable :: f3d_sub,f3d_glb,hidra_out + real(rp),dimension(:,:,:,:),allocatable :: f3d_sub,f3d_glb, + | hidra_out ! ... Begin ............................................................ @@ -487,7 +541,7 @@ subroutine prep_export_hidra(modeltime,hidra_out) do i=1,nlon do j=1,nlat do k=1,nlevp1-1 - if ((f3d_glb(k,i,j,1) .lt.1e-5) .or. + if ((f3d_glb(k,i,j,1) .lt.1e-5_rp) .or. | (isnan(f3d_glb(k,i,j,1)))) then write(*,*) "Bad TN: ",f3d_glb(k,i,j,1),k,i,j endif @@ -528,7 +582,7 @@ subroutine export_hidra(hidra_out,commId,hidraCplRank) use mpi_module,only: CplComm,handle_mpi_err,mytid use mpi - real,dimension(:,:,:,:) :: hidra_out + real(rp),dimension(:,:,:,:) :: hidra_out integer :: commId,ierr,hidraCplRank ! Export the data @@ -554,7 +608,7 @@ subroutine prep_export_remix(modeltime,avar2d,gvar2d) | mp_gather_pdyn use mpi_module,only: lon0,lon1,lat0,lat1,mp_gather_f2d use addfld_module,only: addfld - use fields_module,only: zigm1,zigm2 + use fields_module,only: azigm1,azigm2 use mpi ! ... Parameter variables .............................................. @@ -562,21 +616,21 @@ subroutine prep_export_remix(modeltime,avar2d,gvar2d) ! ... Local variables .................................................. integer :: i,j,v,ierr - real,dimension(:,:,:),allocatable :: avar2d,gvar2d + real(rp),dimension(:,:,:),allocatable :: avar2d,gvar2d - real :: amsub(mlon0:mlon1,mlat0:mlat1,nmixoutapex) - real :: amglb(nmlonp1,nmlat,nmixoutapex) + real(rp) :: amsub(mlon0:mlon1,mlat0:mlat1,nmixoutapex) + real(rp) :: amglb(nmlonp1,nmlat,nmixoutapex) - real,allocatable,dimension(:,:,:) :: gsub - real,allocatable,dimension(:,:,:) :: gglb + real(rp),allocatable,dimension(:,:,:) :: gsub + real(rp),allocatable,dimension(:,:,:) :: gglb ! ... Begin ............................................................ ! Prepare data for export - amsub(:,:,1) = zigm1(mlon0:mlon1,mlat0:mlat1) - amsub(:,:,2) = zigm2(mlon0:mlon1,mlat0:mlat1) + amsub(:,:,1) = azigm1(mlon0:mlon1,mlat0:mlat1) + amsub(:,:,2) = azigm2(mlon0:mlon1,mlat0:mlat1) - where(amsub < 0.2) amsub = 0.2 + where(amsub < 0.2_rp) amsub = 0.2_rp call mp_gather_pdyn(amsub,mlon0,mlon1,mlat0,mlat1, | amglb,nmlonp1,nmlat,nmixoutapex) @@ -610,7 +664,7 @@ subroutine prep_export_remix(modeltime,avar2d,gvar2d) gsub(:,:,v) = gzigm1 case(2) gsub(:,:,v) = gzigm2 - where(gsub < 0.2) gsub = 0.2 + where(gsub < 0.2_rp) gsub = 0.2_rp case(3) gsub(:,:,v) = gnsrhs end select @@ -662,7 +716,7 @@ subroutine export_remix(avar2d,gvar2d) | myAppId,voltId use mpi - real,dimension(:,:,:) :: avar2d,gvar2d + real(rp),dimension(:,:,:) :: avar2d,gvar2d integer :: ierr ! Export the data @@ -697,10 +751,10 @@ subroutine init_mpi_remix(glatp2,glonp1,gmlat,gmlon) use mpi integer :: ierr,i - real,dimension(nlatp2) :: glatp2 - real,dimension(nlonp1) :: glonp1 - real,dimension(nmlat):: gmlat - real,dimension(nmlonp1):: gmlon + real(rp),dimension(nlatp2) :: glatp2 + real(rp),dimension(nlonp1) :: glonp1 + real(rp),dimension(nmlat):: gmlat + real(rp),dimension(nmlonp1):: gmlon if (CplComm /= MPI_COMM_NULL) then i = 0 @@ -771,7 +825,7 @@ subroutine import_remix(avar2d,gvar2d) use mpi integer :: v,ierr,i,j - real,dimension(:,:,:) :: avar2d,gvar2d + real(rp),dimension(:,:,:) :: avar2d,gvar2d if (CplComm /= MPI_COMM_NULL) then !write(*,*) "GCMCPL: ", mixCplRank,(myAppId+voltId)*100 @@ -928,17 +982,17 @@ subroutine mage_ucurrent(rim1,rim2,mlon0,mlon1,mlat0,mlat1,nsrhs) ! Calculate height-integrated field-aligned neutral wind currents for both hemisphere ! integer,intent(in) :: mlon0,mlon1,mlat0,mlat1 - real,intent(in) :: rim1(mlon0-1:mlon1+1,mlat0-1:mlat1+1), + real(rp),intent(in) :: rim1(mlon0-1:mlon1+1,mlat0-1:mlat1+1), | rim2(mlon0-1:mlon1+1,mlat0-1:mlat1+1) - real,intent(out) :: nsrhs(mlon0-1:mlon1+1,mlat0-1:mlat1+1) + real(rp),intent(out) :: nsrhs(mlon0-1:mlon1+1,mlat0-1:mlat1+1) ! ! Local: ! - real,parameter :: unitvm(nmlon)=1. - real :: cs(mlat0-1:mlat1+1) - real :: dfac - real :: fmsub(mlon0:mlon1,mlat0:mlat1) + real(rp),parameter :: unitvm(nmlon)=1. + real(rp) :: cs(mlat0-1:mlat1+1) + real(rp) :: dfac + real(rp) :: fmsub(mlon0:mlon1,mlat0:mlat1) integer :: j,i integer mlon00,mlon11,mlat00,mlat11 integer latstart, latend diff --git a/src/mpi.F b/src/mpi.F index 2c51a64..aa7b133 100644 --- a/src/mpi.F +++ b/src/mpi.F @@ -219,102 +219,17 @@ subroutine mp_init call shutdown('mpi_comm_rank error') endif -!!!!! - if (mytid == 0) then - color = mageId ! Unique ID for all coupling ranks - else - color = MPI_UNDEFINED ! No message passing on other processes - endif - - write(*,*) "TGCM COUPLING ON COMM: ",mageId - call mpi_comm_split(MPI_COMM_WORLD,color,mytid,CplComm,ier) - if (ier /= 0) then - write(6,"('>>> Error from mpi_comm_split: ier=',i4)") ier - call shutdown('mpi_comm_split error') - endif - -! This can only happen to the root (mytid == 0) - if (CplComm /= MPI_COMM_NULL) then - call mpi_comm_size(CplComm,CplCommSize,ier) - if (ier /= 0) then - write(6,"('>>> Error from mpi_comm_size: ier=',i4)") ier - call shutdown('mpi_comm_size error') - endif - -! At most two processes will register in CplComm (TIEGCM root, REMIX root) -! Therefore CplCommSize is either 1 or 2 - if (CplCommSize == 1) then - -! Only one process registered in CplComm (TIEGCM root) -! No coupling will take place, free up the resources - call mpi_comm_free(CplComm,ier) - if (ier /= 0) then - write(6,"('>>> Error from mpi_comm_free: ier=',i4)") ier - call shutdown('mpi_comm_free error') - endif - CplComm = MPI_COMM_NULL - else - -! There is another process registered in CplComm (REMIX root) - call mpi_comm_rank(CplComm,CplRank,ier) - if (ier /= 0) then - write(6,"('>>> Error from mpi_comm_rank: ier=',i4)") ier - call shutdown('mpi_comm_rank error') - endif - - if (.not.allocated(IAm)) allocate(IAm(CplCommSize)) - IAm(CplRank+1) = myAppId - - do i=1,CplCommSize - call MPI_Bcast(IAm(i), 1, MPI_INTEGER, i-1, CplComm, ier) - enddo - - do i=1,CplCommSize - ! Assign rank if match - select case (IAm(i)) - case (voltId) - mixCplRank = i-1 - doVoltCommSkip = .true. - write(*,*) "T coupling to remix" - case (gamId) - write(*,*) "T not coupling to Gam yet" - case (rcmId) - write(*,*) "T not coupling to RCM yet" - case (hidraNId) - hidraNCplRank = i-1 - write(*,*) "T coupling to hidraN" - case (hidraSId) - hidraSCplRank = i-1 - write(*,*) "T coupling to hidraS" - case (hidraId) - hidraCplRank = i-1 - write(*,*) "T coupling to hidra" - case (myAppId) - write(*,*) "T is T" - case default - write(*,*) "T does not know about this Coupling ID: ", - | IAm(i) - end select - enddo - endif - write(*,'(A,I0,A,I0,A,I0,A)') "T COUPLING to ",CplCommSize, - | " Models on ",CplRank," Rank on ",CplComm," Comm" - endif + call mp_coupling(mytid) - ! only mytid == 0 should have updated doVoltCommSkip - call MPI_BCAST(doVoltCommSkip,1,MPI_LOGICAL,0,TIEGCM_WORLD,ier) - call MPI_BCAST(CplCommSize,1,MPI_INTEGER,0,TIEGCM_WORLD,ier) - if (.not.allocated(IAm)) allocate(IAm(CplCommSize)) - call MPI_BCAST(IAm,CplCommSize,MPI_INTEGER,0,TIEGCM_WORLD,ier) ! -#ifdef GAMERA - if (doVoltCommSkip) then +!@#ifdef GAMERA +!@ if (doVoltCommSkip) then ! gam2volt ! WARNING THIS IS HARDCODED TO OCCUR ONCE. MAY CAUSE ISSUES WITH MULTIPLE COUPLINGS - call mpi_comm_split(MPI_COMM_WORLD, MPI_UNDEFINED, - | mytid, tmpComm, ier) - endif -#endif +!@ call mpi_comm_split(MPI_COMM_WORLD, MPI_UNDEFINED, +!@ | mytid, tmpComm, ier) +!@ endif +!@#endif ! ! Allocate array of tasks (user defined type(task)): allocate(tasks(0:ntask-1),stat=ier) @@ -325,66 +240,137 @@ subroutine mp_init ! write(6,"('mp_init: ntask=',i3,' mytid=',i3)") ntask,mytid end subroutine mp_init !----------------------------------------------------------------------- - subroutine mp_coupling(mytid,CommId,CplComm,CplRank) - integer :: mytid, CommId, CplComm,CplRank - integer :: ier,color,CplCommSize -! Create a second communicator to transfer data between TIEGCM and REMIX + subroutine mp_coupling(mytid) + integer :: mytid + integer :: ier,color,i + + integer :: tmpComm + tmpComm = MPI_COMM_WORLD +! Create a second communicator to transfer data between TIEGCM and MAGE ! This communicator only includes the root processes -! TIEGCM root sends/receives data from/to REMIX root +! TIEGCM root sends/receives data from/to MAGE root + +!!!!! if (mytid == 0) then - color = CommId ! Unique ID on both sides (TIEGCM/VOLTRON) + color = mageId ! Unique ID for all coupling ranks else - color = MPI_UNDEFINED ! No message passing on other processes + color = MPI_UNDEFINED ! No message passing on other processes endif - write(*,*) "TGCM COUPLING ON COMM: ",CommId - call mpi_comm_split(MPI_COMM_WORLD,color,mytid,CplComm,ier) - if (ier /= 0) then - write(6,"('>>> Error from mpi_comm_split: ier=',i4)") ier - call shutdown('mpi_comm_split error') - endif - -! This can only happen to the root (mytid == 0) + tmpComm = MPI_COMM_WORLD + call mp_get_coupling_comm(tmpComm,color, + | 0, CplComm) + + ! This can only happen to the root (mytid == 0) if (CplComm /= MPI_COMM_NULL) then call mpi_comm_size(CplComm,CplCommSize,ier) if (ier /= 0) then - write(6,"('>>> Error from mpi_comm_size: ier=',i4)") ier - call shutdown('mpi_comm_size error') + write(6,"('>>> Error from mpi_comm_size: ier=',i4)") ier + call shutdown('mpi_comm_size error') endif - -! At most two processes will register in CplComm (TIEGCM root, REMIX root) -! Therefore CplCommSize is either 1 or 2 + + ! At most two processes will register in CplComm (TIEGCM root, REMIX root) + ! Therefore CplCommSize is either 1 or 2 if (CplCommSize == 1) then - -! Only one process registered in CplComm (TIEGCM root) -! No coupling will take place, free up the resources - call mpi_comm_free(CplComm,ier) - if (ier /= 0) then - write(6,"('>>> Error from mpi_comm_free: ier=',i4)") ier - call shutdown('mpi_comm_free error') - endif - CplComm = MPI_COMM_NULL + + ! Only one process registered in CplComm (TIEGCM root) + ! No coupling will take place, free up the resources + call mpi_comm_free(CplComm,ier) + if (ier /= 0) then + write(6,"('>>> Error from mpi_comm_free: ier=',i4)") ier + call shutdown('mpi_comm_free error') + endif + CplComm = MPI_COMM_NULL else + + ! There is another process registered in CplComm (REMIX root) + call mpi_comm_rank(CplComm,CplRank,ier) + if (ier /= 0) then + write(6,"('>>> Error from mpi_comm_rank: ier=',i4)") ier + call shutdown('mpi_comm_rank error') + endif -! There is another process registered in CplComm (REMIX root) - call mpi_comm_rank(CplComm,CplRank,ier) - if (ier /= 0) then - write(6,"('>>> Error from mpi_comm_rank: ier=',i4)") ier - call shutdown('mpi_comm_rank error') - endif + if (.not.allocated(IAm)) allocate(IAm(CplCommSize)) + IAm(CplRank+1) = myAppId -! write(6,"('TIEGCM: CplComm,CplCommSize,CplRank,tag=', -! | 4i4)") CplComm,CplCommSize,CplRank,myAppId+voltID + do i=1,CplCommSize + call MPI_Bcast(IAm(i), 1, MPI_INTEGER, i-1, CplComm, ier) + enddo -! CplRank is TIEGCM rank in CplComm -! REMIX rank is the other (0/1) - CplRank = 1-CplRank + do i=1,CplCommSize + ! Assign rank if match + select case (IAm(i)) + case (voltId) + mixCplRank = i-1 + write(*,*) "T coupling to remix" + case (gamId) + write(*,*) "T not coupling to Gam yet" + case (rcmId) + write(*,*) "T not coupling to RCM yet" + case (hidraNId) + hidraNCplRank = i-1 + write(*,*) "T coupling to hidraN" + case (hidraSId) + hidraSCplRank = i-1 + write(*,*) "T coupling to hidraS" + case (hidraId) + hidraCplRank = i-1 + write(*,*) "T coupling to hidra" + case (myAppId) + write(*,*) "T is T" + case default + write(*,*) "T does not know about", + | " this Coupling ID: ", IAm(i) + end select + enddo endif - write(*,*) "T COUPLING: ",mytid,CplRank,CplCommSize,CplComm - endif + write(*,'(A,I0,A,I0,A,I0,A)') "T COUPLING to ",CplCommSize, + | " Models on ",CplRank," Rank on ",CplComm," Comm" + endif + + call MPI_BCAST(CplCommSize,1,MPI_INTEGER,0,TIEGCM_WORLD,ier) + if (.not.allocated(IAm)) allocate(IAm(CplCommSize)) + call MPI_BCAST(IAm,CplCommSize,MPI_INTEGER,0,TIEGCM_WORLD,ier) end subroutine mp_coupling !----------------------------------------------------------------------- + subroutine mp_get_coupling_comm( + | couplingPool,appId,key,coupledComm) + + integer, intent(inout) :: couplingPool + integer, intent(in) :: appId, key + integer, intent(inout) :: coupledComm + + integer :: ierr, myRank, appIdCpy + appIdCpy = appId ! + ! mpi_bcast doesn't interact well with intent(in) + + ! tell everyone I'm the broadcasting root + ! broadcast which app I'm creating a communicator with, split with it, and then + ! create a smaller pool that excludes that app + call MPI_comm_rank(couplingPool, myRank, ierr) + call MPI_Allreduce(MPI_IN_PLACE, myRank, 1, MPI_INTEGER, + | MPI_MAX, couplingPool, ierr) + ! This Bcast is causing a lot of issues. I don't know if this is needed or + ! if it will cause problems for voltron and other models. The behavior here is odd. + call MPI_Bcast(appIdCpy, 1, MPI_INTEGER, myRank, + | couplingPool, ierr) + ! This is a quick hack to force only rank 0 to couple + if (mytid /= 0) then + appIdCpy = MPI_UNDEFINED + endif + + call MPI_comm_split(couplingPool, appIdCpy, key, + | coupledComm, ierr) + ! key is never used when making the exclusion pool, 0 is used to preserve order + call MPI_comm_split(couplingPool, myAppId, 0, + | couplingPool, ierr) + + end subroutine mp_get_coupling_comm + +!----------------------------------------------------------------------- + + subroutine mp_distribute_geo ! ! Set up 2-d data decomposition in lat,lon. Define structure array diff --git a/src/nchist.F b/src/nchist.F index e3192b8..b681cba 100644 --- a/src/nchist.F +++ b/src/nchist.F @@ -535,6 +535,11 @@ subroutine nc_rdhist(ncid,diskfile,mtime,itime,ier) sh%initial_mtime=ivar1(1) if (istat /= NF_NOERR) | call handle_ncerr(istat,'getting att initial_mtime') + if ((sh%initial_mtime(1) .eq. 0) .or. + | (sh%initial_mtime(1) .eq. sh%initial_mtime(2) .and. + | sh%initial_mtime(2) .eq. sh%initial_mtime(3) )) then + sh%initial_mtime = sh%source_mtime + endif endif ! case('mtime') ! already got it from hist search above diff --git a/src/oplus.F b/src/oplus.F index 6f611e4..341ab6d 100644 --- a/src/oplus.F +++ b/src/oplus.F @@ -1,179 +1,329 @@ ! module oplus_module ! -! This software is part of the NCAR TIE-GCM. Use is governed by the -! Open Source Academic Research License Agreement contained in the file +! This software is part of the NCAR TIE-GCM. Use is governed by the +! Open Source Academic Research License Agreement contained in the file ! tiegcmlicense.txt. -! - use params_module,only: nlat,nlonp4,dz,nlon,dlev,nlevp1 - use magfield_module,only: bx,by,bz,bmod2 ! (nlonp4,-1:nlat+2) - use addfld_module,only: addfld - use diags_module,only: mkdiag_BXYZ,mkdiag_BMAG ! ! VT vampir tracing: ! #ifdef VT #include #endif +! implicit none +! +! 2024/09 Haonan Wu: rewrite the whole oplus module +! to split calculations independent of O+ sub-cycling +! this will speed up the model a little +! when the number of O+ sub-cycling is large ! contains !----------------------------------------------------------------------- - subroutine oplus(tn,te,ti,o2,o1,he,n2,n2d,ne,u,v,w,ui,vi,wi, + subroutine oplus(tn,te,ti,o2,o1,he,n2,n2d,ne,un,vn,w,ui,vi,wi, | xnmbar,scht,op,optm1,opout,optm1out,xiop2p,xiop2d,Fe,Fn, | lev0,lev1,lon0,lon1,lat0,lat1) ! ! Update O+ ion at 3d task subdomain. -! Outputs are opout, optm1out, xiop2p, and xiop2d, all other args -! are input. -! There are 4 latitude scans, with 3d mpi calls in between the loops. -! (see also 3d gather/scatter calls in sub filter_op). +! Outputs are opout, optm1out, xiop2p, xiop2d, Fe, and Fn, +! all other args are input. +! + use params_module,only: rp + use input_module,only: nstep_sub + use mpi_module,only: mp_polelats_f3d,mp_bndlats_f3d,mp_bndlons_f3d + use addfld_module,only: addfld +! +! Args: + integer,intent(in) :: + | lev0,lev1, ! first,last pressure indices for current task (bot->top) + | lon0,lon1, ! first,last longitude indices for current task (W->E) + | lat0,lat1 ! first,last latitude indices for current task (S->N) +! +! Input fields (full 3d task subdomain): + real(rp),dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2), + | intent(in) :: + | tn, te, ti, ! neutral, electron, and ion temperatures (deg K) + | o2, o1, he, ! O2, O, He mass mixing ratios + | n2, ! N2 mass mixing ratio + | n2d, ! N(2D) mass mixing ratio + | ne, ! electron density + | un,vn,w, ! neutral wind velocities (zonal, meridional, omega) + | ui,vi,wi, ! zonal, meridional, and vertical ion velocities + | xnmbar, ! p0*e(-z)*mbar/kT + | scht, ! scale height + | op, ! O+ ion + | optm1 ! O+ at time n-1 +! +! Output fields (full 3d task subdomain): + real(rp),dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2), + | intent(out) :: + | opout, ! O+ output for next timestep + | optm1out, ! O+ output for time n-1 + | xiop2p,xiop2d,Fe,Fn +! +! Local: + integer :: k,i,lat,nlevs,istep + real(rp),dimension(lon0-2:lon1+2,lat0-2:lat1+2) :: + | dvb,ubcrhs,lbcrhs + real(rp),dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2) :: + | tp,dj,bdotu,op_prod,op_loss,diffp,diffq,diffr, + | driftp,driftq,driftr,windp,windq,windr, + | p_coeff,q_coeff,r_coeff,optm1_smooth, + | op_sub,optm1_sub,opout_sub,optm1out_sub, + | diffj,diffexp,vdotn_h,bdotdh_bvel + real(rp),dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2,2) :: + | tmpf3d +! +! Number of pressure levels (this will equal nlevp1): + nlevs = lev1-lev0+1 ! for bndlons calls ! + call prep_oplus(tn,te,ti, + | o2,o1,he,n2,n2d,ne,un,vn,w,wi,xnmbar,scht, + | dvb,ubcrhs,lbcrhs,tp,dj,bdotu,xiop2p,xiop2d, + | op_prod,op_loss,diffp,diffq,diffr, + | driftp,driftq,driftr,windp,windq,windr, + | p_coeff,q_coeff,r_coeff, + | lev0,lev1,lon0,lon1,lat0,lat1) +! + do lat=lat0-2,lat1+2 + do i=lon0-2,lon1+2 + do k=lev0,lev1 + op_sub(k,i,lat) = op(k,i,lat) + optm1_sub(k,i,lat) = optm1(k,i,lat) + enddo ! k=lev0,lev1 + enddo ! i=lon0-2,lon1+2 + enddo ! lat=lat0-2,lat1+2 +! + do istep=1,nstep_sub + call smooth_oplus(optm1_sub,optm1_smooth, + | lev0,lev1,lon0,lon1,lat0,lat1) +! + call iterate_oplus(dvb,ubcrhs,lbcrhs,tp,dj,bdotu, + | optm1_smooth,op_prod,ui,vi,scht,p_coeff,q_coeff,r_coeff, + | op_sub,opout_sub,diffj,diffexp,vdotn_h,bdotdh_bvel, + | lev0,lev1,lon0,lon1,lat0,lat1) +! + if (istep == nstep_sub) + | call calc_terms(xnmbar,diffj,Fe,Fn, + | opout_sub,optm1_smooth,op_prod,op_loss, + | diffexp,diffp,diffq,diffr, + | vdotn_h,driftp,driftq,driftr, + | bdotdh_bvel,windp,windq,windr, + | lev0,lev1,lon0,lon1,lat0,lat1) +! +! Filter updated O+: + call filter_op(opout_sub(:,lon0:lon1,lat0:lat1), + | lev0,lev1,lon0,lon1,lat0,lat1,'OPLUS') +! +! do lat=lat0,lat1 +! call addfld('OP_FILT',' ',' ',opout_sub(:,lon0:lon1,lat), +! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) +! enddo ! lat=lat0,lat1 +! + call post_oplus(op_sub,optm1_sub,opout_sub,optm1out_sub, + | lev0,lev1,lon0,lon1,lat0,lat1) +! + do lat=lat0,lat1 + do i=lon0,lon1 + do k=lev0,lev1 + tmpf3d(k,i,lat,1) = opout_sub(k,i,lat) + tmpf3d(k,i,lat,2) = optm1out_sub(k,i,lat) + enddo ! k=lev0,lev1 + enddo ! i=lon0,lon1 + enddo ! lat=lat0,lat1 + call mp_polelats_f3d(tmpf3d(:,lon0:lon1,:,:), + | lev0,lev1,lon0,lon1,lat0,lat1,2,(/1.,1./)) + call mp_bndlats_f3d(tmpf3d,nlevs,lon0,lon1,lat0,lat1,2) + call mp_bndlons_f3d(tmpf3d,nlevs,lon0,lon1,lat0,lat1,2,0) + do lat=lat0-2,lat1+2 + do i=lon0-2,lon1+2 + do k=lev0,lev1 + opout_sub(k,i,lat) = tmpf3d(k,i,lat,1) + optm1out_sub(k,i,lat) = tmpf3d(k,i,lat,2) + enddo ! k=lev0,lev1 + enddo ! i=lon0-2,lon1+2 + enddo ! lat=lat0-2,lat1+2 +! + do lat=lat0-2,lat1+2 + do i=lon0-2,lon1+2 + do k=lev0,lev1 + op_sub(k,i,lat) = opout_sub(k,i,lat) + optm1_sub(k,i,lat) = optm1out_sub(k,i,lat) + enddo ! k=lev0,lev1 + enddo ! i=lon0-2,lon1+2 + enddo ! lat=lat0-2,lat1+2 + enddo ! istep=1,nstep_sub +! + do lat=lat0-2,lat1+2 + do i=lon0-2,lon1+2 + do k=lev0,lev1 + opout(k,i,lat) = opout_sub(k,i,lat) + optm1out(k,i,lat) = optm1out_sub(k,i,lat) + enddo ! k=lev0,lev1 + enddo ! i=lon0-2,lon1+2 + enddo ! lat=lat0-2,lat1+2 +! + end subroutine oplus +!----------------------------------------------------------------------- + subroutine prep_oplus(tn,te,ti, + | o2,o1,he,n2,n2d,ne,un,vn,w,wi,xnmbar,scht, + | dvb,ubcrhs,lbcrhs,tp,dj,bdotu,xiop2p,xiop2d, + | op_prod,op_loss,diffp,diffq,diffr, + | driftp,driftq,driftr,windp,windq,windr, + | p_coeff,q_coeff,r_coeff, + | lev0,lev1,lon0,lon1,lat0,lat1) +! +! Calculate terms that do not change with O+ sub-cycling +! + use params_module,only: nlonp4,dz,zpmid,spval,rp use cons_module,only: rmass_op,gask,grav,re,cs,dphi,dlamda, - | shapiro,dtx2inv,rmassinv_o2,rmassinv_o1, - | rmassinv_n2,rmassinv_n2d,dtsmooth,dtsmooth_div2 - use qrj_module,only: + | boltz,dtx2inv,pi,dtr,rmassinv_o2,rmassinv_o1, + | rmassinv_he,rmassinv_n2,rmassinv_n2d + use input_module,only: nstep_sub,colfac, + | opdiffcap,opdiffrate,opdifflev + use chapman_module,only: chi ! was t2 in old sub opflux + use qrj_module,only: | qop2p, ! O+(2p) ionization from qrj, used in xiop2p | qop2d, ! O+(2d) ionization from qrj, used in xiop2d | qop ! O+ ionization from qrj use chemrates_module,only: ! needed chemical reaction rates | rk1 ,rk2 ,rk10,rk16,rk17,rk18,rk19,rk20, | rk21,rk22,rk23,rk24,rk25,rk26,rk27 - use input_module,only: nstep_sub - use magfield_module,only: dipmag,sndec,csdec - use mpi_module,only: mp_bndlons_f3d, mp_periodic_f3d, - | mp_polelats_f3d,mp_geo_halos_f3d,mp_bndlats_f3d + use magfield_module,only: bx,by,bz,bmod2, ! (nlonp4,-1:nlat+2) + | rlatm + use mpi_module,only: mp_periodic_f2d, + | mp_polelats_f3d,mp_bndlats_f3d,mp_bndlons_f3d + use addfld_module,only: addfld + use diags_module,only: mkdiag_BXYZ,mkdiag_BMAG ! ! Args: - integer,intent(in) :: + integer,intent(in) :: | lev0,lev1, ! first,last pressure indices for current task (bot->top) | lon0,lon1, ! first,last longitude indices for current task (W->E) | lat0,lat1 ! first,last latitude indices for current task (S->N) ! ! Input fields (full 3d task subdomain): - real,dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2), + real(rp),dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2), | intent(in) :: | tn, te, ti, ! neutral, electron, and ion temperatures (deg K) - | o2, o1, ! o2, o mass mixing ratios - | he, ! he mass mixing ratio - | n2d, ! n2d + | o2, o1, he, ! O2, O, He mass mixing ratios + | n2, ! N2 mass mixing ratio + | n2d, ! N(2D) mass mixing ratio | ne, ! electron density - | u,v,w, ! neutral wind velocities (zonal, meridional, omega) - | optm1, ! O+ at time n-1 - | op, ! O+ ion - | ui,vi,wi, ! zonal, meridional, and vertical ion velocities + | un,vn,w, ! neutral wind velocities (zonal, meridional, omega) + | wi, ! vertical ion velocities | xnmbar, ! p0*e(-z)*mbar/kT | scht ! scale height ! -! N2 is intent(inout) for setting halo points (mp_geo_halos_f3d call below) - real,dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2), - | intent(inout) :: n2 +! Output fields (full 2d task subdomain): + real(rp),dimension(lon0-2:lon1+2,lat0-2:lat1+2),intent(out) :: + | dvb, ! output of sub divb + | ubcrhs,lbcrhs ! ! Output fields (full 3d task subdomain): - real,dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2), + real(rp),dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2), | intent(out) :: - | opout, ! O+ output for next timestep - | optm1out, ! O+ output for time n-1 - | xiop2p,xiop2d,Fe,Fn -! -! Local: - integer :: k,i,lonbeg,lonend,lat,ier,nlevs - integer :: jm2,jm1,jp1,jp2 ! lat-2, lat-1, lat+1, lat+2 - real,dimension(lon0:lon1,lat0:lat1) :: - | opflux, ! upward number flux of O+ (returned by sub oplus_flux) (t7) - | dvb ! output of sub divb - real,dimension(lon0:lon1) :: - | ubca, ubcb ! O+ upper boundary condition (were t2,t3) - real :: explic = 1., gmr - real,dimension(lev0:lev1,lon0:lon1) :: - | bdzdvb_op, ! was s7 - | explicit, ! was s4 - | hdz, ! was s15 - | tphdz1,tphdz0, ! were s13,s12 (using gmr) - | djint, ! was s11 - | divbz, ! was s7 (DIV(B)+(DH*D*BZ)/(D*BZ) - | hdzmbz,hdzpbz, ! were s10,s9 - | p_coeff,q_coeff,r_coeff, ! coefficients for tridiagonal solver (s1,s2,s3) - | tp1, ! 0.5*(te+ti) - | wd,bdotdh_djbz,op_prod,op_loss_out,dopdt, - | diffsum,driftsum,windsum - real,dimension(lev0:lev1,lon0:lon1,lat0-1:lat1+1) :: hj ! (s10-s12) -! -! Local fields at 3d subdomain (must be 3d to bridge latitude scans): - real,dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2) :: - | bdotu, ! was s7 (B.U) - | bvel, - | diffj, ! (D/(H*DZ)*2.*TP+M*G/R)*N(O+) (s7,s8,s9) - | tp, ! Plasma temperature (te+ti) - | tr, ! Reduced temperature 0.5*(tn+ti) - | bdotdh_op, ! (b(h)*del(h))*phi - | bdotdh_opj, ! (b(h)*del(h))*phi - | bdotdh_diff, ! (b(h)*del(h))*phi + | tp, ! Plasma temperature 0.5*(te+ti) | dj, ! diffusion coefficients (s13,s14,s15) - | optm1_smooth,! op at time n-1, with shapiro smoother (was s1) - | optm1_smooth2, + | bdotu, ! was s7 (B.U) + | op_prod, ! production rate | op_loss, ! was s13 - | vni,djbz,vdotn_h,bdotdh_bvel,diffexp, - | diffp,diffq,diffr,driftp,driftq,driftr,windp,windq,windr - real,dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2,5) :: f5 - logical,parameter :: debug=.false. ! if set write print statements to stdout -! -! External: - real,external :: fslt + | xiop2p,xiop2d, + | diffp,diffq,diffr, ! tridiagonal coefficients related to diffusion + | driftp,driftq,driftr, ! tridiagonal coefficients related to ion drift + | windp,windq,windr, ! tridiagonal coefficients related to wind + | p_coeff,q_coeff,r_coeff ! coefficients for tridiagonal solver (s1,s2,s3) ! - if (debug) write(6,"('Enter oplus.')") -#ifdef VT -! code = 113 ; state = 'oplus' ; activity='ModelCode' - call vtbegin(113,ier) -#endif +! Local: + real(rp),parameter :: + | phid = 2.0e8, + | phin = -2.0e8, + | ppolar = 0., + | mp = 1.6726e-24 ! proton mass (g) + integer :: k,i,lat,lonbeg,lonend,nlevs + real(rp) :: a,djmin,gmr + real(rp),dimension(lon0:lon1,lat0:lat1) :: + | phi, opflux, ! upward number flux of O+ (returned by sub oplus_flux) (t7) + | dbxdx, dbycdy, ! lon/lat derivatives of unit vector B + | dvb_h, ! horizontal divergence of unit vector B + | ubca, ubcb ! O+ upper boundary condition (were t2,t3) + real(rp),dimension(lev0:lev1,lon0:lon1,lat0:lat1) :: + | bdotdh_djbz, ! (B(H).DEL(H))(D*BZ) + | hdz,hdzi, ! was s15 + | tp1, ! 0.5*(te+ti) + | djint, ! was s11 + | tphdz1,tphdz0, ! were s13,s12 (using gmr) + | bdotdh_djbz2, ! (B(H).DEL(H))(D*BZ) / (D*BZ) + | divbz, ! was s7 (DIV(B)+(DH*D*BZ)/(D*BZ) + | hdzmbz,hdzpbz, ! were s10,s9 + | djint_tphdz0,djint_tphdz1, + | djint_tphdz0_1,djint_tphdz1_1, + | bdotu_m1,bdotu_p1,wii + real(rp),dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2) :: + | tr, ! Reduced temperature 0.5*(tn+ti) + | vni, ! O+ collision frequency + | djbz, ! D*BZ + | o2_cm3,o1_cm3,he_cm3,n2_cm3,n2d_cm3 + real(rp),dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2,2) :: + | tmpf3d ! ! Number of pressure levels (this will equal nlevp1): nlevs = lev1-lev0+1 ! for bndlons calls - ! -! Make latitudes j=-1,0 from j=2,1, and j=nlat+1,nlat+2 from nlat-1,nlat for n2, -! then define 2d halos points. Note that mp_geo_halos_f3d and mp_polelats_f3d -! do not define "outside corner" halo points, but this should be ok since -! cross-derivatives are not performed. +! Calculate O+ number flux in opflux for sub oplus (was sub opflux). ! - call mp_polelats_f3d(n2(:,lon0:lon1,:), ! 3rd dim is lat0-2:lat1+2 - | lev0,lev1,lon0,lon1,lat0,lat1,1,(/1./)) ! last arg means no change in polesign - call mp_geo_halos_f3d(n2,lev0,lev1,lon0,lon1,lat0,lat1,1) +! Change upper boundary flux as electron heat flux in settei + do lat=lat0,lat1 + do i=lon0,lon1 + if (abs(rlatm(i,lat)) >= pi/4.5) then + a = 1. + elseif (abs(rlatm(i,lat)) <= pi/18.) then + a = 0. + else + a = .5*(1.-cos(abs(rlatm(i,lat))*6.-pi/3.)) + endif ! -! Save inputs to secondary history file: -! -! do lat=lat0,lat1 -! call addfld('TE_OP',' ',' ',te(lev0:lev1-1,lon0:lon1,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! call addfld('TI_OP',' ',' ',ti(lev0:lev1-1,lon0:lon1,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! call addfld('N2D_OP',' ',' ',n2d(:,lon0:lon1,lat), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('NE_OP',' ',' ',ne(:,lon0:lon1,lat), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('OPTM1',' ',' ',optm1(:,lon0:lon1,lat), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('OP_OPLUS',' ',' ',op(:,lon0:lon1,lat), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('UI_OP',' ',' ',ui(:,lon0:lon1,lat), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('VI_OP',' ',' ',vi(:,lon0:lon1,lat), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('WI_OP',' ',' ',wi(:,lon0:lon1,lat), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! enddo ! lat=lat0,lat1 + if (chi(i,lat) >= 100.*dtr) then + phi(i,lat) = phin + elseif (chi(i,lat) <= 80.*dtr) then + phi(i,lat) = phid + else + phi(i,lat) = .5*(phid+phin+(phid-phin)*cos(chi(i,lat)*9.)) + endif +! + opflux(i,lat) = phi(i,lat)*a ! -! Sub oplus_flux returns upward number flux of O+ in +! Add ppolar if magnetic latitude >= 60 degrees: + if (abs(rlatm(i,lat)) >= pi/3.) + | opflux(i,lat) = opflux(i,lat)+ppolar + enddo ! i=lon0,lon1 + enddo ! lat=lat0,lat1 ! - call oplus_flux(opflux,lon0,lon1,lat0,lat1) - if (debug) write(6,"('oplus after oplus_flux.')") ! call addfld('OPFLUX',' ',' ',opflux, ! | 'lon',lon0,lon1,'lat',lat0,lat1,0) ! -! Divergence is returned in dvb(lon0:lon1,lat0:lat1) by sub divb: - call divb(dvb,lon0,lon1,lat0,lat1) - if (debug) write(6,"('oplus after divb.')") -! call addfld('OP_DIVB',' ',' ',dvb, +! Evaluate divergence of B, the unit magnetic field vector. + lonbeg = lon0 + if (lon0==1) lonbeg = 3 + lonend = lon1 + if (lon1==nlonp4) lonend = nlonp4-2 +! + dvb = 0. + do lat=lat0,lat1 + do i=lonbeg,lonend + dbxdx(i,lat) = (bx(i+1,lat)-bx(i-1,lat))/(2.*dlamda) + dbycdy(i,lat) = + | (cs(lat+1)*by(i,lat+1)- + | cs(lat-1)*by(i,lat-1))/(2.*dphi) + dvb_h(i,lat) = (dbxdx(i,lat)+dbycdy(i,lat))/(re*cs(lat)) + dvb(i,lat) = dvb_h(i,lat)+2.*bz(i,lat)/re + enddo ! i=lonbeg,lonend + enddo ! lat=lat0,lat1 +! + call mp_periodic_f2d(dvb(lon0:lon1,lat0:lat1), + | lon0,lon1,lat0,lat1,1) +! +! call addfld('OP_DIVB',' ',' ',dvb(lon0:lon1,lat0:lat1), ! | 'lon',lon0,lon1,'lat',lat0,lat1,0) ! call mkdiag_BXYZ('BX',bx(lon0:lon1,lat0:lat1),lon0,lon1,lat0,lat1) @@ -182,1046 +332,897 @@ subroutine oplus(tn,te,ti,o2,o1,he,n2,n2d,ne,u,v,w,ui,vi,wi, call mkdiag_BMAG('BMAG',bmod2(lon0:lon1,lat0:lat1), | lon0,lon1,lat0,lat1) ! -!----------------------- Begin first latitude scan --------------------- - do lat=lat0,lat1 - if (debug) write(6,"('oplus begin first lat scan: lat=',i3)")lat - jm2 = lat-2 - jm1 = lat-1 - jp1 = lat+1 - jp2 = lat+2 + do lat=lat0-2,lat1+2 + do i=lon0-2,lon1+2 + do k=lev0,lev1-1 +! +! Plasma temperature: + tp(k,i,lat) = 0.5*(te(k,i,lat)+ti(k,i,lat)) ! ! Set reduced temperature (average of tn and ti) ! -! 1/2/16 btf: -! This was previously set incorrectly as tp = 0.5*(te+ti)) +! 1/2/16 btf: +! This was previously set incorrectly as tp = 0.5*(te+ti)) ! (see also plasma temp tp). Correcting this resulted in a ! 40% change in ambipolar diffusion DJ, but only 10% or so ! change in O+ and Ne, and very small differences in NMF2,HMF2,TEC. ! Wenbin feels there should be larger changes in these fields -! as a consequence of fixing this bug. -! - do i=lon0,lon1 - do k=lev0,lev1-1 - tr(k,i,jm1) = 0.5*(tn(k,i,jm1)+ti(k,i,jm1)) - tr(k,i,lat) = 0.5*(tn(k,i,lat)+ti(k,i,lat)) - tr(k,i,jp1) = 0.5*(tn(k,i,jp1)+ti(k,i,jp1)) - enddo - enddo - tr(lev1,:,:) = 0. -! call addfld('TR','TR: reduced temperature (0.5*(tn+ti))',' ', -! | tr(lev0:lev1-1,lon0:lon1,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! -! rrk returns djm1,dj,djp1: -! - call rrk(xnmbar(:,lon0:lon1,jm1), - | o2(:,lon0:lon1,jm1),o1(:,lon0:lon1,jm1), - | he(:,lon0:lon1,jm1),n2(:,lon0:lon1,jm1), - | tr(:,lon0:lon1,jm1),dj(:,lon0:lon1,jm1), - | vni(:,lon0:lon1,jm1),lon0,lon1,lev0,lev1) - - call rrk(xnmbar(:,lon0:lon1,lat), - | o2(:,lon0:lon1,lat),o1(:,lon0:lon1,lat), - | he(:,lon0:lon1,lat),n2(:,lon0:lon1,lat), - | tr(:,lon0:lon1,lat),dj(:,lon0:lon1,lat), - | vni(:,lon0:lon1,lat),lon0,lon1,lev0,lev1) - - call rrk(xnmbar(:,lon0:lon1,jp1), - | o2(:,lon0:lon1,jp1),o1(:,lon0:lon1,jp1), - | he(:,lon0:lon1,jp1),n2(:,lon0:lon1,jp1), - | tr(:,lon0:lon1,jp1),dj(:,lon0:lon1,jp1), - | vni(:,lon0:lon1,jp1),lon0,lon1,lev0,lev1) - - if (debug) write(6,"('oplus after rrk: lat=',i3)") lat -! call addfld('DJ','DJ: Ambipolar Diffusion of O+',' ', -! | dj(lev0:lev1-1,lon0:lon1,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) +! as a consequence of fixing this bug. + tr(k,i,lat) = 0.5*(tn(k,i,lat)+ti(k,i,lat)) + enddo ! k=lev0,lev1-1 ! -! Plasma temperature: - do i=lon0,lon1 - do k=lev0,lev1-1 - tp(k,i,jm1) = te(k,i,jm1)+ti(k,i,jm1) - tp(k,i,lat) = te(k,i,lat)+ti(k,i,lat) - tp(k,i,jp1) = te(k,i,jp1)+ti(k,i,jp1) - enddo - enddo - if (debug) write(6,"('oplus after tpj: lat=',i3)") lat -! - do i=lon0,lon1 - do k=lev0,lev1-1 - hj(k,i,jm1) = scht(k,i,jm1) - hj(k,i,lat) = scht(k,i,lat) - hj(k,i,jp1) = scht(k,i,jp1) - enddo - enddo - if (debug) write(6,"('oplus after hj: lat=',i3)") lat -! call addfld('HJ ',' ',' ',hj(lev0:lev1-1,:,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) + tp(lev1,i,lat) = 2.*tp(lev1-1,i,lat)-tp(lev1-2,i,lat) + tr(lev1,i,lat) = 2.*tr(lev1-1,i,lat)-tr(lev1-2,i,lat) ! -! bdotu = B.U (s7) - do i=lon0,lon1 - do k=lev0,lev1-1 - bdotu(k,i,jm1) = bx(i,jm1)*u(k,i,jm1)+by(i,jm1)*v(k,i,jm1)+ - | hj(k,i,jm1)*bz(i,jm1)*0.5*(w(k,i,jm1)+w(k+1,i,jm1)) - bdotu(k,i,lat) = bx(i,lat)*u(k,i,lat)+by(i,lat)*v(k,i,lat)+ - | hj(k,i,lat)*bz(i,lat)*0.5*(w(k,i,lat)+w(k+1,i,lat)) - bdotu(k,i,jp1) = bx(i,jp1)*u(k,i,jp1)+by(i,jp1)*v(k,i,jp1)+ - | hj(k,i,jp1)*bz(i,jp1)*0.5*(w(k,i,jp1)+w(k+1,i,jp1)) - enddo ! k=lev0,lev1-1 - enddo ! i=lon0,lon1 -! call addfld('BDOTU' ,' ',' ',bdotu(lev0:lev1-1,:,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! -! bvel @ jm1 = (B.U)*N(O+) (J-1) (was s6) -! bvel @ j = (B.U)*N(O+) (J) (was s7) -! bvel @ jp1 = (B.U)*N(O+) (J+1) (was s8) -! - do i=lon0,lon1 - do k=lev0,lev1-1 - bvel(k,i,jm1) = bdotu(k,i,jm1)*op(k,i,jm1) - bvel(k,i,lat) = bdotu(k,i,lat)*op(k,i,lat) - bvel(k,i,jp1) = bdotu(k,i,jp1)*op(k,i,jp1) - enddo ! k=lev0,lev1-1 - enddo ! i=lon0,lon1 - if (debug) write(6,"('oplus after bvel: lat=',i3)") lat -! call addfld('BVEL_J' ,' ',' ',bvel(lev0:lev1-1,lon0:lon1,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) + do k=lev0,lev1 + o2_cm3(k,i,lat) = xnmbar(k,i,lat)*o2(k,i,lat)*rmassinv_o2 + o1_cm3(k,i,lat) = xnmbar(k,i,lat)*o1(k,i,lat)*rmassinv_o1 + he_cm3(k,i,lat) = xnmbar(k,i,lat)*he(k,i,lat)*rmassinv_he + n2_cm3(k,i,lat) = xnmbar(k,i,lat)*n2(k,i,lat)*rmassinv_n2 + n2d_cm3(k,i,lat) = xnmbar(k,i,lat)*n2d(k,i,lat)*rmassinv_n2d ! - tp(lev1,:,jm1:jp1) = 0. - call diffus( - | tp(:,lon0:lon1,jm1),op(:,lon0:lon1,jm1),hj(:,:,jm1), - | diffj(:,lon0:lon1,jm1),lon0,lon1,lev0,lev1) - call diffus( - | tp(:,lon0:lon1,lat),op(:,lon0:lon1,lat),hj(:,:,lat), - | diffj(:,lon0:lon1,lat),lon0,lon1,lev0,lev1) - call diffus( - | tp(:,lon0:lon1,jp1),op(:,lon0:lon1,jp1),hj(:,:,jp1), - | diffj(:,lon0:lon1,jp1),lon0,lon1,lev0,lev1) - - if (debug) write(6,"('oplus after diffus: lat=',i3)") lat -! call addfld('DIFFJ','DIFFJ after diffus',' ', -! | diffj(lev0:lev1-1,lon0:lon1,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) +! 8/28/13 btf: Use n2=1-o2-o-he, and include O+/He collision rate from Wenbin: + vni(k,i,lat) = 1e-10* + | (6.64 *o2_cm3(k,i,lat)+ + | 1.32 *he_cm3(k,i,lat)+ + | 6.82 *n2_cm3(k,i,lat)+ + | 0.367*o1_cm3(k,i,lat)*sqrt(tr(k,i,lat))* + | (1.-0.064*log10(tr(k,i,lat)))**2*colfac) +! +! ambipolar diffusion coefficient + dj(k,i,lat) = boltz/(mp*rmass_op*vni(k,i,lat)) + enddo ! k=lev0,lev1 + enddo ! i=lon0-2,lon1+2 + enddo ! lat=lat0-2,lat1+2 ! -! Plasma temperature times O+ - do i=lon0,lon1 - do k=lev0,lev1-1 - tp(k,i,jm2) = op(k,i,jm2)*(te(k,i,jm2)+ti(k,i,jm2)) - tp(k,i,jm1) = tp(k,i,jm1)*op(k,i,jm1) - tp(k,i,lat) = tp(k,i,lat)*op(k,i,lat) - tp(k,i,jp1) = tp(k,i,jp1)*op(k,i,jp1) - tp(k,i,jp2) = op(k,i,jp2)*(te(k,i,jp2)+ti(k,i,jp2)) - enddo ! k=lev0,lev1-1 - enddo ! i=lon0,lon1 - if (debug) write(6,"('oplus after tpj2: lat=',i3)") lat -! call addfld('TPJ','TP after times OP',' ', -! | tp(lev0:lev1-1,lon0:lon1,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) +! 1/30/16 btf: +! Cap ambipolar diffusion coefficient. Namelist parameter OPDIFFCAP. +! This was tested with various values (1.5e8, 3e8, 6e8, 8e8), +! and was found to improve numerical stability in some storm cases, +! for example the November, 2003 and July, 2000 storms, with Weimer +! potential model and IMF/OMNI data. Both of these cases generally +! will not complete if timestep is longer than 10 sec. The Nov, 2003 +! may succeed with opdiffcap turned off, but the July, 2000 +! "Bastille day storm" will succeed only with step=10 and opdiffcap=6.e8. ! -! Shapiro smoother: optm1 is O+ at time n-1 (optm1_smooth was s1) -! optm1_smooth will be used in explicit terms below. - do i=lon0,lon1 - do k=lev0,lev1-1 - optm1_smooth(k,i,lat) = optm1(k,i,lat)-shapiro/nstep_sub* - | (optm1(k,i,jp2)+optm1(k,i,jm2)-4.* - | (optm1(k,i,jp1)+optm1(k,i,jm1))+6.* - | optm1(k,i,lat)) - enddo ! k=lev0,lev1-1 - enddo ! i=lon0,lon1 -! call addfld('OPTM1_SM0' ,' ',' ', -! | optm1_smooth(lev0:lev1-1,lon0:lon1,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! - if (debug) write(6,"('oplus end first lat scan: lat=',i3)") lat - enddo ! lat=lat0,lat1 +! 2024/08 Haonan Wu: Change the original constant O+ diffusion cap +! to an altitude-dependent cap (use logistic function for now) + if (opdiffcap/=0. .and. + | opdiffrate/=0. .and. + | opdifflev/=spval) then + do lat=lat0-2,lat1+2 + do i=lon0-2,lon1+2 + do k=lev0,lev1 + djmin = opdiffcap/(1+exp(opdiffrate*(zpmid(k)-opdifflev))) + if (dj(k,i,lat) > djmin) dj(k,i,lat) = djmin + enddo ! k=lev0,lev1 + enddo ! i=lon0-2,lon1+2 + enddo ! lat=lat0-2,lat1+2 + endif ! do lat=lat0,lat1 do i=lon0,lon1 - do k=lev0,lev1-1 - wd(k,i) = vni(k,i,lat)*diffj(k,i,lat)*dj(k,i,lat)* - | sin(dipmag(i,lat))*cos(dipmag(i,lat)) - Fe(k,i,lat) = wd(k,i)*sndec(i,lat) - Fn(k,i,lat) = wd(k,i)*csdec(i,lat) - enddo - enddo - enddo - - do lat=lat0-1,lat1+1 - do i=lon0,lon1 - do k=lev0,lev1-1 - djbz(k,i,lat) = dj(k,i,lat)*bz(i,lat) - enddo - enddo - enddo -!------------------------- End first latitude scan --------------------- -! -! Boundary longitudes: - f5(:,:,:,1) = djbz(:,:,:) - f5(:,:,:,2) = bvel(:,:,:) - f5(:,:,:,3) = diffj(:,:,:) - f5(:,:,:,4) = tp(:,:,:) - f5(:,:,:,5) = optm1_smooth(:,:,:) - - call mp_bndlons_f3d(f5,nlevs,lon0,lon1,lat0,lat1,5,0) - - djbz(:,:,:) = f5(:,:,:,1) - bvel(:,:,:) = f5(:,:,:,2) - diffj(:,:,:) = f5(:,:,:,3) - tp(:,:,:) = f5(:,:,:,4) - optm1_smooth(:,:,:) = f5(:,:,:,5) -! -!----------------------- Begin second latitude scan -------------------- - do lat=lat0,lat1 - if (debug) - | write(6,"('oplus begin second lat scan: lat=',i3)") lat - jm2 = lat-2 - jm1 = lat-1 - jp1 = lat+1 - jp2 = lat+2 ! -! bdotdh_op = (B(H).DEL(H))*(D/(H*DZ)*TP+M*G/R)*N(O+) -! then bdotdh_op = d*bz*bdotdh_op +! bdotu = B.U (s7) + do k=lev0,lev1-1 + bdotu(k,i,lat) = + | bx(i,lat)*un(k,i,lat)+by(i,lat)*vn(k,i,lat)+ + | scht(k,i,lat)*bz(i,lat)*0.5*(w(k,i,lat)+w(k+1,i,lat)) + enddo ! k=lev0,lev1-1 + bdotu(lev1,i,lat) = 2.*bdotu(lev1-1,i,lat)-bdotu(lev1-2,i,lat) ! - call bdotdh( - | diffj(:,lon0:lon1,jm1), - | diffj(:,:,lat), - | diffj(:,lon0:lon1,jp1), - | bdotdh_op(:,lon0:lon1,lat),lon0,lon1,lev0,lev1,lat) -! - do i=lon0,lon1 - do k=lev0,lev1-1 - bdotdh_op(k,i,lat) = djbz(k,i,lat)*bdotdh_op(k,i,lat) - enddo ! k=lev0,lev1-1 - enddo ! i=lon0,lon1 - -! call addfld('BDOTDH_1',' ',' ', -! | bdotdh_op(lev0:lev1-1,lon0:lon1,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! -! bdotdh_opjm1 = (B(H).DEL(H))*2.*TP*N(O+) (J-1) -! bdotdh_opj = (B(H).DEL(H))*2.*TP*N(O+) (J) -! bdotdh_opjp1 = (B(H).DEL(H))*2.*TP*N(O+) (J+1) -! - call bdotdh( - | tp(:,lon0:lon1,jm2),tp(:,:,jm1),tp(:,lon0:lon1,lat), - | bdotdh_opj(:,lon0:lon1,jm1),lon0,lon1,lev0,lev1,jm1) - call bdotdh( - | tp(:,lon0:lon1,jm1),tp(:,:,lat),tp(:,lon0:lon1,jp1), - | bdotdh_opj(:,lon0:lon1,lat),lon0,lon1,lev0,lev1,lat) - call bdotdh( - | tp(:,lon0:lon1,lat),tp(:,:,jp1),tp(:,lon0:lon1,jp2), - | bdotdh_opj(:,lon0:lon1,jp1),lon0,lon1,lev0,lev1,jp1) -! - do i=lon0,lon1 - do k=lev0,lev1-1 - bdotdh_opj(k,i,jm1) = bdotdh_opj(k,i,jm1)*dj(k,i,jm1) - bdotdh_opj(k,i,lat) = bdotdh_opj(k,i,lat)*dj(k,i,lat) - bdotdh_opj(k,i,jp1) = bdotdh_opj(k,i,jp1)*dj(k,i,jp1) - enddo ! k=lev0,lev1-1 - enddo ! i=lon0,lon1 - -! call addfld('BDOTDH_2',' ',' ', -! | bdotdh_op(lev0:lev1-1,lon0:lon1,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! - if (debug) - | write(6,"('oplus end second lat scan: lat=',i3)") lat + do k=lev0,lev1 + djbz(k,i,lat) = dj(k,i,lat)*bz(i,lat) + enddo ! k=lev0,lev1 + enddo ! i=lon0,lon1 enddo ! lat=lat0,lat1 -!------------------------ End second latitude scan --------------------- ! -! Periodic points for bdotdh_opj (output from bdotdh above): - call mp_periodic_f3d(bdotdh_opj(:,lon0:lon1,lat0:lat1), - | lev0,lev1,lon0,lon1,lat0,lat1,1) -! -! Boundary longitudes for bdotdh_opj (input to below call to bdotdh): - call mp_bndlons_f3d(bdotdh_opj,nlevs,lon0,lon1,lat0,lat1,1,0) -! -!----------------------- Begin third latitude scan --------------------- +! Fill up halo points of bdotu, djbz (used in bdotdh calls) do lat=lat0,lat1 - if (debug) - | write(6,"('oplus begin third lat scan: lat=',i3)") lat - jm2 = lat-2 - jm1 = lat-1 - jp1 = lat+1 - jp2 = lat+2 -! -! bdotdh_opj = (B(H).DEL(H))*D*(B(H).DEL(H))*2.*TP*N(O+) (J) -! Note bdotdh_opj longitude dimension is lon-2:lon+2. bdotdh_diff -! is returned. (periodic points apparently not necessary for -! bdotdh_diff) -! - call bdotdh( - | bdotdh_opj(:,lon0:lon1,jm1), - | bdotdh_opj(:,:,lat), - | bdotdh_opj(:,lon0:lon1,jp1), - | bdotdh_diff(:,lon0:lon1,lat),lon0,lon1,lev0,lev1,lat) - -! call addfld('BDOT_J' ,' ',' ',bdotdh_opj(lev0:lev1-1,lon0:lon1, -! | lat),'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! call addfld('BDOT_DIF',' ',' ',bdotdh_diff(lev0:lev1-1,lon0:lon1, -! | lat),'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! -! bdzdvb_op = (BZ*D/(H*DZ)+DIV(*B))*S2 -! bdzdvb returns bdzdvb_op. -! - call bdzdvb(bdotdh_opj(:,lon0:lon1,lat),dvb(:,lat),hj(:,:,lat), - | bdzdvb_op,lev0,lev1,lon0,lon1,lat) - -! call addfld('BDZDVB',' ',' ', -! | bdzdvb_op(lev0:lev1-1,:),'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! -! Collect explicit terms: - do i=lon0,lon1 - do k=lev0,lev1-1 - diffexp(k,i,lat) = - | bdzdvb_op(k,i)+bdotdh_diff(k,i,lat)+bdotdh_op(k,i,lat) - explicit(k,i) = -explic*diffexp(k,i,lat) - enddo ! k=lev0,lev1-1 - enddo ! i=lon0,lon1 - -! call addfld('EXPLIC0',' ',' ',explicit(lev0:lev1-1,:), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! call addfld('BX_OP',' ',' ',bx(lon0:lon1,:), -! | 'lon',lon0,lon1,'lat',lat,lat,0) -! call addfld('BY_OP',' ',' ',by(lon0:lon1,:), -! | 'lon',lon0,lon1,'lat',lat,lat,0) -! call addfld('UI_VEL',' ',' ',ui(:,lon0:lon1,lat), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('VI_VEL',' ',' ',vi(:,lon0:lon1,lat), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) - - lonbeg = lon0 - if (lon0==1) lonbeg = 3 - lonend = lon1 - if (lon1==nlonp4) lonend = lon1-2 -! - call bdotdh( - | bvel(:,lon0:lon1,jm1),bvel(:,:,lat),bvel(:,lon0:lon1,jp1), - | bdotdh_bvel(:,lon0:lon1,lat),lon0,lon1,lev0,lev1,lat) -! -! Note if input flag DYNAMO<=0, then ui,vi,wi velocities will be zero. - do i=lonbeg,lonend - do k=lev0,lev1-1 - vdotn_h(k,i,lat) = 1./(2.*re)* - | (1./(cs(lat)*dlamda)* - | (0.5*(ui(k,i,lat)+ui(k+1,i,lat))*bmod2(i,lat)**2* - | (op(k,i+1,lat)/bmod2(i+1,lat)**2- - | op(k,i-1,lat)/bmod2(i-1,lat)**2))+ -! - | 1./dphi* - | (0.5*(vi(k,i,lat)+vi(k+1,i,lat))*bmod2(i,lat)**2* - | (op(k,i,jp1)/bmod2(i,jp1)**2- - | op(k,i,jm1)/bmod2(i,jm1)**2))) - explicit(k,i) = - | explicit(k,i)+vdotn_h(k,i,lat)+bdotdh_bvel(k,i,lat) - enddo ! k=lev0,lev1-1 - enddo ! i=lon0+2,lon1-2 -! -! Periodic points for explicit terms. -! This is apparently unnecessary: -! call periodic_f2d(explicit,lon0,lon1,nlevs) - -! call addfld('EXPLIC1',' ',' ',explicit(lev0:lev1-1,:), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) - - do i=lon0,lon1 - dvb(i,lat) = dvb(i,lat)/bz(i,lat) - enddo ! i=lon0,lon1 -! - do i=lon0,lon1 - do k=lev0,lev1-1 - hdz(k,i) = 1./(hj(k,i,lat)*dz) - tp1(k,i) = 0.5*(ti(k,i,lat)+te(k,i,lat)) - enddo ! k=lev0,lev1-1 - enddo ! i=lon0,lon1 - -! call addfld('TP1',' ',' ',tp1(lev0:lev1-1,:), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! call addfld('HDZ',' ',' ',hdz(lev0:lev1-1,:), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) + do i=lon0,lon1 + do k=lev0,lev1 + tmpf3d(k,i,lat,1) = bdotu(k,i,lat) + tmpf3d(k,i,lat,2) = djbz(k,i,lat) + enddo ! k=lev0,lev1 + enddo ! i=lon0,lon1 + enddo ! lat=lat0,lat1 + call mp_polelats_f3d(tmpf3d(:,lon0:lon1,:,:), + | lev0,lev1,lon0,lon1,lat0,lat1,2,(/1.,1./)) + call mp_bndlats_f3d(tmpf3d,nlevs,lon0,lon1,lat0,lat1,2) + call mp_bndlons_f3d(tmpf3d,nlevs,lon0,lon1,lat0,lat1,2,0) + do lat=lat0-2,lat1+2 + do i=lon0-2,lon1+2 + do k=lev0,lev1 + bdotu(k,i,lat) = tmpf3d(k,i,lat,1) + djbz(k,i,lat) = tmpf3d(k,i,lat,2) + enddo ! k=lev0,lev1 + enddo ! i=lon0-2,lon1+2 + enddo ! lat=lat0-2,lat1+2 +! + call bdotdh(djbz,bdotdh_djbz,lev0,lev1,lon0,lon1,lat0,lat1) ! ! gmr = G*M(O+)/(2.*R) gmr = grav*rmass_op/(2.*gask) - do i=lon0,lon1 - do k=lev0,lev1-2 - tphdz1(k+1,i) = 2.*tp1(k+1,i)*(0.5*(hdz(k,i)+hdz(k+1,i)))+ - | gmr ! s13 - tphdz0(k+1,i) = 2.*tp1(k ,i)*(0.5*(hdz(k,i)+hdz(k+1,i)))- - | gmr ! s12 - enddo ! k=lev0,lev1-2 - enddo ! i=lon0,lon1 ! -! Upper and lower boundaries: - do i=lon0,lon1 - tphdz1(lev0,i) = 2.*tp1(lev0,i)* - | (1.5*hdz(lev0,i)-0.5*hdz(lev0+1,i))+gmr - tphdz1(lev1,i) = 2.*(2.*tp1(lev1-1,i)-tp1(lev1-2,i))* - | (1.5*hdz(lev1-1,i)-0.5*hdz(lev1-2,i))+gmr - tphdz0(lev0,i) = 2.*(2.*tp1(lev0,i)-tp1(lev0+1,i))* - | (1.5*hdz(lev0,i)-0.5*hdz(lev0+1,i))-gmr - tphdz0(lev1,i) = 2.*tp1(lev1-1,i)* - | (1.5*hdz(lev1-1,i)-0.5*hdz(lev1-2,i))-gmr - enddo ! i=lon0,lon1 - -! call addfld('TPHDZ1',' ',' ',tphdz1, -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('TPHDZ0',' ',' ',tphdz0, -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! -! djint = dj at interfaces: - do i=lon0,lon1 - do k=lev0,lev1-2 - djint(k+1,i) = 0.5*(dj(k,i,lat)+dj(k+1,i,lat)) - enddo ! k=lev0,lev1-2 - djint(lev0,i) = (1.5*dj(lev0 ,i,lat)-0.5*dj(lev0+1,i,lat)) - djint(lev1,i) = (1.5*dj(lev1-1,i,lat)-0.5*dj(lev1-2,i,lat)) - enddo ! i=lon0,lon1 -! call addfld('DJINT' ,' ',' ',djint, -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! - call bdotdh( - | djbz(:,lon0:lon1,jm1),djbz(:,:,lat),djbz(:,lon0:lon1,jp1), - | bdotdh_djbz,lon0,lon1,lev0,lev1,lat) + do lat=lat0,lat1 + do i=lon0,lon1 + do k=lev0,lev1 + hdz(k,i,lat) = 1./(scht(k,i,lat)*dz) + enddo ! k=lev0,lev1 +! + do k=lev0,lev1-1 + tp1(k+1,i,lat) = tp(k,i,lat) + bdotu_m1(k+1,i,lat) = bdotu(k,i,lat) + bdotu_p1(k,i,lat) = bdotu(k+1,i,lat) + hdzi(k+1,i,lat) = 0.5*(hdz(k,i,lat)+hdz(k+1,i,lat)) + djint(k+1,i,lat) = 0.5*(dj(k,i,lat)+dj(k+1,i,lat)) + wii(k,i,lat) = 0.5*(wi(k,i,lat)+wi(k+1,i,lat)) + enddo ! k=lev0,lev1-1 +! + tp1(lev0,i,lat) = 2.*tp(lev0,i,lat)-tp(lev0+1,i,lat) + bdotu_m1(lev0,i,lat) = + | 2.*bdotu(lev0,i,lat)-bdotu(lev0+1,i,lat) + bdotu_p1(lev1,i,lat) = + | 2.*bdotu(lev1,i,lat)-bdotu(lev1-1,i,lat) + hdzi(lev0,i,lat) = 1.5*hdz(lev0,i,lat)-0.5*hdz(lev0+1,i,lat) + djint(lev0,i,lat) = 1.5*dj(lev0,i,lat)-0.5*dj(lev0+1,i,lat) + wii(lev1,i,lat) = 1.5*wi(lev1,i,lat)-0.5*wi(lev1-1,i,lat) +! + do k=lev0,lev1 + tphdz1(k,i,lat) = 2.*tp (k,i,lat)*hdzi(k,i,lat)+gmr ! s13 + tphdz0(k,i,lat) = 2.*tp1(k,i,lat)*hdzi(k,i,lat)-gmr ! s12 ! ! divbz = (DIV(B)+(DH*D*BZ)/(D*BZ) (was s7) - do i=lonbeg,lonend - do k=lev0,lev1-1 - divbz(k,i) = - | dvb(i,lat)+bdotdh_djbz(k,i)/(dj(k,i,lat)*bz(i,lat)**2) - enddo ! k=lev0,lev1-1 - enddo ! i=lonbeg,lonend - -! Periodic points for divbz apparently not necessary: -! call periodic_f2d(divbz,lon0,lon1,nlevs) -! -! Set periodic points to zero to avoid NaNS trap: - if (lon0==1) divbz(:,lon0:lon0+1) = 0. - if (lon1==nlonp4) divbz(:,lon1-1:lon1) = 0. -! call addfld('DIVBZ' ,' ',' ',divbz(lev0:lev1-1,:), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) + bdotdh_djbz2(k,i,lat) = bdotdh_djbz(k,i,lat)/djbz(k,i,lat) + divbz(k,i,lat) = + | (dvb(i,lat)+bdotdh_djbz2(k,i,lat))/bz(i,lat) ! ! hdzmbz = (1./(H*DZ)-(DIV(B)+DH*D*BZ/(D*BZ))/(2*BZ))*BZ**2 (was s10) ! hdzpbz = (1./(H*DZ)+(DIV(B)+DH*D*BZ/(D*BZ))/(2*BZ))*BZ**2 (was s9 ) + hdzmbz(k,i,lat) = + | (hdz(k,i,lat)-0.5*divbz(k,i,lat))*bz(i,lat)**2 + hdzpbz(k,i,lat) = + | (hdz(k,i,lat)+0.5*divbz(k,i,lat))*bz(i,lat)**2 ! - do i=lon0,lon1 - do k=lev0,lev1-1 - hdzmbz(k,i) = (hdz(k,i)-0.5*divbz(k,i))*bz(i,lat)**2 - hdzpbz(k,i) = (hdz(k,i)+0.5*divbz(k,i))*bz(i,lat)**2 - enddo ! k=lev0,lev1-1 - enddo ! i=lon0,lon1 - -! call addfld('HDZMBZ' ,' ',' ',hdzmbz(lev0:lev1-1,:), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! call addfld('HDZPBZ' ,' ',' ',hdzpbz(lev0:lev1-1,:), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) + djint_tphdz0(k,i,lat) = djint(k,i,lat)*tphdz0(k,i,lat) + djint_tphdz1(k,i,lat) = djint(k,i,lat)*tphdz1(k,i,lat) + enddo ! k=lev0,lev1 ! -! Sum O+ at time n-1 to explicit terms: N(O+)/(2*DT) (N-1) (was s4) -! Boundary longitudes for optm1_smooth were obtained after first -! latitude scan above. + do k=lev0,lev1-1 + djint_tphdz0_1(k,i,lat) = djint_tphdz0(k+1,i,lat) + djint_tphdz1_1(k,i,lat) = djint_tphdz1(k+1,i,lat) +! +! xiop2p and xiop2d are outputs: + xiop2p(k,i,lat) = + | 0.5*(qop2p(k,i,lat)+qop2p(k+1,i,lat))/ + | ((rk16+rk17)*n2_cm3(k,i,lat)+ + | rk18*o1_cm3(k,i,lat)+ + | (rk19(k,i,lat)+rk20(k,i,lat))*ne(k,i,lat)+ + | rk21+rk22) + xiop2d(k,i,lat) = + | (0.5*(qop2d(k,i,lat)+qop2d(k+1,i,lat))+ + | rk20(k,i,lat)*xiop2p(k,i,lat)*ne(k,i,lat)+ + | rk22*xiop2p(k,i,lat))/ + | (rk23*n2_cm3(k,i,lat)+ + | rk24*o1_cm3(k,i,lat)+ + | rk25(k,i,lat)*ne(k,i,lat)+ + | rk26*o2_cm3(k,i,lat)+ + | rk27) +! +! Sources and sinks + op_prod(k,i,lat) = + | 0.5*(qop(k,i,lat)+qop(k+1,i,lat))+ + | rk18*xiop2p(k,i,lat)*o1_cm3(k,i,lat)+ + | rk19(k,i,lat)*xiop2p(k,i,lat)*ne(k,i,lat)+ + | rk21*xiop2p(k,i,lat)+ + | rk24*xiop2d(k,i,lat)*o1_cm3(k,i,lat)+ + | rk25(k,i,lat)*xiop2d(k,i,lat)*ne(k,i,lat)+ + | rk27*xiop2d(k,i,lat) + op_loss(k,i,lat) = + | rk1(k,i,lat)*o2_cm3(k,i,lat)+ + | rk2(k,i,lat)*n2_cm3(k,i,lat)+ + | rk10*n2d_cm3(k,i,lat) + enddo ! k=lev0,lev1-1 +! + djint_tphdz0_1(lev1,i,lat) = + | 2.*djint_tphdz0(lev1,i,lat)-djint_tphdz0(lev1-1,i,lat) + djint_tphdz1_1(lev1,i,lat) = + | 2.*djint_tphdz1(lev1,i,lat)-djint_tphdz1(lev1-1,i,lat) + xiop2p(lev1,i,lat) = + | 2.*xiop2p(lev1-1,i,lat)-xiop2p(lev1-2,i,lat) + xiop2d(lev1,i,lat) = + | 2.*xiop2d(lev1-1,i,lat)-xiop2d(lev1-2,i,lat) + op_prod(lev1,i,lat) = + | 2.*op_prod(lev1-1,i,lat)-op_prod(lev1-2,i,lat) + op_loss(lev1,i,lat) = + | 2.*op_loss(lev1-1,i,lat)-op_loss(lev1-2,i,lat) +! + do k=lev0,lev1 ! - do i=lon0,lon1 - do k=lev0,lev1-1 - optm1_smooth2(k,i,lat) = - | optm1_smooth(k,i,lat)-shapiro/nstep_sub* - | (optm1_smooth(k,i+2,lat)+optm1_smooth(k,i-2,lat)-4.* - | (optm1_smooth(k,i+1,lat)+optm1_smooth(k,i-1,lat))+6.* - | optm1_smooth(k,i,lat)) - enddo - enddo - do i=lonbeg,lonend - do k=lev0,lev1-1 - explicit(k,i) = explicit(k,i)- - | optm1_smooth2(k,i,lat)*dtx2inv*nstep_sub - enddo ! k=lev0,lev1 - enddo ! i=lonbeg,lonend - -! call addfld('OPTM1_SM1' ,' ',' ', -! | optm1_smooth(lev0:lev1-1,lon0:lon1,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! call addfld('EXPLIC2' ,' ',' ',explicit(lev0:lev1-1,:), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! ! Begin coefficients p_coeff, q_coeff, r_coeff (s1,s2,s3) - do i=lon0,lon1 - do k=lev0,lev1-1 - diffp(k,i,lat) = hdzmbz(k,i)*djint(k ,i)*tphdz0(k ,i) - diffq(k,i,lat) = -(hdzpbz(k,i)*djint(k+1,i)*tphdz0(k+1,i)+ - | hdzmbz(k,i)*djint(k ,i)*tphdz1(k ,i)) - diffr(k,i,lat) = hdzpbz(k,i)*djint(k+1,i)*tphdz1(k+1,i) - enddo ! k=lev0,lev1-1 - enddo ! i=lon0,lon1 - -! call addfld('P_COEFF0',' ',' ',diffp(lev0:lev1-1,:,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! call addfld('Q_COEFF0',' ',' ',diffq(lev0:lev1-1,:,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! call addfld('R_COEFF0',' ',' ',diffr(lev0:lev1-1,:,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) + diffp(k,i,lat) = + | hdzmbz(k,i,lat)*djint_tphdz0 (k,i,lat) + diffq(k,i,lat) = + | -(hdzpbz(k,i,lat)*djint_tphdz0_1(k,i,lat)+ + | hdzmbz(k,i,lat)*djint_tphdz1 (k,i,lat)) + diffr(k,i,lat) = + | hdzpbz(k,i,lat)*djint_tphdz1_1(k,i,lat) ! ! Continue coefficients with vertical ion velocity: - do i=lon0,lon1 - do k=lev0,lev1-2 - driftp(k+1,i,lat) = - | 0.5*(wi(k+1,i,lat)+wi(k+2,i,lat))*0.5*hdz(k+1,i) - driftq(k,i,lat) = -0.5*(wi(k,i,lat)+wi(k+1,i,lat))*6./re - driftr(k,i,lat) = - | -0.5*(wi(k,i,lat)+wi(k+1,i,lat))*0.5*hdz(k,i) - enddo ! k=lev0,lev1-2 - enddo ! i=lon0,lon1 -! -! Upper and lower boundaries: - do i=lon0,lon1 - driftp(lev0,i,lat) = - | 0.5*(wi(lev0,i,lat)+wi(lev0+1,i,lat))*0.5*hdz(lev0,i) - driftq(lev1-1,i,lat) = - | -0.5*(wi(lev1,i,lat)+wi(lev1-1,i,lat))*6./re - driftr(lev1-1,i,lat) = - | -0.5*(wi(lev1,i,lat)+wi(lev1-1,i,lat))*0.5*hdz(lev1-1,i) - enddo ! i=lon0,lon1 - -! call addfld('P_COEFF1',' ',' ',driftp(lev0:lev1-1,:,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! call addfld('Q_COEFF1',' ',' ',driftq(lev0:lev1-1,:,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! call addfld('R_COEFF1',' ',' ',driftr(lev0:lev1-1,:,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) + driftp(k,i,lat) = wii(k,i,lat)*0.5*hdz(k,i,lat) + driftq(k,i,lat) = -wii(k,i,lat)*6./re + driftr(k,i,lat) = -wii(k,i,lat)*0.5*hdz(k,i,lat) ! ! Continue coefficients with vertical neutral wind: - do i=lon0,lon1 - do k=lev0,lev1-2 - windp(k+1,i,lat) = bz(i,lat)*bdotu(k,i,lat)*0.5*hdz(k+1,i) - windq(k,i,lat) = -bdotu(k,i,lat)*dvb(i,lat)*bz(i,lat) - windr(k,i,lat) = -bz(i,lat)*bdotu(k+1,i,lat)*0.5*hdz(k,i) - enddo ! k=lev0,lev1-2 - enddo ! i=lon0,lon1 -! -! Upper and lower boundaries: - do i=lon0,lon1 - windp(lev0,i,lat) = bz(i,lat)* - | (2.*bdotu(lev0,i,lat)-bdotu(lev0+1,i,lat))*0.5*hdz(lev0,i) - windq(lev1-1,i,lat) = -bdotu(lev1-1,i,lat)*dvb(i,lat)*bz(i,lat) - windr(lev1-1,i,lat) = bz(i,lat)* - | (2.*bdotu(lev1-1,i,lat)-bdotu(lev1-2,i,lat))*0.5*hdz(lev1-1,i) - enddo ! i=lon0,lon1 - -! call addfld('P_COEFF2',' ',' ',windp(lev0:lev1-1,:,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! call addfld('Q_COEFF2',' ',' ',windq(lev0:lev1-1,:,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! call addfld('R_COEFF2',' ',' ',windr(lev0:lev1-1,:,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! -! Additions to Q coefficients: - do i=lon0,lon1 - do k=lev0,lev1-1 - p_coeff(k,i) = diffp(k,i,lat)+driftp(k,i,lat)+windp(k,i,lat) - q_coeff(k,i) = diffq(k,i,lat)+driftq(k,i,lat)+windq(k,i,lat) - | -dtx2inv*nstep_sub - r_coeff(k,i) = diffr(k,i,lat)+driftr(k,i,lat)+windr(k,i,lat) - enddo ! k=lev0,lev1-1 - enddo ! i=lon0,lon1 + windp(k,i,lat) = + | bz(i,lat)*bdotu_m1(k,i,lat)*0.5*hdz(k,i,lat) + windq(k,i,lat) = -bdotu(k,i,lat)*dvb(i,lat) + windr(k,i,lat) = + | -bz(i,lat)*bdotu_p1(k,i,lat)*0.5*hdz(k,i,lat) + enddo ! k=lev0,lev1 +! +! Additions to Q coefficients, Sinks: + do k=lev0,lev1 + p_coeff(k,i,lat) = + | diffp(k,i,lat)+driftp(k,i,lat)+windp(k,i,lat) + q_coeff(k,i,lat) = + | diffq(k,i,lat)+driftq(k,i,lat)+windq(k,i,lat)- + | dtx2inv*nstep_sub-op_loss(k,i,lat) + r_coeff(k,i,lat) = + | diffr(k,i,lat)+driftr(k,i,lat)+windr(k,i,lat) + enddo ! k=lev0,lev1 ! ! Upper boundary condition for O+: - do i=lon0,lon1 - ubca(i) = 0. - ubcb(i) = -bz(i,lat)**2*djint(lev1,i)*tphdz0(lev1,i)-ubca(i) ! t3 - ubca(i) = -bz(i,lat)**2*djint(lev1,i)*tphdz1(lev1,i)+ubca(i) ! t2 + ubcb(i,lat) = bz(i,lat)**2*djint_tphdz0(lev1,i,lat) ! t3 + ubca(i,lat) = bz(i,lat)**2*djint_tphdz1(lev1,i,lat) ! t2 ! ! Q = Q+B/A*R - q_coeff(lev1-1,i) = q_coeff(lev1-1,i)+ubcb(i)/ubca(i)* - | r_coeff(lev1-1,i) -! -! F = F -R/A*PHI - explicit(lev1-1,i) = explicit(lev1-1,i)-opflux(i,lat)* - | r_coeff(lev1-1,i)/ubca(i) - r_coeff(lev1-1,i) = 0. - enddo ! i=lon0,lon1 - -! call addfld('EXPLIC3',' ',' ',explicit(lev0:lev1-1,:), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! call addfld('P_COEFF2',' ',' ',p_coeff(lev0:lev1-1,:), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! call addfld('Q_COEFF2',' ',' ',q_coeff(lev0:lev1-1,:), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! call addfld('R_COEFF2',' ',' ',r_coeff(lev0:lev1-1,:), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) - -! call addfld('QOP2P_OP',' ',' ',qop2p(:,lon0:lon1,lat), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('QOP2D_OP',' ',' ',qop2d(:,lon0:lon1,lat), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('RK20',' ',' ',rk20(lev0:lev1-1,lon0:lon1,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! call addfld('RK25',' ',' ',rk25(lev0:lev1-1,lon0:lon1,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! -! Sources and sinks (xiop2p and xiop2d are outputs): -! - do i=lon0,lon1 - do k=lev0,lev1-1 - xiop2p(k,i,lat) = - | 0.5*(qop2p(k,i,lat)+qop2p(k+1,i,lat))/((xnmbar(k,i,lat)* - | ((rk16+rk17)*n2(k,i,lat)*rmassinv_n2+ - | rk18*o1(k,i,lat)*rmassinv_o1))+ - | (rk19(k,i,lat)+rk20(k,i,lat))*ne(k,i,lat)+rk21+rk22) -! - xiop2d(k,i,lat) = - | (0.5*(qop2d(k,i,lat)+qop2d(k+1,i,lat))+(rk20(k,i,lat)* - | ne(k,i,lat)+rk22)*xiop2p(k,i,lat))/((xnmbar(k,i,lat)* - | (rk23*n2(k,i,lat)*rmassinv_n2+rk24* - | o1(k,i,lat)*rmassinv_o1+rk26*o2(k,i,lat)*rmassinv_o2))+ - | rk25(k,i,lat)*ne(k,i,lat)+rk27) -! - op_loss(k,i,lat) = - | xnmbar(k,i,lat)*(rk1(k,i,lat)*o2(k,i,lat)*rmassinv_o2+ - | rk2(k,i,lat)*n2(k,i,lat)*rmassinv_n2+rk10* - | n2d(k,i,lat)*rmassinv_n2d) -! - q_coeff(k,i) = q_coeff(k,i)-op_loss(k,i,lat) - enddo ! k=lev0,lev1-1 - enddo ! i=lon0,lon1 - -! call addfld('XIOP2P',' ',' ',xiop2p(lev0:lev1,lon0:lon1,lat), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('XIOP2D',' ',' ',xiop2d(lev0:lev1,lon0:lon1,lat), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('OP_LOSS',' ',' ',op_loss(lev0:lev1-1,lon0:lon1,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! call addfld('OP_QOP',' ',' ',qop(lev0:lev1,lon0:lon1,lat), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('OP_NE' ,' ',' ',ne(lev0:lev1,lon0:lon1,lat), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('OP_O1' ,' ',' ',o1(lev0:lev1,lon0:lon1,lat), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('OP_TN' ,' ',' ',tn(lev0:lev1,lon0:lon1,lat), -! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) -! call addfld('OP_RK19' ,' ',' ',rk19(lev0:lev1-1,lon0:lon1,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! call addfld('OP_RK25' ,' ',' ',rk25(lev0:lev1-1,lon0:lon1,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) + q_coeff(lev1-1,i,lat) = q_coeff(lev1-1,i,lat)+ + | ubcb(i,lat)/ubca(i,lat)*r_coeff(lev1-1,i,lat) ! -! Add source term to RHS (explicit terms): - do i=lon0,lon1 - do k=lev0,lev1-1 - op_prod(k,i) = - | 0.5*(qop(k,i,lat)+qop(k+1,i,lat))+(rk19(k,i,lat)* - | ne(k,i,lat)+rk21)* - | xiop2p(k,i,lat)+(rk25(k,i,lat)*ne(k,i,lat)+rk27)* - | xiop2d(k,i,lat)+(rk18*xiop2p(k,i,lat)+rk24*xiop2d(k,i,lat))* - | o1(k,i,lat)*rmassinv_o1*xnmbar(k,i,lat) - explicit(k,i) = explicit(k,i)-op_prod(k,i) - enddo ! k=lev0,lev1-1 - enddo ! i=lon0,lon1 -! call addfld('EXPLIC4',' ',' ',explicit(lev0:lev1-1,:), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) +! F = F-R/A*PHI + ubcrhs(i,lat) = -opflux(i,lat)* + | r_coeff(lev1-1,i,lat)/ubca(i,lat) + r_coeff(lev1-1,i,lat) = 0. ! ! Lower boundary condition N(O+) = Q/L: - do i=lon0,lon1 - q_coeff(lev0,i) = q_coeff(lev0,i)-p_coeff(lev0,i) - explicit(lev0,i) = explicit(lev0,i)-2.*p_coeff(lev0,i)* - | qop(lev0,i,lat)/ - | (1.5*op_loss(lev0,i,lat)-0.5*op_loss(lev0+1,i,lat)) - p_coeff(lev0,i) = 0. - enddo ! i=lon0,lon1 - -! call addfld('P_COEFF',' ',' ',p_coeff(lev0:lev1-1,:), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! call addfld('Q_COEFF',' ',' ',q_coeff(lev0:lev1-1,:), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! call addfld('R_COEFF',' ',' ',r_coeff(lev0:lev1-2,:), -! | 'lev',lev0,lev1-2,'lon',lon0,lon1,lat) -! call addfld('EXPLIC5',' ',' ',explicit(lev0:lev1-1,:), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) + q_coeff(lev0,i,lat) = q_coeff(lev0,i,lat)-p_coeff(lev0,i,lat) + lbcrhs(i,lat) = 2.*p_coeff(lev0,i,lat)*qop(lev0,i,lat)/ + | (1.5*op_loss(lev0,i,lat)-0.5*op_loss(lev0+1,i,lat)) + p_coeff(lev0,i,lat) = 0. + enddo ! i=lon0,lon1 ! -! Tridiagonal solver returns updated O+ in opout (all other args are input): -! subroutine trsolv(a,b,c,f,x,lev0,lev1,k1,k2,lon0,lon1,lonmax,lat, -! | idebug) -! - call trsolv(p_coeff,q_coeff,r_coeff,explicit, - | opout(:,lon0:lon1,lat),lev0,lev1,lev0,lev1-1,lon0,lon1,nlonp4, - | lat,0) -! -! call addfld('OP_SOLV',' ',' ',opout(lev0:lev1-1,lon0:lon1,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) - - if (debug) - | write(6,"('oplus end third lat scan: lat=',i3)") lat +! call addfld('TR','TR: reduced temperature (0.5*(tn+ti))',' ', +! | tr(:,lon0:lon1,lat),'lev',lev0,lev1,'lon',lon0,lon1,lat) +! call addfld('DJ','DJ: Ambipolar Diffusion of O+',' ', +! | dj(:,lon0:lon1,lat),'lev',lev0,lev1,'lon',lon0,lon1,lat) +! call addfld('BDOTU' ,' ',' ',bdotu(:,lon0:lon1,lat), +! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) +! call addfld('HDZ',' ',' ',hdz(:,:,lat), +! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) +! call addfld('TP1',' ',' ',tp1(:,:,lat), +! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) +! call addfld('DJINT',' ',' ',djint(:,:,lat), +! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) +! call addfld('TPHDZ1',' ',' ',tphdz1(:,:,lat), +! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) +! call addfld('TPHDZ0',' ',' ',tphdz0(:,:,lat), +! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) +! call addfld('DIVBZ',' ',' ',divbz(:,:,lat), +! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) +! call addfld('HDZMBZ' ,' ',' ',hdzmbz(:,:,lat), +! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) +! call addfld('HDZPBZ' ,' ',' ',hdzpbz(:,:,lat), +! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) +! call addfld('XIOP2P',' ',' ',xiop2p(:,lon0:lon1,lat), +! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) +! call addfld('XIOP2D',' ',' ',xiop2d(:,lon0:lon1,lat), +! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) +! call addfld('OP_LOSS_COEF',' ',' ',op_loss(:,lon0:lon1,lat), +! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) +! call addfld('OP_PROD',' ',' ',op_prod(:,lon0:lon1,lat), +! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) +! call addfld('P_COEFF',' ',' ', +! | p_coeff(lev0:lev1-1,lon0:lon1,lat), +! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) +! call addfld('Q_COEFF',' ',' ', +! | q_coeff(lev0:lev1-1,lon0:lon1,lat), +! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) +! call addfld('R_COEFF',' ',' ', +! | r_coeff(lev0:lev1-1,lon0:lon1,lat), +! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) enddo ! lat=lat0,lat1 -!------------------------ End third latitude scan --------------------- - do lat=lat0,lat1 - do i=lon0,lon1 - do k=lev0,lev1-1 - dopdt(k,i) = dtx2inv*nstep_sub* - | (opout(k,i,lat)-optm1_smooth2(k,i,lat)) - op_loss_out(k,i) = op_loss(k,i,lat)*opout(k,i,lat) - enddo - do k=lev0+1,lev1-1 - diffsum (k,i) = diffexp(k,i,lat)+ - | diffp (k,i,lat)*opout(k-1,i,lat)+ - | diffq (k,i,lat)*opout(k ,i,lat)+ - | diffr (k,i,lat)*opout(k+1,i,lat) - driftsum(k,i) = -vdotn_h(k,i,lat)+ - | driftp(k,i,lat)*opout(k-1,i,lat)+ - | driftq(k,i,lat)*opout(k ,i,lat)+ - | driftr(k,i,lat)*opout(k+1,i,lat) - windsum (k,i) = -bdotdh_bvel(k,i,lat)+ - | windp (k,i,lat)*opout(k-1,i,lat)+ - | windq (k,i,lat)*opout(k ,i,lat)+ - | windr (k,i,lat)*opout(k+1,i,lat) - enddo - enddo - call addfld('DOPDT','O+ changing rate','cm-3s-1', - | dopdt(lev0:lev1-1,:),'lev',lev0,lev1-1,'lon',lon0,lon1,lat) - call addfld('OP_PROD','O+ production','cm-3s-1', - | op_prod(lev0:lev1-1,:),'lev',lev0,lev1-1,'lon',lon0,lon1,lat) - call addfld('OP_LOSS','O+ loss','cm-3s-1', - | -op_loss_out(lev0:lev1-1,:), - | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) - call addfld('OP_DIFF', - | 'O+ transport due to ambipolar diffusion','cm-3s-1', - | diffsum(lev0+1:lev1-1,:), - | 'lev',lev0+1,lev1-1,'lon',lon0,lon1,lat) - call addfld('OP_DRIFT', - | 'O+ transport due to ion drift','cm-3s-1', - | driftsum(lev0+1:lev1-1,:), - | 'lev',lev0+1,lev1-1,'lon',lon0,lon1,lat) - call addfld('OP_WIND', - | 'O+ transport due to neutral wind','cm-3s-1', - | windsum(lev0+1:lev1-1,:), - | 'lev',lev0+1,lev1-1,'lon',lon0,lon1,lat) - enddo ! -! Filter updated O+: -! - call filter_op(opout(:,lon0:lon1,lat0:lat1), - | lev0,lev1,lon0,lon1,lat0,lat1,'OPLUS') + end subroutine prep_oplus +!----------------------------------------------------------------------- + subroutine smooth_oplus(optm1,optm1_smooth, + | lev0,lev1,lon0,lon1,lat0,lat1) ! -!----------------------- Begin fourth latitude scan --------------------- - do lat=lat0,lat1 - if (debug) - | write(6,"('oplus begin fourth lat scan: lat=',i3)") lat +! Shapiro smoother for O+ ! -! call addfld('OP_FILT',' ',' ',opout(lev0:lev1-1,lon0:lon1,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) + use params_module,only: rp + use cons_module,only: shapiro + use input_module,only: nstep_sub + use addfld_module,only: addfld ! -! Time smoothing: +! Args: + integer,intent(in) :: + | lev0,lev1, ! first,last pressure indices for current task (bot->top) + | lon0,lon1, ! first,last longitude indices for current task (W->E) + | lat0,lat1 ! first,last latitude indices for current task (S->N) ! -! optm1out(k,i,lat): New O+ at current latitude and time n-1. -! op(k,i,lat) : O+ at current latitude and time. -! optm1(k,i,lat) : O+ at current latitude and time n-1. -! opout(k,i,lat) : New O+ at current latitude and time. +! Input fields (full 3d task subdomain): + real(rp),dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2), + | intent(in) :: + | optm1 ! O+ at time n-1 ! - do i=lon0,lon1 - do k=lev0,lev1-1 - optm1out(k,i,lat) = dtsmooth*op(k,i,lat)+dtsmooth_div2* - | (optm1(k,i,lat)+opout(k,i,lat)) - enddo ! k=lev0,lev1-1 - enddo ! i=lon0,lon1 +! Output fields (full 3d task subdomain): + real(rp),dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2), + | intent(out) :: + | optm1_smooth ! op at time n-1, with shapiro smoother (was s1) ! -! Upper boundary: - opout(lev1,:,lat) = 0. - optm1out(lev1,:,lat) = 0. -! -! Insure global non-negative O+: - do i=lon0,lon1 - do k=lev0,lev1-1 - if (opout(k,i,lat) < 0.) opout(k,i,lat) = 0. - if (optm1out(k,i,lat) < 0.) optm1out(k,i,lat) = 0. - enddo ! k=lev0,lev1-1 - enddo ! i=lon0,lon1 -! -! End fourth and final latitude scan: - enddo ! lat=lat0,lat1 +! Local: + integer :: k,i,lat + real(rp),dimension(lev0:lev1,lon0-2:lon1+2,lat0:lat1) :: + | optm1_smooth1 ! op at time n-1, with shapiro smoother (was s1) ! -! Periodic points for outputs: - call mp_periodic_f3d(opout(:,lon0:lon1,lat0:lat1), - | lev0,lev1,lon0,lon1,lat0,lat1,1) - call mp_periodic_f3d(optm1out(:,lon0:lon1,lat0:lat1), - | lev0,lev1,lon0,lon1,lat0,lat1,1) +! Shapiro smoother: optm1 is O+ at time n-1 (optm1_smooth was s1) +! optm1_smooth will be used in explicit terms below. + do lat=lat0,lat1 + do i=lon0-2,lon1+2 + do k=lev0,lev1 + optm1_smooth1(k,i,lat) = optm1(k,i,lat)- + | shapiro/nstep_sub* + | (optm1(k,i,lat+2)+optm1(k,i,lat-2)- + | 4.*(optm1(k,i,lat+1)+optm1(k,i,lat-1))+ + | 6.*optm1(k,i,lat)) + enddo ! k=lev0,lev1 + enddo ! i=lon0-2,lon1+2 + enddo ! lat=lat0,lat1 ! - call mp_bndlats_f3d(opout,nlevs,lon0,lon1,lat0,lat1,1) - call mp_bndlons_f3d(opout,nlevs,lon0,lon1,lat0,lat1,1,0) +! Boundary longitudes for optm1_smooth1 were obtained after first +! latitude scan above. + do lat=lat0,lat1 + do i=lon0,lon1 + do k=lev0,lev1 + optm1_smooth(k,i,lat) = optm1_smooth1(k,i,lat)- + | shapiro/nstep_sub* + | (optm1_smooth1(k,i+2,lat)+optm1_smooth1(k,i-2,lat)- + | 4.*(optm1_smooth1(k,i+1,lat)+optm1_smooth1(k,i-1,lat))+ + | 6.*optm1_smooth1(k,i,lat)) + enddo ! k=lev0,lev1 + enddo ! i=lon0,lon1 + enddo ! lat=lat0,lat1 ! -! Save outputs on secondary history for diagnostics: ! do lat=lat0,lat1 -! call addfld('OPOUT',' ',' ',opout(lev0:lev1-1,lon0:lon1,lat), -! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) -! call addfld('OPOUTM1',' ',' ',optm1out(lev0:lev1-1,lon0:lon1, -! | lat),'lev',lev0,lev1-1,'lon',lon0,lon1,lat) +! call addfld('OPTM1',' ',' ',optm1(:,lon0:lon1,lat), +! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) +! call addfld('OPTM1_SM0' ,' ',' ', +! | optm1_smooth1(:,lon0:lon1,lat), +! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) +! call addfld('OPTM1_SM1' ,' ',' ', +! | optm1_smooth(:,lon0:lon1,lat), +! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) ! enddo ! lat=lat0,lat1 -#ifdef VT -! code = 113 ; state = 'oplus' ; activity='ModelCode' - call vtend(113,ier) -#endif - if (debug) - | write(6,"('oplus returning.')") - end subroutine oplus +! + end subroutine smooth_oplus !----------------------------------------------------------------------- - subroutine oplus_flux(opflux,lon0,lon1,lat0,lat1) + subroutine iterate_oplus(dvb,ubcrhs,lbcrhs,tp,dj,bdotu, + | optm1_smooth,op_prod,ui,vi,scht,p_coeff,q_coeff,r_coeff, + | op,opout,diffj,diffexp,vdotn_h,bdotdh_bvel, + | lev0,lev1,lon0,lon1,lat0,lat1) ! -! Calculate O+ number flux in opflux for sub oplus (was sub opflux). +! Update O+ ion at 3d task subdomain. +! Outputs are opout, diffj, diffexp, vdotn_h, bdotdh_bvel, +! all other args are input. ! - use cons_module,only: pi,rtd - use chapman_module,only: chi ! was t2 in old sub opflux - use magfield_module,only: rlatm + use params_module,only: nlonp4,dz,rp + use cons_module,only: rmass_op,gask,grav,re,cs,dphi,dlamda,dtx2inv + use input_module,only: nstep_sub + use magfield_module,only: bz,bmod2 ! (nlonp4,-1:nlat+2) + use mpi_module,only: mp_periodic_f3d,mp_polelats_f3d, + | mp_bndlats_f3d,mp_bndlons_f3d + use addfld_module,only: addfld ! ! Args: - integer,intent(in) :: lon0,lon1,lat0,lat1 - real,intent(out) :: opflux(lon0:lon1,lat0:lat1) + integer,intent(in) :: + | lev0,lev1, ! first,last pressure indices for current task (bot->top) + | lon0,lon1, ! first,last longitude indices for current task (W->E) + | lat0,lat1 ! first,last latitude indices for current task (S->N) +! +! Input fields (full 2d task subdomain): + real(rp),dimension(lon0-2:lon1+2,lat0-2:lat1+2),intent(in) :: + | dvb, ! output of sub divb + | ubcrhs,lbcrhs +! +! Input fields (full 3d task subdomain): + real(rp),dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2), + | intent(in) :: + | tp, ! Plasma temperature (te+ti) + | dj, ! diffusion coefficients (s13,s14,s15) + | bdotu, ! was s7 (B.U) + | optm1_smooth,! op at time n-1, with shapiro smoother (was s1) + | op_prod, + | ui,vi, ! zonal, and meridional ion velocities + | scht, ! scale height + | p_coeff,q_coeff,r_coeff, ! coefficients for tridiagonal solver (s1,s2,s3) + | op ! O+ ion +! +! Output fields (full 3d task subdomain): + real(rp),dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2), + | intent(out) :: + | opout, ! O+ output for next timestep + | diffj, ! (D/(H*DZ)*2.*TP+M*G/R)*N(O+) (s7,s8,s9) + | diffexp,vdotn_h,bdotdh_bvel ! ! Local: - integer :: i,lat - real,parameter :: - | phid = 2.0e8, - | phin = -2.0e8, - | ppolar = 0. - real :: a(lon0:lon1) ! was t3 ("a" needs a better name) - real :: fed(lon0:lon1) ! was t4 - real :: fen(lon0:lon1) ! was t5 + integer :: k,i,lat,ier,nlevs + real(rp) :: mgr + real(rp),dimension(lev0:lev1,lon0:lon1,lat0:lat1) :: + | uii,vii,dbdotdh_opjdz, + | bdotdh_op, ! (b(h)*del(h))*phi + | bdotdh_diff, ! (b(h)*del(h))*phi + | bdzdvb_op, ! was s7 + | explicit ! was s4 ! -! Latitude scan: - do lat=lat0,lat1 +! Local fields at 3d subdomain (must be 3d to bridge latitude scans): + real(rp),dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2) :: + | tpop,bvel,opb,dtpopdz,bdotdh_opj ! (b(h)*del(h))*phi + real(rp),dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2,2) :: + | tmpf3d ! -! Longitude loop: - do i=lon0,lon1 +#ifdef VT +! code = 113 ; state = 'oplus' ; activity='ModelCode' + call vtbegin(113,ier) +#endif ! -! Change upper boundary flux as electron heat flux in settei - if (abs(rlatm(i,lat)) >= pi/4.5) then - a(i) = 1. - elseif (abs(rlatm(i,lat)) <= pi/18.) then - a(i) = 0. - else - a(i) = .5*(1.+cos(abs(rlatm(i,lat))*6.-pi*4./3.)) - endif - fed(i) = phid*a(i) - fen(i) = phin*a(i) - if (chi(i,lat)-0.5*pi >= 0.) then - opflux(i,lat) = fen(i) - else - opflux(i,lat) = fed(i) - endif - if ((chi(i,lat)*rtd-80.)*(chi(i,lat)*rtd-100.) < 0.) - | opflux(i,lat) = .5*(fed(i)+fen(i))+.5*(fed(i)-fen(i))* - | cos(pi*(chi(i,lat)*rtd-80.)/20.) +! Number of pressure levels (this will equal nlevp1): + nlevs = lev1-lev0+1 ! for bndlons calls ! -! Add ppolar if magnetic latitude >= 60 degrees: - if (abs(rlatm(i,lat))-pi/3. >= 0.) - | opflux(i,lat) = opflux(i,lat)+ppolar + mgr = rmass_op*grav/gask +! + do lat=lat0-2,lat1+2 + do i=lon0-2,lon1+2 + do k=lev0,lev1 +! +! Plasma temperature times O+ + tpop(k,i,lat) = tp(k,i,lat)*op(k,i,lat) +! +! bvel @ j = (B.U)*N(O+) (J) (was s7) + bvel(k,i,lat) = bdotu(k,i,lat)*op(k,i,lat) + enddo ! k=lev0,lev1 +! +! Evaluates ans = (d/(h*dz)*tp+m*g/r)*en + do k=lev0+1,lev1-1 + dtpopdz(k,i,lat) = (tpop(k+1,i,lat)-tpop(k-1,i,lat))/(2.*dz) + enddo ! k=lev0+1,lev1-1 +! +! Upper and lower boundaries: + dtpopdz(lev1,i,lat) = (tpop(lev1,i,lat)-tpop(lev1-1,i,lat))/dz + dtpopdz(lev0,i,lat) = (tpop(lev0+1,i,lat)-tpop(lev0,i,lat))/dz +! + do k=lev0,lev1 + diffj(k,i,lat) = 2.*dtpopdz(k,i,lat)/scht(k,i,lat)+ + | mgr*op(k,i,lat) + enddo ! k=lev0,lev1 + enddo ! i=lon0-2,lon1+2 + enddo ! lat=lat0-2,lat1+2 +! + call bdotdh(bvel,bdotdh_bvel(:,lon0:lon1,lat0:lat1), + | lev0,lev1,lon0,lon1,lat0,lat1) +! +! bdotdh_op = (B(H).DEL(H))*(D/(H*DZ)*TP+M*G/R)*N(O+) + call bdotdh(diffj,bdotdh_op,lev0,lev1,lon0,lon1,lat0,lat1) +! +! bdotdh_opj = (B(H).DEL(H))*2.*TP*N(O+) (J) + call bdotdh(2.*tpop,bdotdh_opj(:,lon0:lon1,lat0:lat1), + | lev0,lev1,lon0,lon1,lat0,lat1) +! + do lat=lat0,lat1 + do i=lon0,lon1 + do k=lev0,lev1 + bdotdh_opj(k,i,lat) = bdotdh_opj(k,i,lat)*dj(k,i,lat) + opb(k,i,lat) = op(k,i,lat)/bmod2(i,lat)**2 + enddo ! k=lev0,lev1 enddo ! i=lon0,lon1 enddo ! lat=lat0,lat1 ! - end subroutine oplus_flux -!----------------------------------------------------------------------- - subroutine divb(dvb,lon0,lon1,lat0,lat1) - use cons_module,only: cs,dlamda,dphi,re + do lat=lat0,lat1 + do i=lon0,lon1 + do k=lev0,lev1 + tmpf3d(k,i,lat,1) = bdotdh_opj(k,i,lat) + tmpf3d(k,i,lat,2) = opb(k,i,lat) + enddo ! k=lev0,lev1 + enddo ! i=lon0,lon1 + enddo ! lat=lat0,lat1 + call mp_polelats_f3d(tmpf3d(:,lon0:lon1,:,:), + | lev0,lev1,lon0,lon1,lat0,lat1,2,(/1.,1./)) + call mp_bndlats_f3d(tmpf3d,nlevs,lon0,lon1,lat0,lat1,2) + call mp_bndlons_f3d(tmpf3d,nlevs,lon0,lon1,lat0,lat1,2,0) + do lat=lat0-2,lat1+2 + do i=lon0-2,lon1+2 + do k=lev0,lev1 + bdotdh_opj(k,i,lat) = tmpf3d(k,i,lat,1) + opb(k,i,lat) = tmpf3d(k,i,lat,2) + enddo ! k=lev0,lev1 + enddo ! i=lon0-2,lon1+2 + enddo ! lat=lat0-2,lat1+2 ! -! Evaluate divergence of B, the unit magnetic field vector. +! bdotdh_opj = (B(H).DEL(H))*D*(B(H).DEL(H))*2.*TP*N(O+) (J) +! Note bdotdh_opj longitude dimension is lon-2:lon+2. bdotdh_diff is returned. +! (periodic points apparently not necessary for bdotdh_diff) + call bdotdh(bdotdh_opj,bdotdh_diff,lev0,lev1,lon0,lon1,lat0,lat1) ! -! Args: - integer,intent(in) :: lon0,lon1,lat0,lat1 - real,intent(out) :: dvb(lon0:lon1,lat0:lat1) + do lat=lat0,lat1 + do i=lon0,lon1 + do k=lev0,lev1-1 + uii(k,i,lat) = 0.5*(ui(k,i,lat)+ui(k+1,i,lat)) + vii(k,i,lat) = 0.5*(vi(k,i,lat)+vi(k+1,i,lat)) + enddo ! k=lev0,lev1-1 + uii(lev1,i,lat) = 1.5*ui(lev1,i,lat)-0.5*ui(lev1-1,i,lat) + vii(lev1,i,lat) = 1.5*vi(lev1,i,lat)-0.5*vi(lev1-1,i,lat) ! -! Local: - integer :: lonbeg,lonend,i,lat,jm1,jp1 +! bdzdvb_op = (BZ*D/(H*DZ)+DIV(*B))*S2 ! - lonbeg = lon0 - if (lon0==1) lonbeg = 3 - lonend = lon1 - if (lon1==nlonp4) lonend = lon1-2 +! Evaluates (bz*d/(h*dz)+divb)*phi + do k=lev0+1,lev1-1 + dbdotdh_opjdz(k,i,lat) = + | (bdotdh_opj(k+1,i,lat)-bdotdh_opj(k-1,i,lat))/(2.*dz) + enddo ! k=lev0+1,lev1-1 +! +! Upper and lower boundaries: + dbdotdh_opjdz(lev1,i,lat) = + | (bdotdh_opj(lev1,i,lat)-bdotdh_opj(lev1-1,i,lat))/dz + dbdotdh_opjdz(lev0,i,lat) = + | (bdotdh_opj(lev0+1,i,lat)-bdotdh_opj(lev0,i,lat))/dz +! + do k=lev0,lev1 + bdzdvb_op(k,i,lat) = + | bz(i,lat)*dbdotdh_opjdz(k,i,lat)/scht(k,i,lat)+ + | dvb(i,lat)*bdotdh_opj(k,i,lat) ! +! bdotdh_op = (B(H).DEL(H))*(D/(H*DZ)*TP+M*G/R)*N(O+) +! then bdotdh_op = d*bz*bdotdh_op + bdotdh_op(k,i,lat) = + | dj(k,i,lat)*bz(i,lat)*bdotdh_op(k,i,lat) +! + diffexp(k,i,lat) = + | bdzdvb_op(k,i,lat)+bdotdh_diff(k,i,lat)+bdotdh_op(k,i,lat) +! +! Note if input flag DYNAMO<=0, then ui,vi,wi velocities will be zero. + vdotn_h(k,i,lat) = bmod2(i,lat)**2/(2.*re)* + | (uii(k,i,lat)/(cs(lat)*dlamda)* + | (opb(k,i+1,lat)-opb(k,i-1,lat))+ + | vii(k,i,lat)/dphi* + | (opb(k,i,lat+1)-opb(k,i,lat-1))) +! +! Collect explicit terms: +! Sum O+ at time n-1 to explicit terms: N(O+)/(2*DT) (N-1) (was s4) +! Add source term to RHS (explicit terms): + explicit(k,i,lat) = + | vdotn_h(k,i,lat)+bdotdh_bvel(k,i,lat)- + | diffexp(k,i,lat)-op_prod(k,i,lat)- + | optm1_smooth(k,i,lat)*dtx2inv*nstep_sub + enddo ! k=lev0,lev1 +! +! Upper boundary condition for O+ (F = F-R/A*PHI): + explicit(lev1-1,i,lat) = explicit(lev1-1,i,lat)-ubcrhs(i,lat) +! +! Lower boundary condition N(O+) = Q/L: + explicit(lev0,i,lat) = explicit(lev0,i,lat)-lbcrhs(i,lat) + enddo ! i=lon0,lon1 + enddo ! lat=lat0,lat1 +! +! Tridiagonal solver returns updated O+ in opout (all other args are input): do lat=lat0,lat1 - jm1 = lat-1 - jp1 = lat+1 - dvb(:,lat) = 0. - do i=lonbeg,lonend - dvb(i,lat) = (((bx(i+1,lat)-bx(i-1,lat))/(2.*dlamda)+ - | (cs(jp1)*by(i,jp1)-cs(jm1)*by(i,jm1))/(2.*dphi))/ - | cs(lat)+2.*bz(i,lat))/re - enddo ! i=lonbeg,lonend + call trsolv( + | p_coeff(:,lon0:lon1,lat), + | q_coeff(:,lon0:lon1,lat), + | r_coeff(:,lon0:lon1,lat), + | explicit(:,lon0:lon1,lat), + | opout(:,lon0:lon1,lat), + | lev0,lev1,lev0,lev1-1,lon0,lon1,nlonp4,lat,0) +! +! Upper boundary: + do i=lon0,lon1 + opout(lev1,i,lat) = 2.*opout(lev1-1,i,lat)-opout(lev1-2,i,lat) + enddo ! i=lon0,lon1 enddo ! lat=lat0,lat1 ! - end subroutine divb -!----------------------------------------------------------------------- - subroutine rrk(rms,ps1,ps2,he,n2,tr,ans,vni, - | lon0,lon1,lev0,lev1) +! Periodic points for outputs: + call mp_periodic_f3d(opout(:,lon0:lon1,lat0:lat1), + | lev0,lev1,lon0,lon1,lat0,lat1,1) ! -! Returns ambipolar diffusion coefficient in ans and vni. +! do lat=lat0,lat1 +! call addfld('TPJ','TP after times OP',' ',tpop(:,lon0:lon1,lat), +! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) +! call addfld('BVEL_J',' ',' ',bvel(:,lon0:lon1,lat), +! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) +! call addfld('DIFFJ','DIFFJ after diffus',' ', +! | diffj(:,lon0:lon1,lat), +! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) +! call addfld('BDOTDH_1',' ',' ',bdotdh_op(:,:,lat), +! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) +! call addfld('BDOTDH_2',' ',' ',bdotdh_opj(:,lon0:lon1,lat), +! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) +! call addfld('BDOT_DIF',' ',' ',bdotdh_diff(:,:,lat), +! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) +! call addfld('BDZDVB',' ',' ',bdzdvb_op(:,:,lat), +! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) +! call addfld('EXPLIC',' ',' ',explicit(lev0:lev1-1,:,lat), +! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) +! call addfld('OP_SOLV',' ',' ',opout(lev0:lev1-1,lon0:lon1,lat), +! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) +! enddo ! lat=lat0,lat1 ! - use params_module,only: zpint - use cons_module,only: rmassinv_o2,rmassinv_o1,rmassinv_n2, - | rmassinv_he - use input_module,only: colfac,opdiffcap - use init_module,only: istep +#ifdef VT +! code = 113 ; state = 'oplus' ; activity='ModelCode' + call vtend(113,ier) +#endif ! -! Args: - integer,intent(in) :: lon0,lon1,lev0,lev1 - real,dimension(lev0:lev1,lon0:lon1),intent(in) :: - | rms,ps1,ps2,he,n2,tr - real,dimension(lev0:lev1,lon0:lon1),intent(out) :: ans,vni + end subroutine iterate_oplus +!----------------------------------------------------------------------- + subroutine post_oplus(op,optm1,opout,optm1out, + | lev0,lev1,lon0,lon1,lat0,lat1) ! -! Local: - integer :: k,i - real :: opdiffcap_k +! Post-processing time smoothing. +! This is called after filter_op ! - do i=lon0,lon1 - do k=lev0,lev1-1 + use params_module,only: zpmid,spval,rp ! for O+ minimum + use cons_module,only: rtd,dtsmooth,dtsmooth_div2 + use input_module,only: opfloor,oprate,oplev,oplatwidth + use magfield_module,only: rlatm + use addfld_module,only: addfld ! -! 8/28/13 btf: Use n2=1-o2-o-he, and include O+/He collision rate from Wenbin: +! Args: + integer,intent(in) :: + | lev0,lev1, ! first,last pressure indices for current task (bot->top) + | lon0,lon1, ! first,last longitude indices for current task (W->E) + | lat0,lat1 ! first,last latitude indices for current task (S->N) ! - vni(k,i) = 18.1*ps1(k,i)*rmassinv_o2+ - | ps2(k,i)*rmassinv_o1*sqrt(tr(k,i))* - | (1.-0.064*alog10(tr(k,i)))**2*colfac+ - | 3.6*he(k,i)*rmassinv_he+18.6*n2(k,i)*rmassinv_n2 - ans(k,i) = 1.42E17/(rms(k,i)*vni(k,i)) - vni(k,i) = 16*3.53E-11*vni(k,i) - enddo ! k=lev0,lev1 - enddo ! i=lon0,lon1 +! Input fields (full 3d task subdomain): + real(rp),dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2), + | intent(in) :: + | op, ! O+ ion + | optm1 ! O+ at time n-1 ! -! 1/30/16 btf: -! Cap ambipolar diffusion coefficient. Namelist parameter OPDIFFCAP. -! This was tested with various values (1.5e8, 3e8, 6e8, 8e8), -! and was found to improve numerical stability in some storm cases, -! for example the November, 2003 and July, 2000 storms, with Weimer -! potential model and IMF/OMNI data. Both of these cases generally -! will not complete if timestep is longer than 10 sec. The Nov, 2003 -! may succeed with opdiffcap turned off, but the July, 2000 -! "Bastille day storm" will succeed only with step=10 and opdiffcap=6.e8. +! Output fields (full 3d task subdomain): + real(rp),dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2), + | intent(inout) :: + | opout ! O+ output for next timestep +! +! Output fields (full 3d task subdomain): + real(rp),dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2), + | intent(out) :: + | optm1out ! O+ output for time n-1 ! - if (opdiffcap /= 0.) then ! default is off - if (istep==1) write(6,"('oplus rrk: opdiffcap = ',es12.4)") - | opdiffcap -! where(ans(:,:) > opdiffcap) -! ans(:,:) = opdiffcap -! endwhere - do k=lev0,lev1-1 - opdiffcap_k = opdiffcap/(1+2**(zpint(k)-6)) +! Local: + integer :: k,i,lat +! +! For O+ "smooth floor". The floor is a +! spatial gaussian based on the O+ minimum (opmin below). +! +! 1/21/16 btf: Increased O+ minimum. +! (This alleviates numerical instability that can develop +! near the equator at the top of the model in some cases, +! e.g., it allows the 2.5-deg June solstice solar max +! benchmark to run with step=30 rather than step=20, and +! may improve stability in other cases as well.) +! +! 2024/08 Haonan Wu: opmin is determined from input parameters +! OPFLOOR, OPRATE, OPLEV, and OPLATWIDTH to be more flexible + real(rp) :: opmin +! +! 12/4/14 btf: Enforce O+ minimum. +! Opfloor is Stan's "smooth floor" (product of two Gaussians, +! dependent on latitude and pressure level): +! +! 2024/08 Haonan Wu: +! Change the altitude distribution of O+ minimum from Gaussian to logistic, +! also change the latitude distribution based on magnetic latitudes +! instead of geographic latitudes + if (opfloor/=0. .and. + | oprate/=0. .and. + | oplev/=spval .and. + | oplatwidth/=0.) then + do lat=lat0,lat1 do i=lon0,lon1 - if (ans(k,i) > opdiffcap_k) ans(k,i) = opdiffcap_k - enddo - enddo + do k=lev0,lev1 + opmin = opfloor*exp(-(rlatm(i,lat)*rtd/oplatwidth)**2)/ + | (1+exp(-oprate*(zpmid(k)-oplev))) + if (opout(k,i,lat) < opmin) opout(k,i,lat) = opmin + enddo ! k=lev0,lev1 + enddo ! i=lon0,lon1 + enddo ! lat=lat0,lat1 endif - - end subroutine rrk -!----------------------------------------------------------------------- - subroutine diffus(tp,en,hj,ans,lon0,lon1,lev0,lev1) ! -! Evaluates ans = (d/(h*dz)*tp+m*g/r)*en + do lat=lat0,lat1 + do i=lon0,lon1 + do k=lev0,lev1 ! - use cons_module,only: rmass_op,grav,gask +! Ensure global non-negative O+: +! This should already been satisfied if O+ minimum is applied above + if (opout(k,i,lat) < 0.) opout(k,i,lat) = 0. ! -! Args: - integer :: lon0,lon1,lev0,lev1 - real,dimension(lev0:lev1,lon0:lon1),intent(in) :: tp,en,hj - real,dimension(lev0:lev1,lon0:lon1),intent(out) :: ans +! Time smoothing: ! -! Local: - integer :: k,i,k1,k2 - real :: mgr +! optm1out(k,i,lat): New O+ at current latitude and time n-1. +! op(k,i,lat) : O+ at current latitude and time. +! optm1(k,i,lat) : O+ at current latitude and time n-1. +! opout(k,i,lat) : New O+ at current latitude and time. + optm1out(k,i,lat) = dtsmooth*op(k,i,lat)+ + | dtsmooth_div2*(optm1(k,i,lat)+opout(k,i,lat)) + enddo ! k=lev0,lev1 + enddo ! i=lon0,lon1 + enddo ! lat=lat0,lat1 ! - mgr = rmass_op*grav/gask - do i=lon0,lon1 - do k=lev0,lev1-2 - k1 = k+1 - k2 = k+2 - ans(k1,i) = 1./(2.*hj(k1,i)*dlev)*(tp(k2,i)*en(k2,i)- - | tp(k,i)*en(k,i))+mgr*en(k1,i) - enddo - enddo +! Save outputs on secondary history for diagnostics: +! do lat=lat0,lat1 +! call addfld('OPOUT',' ',' ',opout(:,lon0:lon1,lat), +! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) +! call addfld('OPOUTM1',' ',' ',optm1out(:,lon0:lon1,lat), +! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) +! enddo ! lat=lat0,lat1 ! -! Upper and lower boundaries: - k1 = lev1-1 - k2 = lev1-2 - do i=lon0,lon1 - ans(k1,i) = 1./(hj(k1,i)*dlev)*(tp(k1,i)*en(k1,i)- - | tp(k2,i)*en(k2,i))+mgr*en(k1,i) - ans(1,i) = 1./(hj(1,i)*dlev)*(tp(2,i)*en(2,i)- - | tp(1,i)*en(1,i))+mgr*en(1,i) - enddo - end subroutine diffus + end subroutine post_oplus !----------------------------------------------------------------------- - subroutine bdotdh(phijm1,phij,phijp1,ans,lon0,lon1,lev0,lev1,lat) + subroutine bdotdh(phij,ans,lev0,lev1,lon0,lon1,lat0,lat1) +! + use params_module,only: rp use cons_module,only: re,dphi,dlamda,cs + use magfield_module,only: bx,by ! ! Evaluates ans = (b(h)*del(h))*phi ! ! Args: - integer :: lon0,lon1,lev0,lev1,lat - real,dimension(lev0:lev1,lon0:lon1),intent(in) :: phijm1,phijp1 - real,dimension(lev0:lev1,lon0-2:lon1+2),intent(in) :: phij - real,dimension(lev0:lev1,lon0:lon1),intent(out) :: ans + integer,intent(in) :: lev0,lev1,lon0,lon1,lat0,lat1 + real(rp),dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2), + | intent(in) :: phij + real(rp),dimension(lev0:lev1,lon0:lon1,lat0:lat1),intent(out) :: + | ans ! ! Local: - integer :: k,i,lonbeg,lonend -! - lonbeg = lon0 - if (lon0==1) then - lonbeg = 3 - ans(:,lon0:lon1) = 0. ! set periodic points to zero to avoid NaNS trap - endif - lonend = lon1 - if (lon1==nlonp4) then - lonend = lon1-2 - ans(:,lon1-1:lon1) = 0. ! set periodic points to zero to avoid NaNS trap - endif + integer :: k,i,lat + real(rp),dimension(lev0:lev1,lon0:lon1,lat0:lat1) :: dphidx,dphidy ! ! Note phij longitude dimension is lon0-2:lon1+2 (only i-1 and i+1 are used). ! Boundary longitudes i-1 and i+1 must have been set before this routine is ! called (e.g., call mp_bndlons_f3d). -! - do i=lonbeg,lonend - do k=lev0,lev1-1 - ans(k,i) = 1./re*(bx(i,lat)/(cs(lat)*2.*dlamda)* - | (phij(k,i+1)-phij(k,i-1))+by(i,lat)* - | (phijp1(k,i)-phijm1(k,i))/(2.*dphi)) - enddo ! k=lev0,lev1 - enddo ! i=lonbeg,lonend + do lat=lat0,lat1 + do i=lon0,lon1 + do k=lev0,lev1 + dphidx(k,i,lat) = + | (phij(k,i+1,lat)-phij(k,i-1,lat))/(2.*dlamda) + dphidy(k,i,lat) = + | (phij(k,i,lat+1)-phij(k,i,lat-1))/(2.*dphi) + ans(k,i,lat) = + | (bx(i,lat)*dphidx(k,i,lat)/cs(lat)+ + | by(i,lat)*dphidy(k,i,lat))/re + enddo ! k=lev0,lev1 + enddo ! i=lon0,lon1 + enddo ! lat=lat0,lat1 ! end subroutine bdotdh !----------------------------------------------------------------------- - subroutine bdzdvb(phi,dvb,h,ans,lev0,lev1,lon0,lon1,lat) + subroutine calc_terms(xnmbar,diffj,Fe,Fn, + | opout,optm1_smooth,op_prod,op_loss, + | diffexp,diffp,diffq,diffr, + | vdotn_h,driftp,driftq,driftr, + | bdotdh_bvel,windp,windq,windr, + | lev0,lev1,lon0,lon1,lat0,lat1) ! -! Evaluates ans = (bz*d/(h*dz)+divb)*phi +! Post-processing diagnostic term analysis. +! This is called only at the last sub-cycling step +! + use params_module,only: rp + use cons_module,only: rmass_op,dtx2inv + use input_module,only: nstep_sub + use magfield_module,only: dipmag,sndec,csdec + use addfld_module,only: addfld ! ! Args: - integer :: lev0,lev1,lon0,lon1,lat - real,intent(in) :: dvb(lon0:lon1) - real,dimension(lev0:lev1,lon0:lon1),intent(in) :: phi,h - real,dimension(lev0:lev1,lon0:lon1),intent(out) :: ans + integer,intent(in) :: + | lev0,lev1, ! first,last pressure indices for current task (bot->top) + | lon0,lon1, ! first,last longitude indices for current task (W->E) + | lat0,lat1 ! first,last latitude indices for current task (S->N) +! +! Input fields (full 3d task subdomain): + real(rp),dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2), + | intent(in) :: + | xnmbar,diffj, + | opout, ! O+ output for next timestep + | optm1_smooth, ! op at time n-1, with shapiro smoother (was s1) + | op_prod,op_loss, + | diffexp,diffp,diffq,diffr, + | vdotn_h,driftp,driftq,driftr, + | bdotdh_bvel,windp,windq,windr +! + real(rp),dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2), + | intent(out) :: Fe,Fn ! ! Local: - integer :: k,i + integer :: k,i,lat + real(rp),dimension(lon0:lon1,lat0:lat1) :: proj_e,proj_n + real(rp),dimension(lev0:lev1,lon0:lon1,lat0:lat1) :: + | wd,dopdt,op_loss_out,diffsum,driftsum,windsum ! - do i=lon0,lon1 - do k=lev0+1,lev1-2 - ans(k,i) = bz(i,lat)/(2.*h(k,i)*dz)*(phi(k+1,i)-phi(k-1,i))+ - | dvb(i)*phi(k,i) - enddo ! k=lev0+1,lev1-1 - enddo ! i=lon0,lon1 + do lat=lat0,lat1 + do i=lon0,lon1 + proj_e(i,lat) = + | sin(dipmag(i,lat))*cos(dipmag(i,lat))*sndec(i,lat) + proj_n(i,lat) = + | sin(dipmag(i,lat))*cos(dipmag(i,lat))*csdec(i,lat) +! + do k=lev0,lev1 + wd(k,i,lat) = 3.53*1.42E6*rmass_op/ + | xnmbar(k,i,lat)*diffj(k,i,lat) + Fe(k,i,lat) = wd(k,i,lat)*proj_e(i,lat) + Fn(k,i,lat) = wd(k,i,lat)*proj_n(i,lat) +! + dopdt(k,i,lat) = dtx2inv*nstep_sub* + | (opout(k,i,lat)-optm1_smooth(k,i,lat)) + op_loss_out(k,i,lat) = op_loss(k,i,lat)*opout(k,i,lat) + enddo ! k=lev0,lev1 ! -! Upper and lower boundaries: - do i=lon0,lon1 - ans(lev1-1,i) = bz(i,lat)/(h(lev1-1,i)*dz)*(phi(lev1-1,i)- - | phi(lev1-2,i))+dvb(i)*phi(lev1-1,i) - ans(lev0,i) = bz(i,lat)/(h(lev0,i)*dz)* - | (phi(lev0+1,i)-phi(lev0,i))+dvb(i)*phi(lev0,i) - enddo ! i=lon0,lon1 - end subroutine bdzdvb + do k=lev0+1,lev1-1 + diffsum (k,i,lat) = diffexp(k,i,lat)+ + | diffp (k,i,lat)*opout(k-1,i,lat)+ + | diffq (k,i,lat)*opout(k ,i,lat)+ + | diffr (k,i,lat)*opout(k+1,i,lat) + driftsum(k,i,lat) = -vdotn_h(k,i,lat)+ + | driftp(k,i,lat)*opout(k-1,i,lat)+ + | driftq(k,i,lat)*opout(k ,i,lat)+ + | driftr(k,i,lat)*opout(k+1,i,lat) + windsum (k,i,lat) = -bdotdh_bvel(k,i,lat)+ + | windp (k,i,lat)*opout(k-1,i,lat)+ + | windq (k,i,lat)*opout(k ,i,lat)+ + | windr (k,i,lat)*opout(k+1,i,lat) + enddo ! k=lev0+1,lev1-1 + enddo ! i=lon0,lon1 +! +! call addfld('PARDRAG_U','','',Fe(:,lon0:lon1,lat), +! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) +! call addfld('PARDRAG_V','','',Fn(:,lon0:lon1,lat), +! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) + call addfld('DOPDT','O+ changing rate','cm-3s-1', + | dopdt(:,:,lat),'lev',lev0,lev1,'lon',lon0,lon1,lat) + call addfld('OP_PROD','O+ production','cm-3s-1', + | op_prod(:,lon0:lon1,lat),'lev',lev0,lev1,'lon',lon0,lon1,lat) + call addfld('OP_LOSS','O+ loss','cm-3s-1', + | -op_loss_out(:,:,lat),'lev',lev0,lev1,'lon',lon0,lon1,lat) + call addfld('OP_DIFF', + | 'O+ transport due to ambipolar diffusion','cm-3s-1', + | diffsum(lev0+1:lev1-1,:,lat), + | 'lev',lev0+1,lev1-1,'lon',lon0,lon1,lat) + call addfld('OP_DRIFT', + | 'O+ transport due to ion drift','cm-3s-1', + | driftsum(lev0+1:lev1-1,:,lat), + | 'lev',lev0+1,lev1-1,'lon',lon0,lon1,lat) + call addfld('OP_WIND', + | 'O+ transport due to neutral wind','cm-3s-1', + | windsum(lev0+1:lev1-1,:,lat), + | 'lev',lev0+1,lev1-1,'lon',lon0,lon1,lat) + enddo ! lat=lat0,lat1 +! + end subroutine calc_terms !----------------------------------------------------------------------- subroutine filter_op(opout,lev0,lev1,lon0,lon1,lat0,lat1,name) ! -! Filter updated O+. This is called from outside latitude loop, -! i.e., once per timestep. +! Filter updated O+. This is called once per timestep. ! + use params_module,only: nlonp4,rp use mpi_module,only: mytidi,mp_gatherlons_f3d,mp_scatterlons_f3d ! ! Args: integer,intent(in) :: lev0,lev1,lon0,lon1,lat0,lat1 - real,intent(inout) :: opout(lev0:lev1,lon0:lon1,lat0:lat1) + real(rp),dimension(lev0:lev1,lon0:lon1,lat0:lat1),intent(inout) :: + | opout character(len=*),intent(in) :: name ! ! Local: - integer :: i,j,ier - real :: op_ik(nlonp4,lev0:lev1),op_kij(lev0:lev1,nlonp4,lat0:lat1) + integer :: k,i,lat,ier + real(rp),dimension(nlonp4,lev0:lev1) :: op_ik + real(rp),dimension(lev0:lev1,nlonp4,lat0:lat1) :: op_kij ! #ifdef VT ! code = 124 ; state = 'filter_op' ; activity='Filtering' @@ -1230,57 +1231,66 @@ subroutine filter_op(opout,lev0,lev1,lon0,lon1,lat0,lat1,name) ! ! Define lons in op_kij from current task subdomain opout: op_kij = 0. - do j=lat0,lat1 + do lat=lat0,lat1 do i=lon0,lon1 - op_kij(:,i,j) = opout(:,i,j) - enddo - enddo ! j=lat0,lat1 + do k=lev0,lev1 + op_kij(k,i,lat) = opout(k,i,lat) + enddo ! k=lev0,lev1 + enddo ! i=lon0,lon1 + enddo ! lat=lat0,lat1 ! ! Gather longitudes into tasks in first longitude column of task table -! (leftmost of each j-row) for global fft. (i.e., tasks with mytidi==0 +! (leftmost of each lat-row) for global fft. (i.e., tasks with mytidi==0 ! gather lons from other tasks in that row). This includes all latitudes. ! call mp_gatherlons_f3d(op_kij,lev0,lev1,lon0,lon1,lat0,lat1,1, | name) ! -! Only leftmost tasks at each j-row of tasks does the global filtering: +! Only leftmost tasks at each lat-row of tasks does the global filtering: if (mytidi==0) then ! ! Loop through subdomain latitudes: - latscan: do j=lat0,lat1 + latscan: do lat=lat0,lat1 ! ! Define 2d array at all longitudes for filter: do i=1,nlonp4 - op_ik(i,:) = op_kij(:,i,j) + do k=lev0,lev1 + op_ik(i,k) = op_kij(k,i,lat) + enddo ! k=lev0,lev1 enddo ! i=1,nlonp4 ! ! Do the filtering: - call ringfilter(op_ik,lev0,lev1,3,name,j) + call ringfilter(op_ik,lev0,lev1,3,name,lat) ! ! Return filtered array to op_kij: do i=1,nlonp4 - op_kij(:,i,j) = op_ik(i,:) + do k=lev0,lev1 + op_kij(k,i,lat) = op_ik(i,k) + enddo ! k=lev0,lev1 enddo ! i=1,nlonp4 - enddo latscan ! j=lat0,lat1 + enddo latscan ! lat=lat0,lat1 endif ! mytidi==0 ! -! Now leftmost task at each j-row must redistribute filtered data -! back to other tasks in the j-row (mytidi>0,mytidj) (includes latitude): +! Now leftmost task at each lat-row must redistribute filtered data +! back to other tasks in the lat-row (mytidi>0,mytidj) (includes latitude): ! call mp_scatterlons_f3d(op_kij,lev0,lev1,lon0,lon1,lat0,lat1,1, | name) ! ! Return filtered array to opout at task subdomain: - do j=lat0,lat1 + do lat=lat0,lat1 do i=lon0,lon1 - opout(:,i,j) = op_kij(:,i,j) - enddo - enddo + do k=lev0,lev1 + opout(k,i,lat) = op_kij(k,i,lat) + enddo ! k=lev0,lev1 + enddo ! i=lon0,lon1 + enddo ! lat=lat0,lat1 ! #ifdef VT ! code = 124 ; state = 'filter_op' ; activity='Filtering' call vtend(124,ier) #endif +! end subroutine filter_op !----------------------------------------------------------------------- end module oplus_module diff --git a/src/params.F b/src/params.F index 480262b..0ca4221 100644 --- a/src/params.F +++ b/src/params.F @@ -12,7 +12,7 @@ module params_module ! ! Geographic grid parameters: integer,parameter :: rp = REAL64 - real,parameter :: + real(rp),parameter :: | dlat = DLAT, ! delta latitude | glat1 = -90._rp+dlat/2._rp, ! first latitude | dlon = DLON, ! delta longitude @@ -33,8 +33,8 @@ module params_module | nilevp1 = nilev+1, | nlonp1=nlon+1, nlatp1=nlat+1, | nlonp2=nlon+2, nlatp2=nlat+2 - real :: glon(nlon),glat(nlat),zpmid(nlevp1),zpint(nlevp1) - real,parameter :: + real(rp) :: glon(nlon),glat(nlat),zpmid(nlevp1),zpint(nlevp1) + real(rp),parameter :: | spval = 1.e36_rp integer,parameter :: | ispval = 999 @@ -49,9 +49,9 @@ module params_module | nmlatp1=nmlat+1, | nmlath=(nmlat+1)/2 ! index to magnetic equator - real,parameter :: zpbot_dyn = -8.25_rp ! bottom midpoint boundary of dynamo - real,parameter :: zpibot_dyn = -8.5_rp ! bottom interface boundary of dynamo - real,parameter :: dmlev = dlev + real(rp),parameter :: zpbot_dyn = -8.25_rp ! bottom midpoint boundary of dynamo + real(rp),parameter :: zpibot_dyn = -8.5_rp ! bottom interface boundary of dynamo + real(rp),parameter :: dmlev = dlev ! ! nmlev_diff = number of levels from zibot down to zpibot_dyn ! nmlevp1 = total number of mag levels @@ -64,12 +64,12 @@ module params_module integer,parameter :: mlev0 = 1 - nmlev_diff integer,parameter :: mlev1 = nlevp1 - real :: gmlon(nmlonp1), ! magnetic longitude (deg) + real(rp) :: gmlon(nmlonp1), ! magnetic longitude (deg) | gmlat(nmlat), ! magnetic latitude (deg) | zpmag(nmlevp1), ! magnetic midpoint levels | zpimag(nimlevp1) ! magnetic interface levels ! - real,dimension(nlonp4) :: glon0 ! include ghost points (1->nlonp4) + real(rp),dimension(nlonp4) :: glon0 ! include ghost points (1->nlonp4) ! ! For modules hist_mod and input_mod: character(len=16),parameter :: tgcm_version = 'tiegcm_trunk ' diff --git a/src/pdynamo.F b/src/pdynamo.F index fc48e93..ed22320 100644 --- a/src/pdynamo.F +++ b/src/pdynamo.F @@ -17,7 +17,7 @@ module pdynamo_module use heelis_module,only: phihm use init_module,only: istep use input_module,only: current_pg,current_kq - use fields_module,only: zigm1,zigm2,nsrhs + use fields_module,only: nsrhs implicit none ! ! 3d pointers to fields regridded to magnetic subdomains (i,j,k): @@ -39,9 +39,9 @@ module pdynamo_module | rim1,rim2, | rhs, ! right-hand side | phimsolv, ! solution direct from solver (nhem only) - | phim2d ! solution with phihm and both nhem and shem -! | zigm1, nsrhs, -! | zigm2, ! sigma2 + | phim2d, ! solution with phihm and both nhem and shem + | zigm1, + | zigm2 ! sigma2 ! ! 3d potential and electric field on mag subdomains (see sub pthreed): ! (mlon0:mlon1,mlat0:mlat1,mlev0:mlev1) @@ -1080,6 +1080,8 @@ subroutine fieldline_integrals end subroutine fieldline_integrals !----------------------------------------------------------------------- subroutine alloc_pdyn + + use fields_module,only: azigm1,azigm2 ! ! Allocate and initialize arrays for parallel dynamo (module data) ! (called once per run from allocdata.F) @@ -1099,6 +1101,9 @@ subroutine alloc_pdyn allocate(zigmc(mlon00:mlon11,mlat00:mlat11) ,stat=istat) if (istat /= 0) call shutdown('alloc_pdyn: zigmc') zigmc = 0. + allocate(zigm1(mlon00:mlon11,mlat00:mlat11),stat=istat) + if (istat /= 0) call shutdown('alloc_pdyn: zigm1') + zigm1 = 0. allocate(zigm2(mlon00:mlon11,mlat00:mlat11) ,stat=istat) if (istat /= 0) call shutdown('alloc_pdyn: zigm2') zigm2 = 0. @@ -1120,9 +1125,12 @@ subroutine alloc_pdyn allocate(phim2d(mlon00:mlon11,mlat00:mlat11),stat=istat) if (istat /= 0) call shutdown('alloc_pdyn: phim2d') phim2d = 0. - allocate(zigm1(mlon00:mlon11,mlat00:mlat11),stat=istat) - if (istat /= 0) call shutdown('alloc_pdyn: zigm1') - zigm1 = 0. + allocate(azigm1(mlon00:mlon11,mlat00:mlat11),stat=istat) + if (istat /= 0) call shutdown('alloc_pdyn: azigm1') + azigm1 = 0. + allocate(azigm2(mlon00:mlon11,mlat00:mlat11),stat=istat) + if (istat /= 0) call shutdown('alloc_pdyn: azigm2') + azigm2 = 0. allocate(nsrhs(mlon00:mlon11,mlat00:mlat11),stat=istat) if (istat /= 0) call shutdown('alloc_pdyn: nsrhs') nsrhs = 0. @@ -1251,6 +1259,7 @@ subroutine complete_integrals use mpi_module,only: mytid use mpi_module,only: mp_mag_halos use fields_module,only: gzigm1,gzigm2,gnsrhs + use fields_module,only: azigm1,azigm2 use mage_coupling_module,only: mage_ucurrent use my_esmf,only: | mag_zigm1, mag_zigm2, mag_nsrhs, @@ -1582,6 +1591,10 @@ subroutine complete_integrals ! coordinates to be passed to the M-I coupled in the MAGE ! + ! This is to grab zigm1 on the APEX grid for coupling before hemispheres are folded + azigm1 = zigm1 + azigm2 = zigm2 + call mag2geo_2d(zigm1(mlon0:mlon1,mlat0:mlat1), | gzigm1(lon0:lon1,lat0:lat1),mag_zigm1,geo_zigm1,'ZIGM1 ') call mag2geo_2d(zigm2(mlon0:mlon1,mlat0:mlat1), @@ -2985,6 +2998,7 @@ end subroutine define_phim3d !----------------------------------------------------------------------- subroutine stencils use cons_module,only: pi_dyn,dlatm,dlonm + use input_module,only: oneway ! ! Locals: integer :: i,j,jj,jjj,j0,n,ncc,nmaglon,nmaglat @@ -3126,8 +3140,11 @@ subroutine stencils ! ! Convert GAMERA geographic potential to geomagnetic coordinates ! -! call mage_pot2mag - call mage_mag2mag + if (oneway) then + call mage_pot2mag + else + call mage_mag2mag + endif c do jj=1,nmlat c do i=1,nmlonp1 c write(6,*)phihm(i,jj),i,jj diff --git a/src/qjnno.F b/src/qjnno.F index 28b90db..14e72e5 100644 --- a/src/qjnno.F +++ b/src/qjnno.F @@ -37,7 +37,7 @@ subroutine qjnno(o2,o1,ne,no,n4s,n2d,xnmbar, | evergs*avo*xnmbar(k,i)*(n4s(k,i)*rmassinv_n4s* | (beta1(k,i,lat)*o2(k,i)*rmassinv_o2*1.4+ | beta3(k,i,lat)*no(k,i)*rmassinv_no*2.68)+ - | n2d(k,i)*rmassinv_n2d*(beta2*o2(k,i)*rmassinv_o2* + | n2d(k,i)*rmassinv_n2d*(beta2(k,i,lat)*o2(k,i)*rmassinv_o2* | 1.84+beta4*o1(k,i)*rmassinv_o1* | 2.38+beta5(k,i,lat)*.5*(ne(k,i)+ne(k+1,i))*2.38/ | xnmbar(k,i)+beta6*no(k,i)*rmassinv_no*5.63)) diff --git a/src/rdsource.F b/src/rdsource.F index 0502e79..d914cd4 100644 --- a/src/rdsource.F +++ b/src/rdsource.F @@ -13,7 +13,7 @@ subroutine readsource(ier) use hist_module,only: nsource,nhist,ioutfile,ncid use fields_module,only: tlbc,ulbc,vlbc,tlbc_nm,ulbc_nm,vlbc_nm, | he,he_nm,field_initval,ar,ar_nm,n2d,n2d_nm,gzigm1,gzigm2,gnsrhs, - | zigm1,zigm2,itp + | azigm1,azigm2,itp use ar_module,only: ar_glbm use mpi_module,only: lat0,lat1,lon0,lon1,mlat0,mlat1,mlon0,mlon1, | mp_periodic_f4d,mp_periodic_f2d,mp_bndlons_f2d,mp_bndlats_f2d @@ -147,9 +147,9 @@ subroutine readsource(ier) ! Get field-line integrated Pedersen/Hall conductances on mag grids, ! used to send conductances (mag) to magnetosphere before the main loop call geo2mag_2d(gzigm1(lon0:lon1,lat0:lat1), - | zigm1(mlon0:mlon1,mlat0:mlat1),geo_adota1,mag_adota1,'ZIGM1') + | azigm1(mlon0:mlon1,mlat0:mlat1),geo_adota1,mag_adota1,'ZIGM1') call geo2mag_2d(gzigm2(lon0:lon1,lat0:lat1), - | zigm2(mlon0:mlon1,mlat0:mlat1),geo_adota2,mag_adota2,'ZIGM2') + | azigm2(mlon0:mlon1,mlat0:mlat1),geo_adota2,mag_adota2,'ZIGM2') ! ! If n2d_nm was not read from the source history, then set it to n2d ! diff --git a/src/ringfilter.F b/src/ringfilter.F index fe183e7..70d7b57 100644 --- a/src/ringfilter.F +++ b/src/ringfilter.F @@ -20,6 +20,9 @@ subroutine ringfilter(f,lev0,lev1,order,name,lat) real(rp),dimension(lev0:lev1) :: a0,left,right,fa,fb real(rp),dimension(order,lev0:lev1) :: a,b real(rp),dimension(nlon,lev0:lev1) :: w,wm,fx,avg + real(rp),dimension(nlon,lev0:lev1) :: spline_a, spline_b, + | spline_c, spline_d + real(rp),dimension(nlon,lev0:lev1) :: poly_a,poly_b,poly_c,poly_d nchnk = 0 if (lat <= nlat_filter) then @@ -93,6 +96,50 @@ subroutine ringfilter(f,lev0,lev1,order,name,lat) fx((ichnk-1)*n+m,:) = fa*(3._rp*m**2-3._rp*m+1._rp)+ | fb*(2._rp*m-1._rp)+left enddo +! +! spline_a(ichnk,:) = avg(ichnk,:) +! spline_b(ichnk,:) = (avg(ip1,:) - avg(im1,:)) / (2.0_rp * n) +! spline_c(ichnk,:) = (avg(im1,:) - 2.0_rp*avg(ichnk,:) + avg +! | (ip1,:)) / (2.0_rp * n**2) +! spline_d(ichnk,:) = (avg(ip1,:) - avg(ichnk,:)) / (n**3) - +! | spline_b(ichnk,:) / n +! +! do m = 1,n +! fx((ichnk-1)*n + m,:) = spline_a(ichnk,:) + +! | spline_b(ichnk,:) * m + +! | spline_c(ichnk,:) * m**2 + +! | spline_d(ichnk,:) * m**3 +! enddo +! +! ! Polynomial coefficients +! poly_a(ichnk,:) = avg(ichnk,:) +! poly_b(ichnk,:) = (avg(ip1,:) - avg(im1,:)) / (2.0_rp * n) +! poly_c(ichnk,:) = (avg(im1,:) - 2.0_rp*avg(ichnk,:) + avg(ip1,:) +! | ) / (2.0_rp * n**2) +! poly_d(ichnk,:) = (avg(ip1,:) - avg(ichnk,:)) / (n**3) - poly_b( +! | ichnk,:) / n +! do m = 1,n +! fx((ichnk-1)*n + m,:) = poly_a(ichnk,:) + +! & poly_b(ichnk,:) * m + +! & poly_c(ichnk,:) * m**2 + +! & poly_d(ichnk,:) * m**3 +! enddo +! left = (-avg(im2, :) + 7._rp * avg(im1, :) + 7._rp * +! | avg(ichnk, :) - avg(ip1, :)) / 12._rp +! right = (-avg(im1, :) + 7._rp * avg(ichnk, :) + 7._rp * +! | avg(ip1, :) - avg(ip2, :)) / 12._rp +! poly_a(ichnk, :) = avg(ichnk, :) +! poly_b(ichnk, :) = (right - left) / (2.0_rp * n) +! poly_c(ichnk, :) = (left - 2.0_rp * avg(ichnk, :) + +! | right) / (2.0_rp * n**2) +! poly_d(ichnk, :) = (avg(ip1, :) - avg(ichnk, :)) / +! | (n**3) - poly_b(ichnk, :) / n +! do m = 1, n +! fx((ichnk-1)*n + m, :) = poly_a(ichnk, :) + +! | poly_b(ichnk, :) * m + +! | poly_c(ichnk, :) * m**2 + +! | poly_d(ichnk, :) * m**3 +! enddo else ! piece-wise linear reconstruction do m = 1,n diff --git a/src/settei.F b/src/settei.F index b2fe094..224ac02 100644 --- a/src/settei.F +++ b/src/settei.F @@ -9,11 +9,11 @@ subroutine settei(tn,o2,o1,he,n2,ne,te,ti,op,o2p,nplus,n2p,nop, ! ! Calculate electron and ion temperatures. ! - use params_module,only: dz,nlonp4,spval + use params_module,only: dz,nlonp4,spval,rp use cons_module,only: pi,rtd,evergs, | rmassinv_o2,rmassinv_o1,rmassinv_he,rmassinv_n2,dipmin,avo, | rmass_o1,rmassinv_n4s,rmassinv_no - use input_module,only: f107,et,electron_heating + use input_module,only: f107,et,electron_heating, ti_cap, te_cap use chapman_module,only: chi ! solar zenith angle (nlonp4,nlat) use magfield_module,only: rlatm,dipmag use fields_module,only: tlbc @@ -33,7 +33,7 @@ subroutine settei(tn,o2,o1,he,n2,ne,te,ti,op,o2p,nplus,n2p,nop, ! ! Args: integer,intent(in) :: lev0,lev1,lon0,lon1,lat - real,dimension(lev0:lev1,lon0-2:lon1+2),intent(in) :: + real(rp),dimension(lev0:lev1,lon0-2:lon1+2),intent(in) :: | tn, ! neutral temperature (deg K) | o2, ! molecular oxygen (mmr) | o1, ! atomic oxygen (mmr) @@ -56,7 +56,7 @@ subroutine settei(tn,o2,o1,he,n2,ne,te,ti,op,o2p,nplus,n2p,nop, | Q2 ! electrojet turbulent heating ! ! Output args: - real,dimension(lev0:lev1,lon0-2:lon1+2),intent(out) :: + real(rp),dimension(lev0:lev1,lon0-2:lon1+2),intent(out) :: | te_out, ! output electron temperature (deg K) | ti_out ! output ion temperature (deg K) ! @@ -69,7 +69,7 @@ subroutine settei(tn,o2,o1,he,n2,ne,te,ti,op,o2p,nplus,n2p,nop, ! Local: integer :: k,i,ier integer :: nk,nkm1 - real,dimension(lev0:lev1,lon0:lon1) :: + real(rp),dimension(lev0:lev1,lon0:lon1) :: | te_int, ! electron temperature (interfaces) | tn_int, ! neutral temperature (interfaces) | o2n, ! O2 number density (midpoints or interfaces) @@ -101,7 +101,7 @@ subroutine settei(tn,o2,o1,he,n2,ne,te,ti,op,o2p,nplus,n2p,nop, | loss_en, ! electrons/neutrals loss (s11) | loss_ei, ! electron/ion loss (s10) | loss_in ! ion/neutral loss (s9) - real,parameter :: + real(rp),parameter :: | fpolar = -3.0e+9, ! polar te flux | del = 1.e-6 , ! @@ -109,17 +109,17 @@ subroutine settei(tn,o2,o1,he,n2,ne,te,ti,op,o2p,nplus,n2p,nop, | alam = 0.0069 , | ad = 0.0091 , | sd = 2.3e-11 - real :: + real(rp) :: | f107te ! solar flux ! ! a,fed,fen,fe,sindipmag have a z dimension only for diagnostic plotting: - real,dimension(lon0:lon1) :: + real(rp),dimension(lon0:lon1) :: | a,fed,fen, ! day/night | fe, ! heat flux at upper boundary | sindipmag ! sin(dipmag) ! ! For diagnostic plotting: - real,dimension(lev0:lev1-1,lon0:lon1) :: + real(rp),dimension(lev0:lev1-1,lon0:lon1) :: | a_ki, ! for diagnostic plotting of a | fed_ki, ! for diagnostic plotting of fed | fen_ki, ! for diagnostic plotting of fen @@ -135,7 +135,7 @@ subroutine settei(tn,o2,o1,he,n2,ne,te,ti,op,o2p,nplus,n2p,nop, #endif ! f107te = f107 - if (f107te > 235.) f107te = 235. + if (f107te > 235._rp) f107te = 235._rp nk = lev1-lev0+1 nkm1 = nk-1 @@ -143,42 +143,45 @@ subroutine settei(tn,o2,o1,he,n2,ne,te,ti,op,o2p,nplus,n2p,nop, ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) ! do i=lon0,lon1 - if (abs(rlatm(i,lat)) >= pi/4.5) then - a(i) = 1. + if (abs(rlatm(i,lat)) >= pi/4.5_rp) then + a(i) = 1._rp ! else ! a(i) = .5*(1.+sin(pi*(abs(rlatm(i,lat))-pi/9.)/(pi/4.5))) ! Dang, 2019, set a(i)=0 between +10 and -10 magnetic latitude - elseif (abs(rlatm(i,lat)) <= pi/18.) then - a(i) = 0. + elseif (abs(rlatm(i,lat)) <= pi/18._rp) then + a(i) = 0._rp else ! Dang, 2019, change parameter: pi/9.->pi/12., pi/4.5->6, per Hanli and Wenbin ! a(i) = .5*(1.+sin(pi*(abs(rlatm(i,lat))-pi/12.)/(pi/6.))) ! Pham, 2021, try to fix huge gradients in low lat - a(i) = .5*(1.+cos(abs(rlatm(i,lat))*6.-pi*4./3.)) + a(i) = .5_rp*(1._rp+cos(abs(rlatm(i,lat))* + | 6._rp-pi*4._rp/3._rp)) endif ! ! Increased heat flux for TE fom protonosphere. ! fed(i) = ( -5.0e+7*f107te*a(i)-4.0e+7*f107te)*1.2 ! Dang, 2019, FeDCoef2 yields a non-zero downward flux at the equator. ! Remove per Wenbin's suggestion, and FeDCoef1 is changed from -5e7 to -9e7. - fed(i) = -9.0e+7*f107te*a(i) - fen(i) = fed(i)/2. + fed(i) = -9.0e+7_rp*f107te*a(i) + fen(i) = fed(i)/2._rp fed(i) = fed(i)+qteaur(i,lat) ! t4 fen(i) = fen(i)+qteaur(i,lat) ! t5 - if (chi(i,lat)-.5*pi >= 0.) then ! chi==t2 + if (chi(i,lat)-.5_rp*pi >= 0._rp) then ! chi==t2 fe(i) = fen(i) ! t1 else fe(i) = fed(i) endif - if ((chi(i,lat)*rtd-80.)*(chi(i,lat)*rtd-100.)>=0.) then + if ((chi(i,lat)*rtd-80._rp)* + | (chi(i,lat)*rtd-100._rp)>=0._rp) then fe(i) = fe(i)*evergs else - fe(i) = (.5*(fed(i)+fen(i))+.5*(fed(i)-fen(i))* - | cos(pi*(chi(i,lat)*rtd-80.)/20.))*evergs + fe(i) = (.5*(fed(i)+fen(i))+.5_rp*(fed(i)-fen(i))* + | cos(pi*(chi(i,lat)*rtd-80._rp)/20._rp))*evergs endif ! ! Add fpolar if magnetic latitude >= 60 degrees: - if (abs(rlatm(i,lat))-pi/3.>=0.) fe(i) = fe(i)+fpolar*evergs + if (abs(rlatm(i,lat))-pi/3._rp>=0._rp) + | fe(i) = fe(i)+fpolar*evergs ! ! For plotting (first dimension is lev0:lev1-1): a_ki (:,i) = a(i) @@ -210,42 +213,42 @@ subroutine settei(tn,o2,o1,he,n2,ne,te,ti,op,o2p,nplus,n2p,nop, ! te,o2,o,n2,tn at interfaces: do i=lon0,lon1 do k=lev0+1,lev1-1 - te_int(k,i) = .5*(te(k,i)+te(k-1,i)) - o2n(k,i) = .5*(o2(k,i)+o2(k-1,i)) - o1n(k,i) = .5*(o1(k,i)+o1(k-1,i)) - hen(k,i) = .5*(he(k,i)+he(k-1,i)) - n2n(k,i) = .5*(n2(k,i)+n2(k-1,i)) - tn_int(k,i) = .5*(tn(k,i)+tn(k-1,i)) + te_int(k,i) = .5_rp*(te(k,i)+te(k-1,i)) + o2n(k,i) = .5_rp*(o2(k,i)+o2(k-1,i)) + o1n(k,i) = .5_rp*(o1(k,i)+o1(k-1,i)) + hen(k,i) = .5_rp*(he(k,i)+he(k-1,i)) + n2n(k,i) = .5_rp*(n2(k,i)+n2(k-1,i)) + tn_int(k,i) = .5_rp*(tn(k,i)+tn(k-1,i)) enddo ! k=lev0+1,lev1-2 ! ! Bottom: ! 2023/02 Dong Lin: added minimum cap for te (Te>=Tn) ! 2024/04 Haonan Wu: changed the lower boundary calculation of major species te_int(lev0,i) = - | max(1.5*te(lev0,i)-.5*te(lev0+1,i),tlbc(i,lat)) + | max(1.5_rp*te(lev0,i)-.5_rp*te(lev0+1,i),tlbc(i,lat)) o2n(lev0,i) = .5*(fb(1)+ - | (b(1,1)+1.)*o2(lev0,i)+ + | (b(1,1)+1._rp)*o2(lev0,i)+ | b(1,2) *o1(lev0,i)+ | b(1,3) *he(lev0,i)) - o1n(lev0,i) = .5*(fb(2)+ + o1n(lev0,i) = .5_rp*(fb(2)+ | b(2,1) *o2(lev0,i)+ - | (b(2,2)+1.)*o1(lev0,i)+ + | (b(2,2)+1._rp)*o1(lev0,i)+ | b(2,3) *he(lev0,i)) - hen(lev0,i) = .5*(fb(3)+ + hen(lev0,i) = .5_rp*(fb(3)+ | b(3,1) *o2(lev0,i)+ | b(3,2) *o1(lev0,i)+ - | (b(3,3)+1.)*he(lev0,i)) + | (b(3,3)+1._rp)*he(lev0,i)) n2n(lev0,i) = - | max(1.-o2n(lev0,i)-o1n(lev0,i)-hen(lev0,i),0.) + | max(1._rp-o2n(lev0,i)-o1n(lev0,i)-hen(lev0,i),0._rp) tn_int(lev0,i) = tlbc(i,lat) ! ! Top: - te_int(lev1,i) = 1.5*te(lev1-1,i)-.5*te(lev1-2,i) - o2n(lev1,i) = .5*(o2(lev1,i)+o2(lev1-1,i)) - o1n(lev1,i) = .5*(o1(lev1,i)+o1(lev1-1,i)) - hen(lev1,i) = .5*(he(lev1,i)+he(lev1-1,i)) - n2n(lev1,i) = .5*(n2(lev1,i)+n2(lev1-1,i)) - tn_int(lev1,i) = 1.5*tn(lev1-1,i)-.5*tn(lev1-2,i) + te_int(lev1,i) = 1.5_rp*te(lev1-1,i)-.5*te(lev1-2,i) + o2n(lev1,i) = .5_rp*(o2(lev1,i)+o2(lev1-1,i)) + o1n(lev1,i) = .5_rp*(o1(lev1,i)+o1(lev1-1,i)) + hen(lev1,i) = .5_rp*(he(lev1,i)+he(lev1-1,i)) + n2n(lev1,i) = .5_rp*(n2(lev1,i)+n2(lev1-1,i)) + tn_int(lev1,i) = 1.5_rp*tn(lev1-1,i)-.5_rp*tn(lev1-2,i) enddo ! i=lon0,lon1 ! call addfld('TE_INT' ,' ',' ',te_int, @@ -270,12 +273,12 @@ subroutine settei(tn,o2,o1,he,n2,ne,te,ti,op,o2p,nplus,n2p,nop, n2n(k,i) = xnmbari(k,i)*n2n(k,i)*rmassinv_n2 ! s11 root_te(k,i) = sqrt(te_int(k,i)) ! - tek0(k,i) = 7.5e5/ - | (1.+3.22e4*te_int(k,i)**2/ne(k,i)* - | ((2.20e-16 + 7.92e-18 * root_te(k,i))*o2n(k,i)+ - | 1.10e-16 * (1.+5.7e-4 * te_int (k,i))*o1n(k,i)+ - | 5.60e-16 * hen(k,i)+ - | (2.82e-17 - 3.41e-21 * te_int (k,i))*root_te(k,i)* + tek0(k,i) = 7.5e5_rp/ + | (1._rp+3.22e4_rp*te_int(k,i)**2/ne(k,i)* + | ((2.20e-16_rp + 7.92e-18_rp * root_te(k,i))*o2n(k,i)+ + | 1.10e-16_rp * (1._rp+5.7e-4_rp * te_int (k,i))*o1n(k,i)+ + | 5.60e-16_rp * hen(k,i)+ + | (2.82e-17_rp - 3.41e-21_rp * te_int (k,i))*root_te(k,i)* | n2n(k,i)))*evergs ! enddo ! k=lev0,lev1 @@ -306,27 +309,28 @@ subroutine settei(tn,o2,o1,he,n2,ne,te,ti,op,o2p,nplus,n2p,nop, else sindipmag(i) = (sin(dipmin))**2 endif - if (sindipmag(i) < .10) sindipmag(i) = .10 + if (sindipmag(i) < .10_rp) sindipmag(i) = .10_rp ! ! Start coefficients and rhs for trsolv: do k=lev0,lev1-1 - p_coef(k,i) = 2./7.*sindipmag(i)/(h_mid(k,i)*dz**2) ! s1 + p_coef(k,i) = 2._rp/7._rp*sindipmag(i)/(h_mid(k,i)*dz**2) ! s1 r_coef(k,i) = p_coef(k,i)*tek0(k+1,i)/h_int(k+1,i) ! s3 p_coef(k,i) = p_coef(k,i)*tek0(k ,i)/h_int(k ,i) ! s1 q_coef(k,i) = -(p_coef(k,i)+r_coef(k,i)) ! s2 - rhs(k,i) = 0. ! s4 + rhs(k,i) = 0._rp ! s4 enddo ! k=lev0,lev1-1 ! ! Bottom boundary: q_coef(lev0,i) = q_coef(lev0,i)-p_coef(lev0,i) - rhs(lev0,i) = rhs(lev0,i)-2.*p_coef(lev0,i)*tn_int(lev0,i)**3.5 - p_coef(lev0,i) = 0. + rhs(lev0,i) = rhs(lev0,i)-2._rp*p_coef(lev0,i)* + | tn_int(lev0,i)**3.5_rp + p_coef(lev0,i) = 0._rp ! ! Upper boundary: q_coef(lev1-1,i) = q_coef(lev1-1,i)+r_coef(lev1-1,i) - rhs(lev1-1,i) = rhs(lev1-1,i)+r_coef(lev1-1,i)*dz*3.5* + rhs(lev1-1,i) = rhs(lev1-1,i)+r_coef(lev1-1,i)*dz*3.5_rp* | h_int(lev1,i)*fe(i)/tek0(lev1,i) - r_coef(lev1-1,i) = 0. + r_coef(lev1-1,i) = 0._rp enddo ! i=lon0,lon1 do i=lon0,lon1 @@ -380,7 +384,7 @@ subroutine settei(tn,o2,o1,he,n2,ne,te,ti,op,o2p,nplus,n2p,nop, do k=lev0,lev1 qtot(k,i) = qo2p(k,i,lat)+qop(k,i,lat)+qn2p(k,i,lat)+ | qnop(k,i,lat)+qnp(k,i,lat)+qop2d(k,i,lat)+qop2p(k,i,lat) - if (qtot(k,i) < 1.e-20) qtot(k,i) = 1.e-20 + if (qtot(k,i) < 1.e-20_rp) qtot(k,i) = 1.e-20_rp enddo enddo @@ -391,7 +395,7 @@ subroutine settei(tn,o2,o1,he,n2,ne,te,ti,op,o2p,nplus,n2p,nop, do k=lev0,lev1-1 qtot(k,i) = sqrt(qtot(k,i)*qtot(k+1,i)) enddo - qtot(lev1,i) = 0. + qtot(lev1,i) = 0._rp enddo ! i=lon0,lon1 ! call addfld('QTOT',' ',' ',qtot , ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) @@ -401,7 +405,7 @@ subroutine settei(tn,o2,o1,he,n2,ne,te,ti,op,o2p,nplus,n2p,nop, do i=lon0,lon1 do k=lev0,lev1-1 root_ne(k,i) = ne(k,i)*ne(k+1,i) - if (root_ne(k,i) < 1.e4) root_ne(k,i) = 1.e4 + if (root_ne(k,i) < 1.e4_rp) root_ne(k,i) = 1.e4_rp root_ne(k,i) = sqrt(root_ne(k,i)) enddo ! k=lev0,lev1-1 enddo ! i=lon0,lon1 @@ -421,45 +425,48 @@ subroutine settei(tn,o2,o1,he,n2,ne,te,ti,op,o2p,nplus,n2p,nop, if (electron_heating == 6) then ! Modified according to Smithtro & Solomon (2008), by Yihui Cai, 2021/10 qe(k,i) = log(root_ne(k,i)/(o2n(k,i)+n2n(k,i)+o1n(k,i))) - qe(k,i) = exp((((((-1.249e-5*qe(k,i)-5.755e-4)*qe(k,i) - | -9.346e-3)*qe(k,i)-5.900e-2)*qe(k,i)-4.392e-2)* - | qe(k,i)+1.056)*qe(k,i)+5.342) + qe(k,i) = exp((((((-1.249e-5_rp*qe(k,i)-5.755e-4_rp)*qe(k,i) + | -9.346e-3_rp)*qe(k,i)-5.900e-2_rp)*qe(k,i)- + | 4.392e-2_rp)*qe(k,i)+1.056_rp)*qe(k,i)+5.342_rp) else ! Comment from earlier version (maybe the *1.0 below was once *2.0): ! "Correction facor of 2 increase in TE heating rate" - qe(k,i) = log(root_ne(k,i)/(o2n(k,i)+n2n(k,i)+0.1*o1n(k,i))) - qe(k,i) = exp(-((((0.001996*qe(k,i)+0.08034)*qe(k,i)+1.166)* - | qe(k,i)+6.941)*qe(k,i)+12.75))*1.0 + qe(k,i) = log(root_ne(k,i)/(o2n(k,i)+ + | n2n(k,i)+0.1_rp*o1n(k,i))) + qe(k,i) = exp(-((((0.001996_rp*qe(k,i)+0.08034_rp)* + | qe(k,i)+1.166_rp)* + | qe(k,i)+6.941_rp)*qe(k,i)+12.75_rp))*1.0_rp endif ! ! Subtract qe from right-hand-side: rhs(k,i) = rhs(k,i)-qe(k,i)*qtot(k,i)*evergs ! ! Subtract electrojet turbulent heating from rhs - if (et) rhs(k,i) = rhs(k,i)-(Q1(k,i)+Q2(k,i))*10.0 + if (et) rhs(k,i) = rhs(k,i)-(Q1(k,i)+Q2(k,i))*10.0_rp ! root_te(k,i) = sqrt(te(k,i)) ! ! Electron/N2 collision A(E,N2,VIB) (s9): ! - if (te(k,i) >= 1000.) then - coll_en2v(k,i) = 2.e-7*exp(-4605.2/te(k,i)) + if (te(k,i) >= 1000._rp) then + coll_en2v(k,i) = 2.e-7_rp*exp(-4605.2_rp/te(k,i)) else - coll_en2v(k,i) = 5.71e-8*exp(-3352.6/te(k,i)) + coll_en2v(k,i) = 5.71e-8_rp*exp(-3352.6_rp/te(k,i)) endif - if (te(k,i) > 2000.) - | coll_en2v(k,i) = 2.53e-6*root_te(k,i)*exp(-17620./te(k,i)) + if (te(k,i) > 2000._rp) + | coll_en2v(k,i) = 2.53e-6_rp*root_te(k,i)* + | exp(-17620._rp/te(k,i)) ! ! Loss due to electron/n2 collision L0(E,N2,VIB)/(NE*N(N2)) (s10) ! ! Separate the case when te is approaching tn to avoid calculating 0/0 if (abs(te(k,i)-tn(k,i)) < del) then - loss_en2v(k,i) = 3200./tn(k,i)**2 + loss_en2v(k,i) = 3200._rp/tn(k,i)**2 else - loss_en2v(k,i) = 1./(te(k,i)-tn(k,i))* - | (1.-exp(-3200.*(te(k,i)-tn(k,i))/(te(k,i)*tn(k,i)))) + loss_en2v(k,i) = 1._rp/(te(k,i)-tn(k,i))* + | (1._rp-exp(-3200._rp*(te(k,i)-tn(k,i))/(te(k,i)*tn(k,i)))) endif - loss_en2v(k,i) = 1.3e-4*loss_en2v(k,i)*coll_en2v(k,i) + loss_en2v(k,i) = 1.3e-4_rp*loss_en2v(k,i)*coll_en2v(k,i) enddo ! k=lev0,lev1-1 enddo ! i=lon0,lon1 (end DO 20) @@ -486,8 +493,10 @@ subroutine settei(tn,o2,o1,he,n2,ne,te,ti,op,o2p,nplus,n2p,nop, ! ! Electron/O2 loss rates: (L0(E,O2)+L0(E,O2,ROT)+L0(E,O2,VIB)/NE ! - loss_eo2(k,i) = o2n(k,i)*(1.21e-18*(1.+3.6e-2*root_te(k,i))* - | root_te(k,i)+6.9e-14/root_te(k,i)+3.125e-21*te(k,i)**2) + loss_eo2(k,i) = o2n(k,i)*(1.21e-18_rp*(1._rp+ + | 3.6e-2_rp*root_te(k,i))* + | root_te(k,i)+6.9e-14_rp/root_te(k,i)+ + | 3.125e-21_rp*te(k,i)**2) ! ! Electron/O(1d) loss rates: L0(E,O,1D)/(NE*N(O)) ! @@ -503,22 +512,23 @@ subroutine settei(tn,o2,o1,he,n2,ne,te,ti,op,o2p,nplus,n2p,nop, ! loss_eo1d(k,i) = 1.57e-12*exp((2.4e4+0.3*(te(k,i)-1500.)- ! | 1.947e-5*(te(k,i)-1500.)*(te(k,i)-4000.))*(te(k,i)-3000.)/ ! | (3000.*te(k,i)))*loss_eo1d(k,i) - loss_eo1d(k,i) = 0. + loss_eo1d(k,i) = 0._rp ! ! Electron/O1 loss rates: (L0(E,O)+L0(E,O,F))/NE ! - loss_eo1(k,i) = o1n(k,i)*(7.9e-19*(1.+5.7e-4*te(k,i))* - | root_te(k,i)+3.4e-12*(1.-7.e-5*te(k,i))/tn(k,i)* - | (150./te(k,i)+0.4)) + loss_eo1(k,i) = o1n(k,i)*(7.9e-19_rp* + | (1._rp+5.7e-4_rp*te(k,i))* + | root_te(k,i)+3.4e-12_rp*(1._rp-7.e-5_rp*te(k,i))/tn(k,i)* + | (150._rp/te(k,i)+0.4_rp)) ! ! Electron/He loss rate: L0(E,HE)/NE ! - loss_ehe(k,i) = hen(k,i)*2.46e-17*root_te(k,i) + loss_ehe(k,i) = hen(k,i)*2.46e-17_rp*root_te(k,i) ! ! Electron/N2 loss rate: (L0(E,N2)+L0(E,N2,ROT)+L0(E,N2,VIB))/NE ! - loss_en2(k,i) = n2n(k,i)*(1.77E-19*(1.-1.21E-4*te(k,i))* - | te(k,i) + 2.9e-14/root_te(k,i) + loss_en2v(k,i)) + loss_en2(k,i) = n2n(k,i)*(1.77E-19_rp*(1.-1.21E-4_rp*te(k,i))* + | te(k,i) + 2.9e-14_rp/root_te(k,i) + loss_en2v(k,i)) ! ! Total electron/neutral loss rate (s11): ! @@ -526,12 +536,13 @@ subroutine settei(tn,o2,o1,he,n2,ne,te,ti,op,o2p,nplus,n2p,nop, | loss_ehe(k,i)+loss_en2(k,i) ! ! Cooling correction from electrojet turbulent heating - if (et .and. te(k,i)>500.0 .and. Q2(k,i)>0.0) - | loss_en(k,i)=loss_en(k,i)*exp(-7.54E-4*(te(k,i)-500.0)) + if (et .and. te(k,i)>500.0_rp .and. Q2(k,i)>0.0_rp) + | loss_en(k,i)=loss_en(k,i)* + | exp(-7.54E-4_rp*(te(k,i)-500.0_rp)) ! ! loss_xen = L0*(E,N) (s8) ! - loss_xen(k,i) = (loss_en(k,i)+o1n(k,i)*(1.-alam/(ad+sd* + loss_xen(k,i) = (loss_en(k,i)+o1n(k,i)*(1._rp-alam/(ad+sd* | n2n(k,i)))*loss_eo1d(k,i))*root_ne(k,i)*evergs ! ! Complete total electron/neutral loss rate L0(E,N) (s11): @@ -542,8 +553,8 @@ subroutine settei(tn,o2,o1,he,n2,ne,te,ti,op,o2p,nplus,n2p,nop, ! Calculate L0(E,I) = L(E,I)/(TE-TI), where L(E,I) is loss due to ! interactions between electrons and ions. ! - loss_ei(k,i) = 3.2e-8*root_ne(k,i)/(root_te(k,i)*te(k,i))* - | 15.*evergs*rmass_o1* + loss_ei(k,i) = 3.2e-8_rp*root_ne(k,i)/(root_te(k,i)*te(k,i))* + | 15._rp*evergs*rmass_o1* | (op(k,i)*rmassinv_o1+o2p(k,i)*rmassinv_o2+ | nplus(k,i)*rmassinv_n4s+n2p(k,i)*rmassinv_n2+ | nop(k,i)*rmassinv_no) @@ -552,24 +563,24 @@ subroutine settei(tn,o2,o1,he,n2,ne,te,ti,op,o2p,nplus,n2p,nop, ! ! loss_in = ion/neutral cooling = L0(I,N) =L(I,N)/(TI-TN) ! (rates not on Rees & Roble 1975 were calculated based on Banks 1966) - loss_in(k,i) = 1e-14*evergs* - | (op(k,i)*(5.8*o2n(k,i)+0.21*o1n(k,i)*root_tn(k,i)+ - | 2.8*hen(k,i)+6.6*n2n(k,i))+ - | o2p(k,i)*(0.14*o2n(k,i)*root_tn(k,i)+ - | 4.36*o1n(k,i)+1.63*hen(k,i)+5.81*n2n(k,i))+ - | nplus(k,i)*(5.84*o2n(k,i)+5.84*o1n(k,i)+ - | 3.05*hen(k,i)+6.56*n2n(k,i))+ + loss_in(k,i) = 1e-14_rp*evergs* + | (op(k,i)*(5.8_rp*o2n(k,i)+0.21_rp*o1n(k,i)*root_tn(k,i)+ + | 2.8_rp*hen(k,i)+6.6_rp*n2n(k,i))+ + | o2p(k,i)*(0.14_rp*o2n(k,i)*root_tn(k,i)+ + | 4.36_rp*o1n(k,i)+1.63_rp*hen(k,i)+5.81_rp*n2n(k,i))+ + | nplus(k,i)*(5.84_rp*o2n(k,i)+5.84_rp*o1n(k,i)+ + | 3.05_rp*hen(k,i)+6.56_rp*n2n(k,i))+ | n2p(k,i)*(5.54*o2n(k,i)+4.65*o1n(k,i)+ - | 1.82*hen(k,i)+0.27*n2n(k,i)*root_tn(k,i))+ - | nop(k,i)*(5.45*o2n(k,i)+4.5*o1n(k,i)+ - | 1.72*hen(k,i)+5.92*n2n(k,i))) + | 1.82_rp*hen(k,i)+0.27_rp*n2n(k,i)*root_tn(k,i))+ + | nop(k,i)*(5.45_rp*o2n(k,i)+4.5_rp*o1n(k,i)+ + | 1.72_rp*hen(k,i)+5.92_rp*n2n(k,i))) ! ! Complete tridiagonal matrix coefficients and rhs: ! ! q_coef = q_coef-(L0(E,N)+L0(E,I))/TE**2.5 = Q ! q_coef(k,i) = q_coef(k,i)-(loss_en(k,i)+loss_ei(k,i))/ - | te(k,i)**2.5 + | te(k,i)**2.5_rp ! ! rhs = rhs-L0(E,N)*TN-L0(E,I)*TI ! @@ -604,10 +615,10 @@ subroutine settei(tn,o2,o1,he,n2,ne,te,ti,op,o2p,nplus,n2p,nop, ! do i=lon0,lon1 ! (DO 24) do k=lev0,lev1-1 - if (te(k,i)-ti(k,i) >= 0.) then + if (te(k,i)-ti(k,i) >= 0._rp) then q_eni(k,i)=loss_ei(k,i)*(te(k,i)-ti(k,i)) else - q_eni(k,i) = 0. + q_eni(k,i) = 0._rp endif q_eni(k,i) = (loss_xen(k,i)*(te(k,i)-tn(k,i))+q_eni(k,i)) | *avo/xnmbar(k,i) @@ -621,14 +632,14 @@ subroutine settei(tn,o2,o1,he,n2,ne,te,ti,op,o2p,nplus,n2p,nop, do i=lon0,lon1 ! (DO 27) do k=lev0,lev1-2 qtotal(k+1,i,lat) = qtotal(k+1,i,lat)+ - | .5*(q_eni(k,i)+q_eni(k+1,i)) + | .5_rp*(q_eni(k,i)+q_eni(k+1,i)) enddo ! k=lev0,lev1-2 ! ! Upper and lower boundaries: - qtotal(lev0,i,lat) = qtotal(lev0,i,lat)+1.5*q_eni(lev0,i)- - | 0.5*q_eni(lev0+1,i) - qtotal(lev1,i,lat) = qtotal(lev1,i,lat)+1.5*q_eni(lev1-1,i)- - | 0.5*q_eni(lev1-2,i) + qtotal(lev0,i,lat) = qtotal(lev0,i,lat)+1.5_rp*q_eni(lev0,i)- + | 0.5_rp*q_eni(lev0+1,i) + qtotal(lev1,i,lat) = qtotal(lev1,i,lat)+1.5_rp*q_eni(lev1-1,i)- + | 0.5_rp*q_eni(lev1-2,i) enddo ! i=lon0,lon1 ! (DO 27) ! call addfld('Q_TOT',' ',' ',qtotal(:,:,lat), @@ -660,7 +671,7 @@ subroutine settei(tn,o2,o1,he,n2,ne,te,ti,op,o2p,nplus,n2p,nop, ! Te = Te**(2./7.): do i=lon0,lon1 do k=lev0,lev1-1 - te_out(k,i) = te_out(k,i)**(2./7.) + te_out(k,i) = te_out(k,i)**(2._rp/7._rp) enddo enddo ! @@ -670,6 +681,8 @@ subroutine settei(tn,o2,o1,he,n2,ne,te,ti,op,o2p,nplus,n2p,nop, do i=lon0,lon1 do k=lev0,lev1-1 if (te_out(k,i) < tn(k,i)) te_out(k,i) = tn(k,i) + ! Apply cap to prevent superstorm from exploding + if (te_out(k,i) > te_cap) te_out(k,i) = te_cap ! ! 2023/02 Dong Lin: N2 cross section becomes negative ! when te>2.82e-17/3.41e-21=8269.7K. With ET enabled, @@ -697,6 +710,8 @@ subroutine settei(tn,o2,o1,he,n2,ne,te,ti,op,o2p,nplus,n2p,nop, ! ! ti must be at least as large as tn: if (ti_out(k,i) < tn(k,i)) ti_out(k,i) = tn(k,i) + ! Apply cap to prevent superstorm from exploding + if (ti_out(k,i) > ti_cap) ti_out(k,i) = ti_cap enddo enddo ! diff --git a/src/swdot.F b/src/swdot.F index a15dc18..54356d6 100644 --- a/src/swdot.F +++ b/src/swdot.F @@ -10,19 +10,21 @@ subroutine swdot(un,vc,z,w,lev0,lev1,lon0,lon1,lat0,lat1) use cons_module,only: expzmid,dz use addfld_module,only: addfld use diags_module,only: mkdiag_WN + use params_module,only: rp implicit none ! ! Args: integer,intent(in) :: lev0,lev1,lon0,lon1,lat0,lat1 - real,intent(in),dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2):: + real(rp),intent(in), + | dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2):: | un,vc,z - real,intent(out) :: + real(rp),intent(out) :: | w(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2) ! ! Local: integer :: k,i,lat - real :: w_divrg(lev0:lev1,lon0:lon1) + real(rp) :: w_divrg(lev0:lev1,lon0:lon1) ! ! Latitude scan: do lat=lat0,lat1 @@ -67,12 +69,13 @@ subroutine filter_w(wout,lev0,lev1,lon0,lon1,lat0,lat1,name) ! ! Filter updated W omega: ! - use params_module,only: nlonp4 + use params_module,only: nlonp4,rp use mpi_module,only: mp_gatherlons_f3d,mp_scatterlons_f3d,mytidi ! ! Args: integer,intent(in) :: lev0,lev1,lon0,lon1,lat0,lat1 real,intent(inout) :: wout(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2) + real(rp) :: wlimit = 0.007_rp character(len=*),intent(in) :: name ! ! VT vampir tracing: @@ -82,8 +85,9 @@ subroutine filter_w(wout,lev0,lev1,lon0,lon1,lat0,lat1,name) #endif ! ! Local: - integer :: i,j,ier - real :: w_ik(nlonp4,lev0:lev1),w_kij(lev0:lev1,nlonp4,lat0:lat1) + integer :: i,j,k,ier + real(rp) :: w_ik(nlonp4,lev0:lev1), + | w_kij(lev0:lev1,nlonp4,lat0:lat1) ! #ifdef VT ! code = 125 ; state = 'filter_w' ; activity='Filtering' @@ -91,7 +95,7 @@ subroutine filter_w(wout,lev0,lev1,lon0,lon1,lat0,lat1,name) #endif ! ! Define lons in w_kij from current task: - w_kij = 0. + w_kij = 0._rp do j=lat0,lat1 do i=lon0,lon1 w_kij(:,i,j) = wout(:,i,j) @@ -139,6 +143,17 @@ subroutine filter_w(wout,lev0,lev1,lon0,lon1,lat0,lat1,name) wout(:,i,j) = w_kij(:,i,j) enddo enddo + +! Apply a maximum to wout to prevent superstorms from crashing + do j=lat0,lat1 + do i=lon0,lon1 + do k=lev0,lev1 + if (abs(wout(k,i,j)) .gt. wlimit) then + wout(k,i,j) = wlimit * wout(k,i,j)/abs(wout(k,i,j)) + endif + enddo + enddo + enddo ! #ifdef VT ! code = 125 ; state = 'filter_w' ; activity='Filtering' diff --git a/tiegcmrun/compile.py b/tiegcmrun/compile.py new file mode 100644 index 0000000..d315cb1 --- /dev/null +++ b/tiegcmrun/compile.py @@ -0,0 +1,261 @@ +import os +import shutil +import subprocess +import filecmp +import sys +from textwrap import dedent +import logging + +def compile_tiegcm(options, debug, coupling = False, hidra = False): + """ + Compiles the TIEGCM model with the given options. + + Args: + options (dict): A dictionary containing the model options. + debug (bool): A boolean indicating whether to enable debug mode. + coupling (bool): A boolean indicating whether to enable coupling. + + Returns:None + """ + o = options + modeldir = o["model"]["data"]["modeldir"] + execdir = o["model"]["data"]["execdir"] + workdir = o["model"]["data"]["workdir"] + outdir = o["model"]["data"]["histdir"] + tgcmdata = o["model"]["data"]["tgcmdata"] + utildir = os.path.join(o["model"]["data"]["modeldir"],"scripts") + try: + input = o["model"]["data"]["input_file"] + except: + input = "" + try: + output = o["model"]["data"]["log_file"] + except: + output = "" + horires = float(o["model"]["specification"]["horires"]) + vertres = float(o["model"]["specification"]["vertres"]) + zitop = float(o["model"]["specification"]["zitop"]) + mres = float(o["model"]["specification"]["mres"]) + nres_grid = float(o["model"]["specification"]["nres_grid"]) + make = o["model"]["data"]["make"] + coupling = coupling + hidra = hidra + + if coupling == True: + modelexe = os.path.basename(o["model"]["data"]["coupled_modelexe"]) + model = o["model"]["data"]["coupled_modelexe"] + else: + modelexe = os.path.basename(o["model"]["data"]["modelexe"]) + model = o["model"]["data"]["modelexe"] + debug = debug + + try: + os.makedirs(workdir) + except: + print(f"{workdir} exitsts") + try: + os.makedirs(outdir) + except: + print(f"{outdir} exitsts") + try: + os.makedirs(execdir) + except: + print(f"{execdir} exitsts") + os.chdir(workdir) + + if not os.path.isdir(modeldir): + print(f">>> Cannot find model directory {modeldir} <<<") + sys.exit(1) + + if not os.path.isdir(utildir): + print(f">>> Cannot find model directory {utildir} <<<") + sys.exit(1) + + # Set srcdir based on modeldir + srcdir = os.path.join(modeldir, 'src') + + # Check if srcdir exists + if not os.path.isdir(srcdir): + print(f">>> Cannot find model source directory {srcdir} <<<") + sys.exit(1) + + # Convert srcdir to an absolute path + srcdir = os.path.abspath(srcdir) + + if tgcmdata == "None": + tgcmdata = os.environ['TIEGCMDATA'] + print(f"Set tgcmdata = {tgcmdata}") + + if not os.path.isdir(tgcmdata): + print(f">>> Cannot find data directory {tgcmdata}") + + # Check horizontal resolution + if horires not in [5, 2.5, 1.25, 0.625]: + print(f">>> Unknown model horizontal resolution {horires} <<<") + sys.exit(1) + + # Check vertical resolution + if vertres not in [0.5, 0.25, 0.125, 0.0625]: + print(f">>> Unknown model vertical resolution {vertres} <<<") + sys.exit(1) + + if nres_grid == "None" or nres_grid == None: + if mres == 2: + nres_grid = 5 + elif mres == 1: + nres_grid = 6 + elif mres == 0.5: + nres_grid = 7 + else: + print(f">>> Unsupported magnetic resolution {mres} <<<") + sys.exit(1) + + # Copy make if it does not exist in execdir + if not os.path.isfile(os.path.join(execdir, os.path.basename(make))): + shutil.copy(os.path.join(utildir, os.path.basename(make)), execdir) + # Copy Makefile if it does not exist in execdir + if not os.path.isfile(os.path.join(execdir, 'Makefile')): + shutil.copy(os.path.join(utildir, 'Makefile'), execdir) + # Copy mkdepends if it does not exist in execdir + if not os.path.isfile(os.path.join(execdir, 'mkdepends')): + shutil.copy(os.path.join(utildir, 'mkdepends'), execdir) + + if input == '' or output == '': + input = os.path.abspath(input) + output = os.path.abspath(output) + + util = os.path.abspath(utildir) + + + coupling_file_path = os.path.join(execdir, 'coupling') + + # Check if the coupling file exists + if os.path.isfile(coupling_file_path): + with open(coupling_file_path, 'r') as file: + lastcoupling = file.read().strip().lower() == 'true' + # Compare coupling values + if lastcoupling != coupling: + print(f"Clean execdir {execdir} because coupling flag switched from {lastcoupling} to {coupling}") + mycwd = os.getcwd() + os.chdir(execdir) + subprocess.run(['gmake', 'clean']) + os.chdir(mycwd) + with open(coupling_file_path, 'w') as file: + file.write(str(coupling)) + else: + # Create the coupling file and write the coupling value + with open(coupling_file_path, 'w') as file: + file.write(str(coupling)) + print(f"Created file coupling with coupling flag = {coupling}") + + + hidra_file_path = os.path.join(execdir, 'hidra') + + # Check if the hidra file exists + if os.path.isfile(hidra_file_path): + with open(hidra_file_path, 'r') as file: + lasthidra = file.read().strip().lower() == 'true' + # Compare hidra values + if lasthidra != hidra: + print(f"Clean execdir {execdir} because hidra flag switched from {lasthidra} to {hidra}") + mycwd = os.getcwd() + os.chdir(execdir) + subprocess.run(['gmake', 'clean']) + os.chdir(mycwd) + with open(hidra_file_path, 'w') as file: + file.write(str(hidra)) + else: + # Create the hidra file and write the hidra value + with open(hidra_file_path, 'w') as file: + file.write(str(hidra)) + print(f"Created file hidra with hidra flag = {hidra}") + + debug_file_path = os.path.join(execdir, 'debug') + + # Check if the debug file exists + if os.path.isfile(debug_file_path): + with open(debug_file_path, 'r') as file: + lastdebug = file.read().strip().lower() == 'true' + + # Compare debug values + if lastdebug != debug: + print(f"Clean execdir {execdir} because debug flag switched from {lastdebug} to {debug}") + mycwd = os.getcwd() + os.chdir(execdir) + subprocess.run(['gmake', 'clean']) + os.chdir(mycwd) + + with open(debug_file_path, 'w') as file: + file.write(str(debug)) + else: + # Create the debug file and write the debug value + with open(debug_file_path, 'w') as file: + file.write(str(debug)) + print(f"Created file debug with debug flag = {debug}") + + + # Create the defs.h content + defs_content = dedent(f"""\ + #define DLAT {horires} + #define DLON {horires} + #define GLON1 -180 + #define DLEV {vertres} + #define ZIBOT -7 + #define ZITOP {zitop} + #define NRES_GRID {nres_grid} + """) + + # Write to defs.h + defs_path = 'defs.h' + with open(defs_path, 'w') as file: + file.write(defs_content) + + # Check if defs.h exists in execdir and compare + execdir_defs_path = os.path.join(execdir, 'defs.h') + if os.path.isfile(execdir_defs_path): + if not filecmp.cmp(defs_path, execdir_defs_path, shallow=False): + # Files differ, switch resolutions + print(f"Switching defs.h for model resolution {horires} x {vertres}") + mycwd = os.getcwd() + os.chdir(execdir) + subprocess.run(['gmake', 'clean']) + os.chdir(mycwd) + shutil.copy(defs_path, execdir_defs_path) + else: + print(f"defs.h already set for model resolution {horires} x {vertres}") + else: + # defs.h does not exist in execdir, copy the file + print(f"Copying {defs_path} to {execdir_defs_path} for resolution {horires} x {vertres}") + shutil.copy(defs_path, execdir_defs_path) + + + try: + os.chdir(execdir) + print(f"\nBegin building {model} in {os.getcwd()}") + except OSError: + print(f">>> Cannot cd to execdir {execdir}") + sys.exit(1) + + + + # Create Make.env file + make_env_path = os.path.join(execdir, 'Make.env') + with open(make_env_path, 'w') as file: + file.write(f"""MAKE_MACHINE = {make} +DIRS = . {srcdir} +EXECNAME = {model} +NAMELIST = {input} +OUTPUT = {output} +COUPLING = {str(coupling).upper()} +HIDRA = {str(hidra).upper()} +DEBUG = {str(debug).upper()} +""") + + # Build the model + try: + subprocess.run(['gmake', '-j8', 'all'], check=True) + shutil.copy(model, workdir) + print(f"Executable copied from {model} to {workdir}") + except subprocess.CalledProcessError: + print(">>> Error return from gmake all") + sys.exit(1) \ No newline at end of file diff --git a/tiegcmrun/engage_solver.py b/tiegcmrun/engage_solver.py new file mode 100644 index 0000000..d3fedd8 --- /dev/null +++ b/tiegcmrun/engage_solver.py @@ -0,0 +1,212 @@ +""" +engage_solver.py for the TIEGCMrun software. + +This script helps in solving for the correct input and pbs parameters for running the TIEGCM model in coupled mode with Engage. + +Functions included: + +- gamres_to_res(gamres): Converts the GAMERA grid type to horizontal resolution values. +- engage_parser(engage_parameters): Parses the engage.json file and returns the options dictionary. +- get_engage_start_time(datetime_str, seconds): Calculates the start time for the Engage run by subtracting the spin-up time from the coupled start date. +- engage_run(options, debug, coupling, engage): Prepares and runs the TIEGCM model in both standalone and coupled modes, generating the necessary input and PBS files. +""" + +import os +import json +import copy +from datetime import datetime, timedelta + +from misc import seconds_to_dhms, resolution_solver, find_file, select_resource_defaults +from output_solver import segment_inp_pbs +from interpolation import interpic + + +# Path to current tiegcm datafiles +TIEGCMDATA = os.environ["TIEGCMDATA"] +# Path to current tiegcm installation +TIEGCMHOME = os.environ["TIEGCMHOME"] +# Path to directory containing support files for makeitso. +SUPPORT_FILES_DIRECTORY = os.path.join(TIEGCMHOME, "tiegcmrun") +OPTION_DESCRIPTIONS_FILE = os.path.join(SUPPORT_FILES_DIRECTORY, "options_description.json") + +def gamres_to_res(gamres): + "D", "Q", "O", "H" + if gamres == "D": + return 2.5 , 2.5 + elif gamres == "Q": + return 2.5 , 1.25 + elif gamres == "O": + return 1.25 , 0.625 + elif gamres == "H": + return 1.25 ,0.625 + +def engage_parser(engage_parameters): + """ + Parse the engage.json file and return the options dictionary. + + Args: + engage_jsonfile (str): The path to the engage.json file. + + Returns: + dict: The options dictionary. + """ + + o = engage_parameters["simulation"] + + hpc_system = o['hpc_system'] + coupled_job_name = o['job_name'] + coupled_start_date = o['start_date'] + stop_date = o['stop_date'] + + use_segments = o['use_segments'] + segment_duration = int(float((o['segment_duration']))) + segment = seconds_to_dhms(segment_duration) + horires_standalone, horires_coupled = gamres_to_res(o['gamera_grid_type']) + + o = engage_parameters["pbs"] + account_name = o['account_name'] + queue = o['queue'] + if hpc_system == "derecho": + job_priority = o['job_priority'] + walltime = o['walltime'] + modules = o['modules'] + + o = engage_parameters["coupling"] + + gamera_spin_up_time = int(o['gamera_spin_up_time']) + gcm_spin_up_time = int(o['gcm_spin_up_time']) + conda_env = o['conda_env'] + + start_date = get_engage_start_time(coupled_start_date,gamera_spin_up_time+gcm_spin_up_time) + + o = engage_parameters["voltron"] + voltron_dtOut = int(float(o['output']['dtOut'])) + hist = seconds_to_dhms(voltron_dtOut) + STEP = int(float(o['coupling']['dtCouple'])) + + root_directory= os.path.abspath(os.curdir) + eo = engage_options = {} + + eo['job_name'] = coupled_job_name + eo['hpc_system'] = hpc_system + eo['start_time'] = start_date + eo['coupled_start_time'] = coupled_start_date + eo['stop_time'] = stop_date + eo['segment'] = segment + eo['segment_seconds'] = segment_duration + eo['horires'] = horires_standalone + eo['horires_coupled'] = horires_coupled + eo['STEP'] = STEP + eo["voltron_dtOut"] = voltron_dtOut + eo['parentdir'] = root_directory + + eo['account_name'] = account_name + eo['project_code'] = account_name + eo['queue'] = queue + + eo['walltime'] = walltime + eo['modules'] = modules + eo['conda_env'] = conda_env + + if hpc_system == "derecho": + eo['job_priority'] = job_priority + elif hpc_system == 'pleiades': + eo["model"] = "bro" + + eo['skip']= ['job_name','hpc_system','horires','parentdir','vertres', 'mres', 'input_file', 'LABEL','start_time','stop_time','secondary_start_time','secondary_stop_time','segment' ,'SOURCE_START','PRIHIST','MXHIST_PRIM','SECHIST','MXHIST_SECH','account_name','project_code','queue','job_priority','model','walltime'] + + return engage_options + +def get_engage_start_time(datetime_str, seconds): + # Parse the input datetime string + dt = datetime.fromisoformat(datetime_str) + + # Subtract the seconds using timedelta + new_dt = dt - timedelta(seconds=seconds) + + if new_dt.time() != datetime.min.time(): + # Adjust to the previous midnight + new_dt = datetime.combine(new_dt.date(), datetime.min.time()) + + # Return the new datetime as a string in the same format + return new_dt.isoformat() + +def engage_run(options, debug, coupling, engage): + with open(OPTION_DESCRIPTIONS_FILE, "r", encoding="utf-8") as f: + option_descriptions = json.load(f) + options_standalone = copy.deepcopy(options) + options_coupling = copy.deepcopy(options) + #For standalone + pbs=True + options_standalone["simulation"]["job_name"] = f'{engage["job_name"]}-tiegcm-standalone' + options_standalone["inp"]["stop_time"] = engage["coupled_start_time"] + options_standalone["inp"]["PRIHIST"] = '1 0 0 0' + options_standalone["inp"]["MXHIST_PRIM"] = 1 + options_standalone["inp"]["SECHIST"] = '0 1 0 0' + options_standalone["inp"]["MXHIST_SECH"] = 24 + options_standalone["inp"]["segment"] = '1 0 0 0' + options_standalone["inp"]["OPDIFFCAP"] = '2e9' + options_standalone["inp"]["OPDIFFRATE"] = '0.3' + options_standalone["inp"]["OPDIFFLEV"] = '7' + options_standalone["inp"]["OPFLOOR"] = '3000' + options_standalone["inp"]["OPRATE"] = '0.3' + options_standalone["inp"]["OPLEV"] = '7' + options_standalone["inp"]["OPLATWIDTH"] = '20' + options_standalone["inp"]["TE_CAP"] = '8000' + options_standalone["inp"]["TI_CAP"] = '8000' + options_standalone["model"]["data"]["workdir"] = os.path.join(engage["parentdir"],"tiegcm_standalone") + if not os.path.exists(options_standalone["model"]["data"]["workdir"]): + os.makedirs(options_standalone["model"]["data"]["workdir"]) + options_standalone["model"]["data"]["histdir"] = os.path.join(engage["parentdir"],"tiegcm_standalone") + + in_prim = options_standalone["inp"]["SOURCE"] + out_prim = f'{options_standalone["model"]["data"]["workdir"]}/{options_standalone["simulation"]["job_name"]}_prim.nc' + options_standalone["inp"]["SOURCE"] = out_prim + horires_standalone= engage["horires"] + vertres_standalone, mres_standalone, nres_grid_standalone, STEP_standalone = resolution_solver(horires_standalone,engage) + interpic (in_prim,float(horires_standalone),float(vertres_standalone),float(options_standalone['model']['specification']['zitop']),out_prim) + standalone_inp_files,standalone_pbs_files, standalone_log_files,pristart_times, pristop_times=segment_inp_pbs(options_standalone, options_standalone["simulation"]["job_name"],pbs, engage) + #For coupled + pbs=False + options_coupling["model"]["data"]["modelexe"] = options_coupling["model"]["data"]["coupled_modelexe"] + coupling_modelexe=options_coupling["model"]["data"]["coupled_modelexe"] + horires_coupling = float(engage["horires_coupled"]) + options_coupling["model"]["specification"]["horires"] = horires_coupling + vertres_coupling, mres_coupling, nres_grid_coupling, STEP_coupling = resolution_solver(horires_coupling,engage) + options_coupling["model"]["specification"]["vertres"] = vertres_coupling + options_coupling["model"]["specification"]["mres"] = mres_coupling + options_coupling["model"]["specification"]["nres_grid"] = nres_grid_coupling + options_coupling["inp"]["STEP"] = STEP_coupling + SOURCE_coupling = os.path.join(options_coupling["model"]["data"]["workdir"],f'{engage["job_name"]}_prim.nc') + options_coupling["inp"]["SOURCE"] = SOURCE_coupling #standalone_inp_files[-1] + options_coupling["inp"]["SOURCE_START"] = pristop_times[-1] + options_coupling["simulation"]["job_name"] = f'{engage["job_name"]}' + options_coupling["inp"]["start_time"] = engage["coupled_start_time"] + options_coupling["inp"]["PRIHIST"] = " ".join(str(i) for i in engage["segment"]) + options_coupling["inp"]["MXHIST_PRIM"] = 1 + options_coupling["inp"]["SECHIST"] = " ".join(str(i) for i in seconds_to_dhms(engage["voltron_dtOut"])) + options_coupling["inp"]["MXHIST_SECH"] = int(engage["segment_seconds"]/engage["voltron_dtOut"]) + options_coupling["inp"]["OPDIFFCAP"] = '2e9' + options_coupling["inp"]["OPDIFFRATE"] = '0.3' + options_coupling["inp"]["OPDIFFLEV"] = '7' + options_coupling["inp"]["OPFLOOR"] = '3000' + options_coupling["inp"]["OPRATE"] = '0.3' + options_coupling["inp"]["OPLEV"] = '7' + options_coupling["inp"]["OPLATWIDTH"] = '20' + options_coupling["inp"]["TE_CAP"] = '8000' + options_coupling["inp"]["TI_CAP"] = '8000' + options_coupling["inp"]["GSWM_MI_DI_NCFILE"] = find_file(f'*gswm_diurn_{horires_coupling}d_99km*', TIEGCMDATA) + options_coupling["inp"]["GSWM_MI_SDI_NCFILE"] = find_file(f'*gswm_semi_{horires_coupling}d_99km*', TIEGCMDATA) + options_coupling["inp"]["GSWM_NM_DI_NCFILE"] = find_file(f'*gswm_nonmig_diurn_{horires_coupling}d_99km*', TIEGCMDATA) + options_coupling["inp"]["GSWM_NM_SDI_NCFILE"] = find_file(f'*gswm_nonmig_semi_{horires_coupling}d_99km*', TIEGCMDATA) + coupling_inp_files,coupling_pbs_files, coupling_log_files, pristart_times, pristop_times = segment_inp_pbs(options_coupling, options_coupling["simulation"]["job_name"],pbs) + select_coupling,ncpus_coupling,mpiprocs_coupling=select_resource_defaults(options_coupling,option_descriptions) + options_coupling["job"]["resource"]["select"] = select_coupling + options_coupling["job"]["resource"]["ncpus"] = ncpus_coupling + options_coupling["job"]["resource"]["mpiprocs"] = mpiprocs_coupling + nprocs_coupling = int(mpiprocs_coupling)*int(select_coupling) + options_coupling["job"]["nprocs"] = nprocs_coupling + with open(OPTION_DESCRIPTIONS_FILE, "r", encoding="utf-8") as f: + option_descriptions = json.load(f) + + return options_coupling,standalone_pbs_files,coupling_inp_files diff --git a/tiegcmrun/interpolation.py b/tiegcmrun/interpolation.py new file mode 100644 index 0000000..92c5b00 --- /dev/null +++ b/tiegcmrun/interpolation.py @@ -0,0 +1,305 @@ +from numpy import ndarray, interp, log, exp, linspace, allclose, mean +from netCDF4 import Dataset + +def interp2d(variable, inlat, inlon, outlat, outlon): + """ + Interpolates a 2D variable from input latitude and longitude grid to output latitude and longitude grid. + + Parameters: + variable (ndarray): 2D array of the variable to be interpolated. + inlat (ndarray): 1D array of input latitudes. + inlon (ndarray): 1D array of input longitudes. + outlat (ndarray): 1D array of output latitudes. + outlon (ndarray): 1D array of output longitudes. + + Returns: + ndarray: 2D array of the interpolated variable on the output grid. + """ + + ninlat = len(inlat) + noutlon = len(outlon) + + var0 = ndarray(shape=(ninlat, noutlon)) + for ilat in range(ninlat): + var0[ilat, :] = interp(x=outlon, xp=inlon, fp=variable[ilat, :], period=360) + + var1 = ndarray(shape=(len(outlat), noutlon)) + for ilon in range(noutlon): + var1[:, ilon] = interp(x=outlat, xp=inlat, fp=var0[:, ilon]) + + return var1 + + +def interp3d(variable, inlev, inlat, inlon, outlev, outlat, outlon, extrap): + """ + Interpolates a 3-dimensional variable from one set of levels and grid points to another set of levels and grid points. + + Args: + variable (ndarray): The input variable with shape (ninlev, inlat, inlon). + inlev (ndarray): The input levels. + inlat (ndarray): The input latitudes. + inlon (ndarray): The input longitudes. + outlev (ndarray): The output levels. + outlat (ndarray): The output latitudes. + outlon (ndarray): The output longitudes. + extrap (str): The extrapolation method. Must be one of 'constant', 'linear', or 'exponential'. + + Returns: + ndarray: The interpolated variable with shape (noutlev, noutlat, noutlon). + """ + + ninlev = len(inlev) + noutlev = len(outlev) + noutlat = len(outlat) + noutlon = len(outlon) + + var0 = ndarray(shape=(ninlev, noutlat, noutlon)) + for ik in range(ninlev): + var0[ik, :, :] = interp2d(variable=variable[ik, :, :], inlat=inlat, inlon=inlon, outlat=outlat, outlon=outlon) + + # Find the last index of outlev falling in the range of inlev + for lastidx in range(noutlev): + if outlev[lastidx] > inlev[-1]: + break + + # If outlev is completely embedded in inlev (interpolation only), the end point needs to be added separately + if lastidx == noutlev-1 and outlev[lastidx] <= inlev[-1]: + lastidx = noutlev + + v1 = ndarray(shape=noutlev) + var1 = ndarray(shape=(noutlev, noutlat, noutlon)) + for ilat in range(noutlat): + for ilon in range(noutlon): + v0 = var0[:, ilat, ilon] + if extrap == 'constant': + v1[0: lastidx] = interp(x=outlev[0: lastidx], xp=inlev, fp=v0) + if lastidx < noutlev: + v1[lastidx: noutlev] = v1[lastidx-1] + elif extrap == 'linear': + v1[0: lastidx] = interp(x=outlev[0: lastidx], xp=inlev, fp=v0) + k = (v0[ninlev-1] - v0[ninlev-2]) / (inlev[ninlev-1] - inlev[ninlev-2]) + if lastidx < noutlev: + v1[lastidx: noutlev] = k * (outlev[lastidx: noutlev] - inlev[ninlev-1]) + v0[ninlev-1] + elif extrap == 'exponential': + v0 = log(v0) + v1[0: lastidx] = interp(x=outlev[0: lastidx], xp=inlev, fp=v0) + k = (v0[ninlev-1] - v0[ninlev-2]) / (inlev[ninlev-1] - inlev[ninlev-2]) + if lastidx < noutlev: + v1[lastidx: noutlev] = k * (outlev[lastidx: noutlev] - inlev[ninlev-1]) + v0[ninlev-1] + v1 = exp(v1) + else: + exit('Extrapolation method must be one of constant/linear/exponential') + var1[:, ilat, ilon] = v1 + + return var1 + + +def interpic(fin, hres, vres, zitop, fout): + """ + Interpolate and create a new primary file from an old TIEGCM primary file. + + Parameters: + - fin (str): The filename of the old TIEGCM primary file. + - hres (float): The horizontal resolution for the new primary file. + - vres (float): The vertical resolution for the new primary file. + - zitop (float): The top altitude for the new primary file. + - fout (str): The filename of the new primary file to be created. + + Returns: + None + """ + print(f"Interpolating primary file {fin} to create new primary file {fout} at horizontal resolution {hres} and vertical resolution {vres} with zitop {zitop}.") + # Some additional attributes for 4D fields + lower_cap = 1e-12 + fill_top = ['TN', 'UN', 'VN', 'OP', 'TI', 'TE', 'N2D', 'O2P', 'TN_NM', 'UN_NM', 'VN_NM', 'OP_NM'] + mixing_ratio = ['O2', 'O1', 'HE', 'N2D', 'N4S', 'NO', 'AR', 'O2_NM', 'O1_NM', 'HE_NM', 'N2D_NM', 'N4S_NM', 'NO_NM', 'AR_NM'] + extrap_method = {'TN': 'exponential', 'UN': 'linear', 'VN': 'linear', + 'O2': 'exponential', 'O1': 'exponential', 'HE': 'exponential', + 'OP': 'exponential', 'N2D': 'exponential', 'N4S': 'exponential', + 'NO': 'exponential', 'AR': 'exponential', 'TI': 'exponential', + 'TE': 'exponential', 'NE': 'exponential', 'OMEGA': 'linear', + 'O2P': 'constant', 'Z': 'exponential', 'POTEN': 'linear', + 'TN_NM': 'exponential', 'UN_NM': 'linear', 'VN_NM': 'linear', + 'O2_NM': 'exponential', 'O1_NM': 'exponential', 'HE_NM': 'exponential', + 'OP_NM': 'exponential', 'N2D_NM': 'exponential', 'N4S_NM': 'exponential', + 'NO_NM': 'exponential', 'AR_NM': 'exponential'} + + nlon = int(360 / hres) + lon = linspace(start=-180, stop=180-hres, num=nlon) + nlat = int(180 / hres) + lat = linspace(start=-90+hres/2, stop=90-hres/2, num=nlat) + nlev = int((zitop + 7) / vres) + 1 + ilev = linspace(start=-7, stop=zitop, num=nlev) + lev = ilev + vres/2 + + src = Dataset(filename=fin) + dst = Dataset(filename=fout, mode='w') + + print('Creating new primary file: ', fout) + + # Copy all attributes from old to new files (even though many of them are not actually used) + for name in src.ncattrs(): + setattr(dst, name, getattr(src, name)) + + for dimname, dimension in src.dimensions.items(): + if dimname == 'time': + nt = dimension.size + dst.createDimension(dimname='time') + elif dimname == 'lon': + dst.createDimension(dimname='lon', size=nlon) + elif dimname == 'lat': + dst.createDimension(dimname='lat', size=nlat) + elif dimname == 'lev': + dst.createDimension(dimname='lev', size=nlev) + elif dimname == 'ilev': + dst.createDimension(dimname='ilev', size=nlev) + elif dimname == 'mtimedim': + dst.createDimension(dimname='mtimedim', size=4) + else: + dst.createDimension(dimname=dimname, size=dimension.size) + + lon0 = src['lon'][:] + lat0 = src['lat'][:] + lev0 = src['lev'][:] + ilev0 = src['ilev'][:] + + nlon0 = len(lon0) + nlat0 = len(lat0) + nlev0 = len(lev0) + + # Bound latitudes with two poles since the change of horizontal resolutions lead to a boundary latitude shift + lat0_bnd = ndarray(shape=nlat0+2) + lat0_bnd[0] = -90 + lat0_bnd[1: nlat0+1] = lat0 + lat0_bnd[nlat0+1] = 90 + + # Longitude wrap is handled in interp2d, skip + + for varname, variable in src.variables.items(): + # Name change only + if varname == 'coupled_cmit': + varout = dst.createVariable(varname='coupled_mage', datatype=variable.datatype, dimensions=variable.dimensions) + else: + varout = dst.createVariable(varname=varname, datatype=variable.datatype, dimensions=variable.dimensions) + + for name in variable.ncattrs(): + setattr(varout, name, getattr(variable, name)) + + if varname == 'time': + varout[:] = variable[:] + elif varname == 'lon': + varout[:] = lon + elif varname == 'lat': + varout[:] = lat + elif varname == 'lev': + varout[:] = lev + elif varname == 'ilev': + varout[:] = ilev + + # The following variables never appear in standard TIEGCM runs + # But they showed up in some non-standard TIEGCM primary histories + # If that happens, skip those variables (the list may expand) + elif varname in ['lat_bnds', 'lon_bnds', 'gw', 'area']: + continue + + # Change from old format (3 digits) to new format (4 digits) + elif varname == 'mtime': + if src.dimensions['mtimedim'].size == 3: + varout[:, 0: 3] = variable[:] + varout[:, 3] = 0 + else: + varout[:] = variable[:] + + # If the old file was from a run with calc_helium==0, then set a constant for Helium in the new file (don't interpolate) + elif varname in ['HE', 'HE_NM'] and allclose(variable, 0): + varout[:] = lower_cap + + # 3D fields + elif variable.dimensions == ('time', 'lat', 'lon'): + var2d_bnd = ndarray(shape=(nlat0+2, nlon0)) + for it in range(nt): + # Set pole fields as the average of the highest latitude circle + var2d_bnd[0, :] = mean(variable[it, 0, :]) + var2d_bnd[1: nlat0+1, :] = variable[it, :, :] + var2d_bnd[nlat0+1, :] = mean(variable[it, nlat0-1, :]) + varout[it, :, :] = interp2d(variable=var2d_bnd, inlat=lat0_bnd, inlon=lon0, outlat=lat, outlon=lon) + + # 4D fields + elif len(variable.dimensions) == 4: + if not variable.dimensions in [('time', 'lev', 'lat', 'lon'), ('time', 'ilev', 'lat', 'lon')]: + exit('Invalid 4d field: '+varname) + + if variable.dimensions[1] == 'lev': + levin = lev0 + levout = lev + else: + levin = ilev0 + levout = ilev + + # If the topmost level are filling values, exclude that level + if varname in fill_top: + nlevin = nlev0 - 1 + else: + nlevin = nlev0 + + var3d_bnd = ndarray(shape=(nlevin, nlat0+2, nlon0)) + for it in range(nt): + # Set pole fields as the average of the highest latitude circle + for ik in range(nlevin): + var3d_bnd[ik, 0, :] = mean(variable[it, ik, 0, :]) + var3d_bnd[ik, 1: nlat0+1, :] = variable[it, ik, :, :] + var3d_bnd[ik, nlat0+1, :] = mean(variable[it, ik, nlat0-1, :]) + varout[it, :, :, :] = interp3d(variable=var3d_bnd, inlev=levin[0: nlevin], inlat=lat0_bnd, inlon=lon0, + outlev=levout, outlat=lat, outlon=lon, extrap=extrap_method[varname]) + + # Mixing ratio must lie within [0, 1], note that the exponential extrapolation gurantees positivity + if varname in mixing_ratio: + v = varout[:] + # In addition, major species have a lower cap + if varname in ['O2', 'O1', 'HE', 'O2_NM', 'O1_NM', 'HE_NM']: + v[v < lower_cap] = lower_cap + v[v > 1] = 1 + varout[:] = v + + else: + varout[:] = variable[:] + + # N2 needs to be extrapolated to check the validity of other major species (O2, O1, HE) + for ext in ['', '_NM']: + if 'HE'+ext in src.variables.keys(): + N2 = 1 - src['O2'+ext][:] - src['O1'+ext][:] - src['HE'+ext][:] + else: + # In case HE is not in the old file (non-standard format), it has to be added to the new file + N2 = 1 - src['O2'+ext][:] - src['O1'+ext][:] + dst.createVariable(varname='HE'+ext, datatype='f8', dimensions=('time', 'lev', 'lat', 'lon')) + dst['HE'+ext][:] = lower_cap + + N2n = ndarray(shape=(nt, nlev, nlat, nlon)) + N2_bnd = ndarray(shape=(nlev0, nlat0+2, nlon0)) + for it in range(nt): + for ik in range(nlev0): + N2_bnd[ik, 0, :] = mean(N2[it, ik, 0, :]) + N2_bnd[ik, 1: nlat0+1, :] = N2[it, ik, :, :] + N2_bnd[ik, nlat0+1, :] = mean(N2[it, ik, nlat0-1, :]) + N2n[it, :, :, :] = interp3d(variable=N2_bnd, inlev=lev0, inlat=lat0_bnd, inlon=lon0, + outlev=lev, outlat=lat, outlon=lon, extrap='exponential') + + N2n[N2n < lower_cap] = lower_cap + N2n[N2n > 1] = 1 + O2n = dst['O2'+ext][:] + O1n = dst['O1'+ext][:] + HEn = dst['HE'+ext][:] + + normalize = O2n + O1n + HEn + N2n + dst['O2'+ext][:] = O2n / normalize + dst['O1'+ext][:] = O1n / normalize + dst['HE'+ext][:] = HEn / normalize + + # New 2D variables since TIEGCM v3.0 + for varname in ['gzigm1', 'gzigm2', 'gnsrhs']: + if not varname in src.variables.keys(): + newvarout = dst.createVariable(varname=varname, datatype='f8', dimensions=('time', 'lat', 'lon')) + newvarout[:] = 0 + + src.close() + dst.close() \ No newline at end of file diff --git a/tiegcmrun/misc.py b/tiegcmrun/misc.py new file mode 100644 index 0000000..993bb1e --- /dev/null +++ b/tiegcmrun/misc.py @@ -0,0 +1,276 @@ +""" +misc.py for the TIEGCMrun software. + +This script contains various utility functions that are used to support the TIEGCMrun software. These functions include file handling, time segmentation, validation, resolution solving, and default selection for various options. + +Functions included: + +- get_mtime(file_path): Extracts and pads 'mtime' data from a given file. +- segment_time(start_time_str, stop_time_str, interval_array): Generates a list of time intervals between a start and stop time. +- valid_bench(value): Validates the benchmark option. +- resolution_solver(horires, engage_options=None): Determines vertical resolution, model resolution, grid resolution, and step size based on horizontal resolution. +- select_source_defaults(options, option_descriptions): Selects default values for the 'source' option based on input options. +- select_resource_defaults(options, option_descriptions): Selects default values for 'select', 'ncpus', and 'mpiprocs' options based on input options. +- find_file(pattern, path): Finds a file in the specified path that matches the given pattern. +- time_to_dhms(time_str): Converts a time string to a list of day, hour, minute, and second. +- seconds_to_dhms(seconds): Converts seconds to a list of days, hours, minutes, and seconds. +""" + +import os +import fnmatch +import argparse +from datetime import datetime, timedelta +import xarray as xr +from numpy import pad + +# Path to current tiegcm datafiles +TIEGCMDATA = os.environ["TIEGCMDATA"] +# Path to current tiegcm installation +TIEGCMHOME = os.environ["TIEGCMHOME"] + +def get_mtime(file_path): + """ + Get the 'mtime' data from the given file path. + + Parameters: + file_path (str): The path to the file. + + Returns: + list: A list containing the 'mtime' data, padded with zeros if necessary. + """ + ds = xr.open_dataset(file_path) + if 'mtime' in ds.variables: + mtime_data = ds['mtime'].values + mtime_arr = pad(mtime_data, [(0, 0), (0, max(4 - mtime_data.shape[1], 0))], mode='constant').tolist() + return mtime_arr + +def segment_time(start_time_str, stop_time_str, interval_array): + """ + Generate a list of time intervals between a start time and stop time based on a given interval array. + + Args: + start_time_str (str): The start time in the format '%Y-%m-%dT%H:%M:%S'. + stop_time_str (str): The stop time in the format '%Y-%m-%dT%H:%M:%S'. + interval_array (list): A list containing the interval values in the order [days, hours, minutes, seconds]. + + Returns: + list: A list of time intervals in the format [[start_time, end_time], [start_time, end_time], ...]. + """ + # Convert start_time and stop_time to datetime objects + start = datetime.strptime(start_time_str, '%Y-%m-%dT%H:%M:%S') + stop = datetime.strptime(stop_time_str, '%Y-%m-%dT%H:%M:%S') + + # Extract interval values from the array + days, hours, minutes, seconds = interval_array + + # Create a timedelta object using the interval values + delta = timedelta(days=days, hours=hours, minutes=minutes, seconds=seconds) + + # Generate the intervals + intervals = [] + current = start + while current < stop: + next_time = min(current + delta, stop) + intervals.append([current.strftime('%Y-%m-%dT%H:%M:%S'), next_time.strftime('%Y-%m-%dT%H:%M:%S')]) + current = next_time + + return intervals + +def valid_bench(value): + """ + Validate the benchmark option. + + Args: + value (str): The benchmark option to validate. + + Returns: + str: The validated benchmark option. + + Raises: + argparse.ArgumentTypeError: If the value is not a valid benchmark option. + """ + # Custom validation logic + if value not in [None, + 'seasons', 'decsol_smax', 'decsol_smin', 'junsol_smax', 'junsol_smin','mareqx_smax', 'mareqx_smin', 'sepeqx_smax', 'sepeqx_smin', + 'storms', 'dec2006_heelis_gpi', 'dec2006_weimer_imf', 'jul2000_heelis_gpi', 'jul2000_weimer_imf', 'nov2003_heelis_gpi', 'nov2003_weimer_imf', 'whi2008_heelis_gpi', 'whi2008_weimer_imf', + 'climatology', 'climatology_smax', 'climatology_smin' + ]: + raise argparse.ArgumentTypeError(f"{value} is not a valid benchmark option.") + return value + +def resolution_solver(horires, engage_options=None): + if float(horires) == 5: + vertres = 0.5 + mres = 2 + STEP = 60 + elif float(horires) == 2.5: + vertres = 0.25 + mres = 2 + STEP = 30 + elif float(horires) == 1.25: + vertres = 0.125 + mres = 1 + STEP = 10 + elif float(horires) == 0.625: + vertres = 0.0625 + mres = 0.5 + STEP = 5 + + if mres == 2: + nres_grid = 5 + elif mres == 1: + nres_grid = 6 + elif mres == 0.5: + nres_grid = 7 + + if engage_options != None: + STEP = engage_options["STEP"] + + return vertres, mres, nres_grid, STEP + +def select_source_defaults(options, option_descriptions): + """ + Select the default values for the 'source' option based on the given input options. + + Args: + options (dict): A dictionary containing the input options. + option_descriptions (dict): A dictionary containing the descriptions of the available options. + + Returns: + str: The default value for the 'source' option. + + """ + start_time = options["inp"]["start_time"] + time_dhms = time_to_dhms(start_time) + flux_level = options["inp"]["solar_flux_level"] + if flux_level == "low": + f107 = 70 + elif flux_level == "medium": + f107 = 140 + elif flux_level == "high": + f107 = 200 + if time_dhms[0] >= 1 and time_dhms[0] <81: + source_default = find_file(f"decsol_f{f107}*",TIEGCMDATA) + elif time_dhms[0] >= 81 and time_dhms[0] <173: + source_default = find_file(f'mareqx_f{f107}*',TIEGCMDATA) + elif time_dhms[0] >= 173 and time_dhms[0] <265: + source_default = find_file(f'junsol_f{f107}*',TIEGCMDATA) + elif time_dhms[0] >= 265 and time_dhms[0] <356: + source_default = find_file(f'seqex_f{f107}*',TIEGCMDATA) + elif time_dhms[0] >= 356: + source_default = find_file(f'decsol_f{f107}*',TIEGCMDATA) + return source_default + +def select_resource_defaults(options, option_descriptions): + """ + Selects the default values for the 'select', 'ncpus', and 'mpiprocs' options based on the given input options. + + Args: + options (dict): A dictionary containing the input options. + option_descriptions (dict): A dictionary containing the descriptions of the available options. + + Returns: + tuple: A tuple containing the default values for 'select', 'ncpus', and 'mpiprocs' options. + + """ + horires = options["model"]["specification"]["horires"] + hpc_platform = options["simulation"]["hpc_system"] + od = option_descriptions["job"][hpc_platform] + o = options["job"] + if hpc_platform == "derecho": + od=od["resource"] + for on in od: + if on == "select": + if float(horires) == 2.5 or float(horires) == 5: + select_default = 3 + elif float(horires) == 1.25: + select_default = 3 + elif float(horires) == 0.625: + select_default = 3 + if on == "ncpus": + if float(horires) == 2.5 or float(horires) == 5: + ncpus_default = 128 + elif float(horires) == 1.25: + ncpus_default = 128 + elif float(horires) == 0.625: + ncpus_default = 128 + if on == "mpiprocs": + if float(horires) == 2.5 or float(horires) == 5: + mpiprocs_default = 96 + elif float(horires) == 1.25: + mpiprocs_default = 96 + elif float(horires) == 0.625: + mpiprocs_default = 96 + elif hpc_platform == "pleiades": + od=od["resource"] + o=o["resource"] + if o["model"] == "bro": + max_ncpus = 28 + mpiprocs_default = 24 + elif o["model"] == "has": + max_ncpus = 24 + mpiprocs_default = 24 + elif o["model"] == "ivy": + max_ncpus = 20 + mpiprocs_default = 18 + elif o["model"] == "san": + max_ncpus = 16 + mpiprocs_default = 12 + for on in od: + if on == "select": + if float(horires) == 2.5 or float(horires) == 5: + select = 72/mpiprocs_default + if float(horires) == 1.25: + select = 144/mpiprocs_default + if float(horires) == 0.625: + select = 288/mpiprocs_default + select_default = int(select) + if on == "ncpus": + ncpus_default = max_ncpus + if on == "mpiprocs": + mpiprocs_default = mpiprocs_default + return select_default,ncpus_default,mpiprocs_default + +def find_file(pattern, path): + """ + Find a file in the specified path that matches the given pattern. Assumes only one match. + + :param pattern: Pattern to look for in the file names. + :param path: Path of the directory to search in. + :return: File path if a match is found, else None. + """ + for root, dirs, files in os.walk(path): # Recursively go through all directories and subdirectories + for name in files: + if fnmatch.fnmatch(name, pattern): # Check if file name matches the pattern + return os.path.join(root, name) # If so, return the file path immediately + return None + +def time_to_dhms(time_str): + + # Convert string to datetime object + time = datetime.strptime(time_str, "%Y-%m-%dT%H:%M:%S") + + # Extract day of year, hour of day, minute of hour, and second of minute + day = time.timetuple().tm_yday + hour = time.hour + minute = time.minute + second = time.second + + return [day, hour, minute, second] + +def seconds_to_dhms(seconds): + # Calculate the number of days + days = seconds // (24 * 3600) + seconds %= (24 * 3600) + + # Calculate the number of hours + hours = seconds // 3600 + seconds %= 3600 + + # Calculate the number of minutes + minutes = seconds // 60 + + # Calculate the remaining seconds + seconds %= 60 + + return [days, hours, minutes, seconds] diff --git a/tiegcmrun/namelist_solver.py b/tiegcmrun/namelist_solver.py new file mode 100644 index 0000000..259ae36 --- /dev/null +++ b/tiegcmrun/namelist_solver.py @@ -0,0 +1,321 @@ +""" +namelist_solver.py for the TIEGCMrun software. + +This script helps in solving for the correct input parameter for the namelist files for running the TIEGCM model. + +Functions included: + +- inp_pri_date(start_date_str, stop_date_str): Converts start and stop date strings to datetime objects and extracts relevant information. +- valid_hist(start_time, stop_time): Calculates valid divisions for a given time range. +- inp_mxhist(start_time, stop_time, x_hist, mxhist_warn, segment=None): Calculates the MXHIST value based on the given start and stop times, and x_hist values. +- inp_sechist(SECSTART, SECSTOP, segment=None): Determines the value of SECHIST based on the given SECSTART and SECSTOP. +- inp_prihist(PRISTART, PRISTOP, segment=None): Calculates the PRIHIST list based on the PRISTART and PRISTOP values. +- inp_pri_out(start_time, stop_time, PRIHIST, MXHIST_PRIM, pri_files, histdir, run_name): Generates the output file names and the total number of files based on the given parameters. +- inp_sec_out(start_time, stop_time, SECHIST, MXHIST_SECH, sec_files, histdir, run_name): Calculates the output file names and the total number of files for the secondary history output. +- inp_sec_date(start_time, stop_time, SECHIST): Calculates the SECSTART and SECSTOP values based on the given start_time, stop_time, and SECHIST. +""" + + +from datetime import datetime, timedelta +from math import ceil + + +def inp_pri_date(start_date_str, stop_date_str): + """ + Convert start and stop date strings to datetime objects and extract relevant information. + + Args: + start_date_str (str): Start date string in the format "%Y-%m-%dT%H:%M:%S". + stop_date_str (str): Stop date string in the format "%Y-%m-%dT%H:%M:%S". + + Returns: + tuple: A tuple containing the following values: + - START_YEAR (int): The year of the start date. + - START_DAY (int): The day of the year of the start date. + - PRISTART (list): A list containing the day of the year, hour, minute, and second of the start date. + - PRISTOP (list): A list containing the day of the year, hour, minute, and second of the stop date. + """ + # Parse the start and stop dates + start_time = datetime.strptime(start_date_str, "%Y-%m-%dT%H:%M:%S") + stop_time = datetime.strptime(stop_date_str, "%Y-%m-%dT%H:%M:%S") + + # Extract START_YEAR and START_DAY + START_YEAR = start_time.year + START_DAY = start_time.timetuple().tm_yday + + # Format PRISTART and PRISTOP + PRISTART = [start_time.timetuple().tm_yday, start_time.hour, start_time.minute, start_time.second] + PRISTOP = [stop_time.timetuple().tm_yday, stop_time.hour, stop_time.minute, stop_time.second] + + return START_YEAR, START_DAY, PRISTART, PRISTOP + +def valid_hist(start_time, stop_time): + """ + Calculate valid divisions for a given time range. + + Parameters: + start_time (str): The start date in the format '%Y-%m-%dT%H:%M:%S'. + stop_time (str): The stop date in the format '%Y-%m-%dT%H:%M:%S'. + + Returns: + list: A list of valid divisions for days, hours, minutes, and seconds. + Each division is represented as a list [days, hours, minutes, seconds]. + """ + + start = datetime.strptime(start_time, '%Y-%m-%dT%H:%M:%S') + stop = datetime.strptime(stop_time, '%Y-%m-%dT%H:%M:%S') + total_duration = stop - start + total_seconds = total_duration.total_seconds() + + valid_divisions = [] + + # Calculate valid divisions for days + total_days = total_duration.days + for n_day in range(1, total_days + 1): + valid_divisions.append([n_day,0,0,0]) + + # Calculate valid divisions for hours + hours_divisions = [1, 2, 3, 4, 6, 12, 18, 24] + for n_hour in hours_divisions: + if total_seconds % (n_hour * 3600) == 0: + valid_divisions.append([0,n_hour,0,0]) + + # Calculate valid divisions for minutes + minutes_divisions = [1, 2, 5, 10, 15, 30, 45, 60] + for n_min in minutes_divisions: + if total_seconds % (n_min * 60) == 0: + valid_divisions.append([0,0,n_min,0]) + + # Calculate valid divisions for seconds + seconds_divisions = [1, 2, 5, 10, 15, 30, 45, 60] + for n_sec in seconds_divisions: + if total_seconds % n_sec == 0: + valid_divisions.append([0,0,0,n_sec]) + + return valid_divisions + +def inp_mxhist(start_time, stop_time, x_hist, mxhist_warn, segment = None): + """ + Calculate the MXHIST value based on the given start and stop times, and x_hist values. + + Args: + start_time (str): The start time in the format '%Y-%m-%dT%H:%M:%S'. + stop_time (str): The stop time in the format '%Y-%m-%dT%H:%M:%S'. + x_hist (tuple): A tuple containing the number of days, hours, minutes, and seconds for x_hist. + mxhist_warn (str): A warning message for MXHIST. + + Returns: + tuple: A tuple containing the calculated MXHIST value and the updated mxhist_warn message. + + Raises: + None + + """ + start = datetime.strptime(start_time, '%Y-%m-%dT%H:%M:%S') + stop = datetime.strptime(stop_time, '%Y-%m-%dT%H:%M:%S') + total_duration = stop - start + total_seconds = total_duration.total_seconds() + + seconds_in_day = 86400 + seconds_in_hour = 3600 + seconds_in_min = 60 + + n_day, n_hour, n_min, n_sec = x_hist + step_seconds = (n_day * 86400) + (n_hour * 3600) + (n_min * 60) + n_sec + + if step_seconds == 0: + return "Invalid prihist: step cannot be 0." + + mxhist_day = seconds_in_day / step_seconds + mxhist_hour = seconds_in_hour / step_seconds + mxhist_min = seconds_in_min / step_seconds + if segment == None: + if mxhist_day >= 1: + mxhist_warn = (mxhist_warn + "\n" if mxhist_warn is not None else "") + f"For a Daily output set MXHIST to {int(mxhist_day)}" + if mxhist_hour >= 1: + mxhist_warn = mxhist_warn + f"\nFor a Hourly output set MXHIST to {int(mxhist_hour)}" + if mxhist_min >= 1: + mxhist_warn = mxhist_warn + f"\nFor a Minutely output set MXHIST to {int(mxhist_min)}" + MXHIST = mxhist_day + else: + segment_seconds = (segment[0] * 86400) + (segment[1] * 3600) + (segment[2] * 60) + segment[3] + MXHIST = segment_seconds/step_seconds + mxhist_warn = f"MXHIST minimum = 1, maximum = {int(MXHIST)} for segment run." + return(int(MXHIST), mxhist_warn) + +def inp_sechist(SECSTART, SECSTOP, segment = None): + """ + Determines the value of SECHIST based on the given SECSTART and SECSTOP. + + Parameters: + SECSTART (list): A list containing the start day. + SECSTOP (list): A list containing the stop day. + + Returns: + list: A list containing the value of SECHIST. + + """ + PRISTART_DAY = SECSTART[0] + PRISTOP_DAY = SECSTOP[0] + n_split_day = int(PRISTOP_DAY - PRISTART_DAY) + if n_split_day >= 7: + SECHIST = [1, 0, 0, 0] + else: + SECHIST = [0, 1, 0, 0] + + if segment != None: + SECHIST = [1 if x != 0 else 0 for x in segment] + + return SECHIST + +def inp_prihist(PRISTART, PRISTOP, segment = None): + """ + Calculate the PRIHIST list based on the PRISTART and PRISTOP values. + + Parameters: + PRISTART (list): A list containing the start day of the PRIHIST period. + PRISTOP (list): A list containing the stop day of the PRIHIST period. + + Returns: + list: The PRIHIST list, which is either [1, 0, 0, 0] or [0, 1, 0, 0] based on the number of days in the PRIHIST period. + """ + PRISTART_DAY = PRISTART[0] + PRISTOP_DAY = PRISTOP[0] + n_split_day = int(PRISTOP_DAY - PRISTART_DAY) + if n_split_day >= 7: + PRIHIST = [1, 0, 0, 0] + else: + PRIHIST = [0, 1, 0, 0] + + if segment != None: + PRIHIST = [1 if x != 0 else 0 for x in segment] + return PRIHIST + +def inp_pri_out(start_time, stop_time, PRIHIST, MXHIST_PRIM, pri_files, histdir, run_name): + """ + Generate the output file names and the total number of files based on the given parameters. + + Parameters: + start_time (str): The start time in the format '%Y-%m-%dT%H:%M:%S'. + stop_time (str): The stop time in the format '%Y-%m-%dT%H:%M:%S'. + PRIHIST (tuple): A tuple containing the number of days, hours, minutes, and seconds for PRIHIST. + MXHIST_PRIM (int): The maximum number of primary history files. + pri_files (int): The number of existing primary history files. + histdir (str): The directory where the history files are stored. + run_name (str): The name of the run. + + Returns: + tuple: A tuple containing the output file names and the updated number of primary history files. + + """ + # Convert start and stop times to datetime + start = datetime.strptime(start_time, '%Y-%m-%dT%H:%M:%S') + stop = datetime.strptime(stop_time, '%Y-%m-%dT%H:%M:%S') + + # Calculate total duration in seconds + total_seconds = (stop - start).total_seconds() + + # Convert prihist to seconds + n_day, n_hour, n_min, n_sec = PRIHIST + step_seconds = (n_day * 86400) + (n_hour * 3600) + (n_min * 60) + n_sec + + # Calculate model data per output file in seconds + data_per_file_seconds = step_seconds * int(MXHIST_PRIM) + + # Calculate the total number of files, rounding up + number_of_files = ceil(total_seconds / data_per_file_seconds) + pri_files_n = pri_files + number_of_files + if pri_files == 0: + if number_of_files == 1: + OUTPUT = OUTPUT = f"'{histdir}/{run_name}_prim_{'{:02d}'.format(pri_files)}.nc' , '{histdir}/{run_name}_prim_{'{:02d}'.format(pri_files+1)}.nc'" + else: + PRIM_0 = f"{histdir}/{run_name}_prim_{'{:02d}'.format(pri_files)}.nc" + PRIM_N = f"{histdir}/{run_name}_prim_{'{:02d}'.format(pri_files_n)}.nc" + OUTPUT = f"'{PRIM_0}','to','{PRIM_N}','by','1'" + else: + if number_of_files == 1: + OUTPUT = OUTPUT = f"'{histdir}/{run_name}_prim_{'{:02d}'.format(pri_files)}.nc' , '{histdir}/{run_name}_prim_{'{:02d}'.format(pri_files+1)}.nc'" + else: + PRIM_0 = f"{histdir}/{run_name}_prim_{'{:02d}'.format(pri_files)}.nc" + PRIM_N = f"{histdir}/{run_name}_prim_{'{:02d}'.format(pri_files_n)}.nc" + OUTPUT = f"'{PRIM_0}','to','{PRIM_N}','by','1'" + return OUTPUT, pri_files_n + +def inp_sec_out(start_time, stop_time, SECHIST, MXHIST_SECH, sec_files, histdir, run_name): + """ + Calculate the output file names and the total number of files for the secondary history output. + + Args: + start_time (str): The start time of the simulation in the format '%Y-%m-%dT%H:%M:%S'. + stop_time (str): The stop time of the simulation in the format '%Y-%m-%dT%H:%M:%S'. + SECHIST (list): A list of integers representing the duration of each secondary history output file in days, hours, minutes, and seconds. + MXHIST_SECH (int): The maximum number of secondary history output files per primary history output file. + sec_files (int): The number of existing secondary history output files. + histdir (str): The directory where the history output files are stored. + run_name (str): The name of the simulation run. + + Returns: + tuple: A tuple containing the output file name pattern and the updated number of secondary history output files. + + """ + # Convert start and stop times to datetime + start = datetime.strptime(start_time, '%Y-%m-%dT%H:%M:%S') + stop = datetime.strptime(stop_time, '%Y-%m-%dT%H:%M:%S') + sechist_delta = timedelta(days=SECHIST[0], hours=SECHIST[1], minutes=SECHIST[2], seconds=SECHIST[3]) + start = start + sechist_delta + + # Calculate total duration in seconds + total_seconds = (stop - start).total_seconds() + + # Convert prihist to seconds + n_day, n_hour, n_min, n_sec = SECHIST + step_seconds = (n_day * 86400) + (n_hour * 3600) + (n_min * 60) + n_sec + + # Calculate model data per output file in seconds + data_per_file_seconds = step_seconds * int(MXHIST_SECH) + + # Calculate the total number of files, rounding up + number_of_files = ceil(total_seconds / data_per_file_seconds) + sec_files_start = sec_files + 1 # Start numbering from next file + sec_files_end = sec_files_start + number_of_files # End numbering based on number of files + + if number_of_files == 1: + # If only one file is being generated + SECOUT = f"'{histdir}/{run_name}_sech_{'{:02d}'.format(sec_files_start)}.nc'" + sec_files_end = sec_files_start + else: + # If multiple files are being generated + SECH_0 = f"{histdir}/{run_name}_sech_{'{:02d}'.format(sec_files_start)}.nc" + SECH_N = f"{histdir}/{run_name}_sech_{'{:02d}'.format(sec_files_end)}.nc" + SECOUT = f"'{SECH_0}','to','{SECH_N}','by','1'" + + # Return the new sec_files value for subsequent calls + return SECOUT, sec_files_end + +def inp_sec_date(start_time, stop_time, SECHIST): + """ + Calculate the SECSTART and SECSTOP values based on the given start_time, stop_time, and SECHIST. + + Parameters: + start_time (str): The start time in the format '%Y-%m-%dT%H:%M:%S'. + stop_time (str): The stop time in the format '%Y-%m-%dT%H:%M:%S'. + SECHIST (list): A list containing the number of days, hours, minutes, and seconds to be added to the start time. + + Returns: + tuple: A tuple containing the SECSTART and SECSTOP values. + + Example: + start_time = '2022-01-01T00:00:00' + stop_time = '2022-01-02T00:00:00' + SECHIST = [1, 0, 0, 0] + inp_sec_date(start_time, stop_time, SECHIST) + # Output: ([1, 0, 0, 0], [2, 0, 0, 0]) + """ + start = datetime.strptime(start_time, '%Y-%m-%dT%H:%M:%S') + stop = datetime.strptime(stop_time, '%Y-%m-%dT%H:%M:%S') + sechist_delta = timedelta(days=SECHIST[0], hours=SECHIST[1], minutes=SECHIST[2], seconds=SECHIST[3]) + start = start + sechist_delta + SECSTART = [start.timetuple().tm_yday,start.hour,start.minute,start.second] + SECSTOP = [stop.timetuple().tm_yday,stop.hour,stop.minute,stop.second] + + return SECSTART, SECSTOP diff --git a/tiegcmrun/options_description.json b/tiegcmrun/options_description.json index 3ee173e..8a89bdc 100755 --- a/tiegcmrun/options_description.json +++ b/tiegcmrun/options_description.json @@ -270,9 +270,16 @@ }, "modelexe": { "LEVEL": "BENCH", - "prompt": "Executable:", + "prompt": "Standalone Executable", "default": null, - "description": "The path of existing or name of the executable.", + "description": "The path of existing or name of the standalone executable.", + "warning": null + }, + "coupled_modelexe": { + "LEVEL": "BENCH", + "prompt": "Coupled Executable", + "default": null, + "description": "The path of existing or name of the coupled executable.", "warning": null } }, @@ -362,6 +369,14 @@ "description": null, "warning": "secondary_stop_time should not be later than stop_time. Keep default if segmenting runs." }, + "solar_flux_level": { + "LEVEL": "BASIC", + "prompt": "F107 flux level for TIEGCM spin up", + "default": "low", + "valids": ["low", "medium", "high"], + "description": null, + "warning": "Low = 70, Medium = 140 , High = 200" + }, "SOURCE":{ "LEVEL": "BENCH", "prompt": "SOURCE file location", @@ -378,7 +393,7 @@ }, "SOURCE_START":{ "LEVEL": "BASIC", - "prompt": "Selected Date in Source Dile", + "prompt": "Selected date in source file", "default": null, "valids": null, "description": "The selected model time (mtime) in the startup file. This option is typically used to specify the desired time stamp when there are multiple time stamps in one source file.", @@ -516,6 +531,7 @@ "LEVEL": "BASIC", "prompt": "GPI file", "default": null, + "valids": null, "description": "The location of the GPI file containing 3-hourly KP and daily F107, F107A to drive high-latitude convection and the auroral precipitation oval.", "warning": "If GPI_NCFILE is specified, then KP and POWER/CTPOTEN are skipped. If further POTENTIAL_MODEL is WEIMER and IMF_NCFILE is specified, then the Weimer model and aurora will be driven by the IMF data, and only F107 and F107A will be read from the GPI data file." }, @@ -671,9 +687,73 @@ "prompt": "Maximum O+ Ambipolar Diffusion coefficient", "default": null, "valids": null, - "description": "Optional cap on ambipolar diffusion coefficient for O+. This can improve model stability in the topside F-region, but it is only recommended as a last resort since it will change model results. Default is 0, i.e., no cap. If this is non-zero (provided by the user), then it is implemented in subroutine rrk of oplus.F.", + "description": "This works with OPDIFFRATE and OPDIFFLEV to determine the altitude dependence of maximum O+ ambipolar diffusive flux. This can improve model stability in the topside F-region, but it is only recommended as a last resort since it will change model results. Default is 0, i.e., no cap. If this is non-zero (provided by the user), then it is implemented in subroutine rrk of oplus.F.", "warning": null - }, + }, + "OPDIFFRATE":{ + "LEVEL": "EXPERT", + "prompt": "Altitude dependence of maximum O+ ambipolar diffusive flux (rate)", + "default": null, + "valids": null, + "description": "This works with OPDIFFCAP and OPDIFFLEV to determine the altitude dependence of maximum O+ ambipolar diffusive flux. This can improve model stability in the topside F-region, but it is only recommended as a last resort since it will change model results.", + "warning": null + }, + "OPDIFFLEV":{ + "LEVEL": "EXPERT", + "prompt": "Altitude dependence of maximum O+ ambipolar diffusive flux (level)", + "default": null, + "valids": null, + "description": "This works with OPDIFFCAP and OPDIFFLEV to determine the altitude dependence of maximum O+ ambipolar diffusive flux. This can improve model stability in the topside F-region, but it is only recommended as a last resort since it will change model results.", + "warning": null + }, + "OPFLOOR":{ + "LEVEL": "EXPERT", + "prompt": "Minimum O+ density", + "default": null, + "valids": null, + "description": "This works with OPRATE, OPLEV and OPLATWIDTH to form a latitudinal Gaussian shaped floor and altitudinal logistic shaped floor. The floor is applied to O+ at low-to-mid latitudes in the F-region in order to keep the model stable when the ionosphere gets very low in density.", + "warning": null + }, + "OPRATE":{ + "LEVEL": "EXPERT", + "prompt": "Altitude dependence of minimum O+ density (rate)", + "default": null, + "valids": null, + "description": "This works with OPFLOOR, OPLEV and OPLATWIDTH to form a latitudinal Gaussian shaped floor and altitudinal logistic shaped floor. The floor is applied to O+ at low-to-mid latitudes in the F-region in order to keep the model stable when the ionosphere gets very low in density.", + "warning": null + }, + "OPLEV":{ + "LEVEL": "EXPERT", + "prompt": "Altitude dependence of minimum O+ density (level)", + "default": null, + "valids": null, + "description": "This works with OPFLOOR, OPRATE and OPLATWIDTH to form a latitudinal Gaussian shaped floor and altitudinal logistic shaped floor. The floor is applied to O+ at low-to-mid latitudes in the F-region in order to keep the model stable when the ionosphere gets very low in density.", + "warning": null + }, + "OPLATWIDTH":{ + "LEVEL": "EXPERT", + "prompt": "Altitude dependence of minimum O+ density (latitude)", + "default": null, + "valids": null, + "description": "This works with OPFLOOR, OPRATE and OPLEV to form a latitudinal Gaussian shaped floor and altitudinal logistic shaped floor. The floor is applied to O+ at low-to-mid latitudes in the F-region in order to keep the model stable when the ionosphere gets very low in density.", + "warning": null + }, + "TE_CAP":{ + "LEVEL": "EXPERT", + "prompt": "Maximum electron temperature", + "default": null, + "valids": null, + "description": "The maximum electron temperature allowed for the model. Implemented in settei.F.", + "warning": null + }, + "TI_CAP":{ + "LEVEL": "EXPERT", + "prompt": "Maximum ion temperature", + "default": null, + "valids": null, + "description": "The maximum ion temperature allowed for the model. Implemented in settei.F.", + "warning": null + }, "CURRENT_PG": { "LEVEL": "EXPERT", "prompt": "Flag for Pressure Gradient and Gravity Force in Electrodynamo", @@ -802,7 +882,7 @@ "MIXFILE": { "LEVEL": "EXPERT", "prompt": "Data File for Remix", - "default": "msphere.mix.h5", + "default": null, "valids": null, "description": "The location of remix data file.", "warning": null diff --git a/tiegcmrun/output_solver.py b/tiegcmrun/output_solver.py new file mode 100644 index 0000000..0191d85 --- /dev/null +++ b/tiegcmrun/output_solver.py @@ -0,0 +1,205 @@ +""" +output_solver.py for the TIEGCMrun software. + +This script generates input and PBS scripts for running the TIEGCM model. It handles the creation of segmented input and PBS scripts based on the provided model options and time segments. + +Functions included: + +- create_pbs_scripts(options, run_name, segment_number): Creates PBS scripts for running the TIEGCM model. +- create_inp_scripts(options, run_name, segment_number): Creates input scripts for running the TIEGCM model. +- segment_inp_pbs(options, run_name, pbs, engage_options=None): Segments the input and PBS scripts based on the provided options and time segments. +""" + + +import os +import json +import copy +from jinja2 import Template + +from misc import segment_time, resolution_solver +from namelist_solver import inp_pri_date, inp_pri_out, inp_sec_date, inp_sec_out + + +JSON_INDENT = 4 +# Path to current tiegcm datafiles +TIEGCMDATA = os.environ["TIEGCMDATA"] +# Path to current tiegcm installation +TIEGCMHOME = os.environ["TIEGCMHOME"] +# Path to directory containing support files for makeitso. +SUPPORT_FILES_DIRECTORY = os.path.join(TIEGCMHOME, "tiegcmrun") +OPTION_DESCRIPTIONS_FILE = os.path.join(SUPPORT_FILES_DIRECTORY, "options_description.json") +# Path to template .inp file. +INP_TEMPLATE = os.path.join(SUPPORT_FILES_DIRECTORY, "template.inp") + +# Path to template .pbs file. +PBS_TEMPLATE = os.path.join(SUPPORT_FILES_DIRECTORY, "template.pbs") + +def create_pbs_scripts(options, run_name, segment_number): + """ + Create PBS scripts for running TIEGCM model. + + Args: + options (dict): A dictionary containing the model options. + run_name (str): The name of the run. + segment_number (int or None): The segment number of the run. If None, a single PBS script is created. + + Returns: + str: The filepath of the created PBS script. + + Raises: + FileNotFoundError: If the PBS template file is not found. + + """ + global PBS_TEMPLATE + if PBS_TEMPLATE == None: + PBS_TEMPLATE = os.path.join(options["model"]["data"]["modeldir"], 'tiegcmrun/template.pbs') + with open(PBS_TEMPLATE, "r", encoding="utf-8") as f: + template_content = f.read() + template = Template(template_content) + opt = copy.deepcopy(options) + pbs_content = template.render(opt) + workdir = opt["model"]["data"]["workdir"] + if segment_number == None: + pbs_script = os.path.join(workdir, f"{run_name}.pbs") + else: + pbs_script = os.path.join(workdir, f"{run_name}-{'{:02d}'.format(segment_number+1)}.pbs") + with open(pbs_script, "w", encoding="utf-8") as f: + f.write(pbs_content) + return pbs_script + +def create_inp_scripts(options, run_name, segment_number): + """ + Create input scripts for running the TIEGCM model. + + Args: + options (dict): A dictionary containing the model options. + run_name (str): The name of the run. + segment_number (int): The segment number. + + Returns: + str: The path to the created input script. + """ + global INP_TEMPLATE + if INP_TEMPLATE == None: + INP_TEMPLATE = os.path.join(options["model"]["data"]["modeldir"],'tiegcmrun/template.inp') + with open(INP_TEMPLATE, "r", encoding="utf-8") as f: + template_content = f.read() + template = Template(template_content) + opt = copy.deepcopy(options) + inp_content = template.render(opt) + workdir = opt["model"]["data"]["workdir"] + if segment_number == None: + inp_script = os.path.join(workdir,f"{run_name}.inp") + else: + inp_script = os.path.join(workdir,f"{run_name}-{'{:02d}'.format(segment_number+1)}.inp") + if not os.path.exists(workdir): + os.makedirs(workdir) + with open(inp_script, "w", encoding="utf-8") as f: + f.write(inp_content) + return inp_script + +def segment_inp_pbs(options, run_name, pbs, engage_options=None): + segment_times = segment_time(options["inp"]["start_time"], options["inp"]["stop_time"], [int(i) for i in options["inp"]["segment"].split()]) + pri_files = 0 + sec_files = 0 + og_options = copy.deepcopy(options) + PRIHIST = og_options["inp"]["PRIHIST"] + MXHIST_PRIM = og_options["inp"]["MXHIST_PRIM"] + SECHIST = og_options["inp"]["SECHIST"] + MXHIST_SECH = og_options["inp"]["MXHIST_SECH"] + histdir = og_options["model"]["data"]["histdir"] + workdir = og_options["model"]["data"]["workdir"] + job_name = og_options["simulation"]["job_name"] + inp_files = [] + pbs_files = [] + log_files = [] + pristart_times = [] + pristop_times = [] + with open(os.path.join(workdir,f'{run_name}.json'), "w", encoding="utf-8") as f: + json.dump(options, f, indent=JSON_INDENT) + last_segment_time = len(segment_times) - 1 + for segment_number, segment in enumerate(segment_times): + segment_options = copy.deepcopy(og_options) + segment_start = segment[0] + segment_stop = segment[1] + segment_options["simulation"]["job_name"] = job_name+"-{:02d}".format(segment_number +1) + if segment_number == 0: + segment_options["inp"]["SOURCE"] = og_options["inp"]["SOURCE"] + segment_options["inp"]["SOURCE_START"] = og_options["inp"]["SOURCE_START"] + segment_START_YEAR, segment_START_DAY, segment_PRISTART, segment_PRISTOP = inp_pri_date(segment_start,segment_stop) + segment_options["inp"]["START_YEAR"] = segment_START_YEAR + segment_options["inp"]["START_DAY"] = segment_START_DAY + segment_options["inp"]["PRISTART"] = ' '.join(map(str, segment_PRISTART)) + segment_options["inp"]["PRISTOP"] = ' '.join(map(str, segment_PRISTOP)) + segment_OUTPUT, pri_files = inp_pri_out(segment_start, segment_stop, [int(i) for i in PRIHIST.split()], MXHIST_PRIM, pri_files, histdir,run_name) + segment_options["inp"]["OUTPUT"] = segment_OUTPUT + else: + segment_START_YEAR, segment_START_DAY, segment_PRISTART, segment_PRISTOP = inp_pri_date(segment_start,segment_stop) + segment_options["inp"]["SOURCE"] = f"{histdir}/{run_name}_prim_{'{:02d}'.format(pri_files)}.nc" + segment_options["inp"]["SOURCE_START"] = ' '.join(map(str, segment_PRISTART)) + segment_options["inp"]["START_YEAR"] = segment_START_YEAR + segment_options["inp"]["START_DAY"] = segment_START_DAY + segment_options["inp"]["PRISTART"] = ' '.join(map(str, segment_PRISTART)) + segment_options["inp"]["PRISTOP"] = ' '.join(map(str, segment_PRISTOP)) + if segment_number == last_segment_time and engage_options != None: + segment_START_YEAR, segment_START_DAY, segment_PRISTART, segment_PRISTOP = inp_pri_date(segment_start,segment_stop) + segment_PRISTOP_day, segment_PRISTOP_hour, segment_PRISTOP_minute, segment_PRISTOP_second = segment_PRISTOP + if segment_PRISTOP_second != 0: + segment_PRIHIST = [0, 0, 0, 1] + segment_MXHIST_PRIM = segment_PRISTOP_minute*60 + segment_PRISTOP_hour*60 + segment_PRISTOP_second + elif segment_PRISTOP_minute != 0: + segment_PRIHIST = [0, 0, 1, 0] + segment_MXHIST_PRIM = segment_PRISTOP_hour*60 + segment_PRISTOP_minute + elif segment_PRISTOP_hour != 0: + segment_PRIHIST = [0, 1, 0, 0] + segment_MXHIST_PRIM = segment_PRISTOP_hour + else: + segment_PRIHIST = [int(i) for i in PRIHIST.split()] + segment_MXHIST_PRIM = MXHIST_PRIM + segment_OUTPUT, pri_files = inp_pri_out(segment_start, segment_stop, segment_PRIHIST, segment_MXHIST_PRIM, pri_files, histdir,run_name) + segment_options["inp"]["PRIHIST"] = ' '.join(map(str, segment_PRIHIST)) + segment_options["inp"]["MXHIST_PRIM"] = segment_MXHIST_PRIM + segment_options["inp"]["OUTPUT"] = segment_OUTPUT + else: + segment_OUTPUT, pri_files = inp_pri_out(segment_start, segment_stop, [int(i) for i in PRIHIST.split()], MXHIST_PRIM, pri_files, histdir,run_name) + segment_options["inp"]["OUTPUT"] = segment_OUTPUT + segment_SECSTART, segment_SECSTOP = inp_sec_date(segment_start, segment_stop, [int(i) for i in SECHIST.split()]) + segment_options["inp"]["SECSTART"] = ' '.join(map(str, segment_SECSTART)) + segment_options["inp"]["SECSTOP"] = ' '.join(map(str, segment_SECSTOP)) + segment_SECOUT, sec_files = inp_sec_out(segment_start, segment_stop, [int(i) for i in SECHIST.split()], MXHIST_SECH, sec_files, histdir,run_name) + segment_options["inp"]["SECOUT"] = segment_SECOUT + segment_options["model"]["data"]["input_file"] = create_inp_scripts(segment_options,run_name,segment_number) + pristart_times.append(segment_options["inp"]["PRISTART"]) + pristop_times.append(segment_options["inp"]["PRISTOP"]) + if segment_number == 0: + init_inp = segment_options["model"]["data"]["input_file"] + segment_options["model"]["data"]["log_file"] = os.path.join( options["model"]["data"]["workdir"],f"{run_name}-{'{:02d}'.format(segment_number+1)}.out") + if pbs == True: + if options["simulation"]["hpc_system"] != "linux": + if segment_number == last_segment_time and engage_options != None: + interpolation_script = os.path.join(segment_options["model"]["data"]["workdir"],f'tiegcm_resolution_upscale.py') + with open(interpolation_script, "w", encoding="utf-8") as f: + f.write("import sys\n") + f.write(f"sys.path.append('{TIEGCMHOME}/tiegcmrun')\n") + f.write("import interpolation\n") + horires_coupled = engage_options["horires_coupled"] + vertres_coupled, mres_coupled, nres_grid_coupled, STEP_coupled = resolution_solver(horires_coupled,engage_options) + SOURCE_coupling = os.path.join(os.path.dirname(segment_options["model"]["data"]["workdir"]),f'{engage_options["job_name"]}_prim.nc') + input_standalone = f"{histdir}/{run_name}_prim_{'{:02d}'.format(pri_files)}.nc" + f.write(f"interpolation.interpic('{input_standalone}',{float(horires_coupled)},{float(vertres_coupled)},{float(segment_options['model']['specification']['zitop'])},'{SOURCE_coupling}')\n") + if options["simulation"]["hpc_system"] == "derecho": + interpolation_pbs = [f'conda activate {engage_options["conda_env"]}',f'python {interpolation_script}'] + elif options["simulation"]["hpc_system"] == "pleiades": + interpolation_pbs = [f'source activate {engage_options["conda_env"]}',f'python {interpolation_script}'] + segment_options["job"]["job_chain"] = interpolation_pbs + pbs_script = create_pbs_scripts(segment_options,run_name,segment_number) + if segment_number == 0: + init_pbs = pbs_script + else: + pbs_script = None + else: + pbs_script = None + inp_files.append(segment_options["model"]["data"]["input_file"]) + pbs_files.append(pbs_script) + log_files.append(segment_options["model"]["data"]["log_file"]) + return inp_files, pbs_files,log_files, pristart_times, pristop_times diff --git a/tiegcmrun/requirements.txt b/tiegcmrun/requirements.txt index ff1f5fd..1000970 100755 --- a/tiegcmrun/requirements.txt +++ b/tiegcmrun/requirements.txt @@ -1,4 +1,5 @@ numpy netCDF4 +xarray jinja2 xarray diff --git a/tiegcmrun/template.inp b/tiegcmrun/template.inp index 52ee7d1..e0f2196 100755 --- a/tiegcmrun/template.inp +++ b/tiegcmrun/template.inp @@ -125,6 +125,22 @@ JOULEFAC = {{inp.JOULEFAC}}{%- endif %} COLFAC = {{inp.COLFAC}}{%- endif %} {%- if inp.OPDIFFCAP is not none %} OPDIFFCAP = {{inp.OPDIFFCAP}}{%- endif %} +{%- if inp.OPDIFFRATE is not none %} +OPDIFFRATE = {{inp.OPDIFFRATE}}{%- endif %} +{%- if inp.OPDIFFLEV is not none %} +OPDIFFLEV = {{inp.OPDIFFLEV}}{%- endif %} +{%- if inp.OPFLOOR is not none %} +OPFLOOR = {{inp.OPFLOOR}}{%- endif %} +{%- if inp.OPRATE is not none %} +OPRATE = {{inp.OPRATE}}{%- endif %} +{%- if inp.OPLEV is not none %} +OPLEV = {{inp.OPLEV}}{%- endif %} +{%- if inp.OPLATWIDTH is not none %} +OPLATWIDTH = {{inp.OPLATWIDTH}}{%- endif %} +{%- if inp.TE_CAP is not none %} +TE_CAP = {{inp.TE_CAP}}{%- endif %} +{%- if inp.TI_CAP is not none %} +TI_CAP = {{inp.TI_CAP}}{%- endif %} {%- if inp.CURRENT_PG is not none %} CURRENT_PG = {{inp.CURRENT_PG}}{%- endif %} {%- if inp.CURRENT_KQ is not none %} diff --git a/tiegcmrun/template.pbs b/tiegcmrun/template.pbs index b804436..a4d01b4 100755 --- a/tiegcmrun/template.pbs +++ b/tiegcmrun/template.pbs @@ -12,6 +12,8 @@ # Set enviroment variables setenv TGCMDATA {{model.data.tgcmdata}} +setenv TIEGCMDATA {{model.data.tgcmdata}} +setenv TIEGCMHOME {{model.data.modeldir}} {%- for data in job.other_job %} {%- if data != None %} {{data}} @@ -31,13 +33,6 @@ cd {{model.data.execdir}} {{job.mpi_command}} -np {{job.nprocs}} {{model.data.modelexe}} {{model.data.input_file}} >&! {{model.data.log_file}} -cd {{model.data.workdir}} - -# Make tar file of task log files: -tar -cf {{model.data.log_file}}.tar *task*.out -echo "Saved stdout tar file {{model.data.log_file}}.tar" -rm *task*.out - # Job chaining {%- for data in job.job_chain %} {%- if data != None %} diff --git a/tiegcmrun/tiegcmrun.py b/tiegcmrun/tiegcmrun.py index 7ef854b..12db746 100755 --- a/tiegcmrun/tiegcmrun.py +++ b/tiegcmrun/tiegcmrun.py @@ -1,7 +1,7 @@ #!/usr/bin/env python -"""makeitso for the TIE-GCM software. +"""tiegcmrun for the TIE-GCM software. This script is performs all of the steps that are required to prepare to run a TIE-GCM simulation run. By default, this script is interactive - the user is prompted for each decision that must be made to prepare for the run, based @@ -11,7 +11,7 @@ "BENCH" - The user requests for a benchmark run for TIE-GCM -"BASIC" (the default) - the user is prompted to set only a small subset of MAGE +"BASIC" (the default) - the user is prompted to set only a small subset of TIE-GCM parameters. All "INTERMEDIATE"- and "EXPERT"-mode parameters are automatically set to default values. @@ -23,31 +23,27 @@ # Import standard modules import argparse -from argparse import ArgumentParser -import copy import datetime from datetime import datetime, timedelta import json import os -from os.path import isfile, splitext import subprocess -import sys -import shutil -import filecmp import fnmatch -from textwrap import dedent from fractions import Fraction -from math import ceil # Import 3rd-party modules -import numpy as np -from numpy import ndarray, interp, log, exp, linspace, allclose, mean -from netCDF4 import Dataset +#import numpy as np +from numpy import pad import xarray as xr from jinja2 import Template - - +# Import local modules +from compile import compile_tiegcm +from interpolation import interpic +from engage_solver import engage_parser, engage_run +from namelist_solver import inp_pri_date,valid_hist,inp_mxhist,inp_sechist,inp_prihist,inp_pri_out,inp_sec_out,inp_sec_date +from output_solver import create_inp_scripts, create_pbs_scripts, segment_inp_pbs +from misc import get_mtime, segment_time, valid_bench, find_file, resolution_solver, select_resource_defaults, select_source_defaults # Program constants RED = '\033[31m' # Red text GREEN = '\033[32m' # Green text @@ -88,649 +84,6 @@ BENCHAMRKS_FILE = os.path.join(SUPPORT_FILES_DIRECTORY, 'benchmarks.json') -def get_mtime(file_path): - """ - Get the 'mtime' data from the given file path. - - Parameters: - file_path (str): The path to the file. - - Returns: - list: A list containing the 'mtime' data, padded with zeros if necessary. - """ - ds = xr.open_dataset(file_path) - if 'mtime' in ds.variables: - mtime_data = ds['mtime'].values - mtime_arr = np.pad(mtime_data, [(0, 0), (0, max(4 - mtime_data.shape[1], 0))], mode='constant').tolist() - return mtime_arr - -def interp2d(variable, inlat, inlon, outlat, outlon): - """ - Interpolates a 2D variable from input latitude and longitude grid to output latitude and longitude grid. - - Parameters: - variable (ndarray): 2D array of the variable to be interpolated. - inlat (ndarray): 1D array of input latitudes. - inlon (ndarray): 1D array of input longitudes. - outlat (ndarray): 1D array of output latitudes. - outlon (ndarray): 1D array of output longitudes. - - Returns: - ndarray: 2D array of the interpolated variable on the output grid. - """ - - ninlat = len(inlat) - noutlon = len(outlon) - - var0 = ndarray(shape=(ninlat, noutlon)) - for ilat in range(ninlat): - var0[ilat, :] = interp(x=outlon, xp=inlon, fp=variable[ilat, :], period=360) - - var1 = ndarray(shape=(len(outlat), noutlon)) - for ilon in range(noutlon): - var1[:, ilon] = interp(x=outlat, xp=inlat, fp=var0[:, ilon]) - - return var1 - - -def interp3d(variable, inlev, inlat, inlon, outlev, outlat, outlon, extrap): - """ - Interpolates a 3-dimensional variable from one set of levels and grid points to another set of levels and grid points. - - Args: - variable (ndarray): The input variable with shape (ninlev, inlat, inlon). - inlev (ndarray): The input levels. - inlat (ndarray): The input latitudes. - inlon (ndarray): The input longitudes. - outlev (ndarray): The output levels. - outlat (ndarray): The output latitudes. - outlon (ndarray): The output longitudes. - extrap (str): The extrapolation method. Must be one of 'constant', 'linear', or 'exponential'. - - Returns: - ndarray: The interpolated variable with shape (noutlev, noutlat, noutlon). - """ - ninlev = len(inlev) - noutlev = len(outlev) - noutlat = len(outlat) - noutlon = len(outlon) - - var0 = ndarray(shape=(ninlev, noutlat, noutlon)) - for ik in range(ninlev): - var0[ik, :, :] = interp2d(variable=variable[ik, :, :], inlat=inlat, inlon=inlon, outlat=outlat, outlon=outlon) - - # Find the last index of outlev falling in the range of inlev - for lastidx in range(noutlev): - if outlev[lastidx] > inlev[-1]: - break - - # If outlev is completely embedded in inlev (interpolation only), the end point needs to be added separately - if lastidx == noutlev-1 and outlev[lastidx] <= inlev[-1]: - lastidx = noutlev - - v1 = ndarray(shape=noutlev) - var1 = ndarray(shape=(noutlev, noutlat, noutlon)) - for ilat in range(noutlat): - for ilon in range(noutlon): - v0 = var0[:, ilat, ilon] - if extrap == 'constant': - v1[0: lastidx] = interp(x=outlev[0: lastidx], xp=inlev, fp=v0) - if lastidx < noutlev: - v1[lastidx: noutlev] = v1[lastidx-1] - elif extrap == 'linear': - v1[0: lastidx] = interp(x=outlev[0: lastidx], xp=inlev, fp=v0) - k = (v0[ninlev-1] - v0[ninlev-2]) / (inlev[ninlev-1] - inlev[ninlev-2]) - if lastidx < noutlev: - v1[lastidx: noutlev] = k * (outlev[lastidx: noutlev] - inlev[ninlev-1]) + v0[ninlev-1] - elif extrap == 'exponential': - v0 = log(v0) - v1[0: lastidx] = interp(x=outlev[0: lastidx], xp=inlev, fp=v0) - k = (v0[ninlev-1] - v0[ninlev-2]) / (inlev[ninlev-1] - inlev[ninlev-2]) - if lastidx < noutlev: - v1[lastidx: noutlev] = k * (outlev[lastidx: noutlev] - inlev[ninlev-1]) + v0[ninlev-1] - v1 = exp(v1) - else: - exit('Extrapolation method must be one of constant/linear/exponential') - var1[:, ilat, ilon] = v1 - - return var1 - - -def interpic(fin, hres, vres, zitop, fout): - """ - Interpolate and create a new primary file from an old TIEGCM primary file. - - Parameters: - - fin (str): The filename of the old TIEGCM primary file. - - hres (float): The horizontal resolution for the new primary file. - - vres (float): The vertical resolution for the new primary file. - - zitop (float): The top altitude for the new primary file. - - fout (str): The filename of the new primary file to be created. - - Returns: - None - """ - # Some additional attributes for 4D fields - lower_cap = 1e-12 - fill_top = ['TN', 'UN', 'VN', 'OP', 'TI', 'TE', 'N2D', 'O2P', 'TN_NM', 'UN_NM', 'VN_NM', 'OP_NM'] - mixing_ratio = ['O2', 'O1', 'HE', 'N2D', 'N4S', 'NO', 'AR', 'O2_NM', 'O1_NM', 'HE_NM', 'N2D_NM', 'N4S_NM', 'NO_NM', 'AR_NM'] - extrap_method = {'TN': 'exponential', 'UN': 'linear', 'VN': 'linear', - 'O2': 'exponential', 'O1': 'exponential', 'HE': 'exponential', - 'OP': 'exponential', 'N2D': 'exponential', 'N4S': 'exponential', - 'NO': 'exponential', 'AR': 'exponential', 'TI': 'exponential', - 'TE': 'exponential', 'NE': 'exponential', 'OMEGA': 'linear', - 'O2P': 'constant', 'Z': 'exponential', 'POTEN': 'linear', - 'TN_NM': 'exponential', 'UN_NM': 'linear', 'VN_NM': 'linear', - 'O2_NM': 'exponential', 'O1_NM': 'exponential', 'HE_NM': 'exponential', - 'OP_NM': 'exponential', 'N2D_NM': 'exponential', 'N4S_NM': 'exponential', - 'NO_NM': 'exponential', 'AR_NM': 'exponential'} - - nlon = int(360 / hres) - lon = linspace(start=-180, stop=180-hres, num=nlon) - nlat = int(180 / hres) - lat = linspace(start=-90+hres/2, stop=90-hres/2, num=nlat) - nlev = int((zitop + 7) / vres) + 1 - ilev = linspace(start=-7, stop=zitop, num=nlev) - lev = ilev + vres/2 - - src = Dataset(filename=fin) - dst = Dataset(filename=fout, mode='w') - - print('Creating new primary file: ', fout) - - # Copy all attributes from old to new files (even though many of them are not actually used) - for name in src.ncattrs(): - setattr(dst, name, getattr(src, name)) - - for dimname, dimension in src.dimensions.items(): - if dimname == 'time': - nt = dimension.size - dst.createDimension(dimname='time') - elif dimname == 'lon': - dst.createDimension(dimname='lon', size=nlon) - elif dimname == 'lat': - dst.createDimension(dimname='lat', size=nlat) - elif dimname == 'lev': - dst.createDimension(dimname='lev', size=nlev) - elif dimname == 'ilev': - dst.createDimension(dimname='ilev', size=nlev) - elif dimname == 'mtimedim': - dst.createDimension(dimname='mtimedim', size=4) - else: - dst.createDimension(dimname=dimname, size=dimension.size) - - lon0 = src['lon'][:] - lat0 = src['lat'][:] - lev0 = src['lev'][:] - ilev0 = src['ilev'][:] - - nlon0 = len(lon0) - nlat0 = len(lat0) - nlev0 = len(lev0) - - # Bound latitudes with two poles since the change of horizontal resolutions lead to a boundary latitude shift - lat0_bnd = ndarray(shape=nlat0+2) - lat0_bnd[0] = -90 - lat0_bnd[1: nlat0+1] = lat0 - lat0_bnd[nlat0+1] = 90 - - # Longitude wrap is handled in interp2d, skip - - for varname, variable in src.variables.items(): - # Name change only - if varname == 'coupled_cmit': - varout = dst.createVariable(varname='coupled_mage', datatype=variable.datatype, dimensions=variable.dimensions) - else: - varout = dst.createVariable(varname=varname, datatype=variable.datatype, dimensions=variable.dimensions) - - for name in variable.ncattrs(): - setattr(varout, name, getattr(variable, name)) - - if varname == 'time': - varout[:] = variable[:] - elif varname == 'lon': - varout[:] = lon - elif varname == 'lat': - varout[:] = lat - elif varname == 'lev': - varout[:] = lev - elif varname == 'ilev': - varout[:] = ilev - - # The following variables never appear in standard TIEGCM runs - # But they showed up in some non-standard TIEGCM primary histories - # If that happens, skip those variables (the list may expand) - elif varname in ['lat_bnds', 'lon_bnds', 'gw', 'area']: - continue - - # Change from old format (3 digits) to new format (4 digits) - elif varname == 'mtime': - if src.dimensions['mtimedim'].size == 3: - varout[:, 0: 3] = variable[:] - varout[:, 3] = 0 - else: - varout[:] = variable[:] - - # If the old file was from a run with calc_helium==0, then set a constant for Helium in the new file (don't interpolate) - elif varname in ['HE', 'HE_NM'] and allclose(variable, 0): - varout[:] = lower_cap - - # 3D fields - elif variable.dimensions == ('time', 'lat', 'lon'): - var2d_bnd = ndarray(shape=(nlat0+2, nlon0)) - for it in range(nt): - # Set pole fields as the average of the highest latitude circle - var2d_bnd[0, :] = mean(variable[it, 0, :]) - var2d_bnd[1: nlat0+1, :] = variable[it, :, :] - var2d_bnd[nlat0+1, :] = mean(variable[it, nlat0-1, :]) - varout[it, :, :] = interp2d(variable=var2d_bnd, inlat=lat0_bnd, inlon=lon0, outlat=lat, outlon=lon) - - # 4D fields - elif len(variable.dimensions) == 4: - if not variable.dimensions in [('time', 'lev', 'lat', 'lon'), ('time', 'ilev', 'lat', 'lon')]: - exit('Invalid 4d field: '+varname) - - if variable.dimensions[1] == 'lev': - levin = lev0 - levout = lev - else: - levin = ilev0 - levout = ilev - - # If the topmost level are filling values, exclude that level - if varname in fill_top: - nlevin = nlev0 - 1 - else: - nlevin = nlev0 - - var3d_bnd = ndarray(shape=(nlevin, nlat0+2, nlon0)) - for it in range(nt): - # Set pole fields as the average of the highest latitude circle - for ik in range(nlevin): - var3d_bnd[ik, 0, :] = mean(variable[it, ik, 0, :]) - var3d_bnd[ik, 1: nlat0+1, :] = variable[it, ik, :, :] - var3d_bnd[ik, nlat0+1, :] = mean(variable[it, ik, nlat0-1, :]) - varout[it, :, :, :] = interp3d(variable=var3d_bnd, inlev=levin[0: nlevin], inlat=lat0_bnd, inlon=lon0, - outlev=levout, outlat=lat, outlon=lon, extrap=extrap_method[varname]) - - # Mixing ratio must lie within [0, 1], note that the exponential extrapolation gurantees positivity - if varname in mixing_ratio: - v = varout[:] - # In addition, major species have a lower cap - if varname in ['O2', 'O1', 'HE', 'O2_NM', 'O1_NM', 'HE_NM']: - v[v < lower_cap] = lower_cap - v[v > 1] = 1 - varout[:] = v - - else: - varout[:] = variable[:] - - # N2 needs to be extrapolated to check the validity of other major species (O2, O1, HE) - for ext in ['', '_NM']: - if 'HE'+ext in src.variables.keys(): - N2 = 1 - src['O2'+ext][:] - src['O1'+ext][:] - src['HE'+ext][:] - else: - # In case HE is not in the old file (non-standard format), it has to be added to the new file - N2 = 1 - src['O2'+ext][:] - src['O1'+ext][:] - dst.createVariable(varname='HE'+ext, datatype='f8', dimensions=('time', 'lev', 'lat', 'lon')) - dst['HE'+ext][:] = lower_cap - - N2n = ndarray(shape=(nt, nlev, nlat, nlon)) - N2_bnd = ndarray(shape=(nlev0, nlat0+2, nlon0)) - for it in range(nt): - for ik in range(nlev0): - N2_bnd[ik, 0, :] = mean(N2[it, ik, 0, :]) - N2_bnd[ik, 1: nlat0+1, :] = N2[it, ik, :, :] - N2_bnd[ik, nlat0+1, :] = mean(N2[it, ik, nlat0-1, :]) - N2n[it, :, :, :] = interp3d(variable=N2_bnd, inlev=lev0, inlat=lat0_bnd, inlon=lon0, - outlev=lev, outlat=lat, outlon=lon, extrap='exponential') - - N2n[N2n < lower_cap] = lower_cap - N2n[N2n > 1] = 1 - O2n = dst['O2'+ext][:] - O1n = dst['O1'+ext][:] - HEn = dst['HE'+ext][:] - - normalize = O2n + O1n + HEn + N2n - dst['O2'+ext][:] = O2n / normalize - dst['O1'+ext][:] = O1n / normalize - dst['HE'+ext][:] = HEn / normalize - - # New 2D variables since TIEGCM v3.0 - for varname in ['gzigm1', 'gzigm2', 'gnsrhs']: - if not varname in src.variables.keys(): - newvarout = dst.createVariable(varname=varname, datatype='f8', dimensions=('time', 'lat', 'lon')) - newvarout[:] = 0 - - src.close() - dst.close() - - - -def segment_time(start_time_str, stop_time_str, interval_array): - """ - Generate a list of time intervals between a start time and stop time based on a given interval array. - - Args: - start_time_str (str): The start time in the format '%Y-%m-%dT%H:%M:%S'. - stop_time_str (str): The stop time in the format '%Y-%m-%dT%H:%M:%S'. - interval_array (list): A list containing the interval values in the order [days, hours, minutes, seconds]. - - Returns: - list: A list of time intervals in the format [[start_time, end_time], [start_time, end_time], ...]. - """ - # Convert start_time and stop_time to datetime objects - start = datetime.strptime(start_time_str, '%Y-%m-%dT%H:%M:%S') - stop = datetime.strptime(stop_time_str, '%Y-%m-%dT%H:%M:%S') - - # Extract interval values from the array - days, hours, minutes, seconds = interval_array - - # Create a timedelta object using the interval values - delta = timedelta(days=days, hours=hours, minutes=minutes, seconds=seconds) - - # Generate the intervals - intervals = [] - current = start - while current < stop: - next_time = min(current + delta, stop) - intervals.append([current.strftime('%Y-%m-%dT%H:%M:%S'), next_time.strftime('%Y-%m-%dT%H:%M:%S')]) - current = next_time - - return intervals - - - -def inp_pri_date(start_date_str, stop_date_str): - """ - Convert start and stop date strings to datetime objects and extract relevant information. - - Args: - start_date_str (str): Start date string in the format "%Y-%m-%dT%H:%M:%S". - stop_date_str (str): Stop date string in the format "%Y-%m-%dT%H:%M:%S". - - Returns: - tuple: A tuple containing the following values: - - START_YEAR (int): The year of the start date. - - START_DAY (int): The day of the year of the start date. - - PRISTART (list): A list containing the day of the year, hour, minute, and second of the start date. - - PRISTOP (list): A list containing the day of the year, hour, minute, and second of the stop date. - """ - # Parse the start and stop dates - start_time = datetime.strptime(start_date_str, "%Y-%m-%dT%H:%M:%S") - stop_time = datetime.strptime(stop_date_str, "%Y-%m-%dT%H:%M:%S") - - # Extract START_YEAR and START_DAY - START_YEAR = start_time.year - START_DAY = start_time.timetuple().tm_yday - - # Format PRISTART and PRISTOP - PRISTART = [start_time.timetuple().tm_yday, start_time.hour, start_time.minute, start_time.second] - PRISTOP = [stop_time.timetuple().tm_yday, stop_time.hour, stop_time.minute, stop_time.second] - - return START_YEAR, START_DAY, PRISTART, PRISTOP - -def valid_hist(start_time, stop_time): - """ - Calculate valid divisions for a given time range. - - Parameters: - start_time (str): The start date in the format '%Y-%m-%dT%H:%M:%S'. - stop_time (str): The stop date in the format '%Y-%m-%dT%H:%M:%S'. - - Returns: - list: A list of valid divisions for days, hours, minutes, and seconds. - Each division is represented as a list [days, hours, minutes, seconds]. - """ - - start = datetime.strptime(start_time, '%Y-%m-%dT%H:%M:%S') - stop = datetime.strptime(stop_time, '%Y-%m-%dT%H:%M:%S') - total_duration = stop - start - total_seconds = total_duration.total_seconds() - - valid_divisions = [] - - # Calculate valid divisions for days - total_days = total_duration.days - for n_day in range(1, total_days + 1): - valid_divisions.append([n_day,0,0,0]) - - # Calculate valid divisions for hours - hours_divisions = [1, 2, 3, 4, 6, 12, 18, 24] - for n_hour in hours_divisions: - if total_seconds % (n_hour * 3600) == 0: - valid_divisions.append([0,n_hour,0,0]) - - # Calculate valid divisions for minutes - minutes_divisions = [1, 2, 5, 10, 15, 30, 45, 60] - for n_min in minutes_divisions: - if total_seconds % (n_min * 60) == 0: - valid_divisions.append([0,0,n_min,0]) - - # Calculate valid divisions for seconds - seconds_divisions = [1, 2, 5, 10, 15, 30, 45, 60] - for n_sec in seconds_divisions: - if total_seconds % n_sec == 0: - valid_divisions.append([0,0,0,n_sec]) - - return valid_divisions - -def inp_mxhist(start_time, stop_time, x_hist, mxhist_warn): - """ - Calculate the MXHIST value based on the given start and stop times, and x_hist values. - - Args: - start_time (str): The start time in the format '%Y-%m-%dT%H:%M:%S'. - stop_time (str): The stop time in the format '%Y-%m-%dT%H:%M:%S'. - x_hist (tuple): A tuple containing the number of days, hours, minutes, and seconds for x_hist. - mxhist_warn (str): A warning message for MXHIST. - - Returns: - tuple: A tuple containing the calculated MXHIST value and the updated mxhist_warn message. - - Raises: - None - - """ - start = datetime.strptime(start_time, '%Y-%m-%dT%H:%M:%S') - stop = datetime.strptime(stop_time, '%Y-%m-%dT%H:%M:%S') - total_duration = stop - start - total_seconds = total_duration.total_seconds() - - seconds_in_day = 86400 - seconds_in_hour = 3600 - seconds_in_min = 60 - - n_day, n_hour, n_min, n_sec = x_hist - step_seconds = (n_day * 86400) + (n_hour * 3600) + (n_min * 60) + n_sec - - if step_seconds == 0: - return "Invalid prihist: step cannot be 0." - - mxhist_day = seconds_in_day / step_seconds - mxhist_hour = seconds_in_hour / step_seconds - mxhist_min = seconds_in_min / step_seconds - if mxhist_day >= 1: - mxhist_warn = (mxhist_warn + "\n" if mxhist_warn is not None else "") + f"For a Daily output set MXHIST to {int(mxhist_day)}" - if mxhist_hour >= 1: - mxhist_warn = mxhist_warn + f"\nFor a Hourly output set MXHIST to {int(mxhist_hour)}" - if mxhist_min >= 1: - mxhist_warn = mxhist_warn + f"\nFor a Minutely output set MXHIST to {int(mxhist_min)}" - MXHIST = mxhist_day - return(int(MXHIST), mxhist_warn) - - -def inp_sechist(SECSTART, SECSTOP): - """ - Determines the value of SECHIST based on the given SECSTART and SECSTOP. - - Parameters: - SECSTART (list): A list containing the start day. - SECSTOP (list): A list containing the stop day. - - Returns: - list: A list containing the value of SECHIST. - - """ - PRISTART_DAY = SECSTART[0] - PRISTOP_DAY = SECSTOP[0] - n_split_day = int(PRISTOP_DAY - PRISTART_DAY) - if n_split_day >= 7: - SECHIST = [1, 0, 0, 0] - else: - SECHIST = [0, 1, 0, 0] - return SECHIST - -def inp_prihist(PRISTART, PRISTOP): - """ - Calculate the PRIHIST list based on the PRISTART and PRISTOP values. - - Parameters: - PRISTART (list): A list containing the start day of the PRIHIST period. - PRISTOP (list): A list containing the stop day of the PRIHIST period. - - Returns: - list: The PRIHIST list, which is either [1, 0, 0, 0] or [0, 1, 0, 0] based on the number of days in the PRIHIST period. - """ - PRISTART_DAY = PRISTART[0] - PRISTOP_DAY = PRISTOP[0] - n_split_day = int(PRISTOP_DAY - PRISTART_DAY) - if n_split_day >= 7: - PRIHIST = [1, 0, 0, 0] - else: - PRIHIST = [0, 1, 0, 0] - return PRIHIST - -def inp_pri_out(start_time, stop_time, PRIHIST, MXHIST_PRIM, pri_files, histdir, run_name): - """ - Generate the output file names and the total number of files based on the given parameters. - - Parameters: - start_time (str): The start time in the format '%Y-%m-%dT%H:%M:%S'. - stop_time (str): The stop time in the format '%Y-%m-%dT%H:%M:%S'. - PRIHIST (tuple): A tuple containing the number of days, hours, minutes, and seconds for PRIHIST. - MXHIST_PRIM (int): The maximum number of primary history files. - pri_files (int): The number of existing primary history files. - histdir (str): The directory where the history files are stored. - run_name (str): The name of the run. - - Returns: - tuple: A tuple containing the output file names and the updated number of primary history files. - - """ - # Convert start and stop times to datetime - start = datetime.strptime(start_time, '%Y-%m-%dT%H:%M:%S') - stop = datetime.strptime(stop_time, '%Y-%m-%dT%H:%M:%S') - - # Calculate total duration in seconds - total_seconds = (stop - start).total_seconds() - - # Convert prihist to seconds - n_day, n_hour, n_min, n_sec = PRIHIST - step_seconds = (n_day * 86400) + (n_hour * 3600) + (n_min * 60) + n_sec - - # Calculate model data per output file in seconds - data_per_file_seconds = step_seconds * int(MXHIST_PRIM) - - # Calculate the total number of files, rounding up - number_of_files = ceil(total_seconds / data_per_file_seconds) - pri_files_n = pri_files + number_of_files - if pri_files == 0: - if number_of_files == 1: - OUTPUT = OUTPUT = f"'{histdir}/{run_name}_prim_{'{:03d}'.format(pri_files)}.nc' , '{histdir}/{run_name}_prim_{'{:03d}'.format(pri_files+1)}.nc'" - else: - PRIM_0 = f"{histdir}/{run_name}_prim_{'{:03d}'.format(pri_files)}.nc" - PRIM_N = f"{histdir}/{run_name}_prim_{'{:03d}'.format(pri_files_n)}.nc" - OUTPUT = f"'{PRIM_0}','to','{PRIM_N}','by','1'" - else: - if number_of_files == 1: - OUTPUT = OUTPUT = f"'{histdir}/{run_name}_prim_{'{:03d}'.format(pri_files)}.nc' , '{histdir}/{run_name}_prim_{'{:03d}'.format(pri_files+1)}.nc'" - else: - PRIM_0 = f"{histdir}/{run_name}_prim_{'{:03d}'.format(pri_files)}.nc" - PRIM_N = f"{histdir}/{run_name}_prim_{'{:03d}'.format(pri_files_n)}.nc" - OUTPUT = f"'{PRIM_0}','to','{PRIM_N}','by','1'" - return OUTPUT, pri_files_n - -def inp_sec_out(start_time, stop_time, SECHIST, MXHIST_SECH, sec_files, histdir, run_name): - """ - Calculate the output file names and the total number of files for the secondary history output. - - Args: - start_time (str): The start time of the simulation in the format '%Y-%m-%dT%H:%M:%S'. - stop_time (str): The stop time of the simulation in the format '%Y-%m-%dT%H:%M:%S'. - SECHIST (list): A list of integers representing the duration of each secondary history output file in days, hours, minutes, and seconds. - MXHIST_SECH (int): The maximum number of secondary history output files per primary history output file. - sec_files (int): The number of existing secondary history output files. - histdir (str): The directory where the history output files are stored. - run_name (str): The name of the simulation run. - - Returns: - tuple: A tuple containing the output file name pattern and the updated number of secondary history output files. - - """ - # Convert start and stop times to datetime - start = datetime.strptime(start_time, '%Y-%m-%dT%H:%M:%S') - stop = datetime.strptime(stop_time, '%Y-%m-%dT%H:%M:%S') - sechist_delta = timedelta(days=SECHIST[0], hours=SECHIST[1], minutes=SECHIST[2], seconds=SECHIST[3]) - start = start + sechist_delta - - # Calculate total duration in seconds - total_seconds = (stop - start).total_seconds() - - # Convert prihist to seconds - n_day, n_hour, n_min, n_sec = SECHIST - step_seconds = (n_day * 86400) + (n_hour * 3600) + (n_min * 60) + n_sec - - # Calculate model data per output file in seconds - data_per_file_seconds = step_seconds * int(MXHIST_SECH) - - # Calculate the total number of files, rounding up - number_of_files = ceil(total_seconds / data_per_file_seconds) - sec_files_n = sec_files + number_of_files - - if sec_files == 0: - if number_of_files == 1: - SECOUT = f"'{histdir}/{run_name}_sech_{'{:03d}'.format(sec_files)}.nc'" - else: - SECH_0 = f"{histdir}/{run_name}_sech_{'{:03d}'.format(sec_files)}.nc" - SECH_N = f"{histdir}/{run_name}_sech_{'{:03d}'.format(sec_files_n)}.nc" - SECOUT = f"'{SECH_0}','to','{SECH_N}','by','1'" - else: - if number_of_files == 1: - SECOUT = f"'{histdir}/{run_name}_sech_{'{:03d}'.format(sec_files)}.nc'" - else: - SECH_0 = f"{histdir}/{run_name}_sech_{'{:03d}'.format(sec_files+1)}.nc" - SECH_N = f"{histdir}/{run_name}_sech_{'{:03d}'.format(sec_files_n+1)}.nc" - SECOUT = f"'{SECH_0}','to','{SECH_N}','by','1'" - return SECOUT, sec_files_n - -def inp_sec_date(start_time, stop_time, SECHIST): - """ - Calculate the SECSTART and SECSTOP values based on the given start_time, stop_time, and SECHIST. - - Parameters: - start_time (str): The start time in the format '%Y-%m-%dT%H:%M:%S'. - stop_time (str): The stop time in the format '%Y-%m-%dT%H:%M:%S'. - SECHIST (list): A list containing the number of days, hours, minutes, and seconds to be added to the start time. - - Returns: - tuple: A tuple containing the SECSTART and SECSTOP values. - - Example: - start_time = '2022-01-01T00:00:00' - stop_time = '2022-01-02T00:00:00' - SECHIST = [1, 0, 0, 0] - inp_sec_date(start_time, stop_time, SECHIST) - # Output: ([1, 0, 0, 0], [2, 0, 0, 0]) - """ - start = datetime.strptime(start_time, '%Y-%m-%dT%H:%M:%S') - stop = datetime.strptime(stop_time, '%Y-%m-%dT%H:%M:%S') - sechist_delta = timedelta(days=SECHIST[0], hours=SECHIST[1], minutes=SECHIST[2], seconds=SECHIST[3]) - start = start + sechist_delta - SECSTART = [start.timetuple().tm_yday,start.hour,start.minute,start.second] - SECSTOP = [stop.timetuple().tm_yday,stop.hour,stop.minute,stop.second] - - return SECSTART, SECSTOP def create_command_line_parser(): """Create the command-line argument parser. @@ -767,12 +120,14 @@ def create_command_line_parser(): "--mode", default=None, help="User mode (BASIC|INTERMEDIATE|EXPERT) (default: %(default)s)." ) - """ parser.add_argument( "--coupling","-co", action="store_true", help="Enable coupling (default: %(default)s)." ) - """ + parser.add_argument( + "--hidra", "-hi", action="store_true", + help="Enable HIDRA (default: %(default)s)." + ) parser.add_argument( "--options_path", "-o", default=None, help="Path to JSON file of options (default: %(default)s)" @@ -793,31 +148,13 @@ def create_command_line_parser(): "--benchmark", "-bench", default = None, type=valid_bench, help="Bechmark run name (default: %(default)s)." ) + parser.add_argument( + "--engage", default=None, + help="Path to JSON file of engage options (default: %(default)s)." + ) return parser -def valid_bench(value): - """ - Validate the benchmark option. - - Args: - value (str): The benchmark option to validate. - - Returns: - str: The validated benchmark option. - - Raises: - argparse.ArgumentTypeError: If the value is not a valid benchmark option. - """ - # Custom validation logic - if value not in [None, - 'seasons', 'decsol_smax', 'decsol_smin', 'junsol_smax', 'junsol_smin','mareqx_smax', 'mareqx_smin', 'sepeqx_smax', 'sepeqx_smin', - 'storms', 'dec2006_heelis_gpi', 'dec2006_weimer_imf', 'jul2000_heelis_gpi', 'jul2000_weimer_imf', 'nov2003_heelis_gpi', 'nov2003_weimer_imf', 'whi2008_heelis_gpi', 'whi2008_weimer_imf', - 'climatology', 'climatology_smax', 'climatology_smin' - ]: - raise argparse.ArgumentTypeError(f"{value} is not a valid benchmark option.") - return value - -def get_run_option(name, description, mode="BASIC"): +def get_run_option(name, description, mode="BASIC", skip_parameters=[]): """Prompt the user for a single run option. Prompt the user for a single run option. If no user input is provided, @@ -853,11 +190,17 @@ def get_run_option(name, description, mode="BASIC"): # Compare the current mode to the parameter level setting. If the variable # level is higher than the user mode, just use the default. fourvar_variables = ["SOURCE_START","segment","PRISTART","PRISTOP","PRIHIST","SECSTART","SECSTOP","SECHIST"] + if mode == "BENCH" and level in ["BASIC","INTERMEDIATE", "EXPERT"]: if name in fourvar_variables and default is not None: return ' '.join(map(str, default)) else: return default + if mode == "BASIC" and name in skip_parameters: + if name in fourvar_variables and default is not None: + return ' '.join(map(str, default)) + else: + return default if mode == "BASIC" and level in ["INTERMEDIATE", "EXPERT"]: if name in fourvar_variables: return ' '.join(map(str, default)) @@ -1014,15 +357,19 @@ def get_run_option(name, description, mode="BASIC"): print(f'{YELLOW}{var_description}{RESET}') continue elif option_value != None: - if os.path.exists(option_value) == False: - file_path = find_file(option_value,TIEGCMDATA) - if file_path == None: - print(f'{YELLOW} Unable to find {option_value} in {TIEGCMDATA}.\n Give path to file as an alternative.{RESET}') + if os.path.isfile(option_value) == False: + if os.path.isdir(option_value) == True: + print(f'{YELLOW} {option_value} is a directory. Please provide a file path.{RESET}') continue else: - print(f'File Found: {file_path}') - option_value = str(file_path) - ok = True + file_path = find_file(option_value,TIEGCMDATA) + if file_path == None: + print(f'{YELLOW} Unable to find {option_value} in {TIEGCMDATA}.\n Give path to file as an alternative.{RESET}') + continue + else: + print(f'File Found: {file_path}') + option_value = str(file_path) + ok = True else: option_value = str(option_value) ok = True @@ -1124,74 +471,6 @@ def get_run_option(name, description, mode="BASIC"): # Return the option as a string. return option_value - -def select_resource_defaults(options, option_descriptions): - """ - Selects the default values for the 'select', 'ncpus', and 'mpiprocs' options based on the given input options. - - Args: - options (dict): A dictionary containing the input options. - option_descriptions (dict): A dictionary containing the descriptions of the available options. - - Returns: - tuple: A tuple containing the default values for 'select', 'ncpus', and 'mpiprocs' options. - - """ - horires = options["model"]["specification"]["horires"] - hpc_platform = options["simulation"]["hpc_system"] - od = option_descriptions["job"][hpc_platform] - o = options["job"] - if hpc_platform == "derecho": - od=od["resource"] - for on in od: - if on == "select": - if float(horires) == 2.5 or float(horires) == 5: - select_default = 1 - elif float(horires) == 1.25: - select_default = 1 - elif float(horires) == 0.625: - select_default = 2 - if on == "ncpus": - if float(horires) == 2.5 or float(horires) == 5: - ncpus_default = 128 - elif float(horires) == 1.25: - ncpus_default = 128 - elif float(horires) == 0.625: - ncpus_default = 128 - if on == "mpiprocs": - if float(horires) == 2.5 or float(horires) == 5: - mpiprocs_default = 128 - elif float(horires) == 1.25: - mpiprocs_default = 128 - elif float(horires) == 0.625: - mpiprocs_default = 256 - elif hpc_platform == "pleiades": - od=od["resource"] - o=o["resource"] - if o["model"] == "bro": - max_ncpus = 24 - elif o["model"] == "has": - max_ncpus = 24 - elif o["model"] == "ivy": - max_ncpus = 18 - elif o["model"] == "san": - max_ncpus = 12 - for on in od: - if on == "select": - if float(horires) == 2.5 or float(horires) == 5: - select = 72/max_ncpus - if float(horires) == 1.25: - select = 144/max_ncpus - if float(horires) == 0.625: - select = 288/max_ncpus - select_default = int(select) - if on == "ncpus": - ncpus_default = max_ncpus - if on == "mpiprocs": - mpiprocs_default = ncpus_default - return select_default,ncpus_default,mpiprocs_default - - def prompt_user_for_run_options(args): """Prompt the user for run options. @@ -1221,9 +500,15 @@ def prompt_user_for_run_options(args): global TIEGCMHOME input_build_skip = False pbs_build_skip = False + base_skip = False + skip_parameters = [] # Save the user mode. mode = args.mode benchmark = args.benchmark + engage= args.engage + coupling = args.coupling + if engage != None: + skip_parameters = engage["skip"] if benchmark != None and mode == None: mode = "BENCH" elif mode == None: @@ -1232,6 +517,9 @@ def prompt_user_for_run_options(args): if onlycompile == True: input_build_skip = True pbs_build_skip = True + skip_parameters = ['input_file','log_file','job_name','modeldir','parentdir','tgcmdata'] + if coupling == True: + skip_parameters.append('modelexe') # Read the dictionary of option descriptions. with open(OPTION_DESCRIPTIONS_FILE, "r", encoding="utf-8") as f: option_descriptions = json.load(f) @@ -1241,22 +529,24 @@ def prompt_user_for_run_options(args): options = {} #------------------------------------------------------------------------- - - # General options for the simulation - o = options["simulation"] = {} - od = option_descriptions["simulation"] - if benchmark != None: - od["job_name"]["default"] = benchmark - system_name = os.popen('hostname').read().strip() - if 'pfe' in system_name.lower(): - od["hpc_system"]["default"]= "pleiades" - elif 'derecho' in system_name.lower(): - od["hpc_system"]["default"] = "derecho" - else: - od["hpc_system"]["default"] = "linux" - # Prompt for the parameters. - for on in ["job_name", "hpc_system"]: - o[on] = get_run_option(on, od[on], mode) + if base_skip == False: + # General options for the simulation + o = options["simulation"] = {} + od = option_descriptions["simulation"] + if benchmark != None: + od["job_name"]["default"] = benchmark + elif engage != None: + od["job_name"]["default"] = engage["job_name"] + system_name = os.popen('hostname').read().strip() + if 'pfe' in system_name.lower(): + od["hpc_system"]["default"]= "pleiades" + elif 'derecho' in system_name.lower(): + od["hpc_system"]["default"] = "derecho" + else: + od["hpc_system"]["default"] = "linux" + # Prompt for the parameters. + for on in ["job_name", "hpc_system"]: + o[on] = get_run_option(on, od[on], mode, skip_parameters) #------------------------------------------------------------------------- # Model options @@ -1270,35 +560,43 @@ def prompt_user_for_run_options(args): temp_mode = mode od = option_descriptions["model"]["data"] od["modeldir"]["default"] = TIEGCMHOME - o["modeldir"] = get_run_option("modeldir", od["modeldir"], mode) - od["parentdir"]["default"] = os.getcwd() - o["parentdir"] = get_run_option("parentdir", od["parentdir"], mode) - if o["parentdir"] == None: - temp_mode = "INTERMEDIATE" - o["execdir"] = get_run_option("execdir", od["execdir"], temp_mode) - od["workdir"]["default"] = o["execdir"] - od["histdir"]["default"] = o["execdir"] + o["modeldir"] = get_run_option("modeldir", od["modeldir"], mode, skip_parameters) + if engage != None: + od["parentdir"]["default"] = engage["parentdir"] + o["parentdir"] = get_run_option("parentdir", od["parentdir"], mode, skip_parameters) + od["execdir"]["default"] = o["parentdir"] + od["workdir"]["default"] = o["parentdir"] + od["histdir"]["default"] = o["parentdir"] + o["execdir"] = get_run_option("execdir", od["execdir"], mode, skip_parameters) else: - od["execdir"]["default"] = os.path.join(o["parentdir"],"exec") - od["workdir"]["default"] = os.path.join(o["parentdir"],"stdout") - od["histdir"]["default"] = os.path.join(o["parentdir"],"hist") - o["execdir"] = get_run_option("execdir", od["execdir"], mode) + od["parentdir"]["default"] = os.getcwd() + o["parentdir"] = get_run_option("parentdir", od["parentdir"], mode, skip_parameters) + if o["parentdir"] == None: + temp_mode = "INTERMEDIATE" + o["execdir"] = get_run_option("execdir", od["execdir"], temp_mode, skip_parameters) + od["workdir"]["default"] = o["execdir"] + od["histdir"]["default"] = o["execdir"] + else: + od["execdir"]["default"] = os.path.join(o["parentdir"],"exec") + od["workdir"]["default"] = os.path.join(o["parentdir"],"stdout") + od["histdir"]["default"] = os.path.join(o["parentdir"],"hist") + o["execdir"] = get_run_option("execdir", od["execdir"], mode, skip_parameters) - o["workdir"] = get_run_option("workdir", od["workdir"], temp_mode) - o["histdir"] = get_run_option("histdir", od["histdir"], temp_mode) + o["workdir"] = get_run_option("workdir", od["workdir"], temp_mode, skip_parameters) + o["histdir"] = get_run_option("histdir", od["histdir"], temp_mode, skip_parameters) temp_mode = mode o["utildir"] = os.path.join(o["modeldir"],'scripts') od["tgcmdata"]["default"] = TIEGCMDATA - o["tgcmdata"] = get_run_option("tgcmdata", od["tgcmdata"], mode) - - if benchmark == None: - o["input_file"] = get_run_option("input_file", od["input_file"], mode) - if o["input_file"] != None: - input_build_skip = True - else: - o["input_file"] = None + o["tgcmdata"] = get_run_option("tgcmdata", od["tgcmdata"], mode, skip_parameters) + if base_skip == False: + if benchmark == None or engage == None: + o["input_file"] = get_run_option("input_file", od["input_file"], mode, skip_parameters) + if o["input_file"] != None: + input_build_skip = True + else: + o["input_file"] = None od["log_file"]["default"] = f'{o["workdir"]}/{options["simulation"]["job_name"]}.out' - o["log_file"] = get_run_option("log_file", od["log_file"], mode) + o["log_file"] = get_run_option("log_file", od["log_file"], mode, skip_parameters) if od["make"]["default"] == None: if options["simulation"]["hpc_system"] == "derecho": @@ -1307,13 +605,22 @@ def prompt_user_for_run_options(args): od["make"]["default"] = os.path.join(options["model"]["data"]["modeldir"],'scripts/Make.intel_pf') elif options["simulation"]["hpc_system"] == "linux": od["make"]["default"] = os.path.join(options["model"]["data"]["modeldir"],'scripts/Make.intel_linux') - o["make"] = get_run_option("make", od["make"], mode) + o["make"] = get_run_option("make", od["make"], mode, skip_parameters) od["modelexe"]["default"] = os.path.join(o["execdir"],"tiegcm.exe") - o["modelexe"] = get_run_option("modelexe", od["modelexe"], mode) + o["modelexe"] = get_run_option("modelexe", od["modelexe"], mode, skip_parameters) if os.path.isfile(o["modelexe"]) == False: o["modelexe"] = os.path.join(o["execdir"],o["modelexe"]) - if args.compile == False: - print(f'{YELLOW}Unable to find {o["modelexe"]}, model must be compiled. Use --compile or -c {RESET}') + if args.compile == False and args.onlycompile == False: + print(f'{YELLOW}Unable to find {o["modelexe"]}, model must be compiled. Use --compile/-c or --onlycompile/-oc {RESET}') + if args.coupling == True: + od["coupled_modelexe"]["default"] = os.path.join(o["execdir"],"tiegcm.x") + o["coupled_modelexe"] = get_run_option("coupled_modelexe", od["coupled_modelexe"], mode, skip_parameters) + if os.path.isfile(o["coupled_modelexe"]) == False: + o["coupled_modelexe"] = os.path.join(o["execdir"],o["coupled_modelexe"]) + #o["modelexe"] = o["coupled_modelexe"] + if args.compile == False and args.onlycompile == False: + print(f'{YELLOW}Unable to find {o["coupled_modelexe"]}, model must be compiled. Use --compile/-c or --onlycompile/-oc {RESET}') + TIEGCMDATA = o["tgcmdata"] #------------------------------------ @@ -1326,24 +633,20 @@ def prompt_user_for_run_options(args): od = option_descriptions["model"]["specification"] for on in od: - if on == "mres": - if float(horires) == 2.5: - od["mres"]["default"] = 2 - elif float(horires) == 1.25: - od["mres"]["default"] = 1 - elif float(horires) == 0.625: - od["mres"]["default"] = 0.5 - o[on] = get_run_option(on, od[on], mode) + if engage != None: + od["horires"]["default"] = engage["horires"] + if on == "vertres": + od["vertres"]["default"] = vertres + elif on == "mres": + od["mres"]["default"] = mres + o[on] = get_run_option(on, od[on], mode, skip_parameters) if on =="horires": horires = float(o[on]) + vertres, mres, nres_grid, STEP = resolution_solver(horires) if o["nres_grid"] == None: - if float(o["mres"]) == 2: - o["nres_grid"] = 5 - elif float(o["mres"]) == 1: - o["nres_grid"] = 6 - elif float(o["mres"]) == 0.5: - o["nres_grid"] = 7 + o["nres_grid"] = nres_grid + if input_build_skip == True: input_build_skip = True @@ -1356,16 +659,8 @@ def prompt_user_for_run_options(args): o = options["inp"] od = option_descriptions["inp"] - - - if float(horires) == 5: - od["STEP"]["default"] = 60 - elif float(horires) == 2.5: - od["STEP"]["default"] = 30 - elif float(horires) == 1.25: - od["STEP"]["default"] = 10 - elif float(horires) == 0.625: - od["STEP"]["default"] = 5 + od["STEP"]["default"] = STEP + run_name = f"{options['simulation']['job_name']}_{options['model']['specification']['horires']}x{options['model']['specification']['vertres']}" histdir = options["model"]["data"]["histdir"] if benchmark != None: @@ -1373,7 +668,7 @@ def prompt_user_for_run_options(args): for on in od: if on in oben: if on == "SOURCE": - od[on]["default"] = find_file('*tiegcm*'+options['simulation']['job_name']+'*.nc', TIEGCMDATA) + od[on]["default"] = find_file(options['simulation']['job_name']+'.nc', TIEGCMDATA) elif on in ["OUTPUT", "SECOUT"]: temp_output = oben[on] try: @@ -1397,16 +692,23 @@ def prompt_user_for_run_options(args): od["SECFLDS"]["warning"] = "Limit SECFLDS. File libraries on pleiades are built without big file support." temp_mode = mode skip_inp = [] + segment = None start_stop_set = 0 for on in od: if start_stop_set == 0 and benchmark == None: - temp_mode = "INTERMEDIATE" + temp_mode = "BASIC" # "INTERMEDIATE" if on == "start_time" and benchmark != None: continue elif on == "stop_time" and benchmark != None: continue + elif on == "start_time" and benchmark == None: + if engage != None: + od["start_time"]["default"] = engage["start_time"] + o[on] = get_run_option(on, od[on], temp_mode, skip_parameters) elif on == "stop_time" and benchmark == None: - o[on] = get_run_option(on, od[on], temp_mode) + if engage != None: + od["stop_time"]["default"] = engage["stop_time"] + o[on] = get_run_option(on, od[on], temp_mode, skip_parameters) if o[on] != None: start_stop_set = 1 temp_mode = mode @@ -1417,14 +719,16 @@ def prompt_user_for_run_options(args): od["PRISTOP"]["default"] = PRISTOP elif on == "secondary_start_time" and benchmark == None: od["secondary_start_time"]["default"] = o["start_time"] - o[on] = get_run_option(on, od[on], temp_mode) + o[on] = get_run_option(on, od[on], temp_mode, skip_parameters) #od["SECSTART"]["default"] = o[on] elif on == "secondary_stop_time" and benchmark == None: od["secondary_stop_time"]["default"] = o["stop_time"] - o[on] = get_run_option(on, od[on], temp_mode) + o[on] = get_run_option(on, od[on], temp_mode, skip_parameters) #od["SECSTOP"]["default"] = o[on] elif on == "segment" and benchmark == None: - o[on] = get_run_option(on, od[on], temp_mode) + if engage != None: + od["segment"]["default"] = engage["segment"] + o[on] = get_run_option(on, od[on], temp_mode, skip_parameters) if o[on] != [None]: options["model"]["specification"]["segmentation"] = True segment = [int(i) for i in o[on].split()] @@ -1437,8 +741,12 @@ def prompt_user_for_run_options(args): od["MXHIST_SECH"]["warning"] = (od["MXHIST_SECH"]["warning"] + "\n" if od["MXHIST_SECH"]["warning"] is not None else "") + segment_warn_0 + "MXHIST_SECH" + segment_warn_1 od["OUTPUT"]["warning"] = (od["OUTPUT"]["warning"] + "\n" if od["OUTPUT"]["warning"] is not None else "") + "Primary Output can be ignored. Will be set on segmentation" od["SECOUT"]["warning"] = (od["SECOUT"]["warning"] + "\n" if od["SECOUT"]["warning"] is not None else "") + "Secondary Output can be ignored. Will be set on segmentation" + elif on == "solar_flux_level" and benchmark == None: + o[on] = get_run_option(on, od[on], temp_mode, skip_parameters) elif on == "SOURCE": - o[on] = get_run_option(on, od[on], temp_mode) + if benchmark == None: + od["SOURCE"]["default"] = select_source_defaults(options, option_descriptions) + o[on] = get_run_option(on, od[on], temp_mode, skip_parameters) if o[on] == None: o[on] = get_run_option(on, od[on], "BASIC") elif on == "SOURCE_START": @@ -1450,40 +758,40 @@ def prompt_user_for_run_options(args): od["SOURCE_START"]["default"] = od["SOURCE_START"]["valids"][0] o[on] = get_run_option(on, od[on], temp_mode_1) elif on == "PRIHIST" and benchmark== None: - PRIHIST = inp_prihist(PRISTART,PRISTOP) + PRIHIST = inp_prihist(PRISTART,PRISTOP, segment) od["PRIHIST"]["default"] = PRIHIST - o[on] = get_run_option(on, od[on], temp_mode) + o[on] = get_run_option(on, od[on], temp_mode, skip_parameters) PRIHIST = [int(i) for i in o[on].split()] - MXHIST_PRIM_set ,MXHIST_PRIM_warning_set = inp_mxhist(o["start_time"], o["stop_time"], PRIHIST, od["MXHIST_PRIM"]["warning"]) + MXHIST_PRIM_set ,MXHIST_PRIM_warning_set = inp_mxhist(o["start_time"], o["stop_time"], PRIHIST, od["MXHIST_PRIM"]["warning"], segment) od["MXHIST_PRIM"]["default"] = MXHIST_PRIM_set od["MXHIST_PRIM"]["warning"] = MXHIST_PRIM_warning_set elif on == "MXHIST_PRIM" and benchmark== None: - o[on] = get_run_option(on, od[on], temp_mode) + o[on] = get_run_option(on, od[on], temp_mode, skip_parameters) MXHIST_PRIM = int(o[on]) elif on == "OUTPUT" and benchmark== None: OUTPUT, pri_files_n = inp_pri_out(o["start_time"], o["stop_time"], PRIHIST, MXHIST_PRIM, 0, histdir,run_name) od["OUTPUT"]["default"] = OUTPUT - o[on] = get_run_option(on, od[on], temp_mode) + o[on] = get_run_option(on, od[on], temp_mode, skip_parameters) elif on == "SECHIST" and benchmark== None: - SECHIST = inp_sechist(PRISTART,PRISTOP) + SECHIST = inp_sechist(PRISTART,PRISTOP, segment) od["SECHIST"]["default"] = SECHIST - o[on] = get_run_option(on, od[on], temp_mode) + o[on] = get_run_option(on, od[on], temp_mode, skip_parameters) SECHIST = [int(i) for i in o[on].split()] - MXHIST_SECH_set ,MXHIST_SECH_warning_set = inp_mxhist(o["start_time"], o["stop_time"], SECHIST, od["MXHIST_SECH"]["warning"]) + MXHIST_SECH_set ,MXHIST_SECH_warning_set = inp_mxhist(o["start_time"], o["stop_time"], SECHIST, od["MXHIST_SECH"]["warning"],segment) od["MXHIST_SECH"]["default"] = MXHIST_SECH_set od["MXHIST_SECH"]["warning"] = MXHIST_SECH_warning_set SECSTART, SECSTOP = inp_sec_date(o["secondary_start_time"], o["secondary_stop_time"], SECHIST) od["SECSTART"]["default"] = SECSTART od["SECSTOP"]["default"] = SECSTOP elif on == "MXHIST_SECH" and benchmark== None: - o[on] = get_run_option(on, od[on], temp_mode) + o[on] = get_run_option(on, od[on], temp_mode, skip_parameters) MXHIST_SECH = int(o[on]) elif on == "SECOUT" and benchmark== None: SECOUT, sec_files_n = inp_sec_out(o["secondary_start_time"], o["secondary_stop_time"], SECHIST, MXHIST_SECH, 0, histdir,run_name) od["SECOUT"]["default"] = SECOUT - o[on] = get_run_option(on, od[on], temp_mode) + o[on] = get_run_option(on, od[on], temp_mode, skip_parameters) elif on == "POTENTIAL_MODEL": - o[on] = get_run_option(on, od[on], temp_mode) + o[on] = get_run_option(on, od[on], temp_mode, skip_parameters) if o[on] == "HEELIS": skip_inp_temp = ["IMF_NCFILE","BXIMF","BYIMF","BZIMF","SWDEN","SWVEL"] for item in skip_inp_temp: @@ -1495,9 +803,11 @@ def prompt_user_for_run_options(args): if item not in skip_inp: skip_inp.append(item) elif on == "ONEWAY": - o[on] = get_run_option(on, od[on], temp_mode) + o[on] = get_run_option(on, od[on], temp_mode, skip_parameters) elif on == "GPI_NCFILE" and on not in skip_inp: - o[on] = get_run_option(on, od[on], temp_mode) + if engage != None: + od["GPI_NCFILE"]["default"] = find_file('gpi_*', TIEGCMDATA) + o[on] = get_run_option(on, od[on], temp_mode, skip_parameters) if o[on] != None: skip_inp_temp = ["KP","POWER","CTPOTEN","F107","F107A"] for item in skip_inp_temp: @@ -1506,14 +816,14 @@ def prompt_user_for_run_options(args): od["F107"]["warning"] = "F10.7 can be read by GPI File and can be skipped." od["F107A"]["warning"] = "81-Day Average of F10.7 can be read by GPI File and can be skipped." elif on == "IMF_NCFILE" and on not in skip_inp: - o[on] = get_run_option(on, od[on], temp_mode) + o[on] = get_run_option(on, od[on], temp_mode, skip_parameters) if o[on] != None: skip_inp_temp = ["BXIMF","BYIMF","BZIMF","SWDEN","SWVEL"] for item in skip_inp_temp: if item not in skip_inp: skip_inp.append(item) elif on == "KP" and on not in skip_inp: - o[on] = get_run_option(on, od[on], temp_mode) + o[on] = get_run_option(on, od[on], temp_mode, skip_parameters) if o[on] != None: skip_inp_temp = ["POWER","CTPOTEN"] for item in skip_inp_temp: @@ -1522,25 +832,25 @@ def prompt_user_for_run_options(args): elif on == "GSWM_MI_DI_NCFILE": GSWM_MI_DI_NCFILE = find_file(f'*gswm_diurn_{horires}d_99km*', TIEGCMDATA) od[on]["default"] = f"{GSWM_MI_DI_NCFILE}" if GSWM_MI_DI_NCFILE is not None else None - o[on] = get_run_option(on, od[on], temp_mode) + o[on] = get_run_option(on, od[on], temp_mode, skip_parameters) elif on == "GSWM_MI_SDI_NCFILE": GSWM_MI_SDI_NCFILE = find_file(f'*gswm_semi_{horires}d_99km*', TIEGCMDATA) od[on]["default"] = f"{GSWM_MI_SDI_NCFILE}" if GSWM_MI_SDI_NCFILE is not None else None - o[on] = get_run_option(on, od[on], temp_mode) + o[on] = get_run_option(on, od[on], temp_mode, skip_parameters) elif on == "GSWM_NM_DI_NCFILE": GSWM_NM_DI_NCFILE = find_file(f'*gswm_nonmig_diurn_{horires}d_99km*', TIEGCMDATA) od[on]["default"] = f"{GSWM_NM_DI_NCFILE}" if GSWM_NM_DI_NCFILE is not None else None - o[on] = get_run_option(on, od[on], temp_mode) + o[on] = get_run_option(on, od[on], temp_mode, skip_parameters) elif on == "GSWM_NM_SDI_NCFILE": GSWM_NM_SDI_NCFILE = find_file(f'*gswm_nonmig_semi_{horires}d_99km*', TIEGCMDATA) od[on]["default"] = f"{GSWM_NM_SDI_NCFILE}" if GSWM_NM_SDI_NCFILE is not None else None - o[on] = get_run_option(on, od[on], temp_mode) + o[on] = get_run_option(on, od[on], temp_mode, skip_parameters) elif on == "HE_COEFS_NCFILE": HE_COEFS_NCFILE = f"{find_file(f'*he_coefs_dres*', TIEGCMDATA)}" od[on]["default"] = f"{HE_COEFS_NCFILE}" if HE_COEFS_NCFILE is not None else None - o[on] = get_run_option(on, od[on], temp_mode) + o[on] = get_run_option(on, od[on], temp_mode, skip_parameters) elif on not in skip_inp: - o[on] = get_run_option(on, od[on], temp_mode) + o[on] = get_run_option(on, od[on], temp_mode, skip_parameters) elif on in skip_inp: o[on] = od[on]["default"] @@ -1558,15 +868,24 @@ def prompt_user_for_run_options(args): od = option_descriptions["job"]["_common"] od["account_name"]["default"] = os.getlogin() for on in od: - o[on] = get_run_option(on, od[on], mode) + if engage != None: + od['account_name']['default'] = engage['account_name'] + o[on] = get_run_option(on, od[on], mode, skip_parameters) # HPC platform-specific options hpc_platform = options["simulation"]["hpc_system"] od = option_descriptions["job"][hpc_platform] if hpc_platform == "derecho": o["mpi_command"] = "mpirun" + if engage != None: + od['queue']['default'] = engage['queue'] + od['job_priority']['default'] = engage['job_priority'] + od['walltime']['default'] = engage['walltime'] elif hpc_platform == "pleiades": o["mpi_command"] = "mpiexec_mpt" + if engage != None: + od['queue']['default'] = engage['queue'] + od['walltime']['default'] = engage['walltime'] for on in od: if on == "resource": options["job"]["resource"] = {} @@ -1580,367 +899,74 @@ def prompt_user_for_run_options(args): odt["mpiprocs"]["default"] = mpiprocs_default elif hpc_platform == "pleiades": if ont == "model": - ot[ont] = get_run_option(ont, odt[ont], mode) + ot[ont] = get_run_option(ont, odt[ont], mode, skip_parameters) select_default,ncpus_default,mpiprocs_default = select_resource_defaults(options,option_descriptions) odt["select"]["default"] = select_default odt["ncpus"]["default"] = ncpus_default odt["mpiprocs"]["default"] = mpiprocs_default if ont == "select": - ot[ont] = get_run_option(ont, odt[ont], mode) + ot[ont] = get_run_option(ont, odt[ont], mode, skip_parameters) nnodes = ot[ont] elif ont == "ncpus": - ot[ont] = get_run_option(ont, odt[ont], mode) + ot[ont] = get_run_option(ont, odt[ont], mode, skip_parameters) ncpus = ot[ont] elif ont == "mpiprocs": - ot[ont] = get_run_option(ont, odt[ont], mode) + ot[ont] = get_run_option(ont, odt[ont], mode, skip_parameters) mpiprocs = ot[ont] else: - ot[ont] = get_run_option(ont, odt[ont], mode) + ot[ont] = get_run_option(ont, odt[ont], mode, skip_parameters) elif on =="nprocs": - od[on]["default"] = int(mpiprocs) #int(nnodes) * int(mpiprocs) - o[on] = get_run_option(on, od[on], mode) + od[on]["default"] = int(nnodes) * int(mpiprocs) #int(mpiprocs) + o[on] = get_run_option(on, od[on], mode, skip_parameters) elif on == "module_list": - o[on] = get_run_option(on, od[on], mode) + o[on] = get_run_option(on, od[on], mode, skip_parameters) if o[on] != None: skip_pbs.append("modules") + elif on == "modules" and on not in skip_pbs: + if engage != None: + od[on]["default"] = engage["modules"] + o[on] = get_run_option(on, od[on], mode, skip_parameters) + elif on == "project_code": + if engage != None: + od[on]["default"] = engage["project_code"] + o[on] = get_run_option(on, od[on], mode, skip_parameters) elif on not in skip_pbs: - o[on] = get_run_option(on, od[on], mode) + o[on] = get_run_option(on, od[on], mode, skip_parameters) # Return the options dictionary. return options -def compile_tiegcm(options, debug, coupling): - """ - Compiles the TIEGCM model with the given options. - - Args: - options (dict): A dictionary containing the model options. - debug (bool): A boolean indicating whether to enable debug mode. - coupling (bool): A boolean indicating whether to enable coupling. - - Returns:None - """ - o = options - modeldir = o["model"]["data"]["modeldir"] - execdir = o["model"]["data"]["execdir"] - workdir = o["model"]["data"]["workdir"] - outdir = o["model"]["data"]["histdir"] - tgcmdata = o["model"]["data"]["tgcmdata"] - utildir = os.path.join(o["model"]["data"]["modeldir"],"scripts") - try: - input = o["model"]["data"]["input_file"] - except: - input = "" - try: - output = o["model"]["data"]["log_file"] - except: - output = "" - horires = float(o["model"]["specification"]["horires"]) - vertres = float(o["model"]["specification"]["vertres"]) - zitop = float(o["model"]["specification"]["zitop"]) - mres = float(o["model"]["specification"]["mres"]) - nres_grid = float(o["model"]["specification"]["nres_grid"]) - make = o["model"]["data"]["make"] - coupling = coupling - modelexe = os.path.basename(o["model"]["data"]["modelexe"]) - model = o["model"]["data"]["modelexe"] - try: - os.makedirs(workdir) - except: - print(f"{workdir} exitsts") - try: - os.makedirs(outdir) - except: - print(f"{outdir} exitsts") - try: - os.makedirs(execdir) - except: - print(f"{execdir} exitsts") - os.chdir(workdir) - - if not os.path.isdir(modeldir): - print(f">>> Cannot find model directory {modeldir} <<<") - sys.exit(1) - - if not os.path.isdir(utildir): - print(f">>> Cannot find model directory {utildir} <<<") - sys.exit(1) - - # Set srcdir based on modeldir - srcdir = os.path.join(modeldir, 'src') - - # Check if srcdir exists - if not os.path.isdir(srcdir): - print(f">>> Cannot find model source directory {srcdir} <<<") - sys.exit(1) - - # Convert srcdir to an absolute path - srcdir = os.path.abspath(srcdir) - - if tgcmdata == "None": - tgcmdata = os.environ['TGCMDATA'] - print(f"Set tgcmdata = {tgcmdata}") - - if not os.path.isdir(tgcmdata): - print(f">>> Cannot find data directory {tgcmdata}") - - # Check horizontal resolution - if horires not in [5, 2.5, 1.25, 0.625]: - print(f">>> Unknown model horizontal resolution {horires} <<<") - sys.exit(1) - - # Check vertical resolution - if vertres not in [0.5, 0.25, 0.125, 0.0625]: - print(f">>> Unknown model vertical resolution {vertres} <<<") - sys.exit(1) - - if nres_grid == "None" or nres_grid == None: - if mres == 2: - nres_grid = 5 - elif mres == 1: - nres_grid = 6 - elif mres == 0.5: - nres_grid = 7 - else: - print(f">>> Unsupported magnetic resolution {mres} <<<") - sys.exit(1) - - # Copy make if it does not exist in execdir - if not os.path.isfile(os.path.join(execdir, os.path.basename(make))): - shutil.copy(os.path.join(utildir, os.path.basename(make)), execdir) - # Copy Makefile if it does not exist in execdir - if not os.path.isfile(os.path.join(execdir, 'Makefile')): - shutil.copy(os.path.join(utildir, 'Makefile'), execdir) - - # Copy mkdepends if it does not exist in execdir - if not os.path.isfile(os.path.join(execdir, 'mkdepends')): - shutil.copy(os.path.join(utildir, 'mkdepends'), execdir) - - """ - if not os.path.isfile(input): - print(f">>> Cannot find namelist input file {input} <<<") - sys.exit(1) - """ - - if input == '' or output == '': - input = os.path.abspath(input) - output = os.path.abspath(output) - - util = os.path.abspath(utildir) - - - coupling_file_path = os.path.join(execdir, 'coupling') - - # Check if the coupling file exists - if os.path.isfile(coupling_file_path): - with open(coupling_file_path, 'r') as file: - lastcoupling = file.read().strip().lower() == 'true' - - # Compare coupling values - if lastcoupling != coupling: - print(f"Clean execdir {execdir} because coupling flag switched from {lastcoupling} to {coupling}") - mycwd = os.getcwd() - os.chdir(execdir) - subprocess.run(['gmake', 'clean']) - os.chdir(mycwd) - with open(coupling_file_path, 'w') as file: - file.write(str(coupling)) - else: - # Create the coupling file and write the coupling value - with open(coupling_file_path, 'w') as file: - file.write(str(coupling)) - print(f"Created file coupling with coupling flag = {coupling}") - - - debug_file_path = os.path.join(execdir, 'debug') - - # Check if the debug file exists - if os.path.isfile(debug_file_path): - with open(debug_file_path, 'r') as file: - lastdebug = file.read().strip().lower() == 'true' - - # Compare debug values - if lastdebug != debug: - print(f"Clean execdir {execdir} because debug flag switched from {lastdebug} to {debug}") - mycwd = os.getcwd() - os.chdir(execdir) - subprocess.run(['gmake', 'clean']) - os.chdir(mycwd) - - with open(debug_file_path, 'w') as file: - file.write(str(debug)) - else: - # Create the debug file and write the debug value - with open(debug_file_path, 'w') as file: - file.write(str(debug)) - print(f"Created file debug with debug flag = {debug}") - - - # Create the defs.h content - defs_content = dedent(f"""\ - #define DLAT {horires} - #define DLON {horires} - #define GLON1 -180 - #define DLEV {vertres} - #define ZIBOT -7 - #define ZITOP {zitop} - #define NRES_GRID {nres_grid} - """) - - # Write to defs.h - defs_path = 'defs.h' - with open(defs_path, 'w') as file: - file.write(defs_content) - - # Check if defs.h exists in execdir and compare - execdir_defs_path = os.path.join(execdir, 'defs.h') - if os.path.isfile(execdir_defs_path): - if not filecmp.cmp(defs_path, execdir_defs_path, shallow=False): - # Files differ, switch resolutions - print(f"Switching defs.h for model resolution {horires} x {vertres}") - mycwd = os.getcwd() - os.chdir(execdir) - subprocess.run(['gmake', 'clean']) - os.chdir(mycwd) - shutil.copy(defs_path, execdir_defs_path) - else: - print(f"defs.h already set for model resolution {horires} x {vertres}") - else: - # defs.h does not exist in execdir, copy the file - print(f"Copying {defs_path} to {execdir_defs_path} for resolution {horires} x {vertres}") - shutil.copy(defs_path, execdir_defs_path) - - - try: - os.chdir(execdir) - print(f"\nBegin building {model} in {os.getcwd()}") - except OSError: - print(f">>> Cannot cd to execdir {execdir}") - sys.exit(1) - - - - # Create Make.env file - make_env_path = os.path.join(execdir, 'Make.env') - with open(make_env_path, 'w') as file: - file.write(f"""MAKE_MACHINE = {make} - DIRS = . {srcdir} - EXECNAME = {model} - NAMELIST = {input} - OUTPUT = {output} - COUPLING = {coupling} - DEBUG = {debug} - """) - - # Build the model - try: - subprocess.run(['gmake', '-j8', 'all'], check=True) - shutil.copy(model, workdir) - print(f"Executable copied from {model} to {workdir}") - except subprocess.CalledProcessError: - print(">>> Error return from gmake all") - sys.exit(1) - -def create_pbs_scripts(options, run_name, segment_number): - """ - Create PBS scripts for running TIEGCM model. - - Args: - options (dict): A dictionary containing the model options. - run_name (str): The name of the run. - segment_number (int or None): The segment number of the run. If None, a single PBS script is created. - - Returns: - str: The filepath of the created PBS script. - - Raises: - FileNotFoundError: If the PBS template file is not found. - - """ - global PBS_TEMPLATE - if PBS_TEMPLATE == None: - PBS_TEMPLATE = os.path.join(options["model"]["data"]["modeldir"], 'tiegcmrun/template.pbs') - with open(PBS_TEMPLATE, "r", encoding="utf-8") as f: - template_content = f.read() - template = Template(template_content) - opt = copy.deepcopy(options) - pbs_content = template.render(opt) - workdir = opt["model"]["data"]["workdir"] - if segment_number == None: - pbs_script = os.path.join(workdir, f"{run_name}.pbs") - else: - pbs_script = os.path.join(workdir, f"{run_name}_{'{:03d}'.format(segment_number)}.pbs") - with open(pbs_script, "w", encoding="utf-8") as f: - f.write(pbs_content) - return pbs_script - -def create_inp_scripts(options, run_name, segment_number): - """ - Create input scripts for running the TIEGCM model. - - Args: - options (dict): A dictionary containing the model options. - run_name (str): The name of the run. - segment_number (int): The segment number. - - Returns: - str: The path to the created input script. - """ - global INP_TEMPLATE - if INP_TEMPLATE == None: - INP_TEMPLATE = os.path.join(options["model"]["data"]["modeldir"],'tiegcmrun/template.inp') - with open(INP_TEMPLATE, "r", encoding="utf-8") as f: - template_content = f.read() - template = Template(template_content) - opt = copy.deepcopy(options) - inp_content = template.render(opt) - workdir = opt["model"]["data"]["workdir"] - if segment_number == None: - inp_script = os.path.join(workdir,f"{run_name}.inp") - else: - inp_script = os.path.join(workdir,f"{run_name}_{'{:03d}'.format(segment_number)}.inp") - if not os.path.exists(workdir): - os.makedirs(workdir) - with open(inp_script, "w", encoding="utf-8") as f: - f.write(inp_content) - return inp_script - -def find_file(pattern, path): - """ - Find a file in the specified path that matches the given pattern. Assumes only one match. - - :param pattern: Pattern to look for in the file names. - :param path: Path of the directory to search in. - :return: File path if a match is found, else None. - """ - for root, dirs, files in os.walk(path): # Recursively go through all directories and subdirectories - for name in files: - if fnmatch.fnmatch(name, pattern): # Check if file name matches the pattern - return os.path.join(root, name) # If so, return the file path immediately - return None - - - -def main(): +def tiegcmrun(args=None): # Set up the command-line parser. parser = create_command_line_parser() - args = parser.parse_args() - if args.debug: - print(f"args = {args}") + if args is not None: + args = parser.parse_args(args) + else: + args = parser.parse_args() clobber = args.clobber debug = args.debug options_path = args.options_path verbose = args.verbose - coupling = False#args.coupling + coupling = args.coupling + hidra = args.hidra compile = args.compile + onlycompile = args.onlycompile execute = args.execute benchmark = args.benchmark - mode = args.mode + engage = args.engage + if args.engage != None: + args.engage = engage_parser(json.loads(engage)) + mode = args.mode # Fetch the run options. if benchmark != None and mode == None: mode = "BENCH" elif mode == None: mode = "BASIC" + if compile == True or onlycompile == True: + compile_flag = True + elif compile == False and onlycompile == False: + compile_flag = False + submit_all_jobs_script = '' print("\n") print("Instructions:") print(f"-> Default Selected input parameter is given in {GREEN}GREEN{RESET}") @@ -1953,10 +979,13 @@ def main(): if benchmark != None: print(f"Benchmark = {benchmark}") print(f"User Mode = {mode}") - print(f"Compile = {compile}") + print(f"Compile = {compile_flag}") print(f"Execute = {execute}") - #print(f"Coupling = {coupling}") + print(f"Coupling = {coupling}") + if args.engage != None: + print(f"Engage = True") print(f"\n") + if options_path: # Read the run options from a JSON file. with open(options_path, "r", encoding="utf-8") as f: @@ -1968,7 +997,6 @@ def main(): print(f"options = {options}") # Move to the run directory. - #os.chdir(options["job"]["run_directory"]) run_name = f"{options['simulation']['job_name']}_{options['model']['specification']['horires']}x{options['model']['specification']['vertres']}" execdir = options["model"]["data"]["execdir"] workdir = options["model"]["data"]["workdir"] @@ -1986,33 +1014,34 @@ def main(): except: print(f"{execdir} exitsts") # Save the options dictionary as a JSON file in the current directory. - path = f"{workdir}/{run_name}.json" + json_path = f"{workdir}/{run_name}.json" tiegcmdata = options["model"]["data"]["tgcmdata"] horires = options["model"]["specification"]["horires"] vertres = options["model"]["specification"]["vertres"] zitop = options["model"]["specification"]["zitop"] + if options.get("inp") == None: input_file_generatred = True else: input_file_generatred = False + print(input_file_generatred) if args.onlycompile == True: - compile_tiegcm(options, debug, coupling) + compile_tiegcm(options, debug, coupling, hidra) + elif args.engage != None: + options_coupling,standalone_pbs_files,coupling_inp_files = engage_run(options, debug, coupling, args.engage) + return (options_coupling,standalone_pbs_files,coupling_inp_files) else: + if args.compile == True: + compile_tiegcm(options, debug, coupling, hidra) if options["model"]["specification"]["segmentation"] == False: if options["model"]["data"]["input_file"] == None or not os.path.isfile(options["model"]["data"]["input_file"]): if input_file_generatred == False: if not os.path.isfile(f'{options["model"]["data"]["workdir"]}/{run_name}_prim.nc'): - if args.benchmark == None: - in_prim = options["inp"]["SOURCE"] - out_prim = f'{options["model"]["data"]["workdir"]}/{run_name}_prim.nc' - options["inp"]["SOURCE"] = out_prim - interpic (in_prim,float(horires),float(vertres),float(zitop),out_prim) - else: - in_prim = options["inp"]["SOURCE"] - out_prim = f'{options["model"]["data"]["workdir"]}/{run_name}_prim.nc' - options["inp"]["SOURCE"] = out_prim - interpic (in_prim,float(horires),float(vertres),float(zitop),out_prim) + in_prim = options["inp"]["SOURCE"] + out_prim = f'{options["model"]["data"]["workdir"]}/{run_name}_prim.nc' + options["inp"]["SOURCE"] = out_prim + interpic (in_prim,float(horires),float(vertres),float(zitop),out_prim) else: out_prim = f'{options["model"]["data"]["workdir"]}/{run_name}_prim.nc' options["inp"]["SOURCE"] = out_prim @@ -2021,135 +1050,82 @@ def main(): if options["model"]["data"]["log_file"] == None: options["model"]["data"]["log_file"] = os.path.join( options["model"]["data"]["workdir"], f"{run_name}.out") - if os.path.exists(path): + if os.path.exists(json_path): if not clobber: - raise FileExistsError(f"Options file {path} exists!") - with open(path, "w", encoding="utf-8") as f: + raise FileExistsError(f"Options file {json_path} exists!") + with open(json_path, "w", encoding="utf-8") as f: json.dump(options, f, indent=JSON_INDENT) - if args.compile == True: - compile_tiegcm(options, debug, coupling) - if options["simulation"]["hpc_system"] != "linux": pbs_script = create_pbs_scripts(options,run_name,None) - if args.execute == True and options["simulation"]["hpc_system"] != "linux": - if args.compile == False: - if find_file(options["model"]["data"]["modelexe"], execdir) == None and os.path.exists(options["model"]["data"]["modelexe"]) == False : - print(f'{RED}Unable to find executable in {execdir}{RESET}') - exit(1) - try: - result = subprocess.run(['qsub', pbs_script], check=True, stdout=subprocess.PIPE, stderr=subprocess.PIPE, text=True) - job_id = result.stdout.strip() - print(f'Job submitted successfully. Job ID: {job_id}') - except subprocess.CalledProcessError as e: - print(f'{YELLOW}Error submitting job: {e.stderr}{RESET}') - print(f"{YELLOW}Check PBS script for erros{RESET}") - print(f"To submit job use command {YELLOW}qsub {pbs_script}{RESET}") - elif options["simulation"]["hpc_system"] != "linux": - print(f"{YELLOW}Execute is set to false{RESET}") - print(f"{YELLOW}To submit job use command{RESET} qsub {pbs_script}") - else: - print(f"{YELLOW}HPC System is set to linux{RESET}") - print(f"{YELLOW}To run the model use command{RESET} mpirun {options['model']['data']['modelexe']} {options['model']['data']['input_file']}") else: if not os.path.isfile(f'{options["model"]["data"]["workdir"]}/{run_name}_prim.nc'): - if args.benchmark == None: - in_prim = options["inp"]["SOURCE"] - out_prim = f'{options["model"]["data"]["workdir"]}/{run_name}_prim.nc' - options["inp"]["SOURCE"] = out_prim - interpic (in_prim,float(horires),float(vertres),float(zitop),out_prim) - else: - in_prim = options["inp"]["SOURCE"] - out_prim = f'{options["model"]["data"]["workdir"]}/{run_name}_prim.nc' - options["inp"]["SOURCE"] = out_prim - interpic (in_prim,float(horires),float(vertres),float(zitop),out_prim) + in_prim = options["inp"]["SOURCE"] + out_prim = f'{options["model"]["data"]["workdir"]}/{run_name}_prim.nc' + options["inp"]["SOURCE"] = out_prim + interpic (in_prim,float(horires),float(vertres),float(zitop),out_prim) else: out_prim = f'{options["model"]["data"]["workdir"]}/{run_name}_prim.nc' options["inp"]["SOURCE"] = out_prim print(f'{options["model"]["data"]["workdir"]}/{run_name}_prim.nc exists') - segment_times = segment_time(options["inp"]["start_time"], options["inp"]["stop_time"], [int(i) for i in options["inp"]["segment"].split()]) - #segment_number = 0 - pri_files = 0 - sec_files = 0 - og_options = copy.deepcopy(options) - PRIHIST = og_options["inp"]["PRIHIST"] - MXHIST_PRIM = og_options["inp"]["MXHIST_PRIM"] - SECHIST = og_options["inp"]["SECHIST"] - MXHIST_SECH = og_options["inp"]["MXHIST_SECH"] - histdir = og_options["model"]["data"]["histdir"] - job_name = og_options["simulation"]["job_name"] - with open(path, "w", encoding="utf-8") as f: - json.dump(options, f, indent=JSON_INDENT) - for segment_number, segment in enumerate(segment_times): - segment_options = copy.deepcopy(og_options) - segment_start = segment[0] - segment_stop = segment[1] - segment_options["simulation"]["job_name"] = job_name+"{:03d}".format(segment_number) - if segment_number == 0: - segment_options["inp"]["SOURCE"] = og_options["inp"]["SOURCE"] - segment_options["inp"]["SOURCE_START"] = og_options["inp"]["SOURCE_START"] - segment_START_YEAR, segment_START_DAY, segment_PRISTART, segment_PRISTOP = inp_pri_date(segment_start,segment_stop) - segment_options["inp"]["START_YEAR"] = segment_START_YEAR - segment_options["inp"]["START_DAY"] = segment_START_DAY - segment_options["inp"]["PRISTART"] = ' '.join(map(str, segment_PRISTART)) - segment_options["inp"]["PRISTOP"] = ' '.join(map(str, segment_PRISTOP)) - segment_OUTPUT, pri_files = inp_pri_out(segment_start, segment_stop, [int(i) for i in PRIHIST.split()], MXHIST_PRIM, pri_files, histdir,run_name) - print(segment_OUTPUT) - segment_options["inp"]["OUTPUT"] = segment_OUTPUT - - - else: - segment_options["inp"]["SOURCE"] = None - segment_options["inp"]["SOURCE_START"] = None - segment_START_YEAR, segment_START_DAY, segment_PRISTART, segment_PRISTOP = inp_pri_date(segment_start,segment_stop) - segment_options["inp"]["START_YEAR"] = segment_START_YEAR - segment_options["inp"]["START_DAY"] = segment_START_DAY - segment_options["inp"]["PRISTART"] = ' '.join(map(str, segment_PRISTART)) - segment_options["inp"]["PRISTOP"] = ' '.join(map(str, segment_PRISTOP)) - segment_OUTPUT, pri_files = inp_pri_out(segment_start, segment_stop, [int(i) for i in PRIHIST.split()], MXHIST_PRIM, pri_files, histdir,run_name) - segment_options["inp"]["OUTPUT"] = segment_OUTPUT - segment_SECSTART, segment_SECSTOP = inp_sec_date(segment_start, segment_stop, [int(i) for i in SECHIST.split()]) - segment_options["inp"]["SECSTART"] = ' '.join(map(str, segment_SECSTART)) - segment_options["inp"]["SECSTOP"] = ' '.join(map(str, segment_SECSTOP)) - segment_SECOUT, sec_files = inp_sec_out(segment_start, segment_stop, [int(i) for i in SECHIST.split()], MXHIST_SECH, sec_files, histdir,run_name) - segment_options["inp"]["SECOUT"] = segment_SECOUT - segment_options["model"]["data"]["input_file"] = create_inp_scripts(segment_options,run_name,segment_number) - if segment_number == 0: - init_inp = segment_options["model"]["data"]["input_file"] - segment_options["model"]["data"]["log_file"] = os.path.join( options["model"]["data"]["workdir"],f"{run_name}_{'{:03d}'.format(segment_number)}.out") - if options["simulation"]["hpc_system"] != "linux": - if segment_number != len(segment_times) - 1: - next_pbs = os.path.join(workdir,f"{run_name}_{'{:03d}'.format(segment_number+1)}.pbs") - segment_options["job"]["job_chain"] = [f"qsub {next_pbs}"] - else: - segment_options["job"]["job_chain"] = [None] - - pbs_script = create_pbs_scripts(segment_options,run_name,segment_number) - if segment_number == 0: - init_pbs = pbs_script - - + inp_files, pbs_files,log_files, pristart_times, pristop_times = segment_inp_pbs(options, run_name, pbs=True) + init_inp = inp_files[0] + init_pbs = pbs_files[0] options["model"]["data"]["input_file"] = init_inp - if args.compile == True: - compile_tiegcm(options, debug, coupling) - - if args.execute == True: - if args.compile == False: - if find_file(options["model"]["data"]["modelexe"], execdir) == None: - print(f'{RED}Unable to find executable in {execdir}{RESET}') - exit(1) - try: - result = subprocess.run(['qsub', init_pbs], check=True, stdout=subprocess.PIPE, stderr=subprocess.PIPE, text=True) - job_id = result.stdout.strip() - print(f'Job submitted successfully. Job ID: {job_id}') - except subprocess.CalledProcessError as e: - print(f'{YELLOW}Error submitting job: {e.stderr}{RESET}') - print(f"{YELLOW}Check PBS script for erros{RESET}") - print(f"To submit job use command {YELLOW}qsub {pbs_script}{RESET}") + + # Create a single script which will submit all of the PBS jobs in order. + os.chdir(workdir) + submit_all_jobs_script = (f"{options['simulation']['job_name']}_pbs.sh") + with open(submit_all_jobs_script, "w", encoding="utf-8") as f: + cmd = f"#!/bin/bash\n" + f.write(cmd) + cmd = f"# TIEGCM Jobs\n" + f.write(cmd) + tiegcm_pbs = pbs_files[0] + cmd = f"tiegcm_job_id=`qsub {tiegcm_pbs}`\n" + f.write(cmd) + cmd = "echo $tiegcm_job_id\n" + f.write(cmd) + for tiegcm_pbs in pbs_files[1:]: + cmd = "old_tiegcm_job_id=$tiegcm_job_id\n" + f.write(cmd) + cmd = f"tiegcm_job_id=`qsub -W depend=afterok:$old_tiegcm_job_id {tiegcm_pbs}`\n" + f.write(cmd) + cmd = "echo $tiegcm_job_id\n" + f.write(cmd) + os.chmod(submit_all_jobs_script, 0o755) + + if args.execute == True and options["simulation"]["hpc_system"] != "linux": + if args.compile == False: + if find_file(options["model"]["data"]["modelexe"], execdir) == None and os.path.exists(options["model"]["data"]["modelexe"]) == False : + print(f'{RED}Unable to find executable in {execdir}{RESET}') + exit(1) + try: + if submit_all_jobs_script == '': + result = subprocess.run(['qsub', pbs_script], check=True, stdout=subprocess.PIPE, stderr=subprocess.PIPE, text=True) + job_id = result.stdout.strip() + print(f'Job submitted successfully. Job ID: {job_id}') + else: + result = subprocess.run(['./'+submit_all_jobs_script], check=True, stdout=subprocess.PIPE, stderr=subprocess.PIPE, text=True) + print(f'Jobs submitted successfully') + except subprocess.CalledProcessError as e: + print(f'{YELLOW}Error submitting job: {e.stderr}{RESET}') + print(f"{YELLOW}Check PBS script for errors{RESET}") + if submit_all_jobs_script == '': + print(f"To submit job use command {YELLOW}qsub {pbs_script}{RESET}") else: - print(f"{YELLOW}Execute is set to false{RESET}") - print(f"{YELLOW}To submit job use command{RESET} qsub {pbs_script}") + print(f"To submit job use command {YELLOW} ./{submit_all_jobs_script}{RESET}") + + elif args.onlycompile == False and options["simulation"]["hpc_system"] != "linux": + print(f"{YELLOW}Execute is set to false{RESET}") + if submit_all_jobs_script == '': + print(f"To submit job use command {YELLOW}qsub {pbs_script}{RESET}") + else: + print(f"To submit job use command {YELLOW} ./{submit_all_jobs_script}{RESET}") + elif args.onlycompile == False: + print(f"{YELLOW}HPC System is set to linux{RESET}") + print(f"{YELLOW}To run the model use command{RESET} mpirun {options['model']['data']['modelexe']} {options['model']['data']['input_file']}") if __name__ == "__main__": - """Begin main program.""" - main() + """Begin tiegcmrun program.""" + tiegcmrun()