diff --git a/parm/msis_lib/msis21.parm b/parm/msis_lib/msis21.parm new file mode 100644 index 000000000..8809e7b4f Binary files /dev/null and b/parm/msis_lib/msis21.parm differ diff --git a/reg_tests/chgres_cube/c96.fv3.netcdf2wam.sh b/reg_tests/chgres_cube/c96.fv3.netcdf2wam.sh index e30e65d97..269448759 100755 --- a/reg_tests/chgres_cube/c96.fv3.netcdf2wam.sh +++ b/reg_tests/chgres_cube/c96.fv3.netcdf2wam.sh @@ -19,6 +19,7 @@ export VCOORD_FILE=${HOMEufs}/fix/am/global_hyblev.l64.txt export INPUT_TYPE="gaussian_netcdf" export CONVERT_SFC=".false." export CONVERT_NST=".false." +export WAM_PARM_FILE=${HOMEufs}/parm/msis_lib/msis21.parm export CDATE=2020020200 diff --git a/sorc/chgres_cube.fd/CMakeLists.txt b/sorc/chgres_cube.fd/CMakeLists.txt index 240b84015..c10a8bbd7 100644 --- a/sorc/chgres_cube.fd/CMakeLists.txt +++ b/sorc/chgres_cube.fd/CMakeLists.txt @@ -23,11 +23,13 @@ set(lib_src set(exe_src chgres.F90) +add_subdirectory(msis2.1.fd) + if(CMAKE_Fortran_COMPILER_ID MATCHES "^(Intel)$") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -r8 -assume byterecl") elseif(CMAKE_Fortran_COMPILER_ID MATCHES "^(GNU)$") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ffree-line-length-0 -fdefault-real-8") - + # Turn on this argument mismatch flag for gfortran10. if(CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10) set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fallow-argument-mismatch") @@ -55,6 +57,7 @@ target_link_libraries( sp::sp_d w3nco::w3nco_d esmf + msis2 MPI::MPI_Fortran NetCDF::NetCDF_Fortran) diff --git a/sorc/chgres_cube.fd/atmosphere.F90 b/sorc/chgres_cube.fd/atmosphere.F90 index b5fd465dc..68281e94c 100644 --- a/sorc/chgres_cube.fd/atmosphere.F90 +++ b/sorc/chgres_cube.fd/atmosphere.F90 @@ -51,7 +51,7 @@ module atmosphere terrain_target_grid use program_setup, only : vcoord_file_target_grid, & - wam_cold_start, & + wam_cold_start, wam_parm_file, & cycle_year, cycle_mon, & cycle_day, cycle_hour, & regional, & @@ -349,7 +349,7 @@ subroutine atmosphere_driver(localpet) call vintg if( wam_cold_start ) then - call vintg_wam (cycle_year,cycle_mon,cycle_day,cycle_hour) + call vintg_wam (cycle_year,cycle_mon,cycle_day,cycle_hour,wam_parm_file) endif !----------------------------------------------------------------------------------- @@ -1521,15 +1521,17 @@ END SUBROUTINE VINTG_THOMP_MP_CLIMO !! @param [in] month initial month !! @param [in] day initial day !! @param [in] hour initial hour +!! @param [in] pf path to MSIS2.1 parm file !! !! @author Hann-Ming Henry Juang NCEP/EMC - SUBROUTINE VINTG_WAM (YEAR,MONTH,DAY,HOUR) + SUBROUTINE VINTG_WAM (YEAR,MONTH,DAY,HOUR,PF) IMPLICIT NONE include 'mpif.h' INTEGER, INTENT(IN) :: YEAR,MONTH,DAY,HOUR + CHARACTER(*), INTENT(IN) :: PF REAL(ESMF_KIND_R8), PARAMETER :: AMO = 15.9994 ! molecular weight of o REAL(ESMF_KIND_R8), PARAMETER :: AMO2 = 31.999 !molecular weight of o2 @@ -1650,11 +1652,9 @@ SUBROUTINE VINTG_WAM (YEAR,MONTH,DAY,HOUR) DO K=1,LEV_TARGET IF(P2PTR(I,J,K).le.P1PTR(I,J,LEV_INPUT)) THEN KREF =K-1 -!x print*,'VINTG_WAM: KREF P1 P2 ',KREF,P1PTR(I,J,LEV_INPUT),P2PTR(I,J,K) - GO TO 11 + EXIT ENDIF ENDDO - 11 CONTINUE ! DO K=KREF,LEV_TARGET COE = P2PTR(I,J,K) / P2PTR(I,J,KREF) @@ -1683,10 +1683,9 @@ SUBROUTINE VINTG_WAM (YEAR,MONTH,DAY,HOUR) DO K=1,LEV_TARGET IF(P2PTR(I,J,K).le.P1PTR(I,J,LEV_INPUT)) THEN KREF =K-1 - GO TO 22 + EXIT ENDIF ENDDO - 22 CONTINUE ! DO K=KREF,LEV_TARGET COE = MIN(1.0, P2PTR(I,J,K) / P2PTR(I,J,KREF) ) @@ -1712,7 +1711,7 @@ SUBROUTINE VINTG_WAM (YEAR,MONTH,DAY,HOUR) DO K=1,LEV_TARGET PRMB(K) = P2PTR(I,J,K) * 0.01 ENDDO - CALL GETTEMP(ICDAY,1,DEGLAT,1,PRMB,LEV_TARGET,TEMP,ON,O2N,N2N) + CALL GETTEMP(ICDAY,DEGLAT,PRMB,LEV_TARGET,PF,TEMP,ON,O2N,N2N) ! DO K=1,LEV_TARGET SUMMASS = ON(K)*AMO+O2N(K)*AMO2+N2N(K)*AMN2 @@ -1730,10 +1729,9 @@ SUBROUTINE VINTG_WAM (YEAR,MONTH,DAY,HOUR) DO K=1,LEV_TARGET IF(P2PTR(I,J,K).le.P1PTR(I,J,LEV_INPUT)) THEN KREF =K-1 - GO TO 33 + EXIT ENDIF ENDDO - 33 CONTINUE ! DO K=KREF,LEV_TARGET T2PTR(I,J,K) = TEMP(K) diff --git a/sorc/chgres_cube.fd/docs/Doxyfile.in b/sorc/chgres_cube.fd/docs/Doxyfile.in index b03185bc3..f66dd3943 100644 --- a/sorc/chgres_cube.fd/docs/Doxyfile.in +++ b/sorc/chgres_cube.fd/docs/Doxyfile.in @@ -897,7 +897,7 @@ FILE_PATTERNS = *.F90 \ # be searched for input files as well. # The default value is: NO. -RECURSIVE = YES +RECURSIVE = NO # The EXCLUDE tag can be used to specify files and/or directories that should be # excluded from the INPUT source files. This way you can easily exclude a @@ -906,7 +906,7 @@ RECURSIVE = YES # Note that relative paths are relative to the directory from which doxygen is # run. -EXCLUDE = ../../fre-nctools.fd +EXCLUDE = # The EXCLUDE_SYMLINKS tag can be used to select whether or not files or # directories that are symbolic links (a Unix file system feature) are excluded diff --git a/sorc/chgres_cube.fd/msis2.1.fd/CMakeLists.txt b/sorc/chgres_cube.fd/msis2.1.fd/CMakeLists.txt new file mode 100644 index 000000000..1eb2dc7be --- /dev/null +++ b/sorc/chgres_cube.fd/msis2.1.fd/CMakeLists.txt @@ -0,0 +1,26 @@ +include(FetchContent) +include(CheckFortranCompilerFlag) + +add_library(msis2 + msis_utils.F90 + msis_constants.F90 + msis_init.F90 + msis_gfn.F90 + msis_tfn.F90 + msis_dfn.F90 + msis_calc.F90 + msis_gtd8d.F90) + +set_target_properties(msis2 PROPERTIES Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/include) + +target_include_directories(msis2 INTERFACE ${CMAKE_CURRENT_BINARY_DIR}/include) + +if(CMAKE_Fortran_COMPILER_ID STREQUAL GNU) + # msis_calc:bspline has argument mismatch on nodes variable + target_compile_options(msis2 PRIVATE -std=legacy) +endif() + +target_link_libraries( + msis2 + PUBLIC + MPI::MPI_Fortran) diff --git a/sorc/chgres_cube.fd/msis2.1.fd/msis_calc.F90 b/sorc/chgres_cube.fd/msis2.1.fd/msis_calc.F90 new file mode 100644 index 000000000..61a63226e --- /dev/null +++ b/sorc/chgres_cube.fd/msis2.1.fd/msis_calc.F90 @@ -0,0 +1,223 @@ +!####################################################################### +! MSIS� (NRL-SOF-014-1) SOFTWARE +! NRLMSIS� empirical atmospheric model software. Use is governed by the +! Open Source Academic Research License Agreement contained in the file +! nrlmsis2.1_license.txt, which is part of this software package. BY +! USING OR MODIFYING THIS SOFTWARE, YOU ARE AGREEING TO THE TERMS AND +! CONDITIONS OF THE LICENSE. +!####################################################################### + +!!! =========================================================================== +!!! NRLMSIS 2.1: +!!! Neutral atmosphere empirical model from the surface to lower exosphere +!!! =========================================================================== +!!! +!!! MSISCALC: Interface with re-ordered input arguments and output arrays. +! +! PREREQUISITES: +! Must first run MSISINIT to load parameters and set switches. The +! MSISCALC subroutine checks for initialization and does a default +! initialization if necessary. This self-initialization will be removed +! in future versions. +! +! CALLING SEQUENCE: +! CALL MSISCALC(DAY, UTSEC, Z, LAT, LON, SFLUXAVG, SFLUX, AP, TN, DN, [TEX]) +! +! INPUT VARIABLES: +! DAY Day of year (1.0 to 365.0 or 366.0) +! UTSEC Universal time (seconds) +! Z Geodetic altitude (km) (default) or Geopotential height (km) +! LAT Geodetic latitude (deg) +! LON Geodetic longitude (deg) +! SFLUXAVG 81 day average, centered on input time, of F10.7 solar +! activity index +! SFLUX Daily F10.7 for previous day +! AP Geomagnetic activity index array: +! (1) Daily Ap +! (2) 3 hr ap index for current time +! (3) 3 hr ap index for 3 hrs before current time +! (4) 3 hr ap index for 6 hrs before current time +! (5) 3 hr ap index for 9 hrs before current time +! (6) Average of eight 3 hr ap indices from 12 to 33 hrs +! prior to current time +! (7) Average of eight 3 hr ap indices from 36 to 57 hrs +! prior to current time +! AP(2:7) are only used when switch_legacy(9) = -1.0 in MSISINIT +! +! NOTES ON INPUT VARIABLES: +! - The day-of-year dependence of the model only uses the DAY argument. If +! a continuous day-of-year dependence is desired, this argument should +! include the fractional day (e.g., DAY = + UTSEC/86400.0 +! - If lzalt_type = .true. (default) in the MSISINIT call, then Z is +! treated as geodetic altitude. +! If lzalt_type = .false., then Z is treated as geopotential height. +! - F107 and F107A values are the 10.7 cm radio flux at the Sun-Earth +! distance, not the radio flux at 1 AU. +! +! OUTPUT VARIABLES: +! TN Temperature at altitude (K) +! DN(1) Total mass density (kg/m3) +! DN(2) N2 number density (m-3) +! DN(3) O2 number density (m-3) +! DN(4) O number density (m-3) +! DN(5) He number density (m-3) +! DN(6) H number density (m-3) +! DN(7) Ar number density (m-3) +! DN(8) N number density (m-3) +! DN(9) Anomalous oxygen number density (m-3) +! DN(10) NO number density (m-3) +! TEX Exospheric temperature (K) (optional argument) +! +! NOTES ON OUTPUT VARIABLES: +! - Missing density values are returned as 9.999e-38 +! - Species included in mass density calculation are set in MSISINIT +! +!!! ========================================================================= + +!************************************************************************************************** +! MSIS_CALC Module: Contains main MSIS entry point +!************************************************************************************************** +module msis_calc + +contains + + !================================================================================================== + ! MSISCALC: The main MSIS subroutine entry point + !================================================================================================== + subroutine msiscalc(day,utsec,z,lat,lon,sfluxavg,sflux,ap,tn,dn,tex) + + use msis_constants, only : rp, dmissing, lnp0, Mbarg0divkB, kB, nspec, nodesTN, nd, zetaF, zetaB, & + Hgamma, zetagamma, maxnbf + use msis_init, only : msisinit, initflag, zaltflag, specflag, massflag, masswgt, etaTN + use msis_gfn, only : globe + use msis_tfn, only : tnparm, tfnparm, tfnx + use msis_dfn, only : dnparm, dfnparm, dfnx + use msis_utils, only : alt2gph, bspline, dilog + + implicit none + + real(kind=rp), intent(in) :: day + real(kind=rp), intent(in) :: utsec + real(kind=rp), intent(in) :: z + real(kind=rp), intent(in) :: lat + real(kind=rp), intent(in) :: lon + real(kind=rp), intent(in) :: sfluxavg,sflux,ap(1:7) + real(kind=rp), intent(out) :: tn, dn(1:10) + real(kind=rp), intent(out), optional :: tex + + real(kind=rp), save :: lastday = -9999.0 + real(kind=rp), save :: lastutsec = -9999.0 + real(kind=rp), save :: lastlat = -9999.0 + real(kind=rp), save :: lastlon = -9999.0 + real(kind=rp), save :: lastz = -9999.0 + real(kind=rp), save :: lastsflux = -9999.0 + real(kind=rp), save :: lastsfluxavg = -9999.0 + real(kind=rp), save :: lastap(1:7) = -9999.0 + real(kind=rp), save :: gf(0:maxnbf-1) + real(kind=rp), save :: Sz(-5:0,2:6) + integer, save :: iz + type(tnparm), save :: tpro + type(dnparm), save :: dpro(1:nspec-1) + + real(8) :: zaltd, latd + real(kind=rp) :: zeta, lndtotz, Vz, Wz, HRfact, lnPz, delz + integer :: i, j, kmax, ispec + + ! Check if model has been initialized; if not, perform default initialization + if (.not. initflag) call msisinit() + + ! Calculate geopotential height, if necessary + if(zaltflag) then + zaltd = dble(z) + latd = dble(lat) + zeta = alt2gph(latd,zaltd) + else + zeta = z + endif + + ! If only altitude changes then update the local spline weights + if (zeta .lt. zetaB) then + if (zeta .ne. lastz) then + if (zeta .lt. zetaF) then + kmax = 5 + else + kmax = 6 + endif + call bspline(zeta,nodesTN,nd+2,kmax,etaTN,Sz,iz) + lastz = zeta + endif + endif + + ! If location, time, or solar/geomagnetic conditions change then recompute the profile parameters + if ((day .ne. lastday) .or. (utsec .ne. lastutsec) .or. & + (lat .ne. lastlat) .or. (lon .ne. lastlon) .or. & + (sflux .ne. lastsflux) .or. (sfluxavg .ne. lastsfluxavg) .or. & + any(ap .ne. lastap)) then + call globe(day,utsec,lat,lon,sfluxavg,sflux,ap,gf) + call tfnparm(gf,tpro) + do ispec = 2, nspec-1 + if (specflag(ispec)) call dfnparm(ispec,gf,tpro,dpro(ispec)) + enddo + lastday = day + lastutsec = utsec + lastlat = lat + lastlon = lon + lastsflux = sflux + lastsfluxavg = sfluxavg + lastap = ap + endif + + ! Exospheric temperature + if (present(tex)) then + tex = tpro%tex + endif + + ! Temperature at altitude + tn = tfnx(zeta,iz,Sz(-3:0,4),tpro) + + ! Temperature integration terms at altitude, total number density + delz = zeta - zetaB + if (zeta .lt. zetaF) then + i = max(iz-4,0) + if (iz .lt. 4) then + j = -iz + else + j = -4 + endif + Vz = dot_product(tpro%beta(i:iz),Sz(j:0,5)) + tpro%cVS + Wz = 0.0_rp + lnPz = lnP0 - Mbarg0divkB*(Vz - tpro%Vzeta0) + lndtotz = lnPz - log(kB*tn) + else + if (zeta .lt. zetaB) then + Vz = dot_product(tpro%beta(iz-4:iz),Sz(-4:0,5)) + tpro%cVS + Wz = dot_product(tpro%gamma(iz-5:iz),Sz(-5:0,6)) + tpro%cVS*delz + tpro%cWS + else + Vz = (delz + log(tn/tpro%tex)/tpro%sigma)/tpro%tex + tpro%cVB + Wz = (0.5_rp*delz*delz + dilog(tpro%b*exp(-tpro%sigma*delz))/tpro%sigmasq)/tpro%tex & + + tpro%cVB*delz + tpro%cWB + endif + endif + + ! Species number densities at altitude + HRfact = 0.5_rp * (1.0_rp + tanh(Hgamma*(zeta - zetagamma))) !Reduction factor for chemical/dynamical correction scale height below zetagamma + do ispec = 2, nspec-1 + if (specflag(ispec)) then + dn(ispec) = dfnx(zeta,tn,lndtotz,Vz,Wz,HRfact,tpro,dpro(ispec)) + else + dn(ispec) = dmissing + endif + enddo + + ! Mass density + if (specflag(1)) then + dn(1) = dot_product(dn,masswgt) + else + dn(1) = dmissing + endif + + return + + end subroutine msiscalc + +end module msis_calc diff --git a/sorc/chgres_cube.fd/msis2.1.fd/msis_constants.F90 b/sorc/chgres_cube.fd/msis2.1.fd/msis_constants.F90 new file mode 100644 index 000000000..29c5355a5 --- /dev/null +++ b/sorc/chgres_cube.fd/msis2.1.fd/msis_constants.F90 @@ -0,0 +1,196 @@ +!####################################################################### +! MSIS� (NRL-SOF-014-1) SOFTWARE +! NRLMSIS� empirical atmospheric model software. Use is governed by the +! Open Source Academic Research License Agreement contained in the file +! nrlmsis2.1_license.txt, which is part of this software package. BY +! USING OR MODIFYING THIS SOFTWARE, YOU ARE AGREEING TO THE TERMS AND +! CONDITIONS OF THE LICENSE. +!####################################################################### + +!!! =========================================================================== +!!! NRLMSIS 2.1: +!!! Neutral atmosphere empirical model from the surface to lower exosphere +!!! =========================================================================== + +!************************************************************************************************** +! MSIS_CONSTANTS Module: Contains constants and hardwired parameters +!************************************************************************************************** +module msis_constants + + implicit none + + ! Floating Point Precision +#ifdef DBLE + integer, parameter :: rp = 8 +#else + integer, parameter :: rp = 4 +#endif + + ! Missing density value + real(kind=rp),parameter :: dmissing = 9.999e-38_rp + + ! Trigonometric constants + real(kind=rp), parameter :: pi = 3.1415926535897932384626433832795_rp + real(kind=rp), parameter :: deg2rad = pi / 180.0_rp + real(kind=rp), parameter :: doy2rad = 2.0_rp*pi / 365.0_rp + real(kind=rp), parameter :: lst2rad = pi / 12.0_rp + !real(kind=rp), parameter :: tanh1 = 0.761594155955765485_rp ! tanh(1.0) + real(kind=rp), parameter :: tanh1 = tanh(1.0_rp) + + ! Thermodynamic constants + ! Boltzmann constant (CODATA 2018) (J/kg) + real(kind=rp), parameter :: kB = 1.380649e-23_rp + ! Avogadro constant (CODATA 2018) + real(kind=rp), parameter :: NA = 6.02214076e23_rp + ! Reference gravity (CIMO Guide 2014) (m/s^2) (specified separately in alt2gph, in msis_utils.F90) + real(kind=rp), parameter :: g0 = 9.80665_rp + ! Species molecular masses (kg/molecule) (CIPM 2007) + real(kind=rp), parameter :: specmass(1:10) = (/ 0.0_rp, & ! Mass density (dummy value) + 28.0134_rp, & ! N2 + 31.9988_rp, & ! O2 + 31.9988_rp/2.0_rp, & ! O + 4.0_rp, & ! He + 1.0_rp, & ! H + 39.948_rp, & ! Ar + 28.0134_rp/2.0_rp, & ! N + 31.9988_rp/2.0_rp, & ! Anomalous O + (28.0134_rp+31.9988_rp)/2.0_rp /) & ! NO + / (1.0e3_rp * NA) ! Convert from g/mol to kg/molecule + ! Dry air mean mass in fully mixed atmosphere (CIPM 2007) (includes CO2 and other trace species that are not yet in MSIS) + real(kind=rp), parameter :: Mbar = 28.96546_rp / (1.0e3_rp * NA) ! kg/molecule + ! Dry air log volume mixing ratios (CIPM 2007) + real(kind=rp), parameter :: lnvmr(1:10) = log( (/ 1.0_rp, & ! Mass density (dummy value) + 0.780848_rp, & ! N2 + 0.209390_rp, & ! O2 + 1.0_rp, & ! O (dummy value) + 0.0000052_rp, & ! He + 1.0_rp, & ! H (dummy value) + 0.009332_rp, & ! Ar + 1.0_rp, & ! N (dummy value) + 1.0_rp, & ! Anomalous O (dummy value) + 1.0_rp /) ) ! NO (dummy value) + ! Natural log of global average surface pressure (Pa) + !real(kind=rp), parameter :: lnP0 = 11.5080482 !+ 0.00759597 After calibration with MERRA2 + real(kind=rp), parameter :: lnP0 = 11.515614 + ! Derived constants + real(kind=rp), parameter :: g0divkB = g0/kB * 1.0e3_rp ! K/(kg km) + real(kind=rp), parameter :: Mbarg0divkB = Mbar*g0/kB * 1.0e3_rp ! K/km + ! References: + ! CODATA Internationally recommended 2018 values of the fundamental physical constants. + ! https://pml.nist.gov/cuu/Constants/; https://pml.nist.gov/cuu/pdf/wallet_2018.pdf + ! Picard, A., Davis, R. S., Glaeser, M., and Fujii, K. (2007). Revised formula for the density of + ! air (CIPM 2007). Metrologia 45, 149�155. doi:10.1088/0026-1394/45/2/004 + ! World Meteorological Organization (2014). WMO guide to meteorological instruments and methods of observation + ! (the CIMO Guide). Part I, Chapter 12. https://www.wmo.int/pages/prog/www/IMOP/CIMO-Guide.html + + ! Vertical profile parameters + integer, parameter :: nspec = 11 !Number of species including temperature + integer, parameter :: nd = 27 !Number of temperature profile nodes + integer, parameter :: p = 4 !Spline order + integer, parameter :: nl = nd - p !Last temperature profile level index + integer, parameter :: nls = 9 !Last parameter index for each species (excluding O, NO splines) + real(kind=rp), parameter :: bwalt = 122.5_rp ! Reference geopotential height for Bates Profile + real(kind=rp), parameter :: zetaF = 70.0_rp ! Fully mixed below this, uses constant mixing ratios + real(kind=rp), parameter :: zetaB = bwalt ! Bates Profile above this altitude + real(kind=rp), parameter :: zetaA = 85.0_rp ! Default reference height for active minor species + real(kind=rp), parameter :: zetagamma = 100.0_rp ! Reference height of tanh taper of chemical/dynamical correction scale height + real(kind=rp), parameter :: Hgamma = 1.0_rp/30.0_rp ! Inverse scale height of tanh taper of chemical/dynamical correction scale height + real(kind=rp), parameter :: nodesTN(0:nd+2) = & !Nodes for temperature profile splines + (/ -15., -10., -5., 0., 5., 10., 15., 20., 25., 30., 35., 40., 45., 50., & + 55., 60., 65., 70., 75., 80., 85., 92.5, 102.5, 112.5, 122.5, 132.5, 142.5, & + 152.5, 162.5, 172.5/) + integer, parameter :: izfmx = 13 ! fully mixed below this spline index + integer, parameter :: izfx = 14 ! Spline index at zetaF + integer, parameter :: izax = 17 ! Spline index at zetaA + integer, parameter :: itex = nl ! Index of Bates exospheric temperature + integer, parameter :: itgb0 = nl - 1 ! Index of Bates temperature gradient at lower boundary + integer, parameter :: itb0 = nl - 2 ! Index of Bates temperature at lower boundary + ! O1 Spline parameters + integer, parameter :: ndO1 = 13 + integer, parameter :: nsplO1 = ndO1-5 !Number of unconstrained spline parameters for O1 (there are 2 additional C1-constrained splines) + real(kind=rp), parameter :: nodesO1(0:ndO1) = & !Nodes for O1 splines (Domain 50-85 km) + (/ 35., 40., 45., 50., 55., 60., 65., 70., 75., 80., 85., 92.5, 102.5, 112.5/) + real(kind=rp), parameter :: zetarefO1 = zetaA !Joining height for O1 splines, and reference height for O1 density + ! NO Spline parameters + integer, parameter :: ndNO = 13 + integer, parameter :: nsplNO = ndNO-5 !Number of unconstrained spline parameters for NO (there are 2 additional C1-constrained splines) + real(kind=rp), parameter :: nodesNO(0:ndNO) = & !Nodes for NO splines (Domain 70-122.5 km) + (/ 47.5, 55., 62.5, 70., 77.5, 85., 92.5, 100., 107.5, 115., 122.5, 130., 137.5, 145./) + real(kind=rp), parameter :: zetarefNO = zetaB !Joining height for NO splines, and reference height for NO density + !C2 Continuity matrix for temperature; Last 3 splines are constrained (must be recomputed if nodes change) + real(kind=rp), parameter :: c2tn(3,3) = reshape((/1.0_rp, -10.0_rp, 33.333333333333336_rp, & + 1.0_rp, 0.0_rp, -16.666666666666668_rp, & + 1.0_rp, 10.0_rp, 33.333333333333336_rp/), & + (/3,3/)) + !C1 Continuity for O1; Last 2 splines are constrained (must be recomputed if nodes change) + real(kind=rp), parameter :: c1o1(2,2) = reshape((/ 1.75_rp, -2.916666573405061_rp, & + -1.624999900076852_rp, 21.458332647194382_rp /), & + (/2,2/)) + real(kind=rp), parameter :: c1o1adj(2) = (/0.257142857142857_rp, -0.102857142686844_rp/) !Weights for coefficents on 3rd to last spline; product to be subtracted from RHS of continuity equation + !C1 Continuity for NO; Last 2 splines are constrained (must be recomputed if nodes change) + real(kind=rp), parameter :: c1NO(2,2) = reshape((/ 1.5_rp, -3.75_rp, & + 0.0_rp, 15.0_rp /), & + (/2,2/)) + real(kind=rp), parameter :: c1NOadj(2) = (/0.166666666666667_rp, -0.066666666666667_rp/) !Weights for coefficents on 3rd to last spline; product to be subtracted from RHS of continuity equation + ! Anomalous Oxygen parameters (legacy profile from NRLMSISE-00) + real(kind=rp),parameter :: zetarefOA = zetaB !Reference height for anomalous oxygen density + real(kind=rp),parameter :: TOA = 4000. !Temperature of anomalous oxygen density (K) + real(kind=rp),parameter :: HOA = (kB * TOA) / ( (16.0_rp/(1.0e3_rp*NA)) * g0 ) * 1.0e-3_rp !Hydrostatic scale height of anomalous oxygen density (km) + + ! Horizontal and time-dependent basis function (gfn) parameters + integer, parameter :: maxnbf = 512 ! Number of basis functions to be allocated + integer, parameter :: maxn = 6 ! Maximum latitude (Legendre) spectral degree + integer, parameter :: maxl = 3 ! Maximum local time (tidal) spectral order + integer, parameter :: maxm = 2 ! Maximum longitude (stationary planetary wave) order + integer, parameter :: maxs = 2 ! Maximimum day of year (intra-annual) Fourier order + integer, parameter :: amaxn = 6 ! Maximum Legendre degree used in time independent and intra-annual zonal mean terms + integer, parameter :: amaxs = 2 ! Maximum intra-annual order used in zonal mean terms + integer, parameter :: tmaxl = 3 ! Maximum tidal order used + integer, parameter :: tmaxn = 6 ! Maximum Legendre degree coupled with tides + integer, parameter :: tmaxs = 2 ! Maximum intra-annual order coupled with tides + integer, parameter :: pmaxm = 2 ! Maximum stationary planetary wave order used + integer, parameter :: pmaxn = 6 ! Maximum Legendre degree coupled with SPW + integer, parameter :: pmaxs = 2 ! Maximum intra-annual order coupled with SPW + integer, parameter :: nsfx = 5 ! Number of linear solar flux terms + integer, parameter :: nsfxmod = 5 ! Number of nonlinear modulating solar flux terms (legacy NRLMSISE-00 terms) + integer, parameter :: nmag = 54 ! Number of terms in NRLMSISE-00 legacy geomagnetic parameterization + integer, parameter :: nut = 12 ! Number of terms in NRLMSISE-00 legacy UT parameterization + integer, parameter :: ctimeind = 0 ! Starting index of time-independent terms + integer, parameter :: cintann = ctimeind + (amaxn+1) ! Starting index of zonal mean intra-annual terms + integer, parameter :: ctide = cintann + ((amaxn+1)*2*amaxs) ! Starting index of zonal mean intra-annual terms + integer, parameter :: cspw = ctide + (4*tmaxs+2)*(tmaxl*(tmaxn+1)-(tmaxl*(tmaxl+1))/2) ! Starting index of SPW terms + integer, parameter :: csfx = cspw + (4*pmaxs+2)*(pmaxm*(pmaxn+1)-(pmaxm*(pmaxm+1))/2) ! Starting index of linear solar flux terms + integer, parameter :: cextra = csfx + nsfx ! Starting index of time-independent terms + integer, parameter :: mbf = 383 ! Last index of linear terms + integer, parameter :: cnonlin = mbf + 1 ! Starting index of nonlinear terms + integer, parameter :: csfxmod = cnonlin ! Starting index of modulating solar flux terms + integer, parameter :: cmag = csfxmod + nsfxmod ! Starting index of daily geomagnetic terms + integer, parameter :: cut = cmag + nmag ! Starting index of UT terms + + ! Weights for calculation log pressure spline coefficients from temperature coefficients (must be recalcuated if nodes change) + real(kind=rp), parameter :: gwht(0:3) = (/ 5.0_rp/24.0_rp, 55.0_rp/24.0_rp, 55.0_rp/24.0_rp, 5.0_rp/24.0_rp /) + + ! Constants needed for analytical integration by parts of hydrostatic piecewise effective mass profile + real(kind=rp), parameter :: wbeta(0:nl) = (nodesTN(4:nd) - nodesTN(0:nl)) / 4.0_rp !Weights for 1st spline integration + real(kind=rp), parameter :: wgamma(0:nl) = (nodesTN(5:nd+1)- nodesTN(0:nl)) / 5.0_rp !Weights for 2nd spline integration + ! Non-zero bspline values at zetaB (5th and 6th order) (must be recalcuated if nodes change) + real(kind=rp), parameter :: S5zetaB(0:3) = (/0.041666666666667_rp, 0.458333333333333_rp, 0.458333333333333_rp, & + 0.041666666666667_rp/) + real(kind=rp), parameter :: S6zetaB(0:4) = (/0.008771929824561_rp, 0.216228070175439_rp, 0.550000000000000_rp, & + 0.216666666666667_rp, 0.008333333333333_rp/) + !Weights for calculating temperature gradient at zetaA (must be recalcuated if nodes change) + real(kind=rp), parameter :: wghtAxdz(0:2) = (/-0.102857142857_rp, 0.0495238095238_rp, 0.053333333333_rp/) + !Non-zero bspline values at zetaA (4th, 5th and 6th order) (must be recalcuated if nodes change) + real(kind=rp), parameter :: S4zetaA(0:2) = (/0.257142857142857_rp, 0.653968253968254_rp, 0.088888888888889_rp/) + real(kind=rp), parameter :: S5zetaA(0:3) = (/0.085714285714286_rp, 0.587590187590188_rp, 0.313020313020313_rp, & + 0.013675213675214_rp/) + real(kind=rp), parameter :: S6zetaA(0:4) = (/0.023376623376623_rp, 0.378732378732379_rp, 0.500743700743701_rp, & + 0.095538448479625_rp, 0.001608848667672_rp/) + !Non-zero bspline values at zetaF (4th and 5th order) (must be recalcuated if nodes change) + real(kind=rp), parameter :: S4zetaF(0:2) = (/0.166666666666667_rp, 0.666666666666667_rp, 0.166666666666667_rp/) + real(kind=rp), parameter :: S5zetaF(0:3) = (/0.041666666666667_rp, 0.458333333333333_rp, 0.458333333333333_rp, & + 0.041666666666667_rp/) + !Non-zero bspline values at zeta=0 (5th order) (must be recalcuated if nodes change) + real(kind=rp), parameter :: S5zeta0(0:2) = (/0.458333333333333_rp, 0.458333333333333_rp, 0.041666666666667_rp/) + +end module msis_constants diff --git a/sorc/chgres_cube.fd/msis2.1.fd/msis_dfn.F90 b/sorc/chgres_cube.fd/msis2.1.fd/msis_dfn.F90 new file mode 100644 index 000000000..566d125b9 --- /dev/null +++ b/sorc/chgres_cube.fd/msis2.1.fd/msis_dfn.F90 @@ -0,0 +1,539 @@ +!####################################################################### +! MSIS� (NRL-SOF-014-1) SOFTWARE +! NRLMSIS� empirical atmospheric model software. Use is governed by the +! Open Source Academic Research License Agreement contained in the file +! nrlmsis2.1_license.txt, which is part of this software package. BY +! USING OR MODIFYING THIS SOFTWARE, YOU ARE AGREEING TO THE TERMS AND +! CONDITIONS OF THE LICENSE. +!####################################################################### + +!!! =========================================================================== +!!! NRLMSIS 2.1: +!!! Neutral atmosphere empirical model from the surface to lower exosphere +!!! =========================================================================== + +!************************************************************************************************** +! MSIS_DFN Module: Contains vertical species density profile parameters and subroutines +!************************************************************************************************** +module msis_dfn + + use msis_constants, only : rp, nl, nsplO1, nsplNO + use msis_utils, only : bspline, dilog + + type dnparm + sequence + real(kind=rp) :: lnPhiF ! (Except O, H) Natural log of mixing ratio at zetaF (70 km), before chemical and dynamical corrections are applied (ln m^-3) (global term only) + real(kind=rp) :: lndref ! Natural log of number density at reference height + real(kind=rp) :: zetaM ! "Turbopause Height": Height of midpoint of effective mass transition (km) + real(kind=rp) :: HML ! Scale height of lower portion of effective mass profile (km) + real(kind=rp) :: HMU ! Scale height of upper portion of effective mass profile (km) + real(kind=rp) :: C ! Chapman term coefficient + real(kind=rp) :: zetaC ! Chapman term reference height (km) + real(kind=rp) :: HC ! Chapman term scale height (km) + real(kind=rp) :: R ! Chemical/dynamical term coefficient + real(kind=rp) :: zetaR ! Chemical/dynamical term reference height (km) + real(kind=rp) :: HR ! Chemical/dynamical term scale height (km) + real(kind=rp) :: cf(0:nsplO1+1) ! Merged spline coefficients (for chemistry-dominated region of O1, NO, and (eventually), H, N) + real(kind=rp) :: zref ! Reference height for hydrostatic integral and ideal gas terms + real(kind=rp) :: Mi(0:4) ! Effective mass at nodes of piecewise mass profile (derived from zetaM, HML, HMU) + real(kind=rp) :: zetaMi(0:4) ! Height of nodes of piecewise mass profile (derived from zetaM, HML, HMU) + real(kind=rp) :: aMi(0:4) = 0.0_rp ! Slopes of piecewise mass profile segments (derived from zetaM, HML, HMU) + real(kind=rp) :: WMi(0:4) = 0.0_rp ! 2nd indefinite integral of 1/T at mass profile nodes + real(kind=rp) :: XMi(0:4) = 0.0_rp ! Cumulative adjustment to M/T integral due to changing effective mass + real(kind=rp) :: Izref ! Indefinite hydrostatic integral at reference height + real(kind=rp) :: Tref ! Temperature at reference height (for ideal gas law term) + real(kind=rp) :: zmin ! Minimum height of profile (missing values below) + real(kind=rp) :: zhyd ! Hydrostatic terms needed above this height + integer(kind=rp) :: ispec ! Species index + end type dnparm + + contains + + !================================================================================================== + ! DFNPARM: Compute the species density profile parameters + !================================================================================================== + subroutine dfnparm(ispec,gf,tpro,dpro) + + use msis_constants, only : tanh1, specmass, lnvmr, Mbar, g0divkB, & + nd, zetaF, zetaB, zetaA, nodesTN, & + nodesO1, zetarefO1, c1o1, c1o1adj, & + nodesNO, zetarefNO, c1NO, c1NOadj, & + zetarefOA, & + maxnbf, mbf, nmag, nut, cmag, cut + use msis_init, only : etaTN, TN,PR,N2,O2,O1,HE,H1,AR,N1,OA,NO, N2Rflag, & + HRfactO1ref, dHRfactO1ref, HRfactNOref, dHRfactNOref + use msis_gfn, only : sfluxmod, geomag, utdep + use msis_tfn, only : tnparm + + implicit none + + integer, intent(in) :: ispec ! Species index + real(kind=rp), intent(in) :: gf(0:maxnbf-1) ! Array of horizontal and temporal basis function terms + type(tnparm), intent(in) :: tpro ! Structure containing temperature vertical profile parameters + type(dnparm), intent(out) :: dpro ! Output structure containing density vertical profile parameters + + integer :: izf, i, i1, iz + real(kind=rp) :: Cterm, Rterm0, Rterm + real(kind=rp) :: bc(2) + real(kind=rp) :: hbetaL,hbetaU + real(kind=rp) :: delM, delz + real(kind=rp) :: Wi ! 2nd indefinite integral at a piecewise mass profile node + real(kind=rp) :: Si(-5:0,2:6) ! Array of b-spline values at a mass profile node + real(kind=rp) :: Mzref ! Effective mass at reference altitude + + dpro%ispec = ispec + + select case(ispec) + + ! Molecular Nitrogen ---------------------- + case(2) + ! Mixing ratio and reference number density + dpro%lnPhiF = lnvmr(ispec) + dpro%lndref = tpro%lndtotF + dpro%lnPhiF + dpro%zref = zetaF + dpro%zmin = -1.0_rp + dpro%zhyd = zetaF + ! Effective mass + dpro%zetaM = dot_product(N2%beta(0:mbf,1),gf(0:mbf)) + dpro%HML = N2%beta(0,2) + dpro%HMU = N2%beta(0,3) + ! Photochemical correction + dpro%R = 0.0_rp + if (N2Rflag) dpro%R = dot_product(N2%beta(0:mbf,7),gf(0:mbf)) + dpro%zetaR = N2%beta(0,8) + dpro%HR = N2%beta(0,9) + + ! Molecular Oxygen ------------------------ + case(3) + ! Mixing ratio and reference number density + dpro%lnPhiF = lnvmr(ispec) + dpro%lndref = tpro%lndtotF + dpro%lnPhiF + dpro%zref = zetaF + dpro%zmin = -1.0_rp + dpro%zhyd = zetaF + ! Effective mass + dpro%zetaM = O2%beta(0,1) + dpro%HML = O2%beta(0,2) + dpro%HMU = O2%beta(0,3) + ! Photochemical correction + dpro%R = dot_product(O2%beta(0:mbf,7),gf(0:mbf)) + dpro%R = dpro%R + geomag(O2%beta(cmag:cmag+nmag-1,7),gf(cmag:cmag+12),gf(cmag+13:cmag+26)) + dpro%zetaR = O2%beta(0,8) + dpro%HR = O2%beta(0,9) + + ! Atomic Oxygen -------------------------- + case(4) + ! Reference number density + dpro%lnPhiF = 0.0_rp + dpro%lndref = dot_product(O1%beta(0:mbf,0),gf(0:mbf)) + dpro%zref = zetarefO1 + dpro%zmin = nodesO1(3) + dpro%zhyd = zetarefO1 + ! Effective mass + dpro%zetaM = O1%beta(0,1) + dpro%HML = O1%beta(0,2) + dpro%HMU = O1%beta(0,3) + ! Chapman correction + dpro%C = dot_product(O1%beta(0:mbf,4),gf(0:mbf)) + dpro%zetaC = O1%beta(0,5) + dpro%HC = O1%beta(0,6) + ! Dynamical correction + dpro%R = dot_product(O1%beta(0:mbf,7),gf(0:mbf)) + dpro%R = dpro%R + sfluxmod(7,gf,O1,0.0_rp) + dpro%R = dpro%R + geomag(O1%beta(cmag:cmag+nmag-1,7),gf(cmag:cmag+12),gf(cmag+13:cmag+26)) + dpro%R = dpro%R + utdep(O1%beta(cut:cut+nut-1,7),gf(cut:cut+8)) + dpro%zetaR = O1%beta(0,8) + dpro%HR = O1%beta(0,9) + ! Unconstrained splines + do izf = 0, nsplO1-1 + dpro%cf(izf) = dot_product(O1%beta(0:mbf,izf+10),gf(0:mbf)) + enddo + ! Constrained splines calculated after case statement + + ! Helium ---------------------- + case(5) + ! Mixing ratio and reference number density + dpro%lnPhiF = lnvmr(ispec) + dpro%lndref = tpro%lndtotF + dpro%lnPhiF + dpro%zref = zetaF + dpro%zmin = -1.0_rp + dpro%zhyd = zetaF + ! Effective mass + dpro%zetaM = HE%beta(0,1) + dpro%HML = HE%beta(0,2) + dpro%HMU = HE%beta(0,3) + ! Dynamical correction + dpro%R = dot_product(HE%beta(0:mbf,7),gf(0:mbf)) + dpro%R = dpro%R + sfluxmod(7,gf,HE,1.0_rp) + dpro%R = dpro%R + geomag(HE%beta(cmag:cmag+nmag-1,7),gf(cmag:cmag+12),gf(cmag+13:cmag+26)) + dpro%R = dpro%R + utdep(HE%beta(cut:cut+nut-1,7),gf(cut:cut+8)) + dpro%zetaR = HE%beta(0,8) + dpro%HR = HE%beta(0,9) + + ! Atomic Hydrogen ---------------------- + case(6) + ! Reference number density + dpro%lnPhiF = 0.0_rp + dpro%lndref = dot_product(H1%beta(0:mbf,0),gf(0:mbf)) + dpro%zref = zetaA + dpro%zmin = 75.0_rp + dpro%zhyd = zetaF + ! Effective mass + dpro%zetaM = H1%beta(0,1) + dpro%HML = H1%beta(0,2) + dpro%HMU = H1%beta(0,3) + ! Chapman correction + dpro%C = dot_product(H1%beta(0:mbf,4),gf(0:mbf)) + dpro%zetaC = dot_product(H1%beta(0:mbf,5),gf(0:mbf)) + dpro%HC = H1%beta(0,6) + ! Dynamical correction + dpro%R = dot_product(H1%beta(0:mbf,7),gf(0:mbf)) + dpro%R = dpro%R + sfluxmod(7,gf,H1,0.0_rp) + dpro%R = dpro%R + geomag(H1%beta(cmag:cmag+nmag-1,7),gf(cmag:cmag+12),gf(cmag+13:cmag+26)) + dpro%R = dpro%R + utdep(H1%beta(cut:cut+nut-1,7),gf(cut:cut+8)) + dpro%zetaR = H1%beta(0,8) + dpro%HR = H1%beta(0,9) + + ! Argon ---------------------- + case(7) + ! Mixing ratio and reference number density + dpro%lnPhiF = lnvmr(ispec) + dpro%lndref = tpro%lndtotF + dpro%lnPhiF + dpro%zref = zetaF + dpro%zmin = -1.0_rp + dpro%zhyd = zetaF + ! Effective mass + dpro%zetaM = AR%beta(0,1) + dpro%HML = AR%beta(0,2) + dpro%HMU = AR%beta(0,3) + ! Dynamical correction + dpro%R = dot_product(AR%beta(0:mbf,7),gf(0:mbf)) + dpro%R = dpro%R + geomag(AR%beta(cmag:cmag+nmag-1,7),gf(cmag:cmag+12),gf(cmag+13:cmag+26)) + dpro%R = dpro%R + utdep(AR%beta(cut:cut+nut-1,7),gf(cut:cut+8)) + dpro%zetaR = AR%beta(0,8) + dpro%HR = AR%beta(0,9) + + ! Atomic Nitrogen ---------------------- + case(8) + ! Reference number density + dpro%lnPhiF = 0.0_rp + dpro%lndref = dot_product(N1%beta(0:mbf,0),gf(0:mbf)) + dpro%lndref = dpro%lndref + sfluxmod(0,gf,N1,0.0_rp) + dpro%lndref = dpro%lndref + geomag(N1%beta(cmag:cmag+nmag-1,0),gf(cmag:cmag+12),gf(cmag+13:cmag+26)) + dpro%lndref = dpro%lndref + utdep(N1%beta(cut:cut+nut-1,0),gf(cut:cut+8)) + dpro%zref = zetaB + dpro%zmin = 90.0_rp + dpro%zhyd = zetaF + ! Effective mass + dpro%zetaM = N1%beta(0,1) + dpro%HML = N1%beta(0,2) + dpro%HMU = N1%beta(0,3) + ! Chapman correction + dpro%C = N1%beta(0,4) + dpro%zetaC = N1%beta(0,5) + dpro%HC = N1%beta(0,6) + ! Dynamical correction + dpro%R = dot_product(N1%beta(0:mbf,7),gf(0:mbf)) + dpro%zetaR = N1%beta(0,8) + dpro%HR = N1%beta(0,9) + + ! Anomalous Oxygen ---------------------- + case(9) + dpro%lndref = dot_product(OA%beta(0:mbf,0),gf(0:mbf)) + dpro%lndref = dpro%lndref + geomag(OA%beta(cmag:cmag+nmag-1,0),gf(cmag:cmag+12),gf(cmag+13:cmag+26)) + dpro%zref = zetarefOA + dpro%zmin = 120.0_rp + dpro%zhyd = 0.0_rp + dpro%C = OA%beta(0,4) + dpro%zetaC = OA%beta(0,5) + dpro%HC = OA%beta(0,6) + return !No further parameters needed for legacy anomalous oxygen profile + + ! Nitic Oxide ---------------------- + ! Added geomag dependence 2/18/21 + case(10) + ! Skip if parameters are not defined + if (NO%beta(0,0) .eq. 0.0_rp) then + dpro%lndref = 0.0_rp + return + endif + ! Reference number density + dpro%lnPhiF = 0.0_rp + dpro%lndref = dot_product(NO%beta(0:mbf,0),gf(0:mbf)) + dpro%lndref = dpro%lndref + geomag(NO%beta(cmag:cmag+nmag-1,0),gf(cmag:cmag+12),gf(cmag+13:cmag+26)) + dpro%zref = zetarefNO + !dpro%zmin = nodesNO(3) + dpro%zmin = 72.5 !JTE 1/18/22 Cut off profile below 72.5 km, due to possible spline artefacts at edge of domain (70 km) + dpro%zhyd = zetarefNO + ! Effective mass + dpro%zetaM = dot_product(NO%beta(0:mbf,1),gf(0:mbf)) + dpro%HML = dot_product(NO%beta(0:mbf,2),gf(0:mbf)) + dpro%HMU = dot_product(NO%beta(0:mbf,3),gf(0:mbf)) + ! Chapman correction + dpro%C = dot_product(NO%beta(0:mbf,4),gf(0:mbf)) + dpro%C = dpro%C + geomag(NO%beta(cmag:cmag+nmag-1,4),gf(cmag:cmag+12),gf(cmag+13:cmag+26)) + dpro%zetaC = dot_product(NO%beta(0:mbf,5),gf(0:mbf)) + dpro%HC = dot_product(NO%beta(0:mbf,6),gf(0:mbf)) + ! Dynamical correction + dpro%R = dot_product(NO%beta(0:mbf,7),gf(0:mbf)) + dpro%zetaR = dot_product(NO%beta(0:mbf,8),gf(0:mbf)) + dpro%HR = dot_product(NO%beta(0:mbf,9),gf(0:mbf)) + ! Unconstrained splines + do izf = 0,nsplNO-1 + dpro%cf(izf) = dot_product(NO%beta(0:mbf,izf+10),gf(0:mbf)) + dpro%cf(izf) = dpro%cf(izf) + geomag(NO%beta(cmag:cmag+nmag-1,izf+10),gf(cmag:cmag+12),gf(cmag+13:cmag+26)) + enddo + ! Constrained splines calculated after case statement + +! Failsafe ----- --------------------------- + case default + stop 'Species not yet implemented' + + endselect + + ! Compute piecewise mass profile values and integration terms + dpro%zetaMi(0) = dpro%zetaM - 2.0_rp*dpro%HML + dpro%zetaMi(1) = dpro%zetaM - dpro%HML + dpro%zetaMi(2) = dpro%zetaM + dpro%zetaMi(3) = dpro%zetaM + dpro%HMU + dpro%zetaMi(4) = dpro%zetaM + 2.0_rp*dpro%HMU + dpro%Mi(0) = Mbar + dpro%Mi(4) = specmass(ispec) + dpro%Mi(2) = (dpro%Mi(0) + dpro%Mi(4)) / 2.0_rp + delM = tanh1 * (dpro%Mi(4) - dpro%Mi(0)) / 2.0_rp + dpro%Mi(1) = dpro%Mi(2) - delM + dpro%Mi(3) = dpro%Mi(2) + delM + do i = 0, 3 + dpro%aMi(i) = (dpro%Mi(i+1) - dpro%Mi(i)) / (dpro%zetaMi(i+1) - dpro%zetaMi(i)) + enddo + do i = 0, 4 + delz = dpro%zetaMi(i) - zetaB + if (dpro%zetaMi(i) .lt. zetaB) then + call bspline(dpro%zetaMi(i),nodesTN,nd+2,6,etaTN,Si,iz) + dpro%WMi(i) = dot_product(tpro%gamma(iz-5:iz),Si(:,6)) + tpro%cVS*delz + tpro%cWS + else + dpro%WMi(i) = (0.5_rp*delz*delz + dilog(tpro%b*exp(-tpro%sigma*delz))/tpro%sigmasq)/tpro%tex & + + tpro%cVB*delz + tpro%cWB + endif + end do + dpro%XMi(0) = -dpro%aMi(0) * dpro%WMi(0) + do i = 1, 3 + dpro%XMi(i) = dpro%XMi(i-1) - dpro%WMi(i) * (dpro%aMi(i) - dpro%aMi(i-1)) + end do + dpro%XMi(4) = dpro%XMi(3) + dpro%WMi(4) * dpro%aMi(3) + + ! Calculate hydrostatic integral at reference height, and copy temperature + if (dpro%zref .eq. zetaF) then + Mzref = Mbar + dpro%Tref = tpro%TzetaF + dpro%Izref = Mbar * tpro%VzetaF + else if (dpro%zref .eq. zetaB) then + Mzref = pwmp(dpro%zref,dpro%zetaMi,dpro%Mi,dpro%aMi) + dpro%Tref = tpro%Tb0 + dpro%Izref = 0.0_rp + if ((zetaB .gt. dpro%zetaMi(0)) .and. (zetaB .lt. dpro%zetaMi(4))) then + i = 0 + do i1 = 1, 3 + if (zetaB .lt. dpro%zetaMi(i1)) then + exit + else + i = i1 + endif + enddo + dpro%Izref = dpro%Izref - dpro%XMi(i) + else + dpro%Izref = dpro%Izref - dpro%XMi(4) + endif + else if (dpro%zref .eq. zetaA) then + Mzref = pwmp(dpro%zref,dpro%zetaMi,dpro%Mi,dpro%aMi) + dpro%Tref = tpro%TzetaA + dpro%Izref = Mzref * tpro%VzetaA + if ((zetaA .gt. dpro%zetaMi(0)) .and. (zetaA .lt. dpro%zetaMi(4))) then + i = 0 + do i1 = 1, 3 + if (zetaA .lt. dpro%zetaMi(i1)) then + exit + else + i = i1 + endif + enddo + dpro%Izref = dpro%Izref - (dpro%aMi(i)*tpro%WzetaA + dpro%XMi(i)) + else + dpro%Izref = dpro%Izref - dpro%XMi(4) + endif + else + stop 'Integrals at reference height not available' + endif + + ! C1 constraint for O1 at 85 km + if (ispec .eq. 4) then + Cterm = dpro%C*exp(-(dpro%zref-dpro%zetaC)/dpro%HC) + Rterm0 = tanh((dpro%zref-dpro%zetaR)/(HRfactO1ref*dpro%HR)) + Rterm = dpro%R*(1+Rterm0) + bc(1) = dpro%lndref - Cterm + Rterm - dpro%cf(7)*c1o1adj(1) !Reference density, Chapman term, logistic term, and subtraction of last unconstrained spline(7) + bc(2) = -Mzref*g0divkB/tpro%tzetaA & !Gradient of hydrostatic term + -tpro%dlntdzA & !Gradient of ideal gas law term + +Cterm/dpro%HC & !Gradient of Chapman term + +Rterm*(1-Rterm0)/dpro%HR*dHrfactO1ref & !Gradient of tapered logistic term + -dpro%cf(7)*c1o1adj(2) !Subtraction of gradient of last unconstrained spline(7) + ! Compute coefficients for constrained splines + dpro%cf(8:9) = matmul(bc,c1o1) + endif + + ! C1 constraint for NO at 122.5 km + if (ispec .eq. 10) then + Cterm = dpro%C*exp(-(dpro%zref - dpro%zetaC)/dpro%HC) + Rterm0 = tanh((dpro%zref-dpro%zetaR)/(HRfactNOref*dpro%HR)) + Rterm = dpro%R*(1+Rterm0) + bc(1) = dpro%lndref - Cterm + Rterm - dpro%cf(7)*c1noadj(1) !Reference density, Chapman term, logistic term, and subtraction of last unconstrained spline(7) + bc(2) = -Mzref*g0divkB/tpro%tb0 & !Gradient of hydrostatic term + -tpro%tgb0/tpro%tb0 & !Gradient of ideal gas law term + +Cterm/dpro%HC & !Gradient of Chapman term + +Rterm*(1-Rterm0)/dpro%HR*dHrfactNOref & !Gradient of tapered logistic term + -dpro%cf(7)*c1noadj(2) !Subtraction of gradient of last unconstrained spline(7) + ! Compute coefficients for constrained splines + dpro%cf(8:9) = matmul(bc,c1no) + endif + + return + + end subroutine dfnparm + + !================================================================================================== + ! DFNX: Compute a species density at specified geopotential height + !================================================================================================== + real(kind=rp) function dfnx(z,tnz,lndtotz,Vz,Wz,HRfact,tpro,dpro) + + use msis_constants, only : dmissing, g0divkB, ndO1, nodesO1, ndNO, nodesNO, HOA + use msis_init, only : etaO1, etaNO + use msis_tfn, only : tnparm + + implicit none + + real(kind=rp), intent(in) :: z ! Geopotential height + real(kind=rp), intent(in) :: tnz, lndtotz ! Temperature, total number density at input z + real(kind=rp), intent(in) :: Vz, Wz ! First and second indefinite integrals of 1/T at z + real(kind=rp), intent(in) :: HRfact ! Reduction factor for chemical/dynamical correction scale height below zetaF + type(tnparm), intent(in) :: tpro ! Structure containing temperature vertical profile parameters + type(dnparm), intent(in) :: dpro ! Structure containing density vertical profile parameters + + integer(4) :: i, i1, iz + real(kind=rp) :: Mz + real(kind=rp) :: Sz(-5:0,2:6) + real(kind=rp) :: Ihyd ! Hydrostatic definite integral + real(kind=rp) :: ccor ! Chapman and logistical corrections + + ! Below minimum height of profile + if (z .lt. dpro%zmin) then + dfnx = dmissing + return + endif + + ! Anomalous Oxygen (legacy MSISE-00 formulation) + if (dpro%ispec .eq. 9) then + dfnx = dpro%lndref - (z - dpro%zref)/HOA - dpro%C*exp(-(z-dpro%zetaC)/dpro%HC) + dfnx = exp(dfnx) + return !No further calculation needed for anomalous oxygen + endif + + ! Nitric Oxide: Skip if parameters are not defined + if (dpro%ispec .eq. 10) then + if (dpro%lndref .eq. 0.0_rp) then + dfnx = dmissing + return + endif + endif + + ! Chapman and logistic corrections + select case(dpro%ispec) + case(2,3,5,7) !For N2, O2, He, and Ar: logistic correction only + ccor = dpro%R*(1+tanh((z-dpro%zetaR)/(HRfact*dpro%HR))) + case(4,6,8,10) !For O, H, N, and NO: Chapman and logistic corrections + ccor = - dpro%C*exp(-(z-dpro%zetaC)/dpro%HC) & + + dpro%R*(1+tanh((z-dpro%zetaR)/(HRfact*dpro%HR))) + endselect + + ! Below height where hydrostatic terms are needed + if (z .lt. dpro%zhyd) then + select case(dpro%ispec) + case(2,3,5,7) !For N2, O2, He, and Ar, apply mixing ratios and exit + dfnx = exp(lndtotz + dpro%lnPhiF + ccor) + return + case(4) !For O, evaluate splines + call bspline(z,nodesO1,ndO1,4,etaO1,Sz,iz) + dfnx = exp(dot_product(dpro%cf(iz-3:iz),Sz(-3:0,4))) + return + case(10) !For NO, evaluate splines + call bspline(z,nodesNO,ndNO,4,etaNO,Sz,iz) + dfnx = exp(dot_product(dpro%cf(iz-3:iz),Sz(-3:0,4))) + return + endselect + endif + + ! Calculate hydrostatic term and apply to reference density + Mz = pwmp(z,dpro%zetaMi,dpro%Mi,dpro%aMi) + Ihyd = Mz * Vz - dpro%Izref + if ((z .gt. dpro%zetaMi(0)) .and. (z .lt. dpro%zetaMi(4))) then + i = 0 + do i1 = 1, 3 + if (z .lt. dpro%zetaMi(i1)) then + exit + else + i = i1 + endif + enddo + Ihyd = Ihyd - (dpro%aMi(i)*Wz + dpro%XMi(i)) + else if (z .ge. dpro%zetaMi(4)) then + Ihyd = Ihyd - dpro%XMi(4) + endif + dfnx = dpro%lndref - Ihyd * g0divkB + ccor + + ! Apply ideal gas law + dfnx = exp(dfnx) * dpro%Tref/tnz + + return + + end function dfnx + + !================================================================================================== + ! PWMP: Piecewise effective mass profile interpolation + !================================================================================================== + real(kind=rp) function pwmp(z,zm,m,dmdz) + + use msis_constants, only : rp + + real(kind=rp), intent(in) :: z + real(kind=rp), intent(in) :: zm(0:4) + real(kind=rp), intent(in) :: m(0:4) + real(kind=rp), intent(in) :: dmdz(0:3) + + integer :: irng !Index of piecwise interval + integer :: inode + + ! Most probable case + if (z .ge. zm(4)) then + pwmp = m(4) + return + endif + + ! Second most probable case + if (z .le. zm(0)) then + pwmp = m(0) + return + endif + + ! None of the above + do inode = 0,3 + if (z .lt. zm(inode+1)) then + pwmp = m(inode) + dmdz(inode)*(z - zm(inode)) + return + endif + enddo + + ! If we are here this is a problem + stop 'Error in pwmp' + + end function pwmp + +end module msis_dfn + diff --git a/sorc/chgres_cube.fd/msis2.1.fd/msis_gfn.F90 b/sorc/chgres_cube.fd/msis2.1.fd/msis_gfn.F90 new file mode 100644 index 000000000..f15f8aecd --- /dev/null +++ b/sorc/chgres_cube.fd/msis2.1.fd/msis_gfn.F90 @@ -0,0 +1,540 @@ +!####################################################################### +! MSIS� (NRL-SOF-014-1) SOFTWARE +! NRLMSIS� empirical atmospheric model software. Use is governed by the +! Open Source Academic Research License Agreement contained in the file +! nrlmsis2.1_license.txt, which is part of this software package. BY +! USING OR MODIFYING THIS SOFTWARE, YOU ARE AGREEING TO THE TERMS AND +! CONDITIONS OF THE LICENSE. +!####################################################################### + +!!! =========================================================================== +!!! NRLMSIS 2.1: +!!! Neutral atmosphere empirical model from the surface to lower exosphere +!!! =========================================================================== + +!************************************************************************************************** +! MSIS_GFN Module: Contains subroutines to calculate global (horizontal and time-dependent) model +! basis functions +!************************************************************************************************** +module msis_gfn + + use msis_constants, only : rp, maxn + use msis_init, only : TN,PR,N2,O2,O1,HE,H1,AR,N1,OA,NO, swg + + implicit none + + real(kind=rp) :: plg(0:maxn,0:maxn) + real(kind=rp) :: cdoy(2), sdoy(2) + real(kind=rp) :: clst(3), slst(3) + real(kind=rp) :: clon(2), slon(2) + real(kind=rp) :: sfluxavgref = 150.0 ! Reference F10.7 value (=150 in NRLMSISE-00) + real(kind=rp) :: sfluxavg_quad_cutoff = 150.0 ! Cutoff F10.7 for truncated quadratic F10.7a function + real(kind=rp) :: lastlat = -999.9 + real(kind=rp) :: lastdoy = -999.9 + real(kind=rp) :: lastlst = -999.9 + real(kind=rp) :: lastlon = -999.9 + +contains + + !================================================================================================== + ! GLOBE: Calculate horizontal and time-dependent basis functions + ! (Same purpose as NRLMSISE-00 "GLOBE7" subroutine) + !================================================================================================== + subroutine globe(doy,utsec,lat,lon,sfluxavg,sflux,ap,bf) + + use msis_constants, only : deg2rad, doy2rad, lst2rad, & + maxnbf, mbf, maxn, amaxn, amaxs, tmaxl, tmaxn, tmaxs, pmaxm, pmaxn, pmaxs, & + nsfx, nsfxmod, ctimeind, cintann, ctide, cspw, csfx, cextra, cnonlin, csfxmod, cmag, cut + implicit none + + real(kind=rp), intent(in) :: doy ! Day of year + real(kind=rp), intent(in) :: utsec ! Universal time in seconds + real(kind=rp), intent(in) :: lat ! Latitude + real(kind=rp), intent(in) :: lon ! Longitdue + real(kind=rp), intent(in) :: sfluxavg ! 81-day average F10.7 + real(kind=rp), intent(in) :: sflux ! Daily F10.7 + real(kind=rp), intent(in) :: ap(1:7) ! Ap geomagnetic activity index history array + real(kind=rp), intent(out) :: bf(0:maxnbf-1) ! Output array of basis function terms + + real(kind=rp) :: lst + real(kind=rp) :: slat, clat, clat2, clat4, slat2 + real(kind=rp) :: cosdoy, sindoy + real(kind=rp) :: coslon, sinlon + real(kind=rp) :: pl + real(kind=rp) :: coslst, sinlst + real(kind=rp) :: dfa, df + real(kind=rp) :: theta + real(kind=rp) :: sza + integer :: n, m, l, s, c + + ! Associated Legendre polynomials + if (lat .ne. lastlat) then + clat = sin(lat*deg2rad) ! clat <=> sin, Legendre polyomial defined in colat + slat = cos(lat*deg2rad) ! slat <=> cos, Legendre polyomial defined in colat + clat2 = clat*clat + clat4 = clat2*clat2 + slat2 = slat*slat + + plg(0,0) = 1.0_rp + plg(1,0) = clat + plg(2,0) = 0.5_rp * (3.0_rp * clat2 - 1.0_rp) + plg(3,0) = 0.5_rp * (5.0_rp * clat * clat2 - 3.0_rp * clat) + plg(4,0) = (35.0_rp * clat4 - 30.0_rp * clat2 + 3.0_rp)/8.0_rp + plg(5,0) = (63.0_rp * clat2 * clat2 * clat - 70.0_rp * clat2 * clat + 15.0_rp * clat)/8.0_rp + plg(6,0) = (11.0_rp * clat * plg(5, 0) - 5.0_rp * plg(4, 0))/6.0_rp + + plg(1,1) = slat + plg(2,1) = 3.0_rp * clat * slat + plg(3,1) = 1.5_rp * (5.0_rp * clat2 - 1.0_rp) * slat + plg(4,1) = 2.5_rp * (7.0_rp * clat2 * clat - 3.0_rp * clat) * slat + plg(5,1) = 1.875_rp * (21.0_rp * clat4 - 14.0_rp * clat2 + 1.0_rp) * slat + plg(6,1) = (11.0_rp * clat * plg(5, 1) - 6.0_rp * plg(4, 1))/5.0_rp + + plg(2,2) = 3.0_rp * slat2 + plg(3,2) = 15.0_rp * slat2 * clat + plg(4,2) = 7.5_rp * (7.0_rp * clat2 - 1.0_rp) * slat2 + plg(5,2) = 3.0_rp * clat * plg(4, 2) - 2.0_rp * plg(3, 2) + plg(6,2) = (11.0_rp * clat * plg(5, 2) - 7.0_rp * plg(4, 2))/4.0_rp + + plg(3,3) = 15.0_rp * slat2 * slat + plg(4,3) = 105.0_rp * slat2 * slat * clat + plg(5,3) = (9.0_rp * clat * plg(4, 3) - 7.0_rp * plg(3, 3))/2.0_rp + plg(6,3) = (11.0_rp * clat * plg(5, 3) - 8.0_rp * plg(4, 3))/3.0_rp + + lastlat = lat + endif + + ! Fourier harmonics of day of year + if (doy .ne. lastdoy) then + cdoy(1) = cos(doy2rad*doy) + sdoy(1) = sin(doy2rad*doy) + cdoy(2) = cos(doy2rad*doy*2.0_rp) + sdoy(2) = sin(doy2rad*doy*2.0_rp) + lastdoy = doy + endif + + ! Fourier harmonics of local time + lst = mod(utsec/3600.0_rp + lon/15.0_rp + 24.0_rp, 24.0_rp) + if (lst .ne. lastlst) then + clst(1) = cos(lst2rad*lst) + slst(1) = sin(lst2rad*lst) + clst(2) = cos(lst2rad*lst*2.0_rp) + slst(2) = sin(lst2rad*lst*2.0_rp) + clst(3) = cos(lst2rad*lst*3.0_rp) + slst(3) = sin(lst2rad*lst*3.0_rp) + lastlst = lst + endif + + ! Fourier harmonics of longitude + if (lon .ne. lastlon) then + clon(1) = cos(deg2rad*lon) + slon(1) = sin(deg2rad*lon) + clon(2) = cos(deg2rad*lon*2.0_rp) + slon(2) = sin(deg2rad*lon*2.0_rp) + lastlon = lon + endif + + !--------------------------------------------- + ! Coupled Linear Terms + !--------------------------------------------- + + ! Reset basis functions + bf(:) = 0.0_rp + + ! Time-independent (pure latitude dependence) + c = ctimeind + do n = 0, amaxn + bf(c) = plg(n,0) + c = c + 1 + enddo + + ! Intra-annual (annual and semiannual) + if (c .ne. cintann) stop 'problem with basis definitions' + do s = 1, amaxs + cosdoy = cdoy(s) + sindoy = sdoy(s) + do n = 0, amaxn + pl = plg(n,0) + bf(c) = pl*cosdoy + bf(c+1) = pl*sindoy + c = c + 2 + enddo + enddo + + ! Migrating Tides (local time dependence) + if (c .ne. ctide) stop 'problem with basis definitions' + do l = 1, tmaxl + coslst = clst(l) + sinlst = slst(l) + do n = l, tmaxn + pl = plg(n,l) + bf(c) = pl*coslst + bf(c+1) = pl*sinlst + c = c + 2 + enddo + ! Intra-annual modulation of tides + do s = 1, tmaxs + cosdoy = cdoy(s) + sindoy = sdoy(s) + do n = l, tmaxn + pl = plg(n,l) + bf(c) = pl*coslst*cosdoy + bf(c+1) = pl*sinlst*cosdoy + bf(c+2) = pl*coslst*sindoy + bf(c+3) = pl*sinlst*sindoy + c = c + 4 + enddo + enddo + enddo + + ! Stationary Planetary Waves (longitude dependence) + if (c .ne. cspw) stop 'problem with basis definitions' + do m = 1, pmaxm + coslon = clon(m) + sinlon = slon(m) + do n = m, pmaxn + pl = plg(n,m) + bf(c) = pl*coslon + bf(c+1) = pl*sinlon + c = c + 2 + enddo + ! Intra-annual modulation of SPWs + do s = 1, pmaxs + cosdoy = cdoy(s) + sindoy = sdoy(s) + do n = m, pmaxn + pl = plg(n,m) + bf(c) = pl*coslon*cosdoy + bf(c+1) = pl*sinlon*cosdoy + bf(c+2) = pl*coslon*sindoy + bf(c+3) = pl*sinlon*sindoy + c = c + 4 + enddo + enddo + enddo + + ! Linear solar flux terms + if (c .ne. csfx) stop 'problem with basis definitions' + dfa = sfluxavg - sfluxavgref + df = sflux - sfluxavg + bf(c) = dfa + bf(c+1) = dfa*dfa + bf(c+2) = df + bf(c+3) = df*df + bf(c+4) = df*dfa + c = c + nsfx + + ! Additional linear terms + if (c .ne. cextra) stop 'problem with basis definitions' + sza = solzen(doy,lst,lat,lon) + bf(c) = -0.5_rp*tanh((sza-98.0_rp)/6.0_rp) !Solar zenith angle logistic function for O, H (transition width 3 deg, transition sza for horizon at ~65 km altitude) + bf(c+1) = -0.5_rp*tanh((sza-101.5_rp)/20.0_rp) !Solar zenith angle logistic function for NO (transition width 10 deg, transition sza for horizon at ~130 km altitude) + bf(c+2) = dfa*bf(c) !Solar flux modulation of logistic sza term + bf(c+3) = dfa*bf(c+1) !Solar flux modulation of logistic sza term + bf(c+4) = dfa*plg(2,0) !Solar flux modulation of P(2,0) term + bf(c+5) = dfa*plg(4,0) !Solar flux modulation of P(4,0) term + bf(c+6) = dfa*plg(0,0)*cdoy(1) !Solar flux modulation of global AO + bf(c+7) = dfa*plg(0,0)*sdoy(1) !Solar flux modulation of global AO + bf(c+8) = dfa*plg(0,0)*cdoy(2) !Solar flux modulation of global SAO + bf(c+9) = dfa*plg(0,0)*sdoy(2) !Solar flux modulation of global SAO + if (sfluxavg .le. sfluxavg_quad_cutoff) then !Quadratic F10.7a function with cutoff of quadratic term (for robust extrapolation) + bf(c+10) = dfa*dfa + else + bf(c+10) = (sfluxavg_quad_cutoff-sfluxavgref)*(2.0_rp*dfa - (sfluxavg_quad_cutoff-sfluxavgref)) + endif + bf(c+11) = bf(c+10)*plg(2,0) !P(2,0) modulation of truncated quadratic F10.7a term + bf(c+12) = bf(c+10)*plg(4,0) !P(4,0) modulation of truncated quadratic F10.7a term + bf(c+13) = df*plg(2,0) !P(2,0) modulation of df --> (F10.7 - F10.7a) + bf(c+14) = df*plg(4,0) !P(4,0) modulation of df --> (F10.7 - F10.7a) + + !--------------------------------------------- + ! Nonlinear Terms + !--------------------------------------------- + + c = cnonlin + + ! Solar flux modulation terms + if (c .ne. csfxmod) stop 'problem with basis definitions' + bf(c) = dfa + bf(c+1) = dfa*dfa + bf(c+2) = df + bf(c+3) = df*df + bf(c+4) = df*dfa + c = c + nsfxmod + + ! Terms needed for legacy geomagnetic activity dependence + if (c .ne. cmag) stop 'problem with basis set' + bf(c:c+6) = ap - 4.0 + bf(c+8) = doy2rad*doy + bf(c+9) = lst2rad*lst + bf(c+10) = deg2rad*lon + bf(c+11) = lst2rad*utsec/3600.0 + bf(c+12) = abs(lat) + c = c + 13 + do m = 0,1 + do n = 0,amaxn + bf(c) = plg(n,m) + c = c + 1 + enddo + enddo + + ! Terms needed for legacy UT dependence + c = cut + bf(c) = lst2rad*utsec/3600.0 + bf(c+1) = doy2rad*doy + bf(c+2) = dfa + bf(c+3) = deg2rad*lon + bf(c+4) = plg(1,0) + bf(c+5) = plg(3,0) + bf(c+6) = plg(5,0) + bf(c+7) = plg(3,2) + bf(c+8) = plg(5,2) + + !--------------------------------------------- + ! Apply Switches + !--------------------------------------------- + where(.not. swg(0:mbf)) bf(0:mbf) = 0.0_rp + + return + + end subroutine globe + + !================================================================================================== + ! SOLZEN: Calculate solar zenith angle (adapted from IRI subroutine) + !================================================================================================== + real(kind=rp) function solzen(ddd,lst,lat,lon) + + use msis_constants, only : pi, deg2rad + + implicit none + + real(kind=rp), intent(in) :: ddd + real(kind=rp), intent(in) :: lst + real(kind=rp), intent(in) :: lat + real(kind=rp), intent(in) :: lon + + real(kind=rp) :: wlon,dec + real(kind=rp) :: teqnx,tf,teqt + real(kind=rp) :: rlat,phi,cosx + real(kind=rp), parameter :: humr = pi/12.0_rp + real(kind=rp), parameter :: dumr = pi/182.5_rp + real(kind=rp), parameter :: p(5) = (/0.017203534,0.034407068,0.051610602,0.068814136,0.103221204/) + + wlon = 360.0 - lon + teqnx = ddd + (lst + wlon / 15.0_rp) / 24.0_rp + 0.9369_rp + teqnx = ddd + 0.9369_rp + + ! Solar declination + dec = 23.256_rp * sin(p(1) * (teqnx - 82.242_rp)) + 0.381_rp * sin(p(2)*(teqnx - 44.855_rp)) & + + 0.167_rp * sin(p(3) * (teqnx - 23.355_rp)) - 0.013_rp * sin(p(4)*(teqnx + 11.97_rp)) & + + 0.011_rp * sin(p(5) * (teqnx - 10.410_rp)) + 0.339137_rp + dec = dec * deg2rad + + ! Equation of time + tf = teqnx - 0.5_rp + teqt = -7.38_rp * sin(p(1) * (tf - 4.0_rp)) - 9.87_rp * sin(p(2) * (tf + 9.0_rp)) & + + 0.27_rp * sin(p(3) * (tf - 53.0_rp)) - 0.2_rp * cos(p(4) * (tf - 17.0_rp)) + + phi = humr * (lst - 12.0_rp) + teqt * deg2rad / 4.0_rp + rlat = lat * deg2rad + + ! Cosine of solar zenith angle + cosx = sin(rlat) * sin(dec) + cos(rlat) * cos(dec) * cos(phi) + if (abs(cosx) .gt. 1.0_rp) cosx = sign(1.0_rp,cosx) + + solzen = acos(cosx) / deg2rad + + return + + end function solzen + + !================================================================================================== + ! SFLUXMOD: Legacy nonlinear modulation of intra-annual, tide, and SPW terms + !================================================================================================== + real(kind=rp) function sfluxmod(iz,gf,parmset,dffact) + + use msis_constants, only : maxnbf, mbf, csfx, csfxmod + use msis_init, only : basissubset, zsfx, tsfx, psfx + + implicit none + + integer, intent(in) :: iz + real(kind=rp), intent(in) :: gf(0:maxnbf-1) + type(basissubset), intent(in) :: parmset + real(kind=rp), intent(in) :: dffact !Turns on or adjusts the delta-F terms added to F1 and F2 (eqns. A22b and A22c in Hedin (1987)). + + real(kind=rp) :: f1, f2, f3, sum + integer :: j + + ! Intra-annual modulation factor + if (swg(csfxmod)) then + f1 = parmset%beta(csfxmod,iz) * gf(csfxmod) & + + (parmset%beta(csfx+2,iz) * gf(csfxmod+2) + parmset%beta(csfx+3,iz) * gf(csfxmod+3) ) * dffact + else + f1 = 0.0_rp + endif + + ! Migrating tide (local time) modulation factor + if (swg(csfxmod+1)) then + f2 = parmset%beta(csfxmod+1,iz) * gf(csfxmod) & + + (parmset%beta(csfx+2,iz) * gf(csfxmod+2) + parmset%beta(csfx+3,iz) * gf(csfxmod+3) ) * dffact + else + f2 = 0.0_rp + endif + + ! SPW (longitude) modulation factor + if (swg(csfxmod+2)) then + f3 = parmset%beta(csfxmod+2,iz) * gf(csfxmod) + else + f3 = 0.0_rp + endif + + sum = 0.0 + do j = 0, mbf + ! Apply intra-annual modulation + if (zsfx(j)) then + sum = sum + parmset%beta(j,iz)*gf(j)*f1 + cycle + endif + ! Apply migrating tide modulation + if (tsfx(j)) then + sum = sum + parmset%beta(j,iz)*gf(j)*f2 + cycle + endif + ! Apply SPW modulation + if (psfx(j)) then + sum = sum + parmset%beta(j,iz)*gf(j)*f3 + cycle + endif + enddo + + sfluxmod = sum + + return + + end function sfluxmod + + !================================================================================================== + ! GEOMAG: Legacy nonlinear ap dependence (daily ap mode and ap history mode), including mixed + ! ap/UT/Longitude terms. + ! Master switch control is as follows: + ! swg(cmag) .nor. swg(cmag+1) Do nothing: Return zero + ! swg(cmag) .and. swg(cmag+1) Daily Ap mode + ! swg(cmag) .neqv. swg(cmag+1) 3-hour ap history mode + !================================================================================================== + real(kind=rp) function geomag(p0,bf,plg) + + use msis_constants, only : nmag, cmag + + implicit none + + real(kind=rp), intent(in) :: p0(0:nmag-1) + real(kind=rp), intent(in) :: bf(0:12) + real(kind=rp), intent(in) :: plg(0:6,0:1) + + logical :: swg1(0:nmag-1) !Copy of switches + real(kind=rp) :: p(0:nmag-1) !Copy of parameters used to apply switches + real(kind=rp) :: delA, gbeta, ex, sumex, G(1:6) + integer(4) :: i + + ! Return zero if both master switches are off + if (.not. (swg(cmag) .or. swg(cmag+1))) then + geomag = 0.0_rp + return + endif + + ! Copy parameters + p = p0 + swg1 = swg(cmag:cmag+nmag-1) + + ! Calculate function + if (swg1(0) .eqv. swg1(1)) then + ! Daily Ap mode + if (p(1) .eq. 0) then !If k00s is zero, then cannot compute function + geomag = 0.0_rp + return + endif + where(.not. swg1(2:25)) p(2:25) = 0.0_rp !Apply switches + p(8) = p0(8) !Need doy phase term + delA = G0fn(bf(0),p(0),p(1)) + geomag = ( p(2)*plg(0,0) + p(3)*plg(2,0) + p(4)*plg(4,0) & ! time independent + + (p(5)*plg(1,0) + p(6)*plg(3,0) + p(7)*plg(5,0)) * cos(bf(8) - p(8)) & ! doy modulation + + (p(9)*plg(1,1) + p(10)*plg(3,1) + p(11)*plg(5,1)) * cos(bf(9) - p(12)) & ! local time modulation + + (1.0_rp + p(13)*plg(1,0)) * & + (p(14)*plg(2,1) + p(15)*plg(4,1) + p(16)*plg(6,1)) * cos(bf(10) - p(17)) & ! longitude effect + + (p(18)*plg(1,1) + p(19)*plg(3,1) + p(20)*plg(5,1)) * cos(bf(10) - p(21)) * & + cos(bf(8) - p(8)) & ! longitude with doy modulaiton + + (p(22)*plg(1,0) + p(23)*plg(3,0) + p(24)*plg(5,0)) * cos(bf(11) - p(25)) ) & ! universal time + *delA + else + ! 3-hour ap history mode + if (p(28) .eq. 0) then !If beta00 is zero, then cannot compute function + geomag = 0.0 + return + endif + where(.not. swg1(30:)) p(30:) = 0.0 !Apply switches + p(36) = p0(36) !Need doy phase term + gbeta = p(28)/(1 + p(29)*(45.0_rp - bf(12))) + ex = exp(-10800.0_rp*gbeta) + sumex = 1 + (1 - ex**19.0_rp) * ex**(0.5_rp) / (1 - ex) + do i = 1, 6 + G(i) = G0fn(bf(i),p(26),p(27)) + enddo + delA = ( G(1) & + + ( G(2)*ex + G(3)*ex*ex + G(4)*ex**3.0_rp & + +(G(5)*ex**4.0_rp + G(6)*ex**12.0_rp)*(1-ex**8.0_rp)/(1-ex) ) ) / sumex + geomag = ( p(30)*plg(0,0) + p(31)*plg(2,0) + p(32)*plg(4,0) & ! time independent + + (p(33)*plg(1,0) + p(34)*plg(3,0) + p(35)*plg(5,0)) * cos(bf(8) - p(36)) & ! doy modulation + + (p(37)*plg(1,1) + p(38)*plg(3,1) + p(39)*plg(5,1)) * cos(bf(9) - p(40)) & ! local time modulation + + (1.0_rp + p(41)*plg(1,0)) * & + (p(42)*plg(2,1) + p(43)*plg(4,1) + p(44)*plg(6,1)) * cos(bf(10) - p(45)) & ! longitude effect + + (p(46)*plg(1,1) + p(47)*plg(3,1) + p(48)*plg(5,1)) * cos(bf(10) - p(49)) * & + cos(bf(8) - p(36)) & ! longitude with doy modulaiton + + (p(50)*plg(1,0) + p(51)*plg(3,0) + p(52)*plg(5,0)) * cos(bf(11) - p(53)) ) & ! universal time + *delA + endif + + return + + contains + + real(kind=rp) function G0fn(a,k00r,k00s) + real(kind=rp),intent(in) :: a, k00r, k00s + G0fn = a + (k00r - 1.0_rp) * (a + (exp(-a*k00s) - 1.0_rp)/k00s) + return + end function G0fn + + end function geomag + + !================================================================================================== + ! UTDEP: Legacy nonlinear UT dependence + !================================================================================================== + real(kind=rp) function utdep(p0,bf) + + use msis_constants, only : nut, cut + + implicit none + + real(kind=rp), intent(in) :: p0(0:nut-1) + real(kind=rp), intent(in) :: bf(0:8) + + real(kind=rp) :: p(0:nut-1) !Copy of parameters used to apply switches + logical :: swg1(0:nut-1) !Copy of switches + + !Copy parameters + p = p0 + swg1 = swg(cut:cut+nut-1) + where(.not. swg1(3:nut-1)) p(3:nut-1) = 0.0 !Apply switches + + ! Calculate function + utdep = cos(bf(0)-p(0)) * & + (1 + p(3)*bf(4)*cos(bf(1)-p(1))) * & + (1 + p(4)*bf(2)) * (1 + p(5)*bf(4)) * & + (p(6)*bf(4) + p(7)*bf(5) + p(8)*bf(6)) + & + cos(bf(0)-p(2)+2*bf(3)) * (p(9)*bf(7) + p(10)*bf(8)) * (1 + p(11)*bf(2)) + + return + + end function utdep + +end module msis_gfn diff --git a/sorc/chgres_cube.fd/msis2.1.fd/msis_gtd8d.F90 b/sorc/chgres_cube.fd/msis2.1.fd/msis_gtd8d.F90 new file mode 100644 index 000000000..1955a3cad --- /dev/null +++ b/sorc/chgres_cube.fd/msis2.1.fd/msis_gtd8d.F90 @@ -0,0 +1,147 @@ +!####################################################################### +! MSIS� (NRL-SOF-014-1) SOFTWARE +! NRLMSIS� empirical atmospheric model software. Use is governed by the +! Open Source Academic Research License Agreement contained in the file +! nrlmsis2.1_license.txt, which is part of this software package. BY +! USING OR MODIFYING THIS SOFTWARE, YOU ARE AGREEING TO THE TERMS AND +! CONDITIONS OF THE LICENSE. +!####################################################################### + +!!! =========================================================================== +!!! NRLMSIS 2.1: +!!! Neutral atmosphere empirical model from the surface to lower exosphere +!!! =========================================================================== +!!! +!!! GTD8D: Legacy wrapper with input and output arguments used in NRLMSISE-00 +! +! PREREQUISITES: +! Must first run MSISINIT to load parameters and set switches. The +! MSISCALC subroutine (called by this wrapper) checks for initialization +! and does a default initialization if necessary. This self-initialization +! will be removed in future versions. +! +! CALLING SEQUENCE: +! CALL GTD8D(IYD, SEC, ALT, GLAT, GLONG, STL, F107A, F107, AP, MASS, D, T) +! +! INPUT VARIABLES: +! IYD Year and day as YYDDD (day of year from 1 to 365 (or 366)) +! (Year is ignored in current model) +! SEC Universal time (seconds) +! ALT Geodetic altitude (km) +! GLAT Geodetic latitude (deg) +! GLONG Geodetic longitude (deg) +! STL Local solar time (Ignored; calculated from SEC and GLONG) +! F107A 81 day average, centered on input time, of F10.7 solar activity +! index +! F107 Daily F10.7 for previous day +! AP Geomagnetic activity index array: +! (1) Daily Ap +! (2) 3 hr ap index for current time +! (3) 3 hr ap index for 3 hrs before current time +! (4) 3 hr ap index for 6 hrs before current time +! (5) 3 hr ap index for 9 hrs before current time +! (6) Average of eight 3 hr ap indices from 12 to 33 hrs +! prior to current time +! (7) Average of eight 3 hr ap indices from 36 to 57 hrs +! prior to current time +! AP(2:7) are only used when switch_legacy(9) = -1.0 in MSISINIT +! MASS Mass number (Ignored in 2.0) +! +! NOTES ON INPUT VARIABLES: +! - If lzalt_type = .false. in the MSISINIT call, then the ALT input +! argument is treated as geopotential height. +! - The STL input argument is ignored in NRLMSIS 2.0. Instead, local time +! is computed from universal time and longitude. +! - F107 and F107A values are the 10.7 cm radio flux at the Sun-Earth +! distance, not the radio flux at 1 AU. +! - The MASS input argument is ignored in NRLMSIS 2.0; species to be +! calculated are set in MSISINIT. +! +! OUTPUT VARIABLES: +! D(1) He number density (cm-3) +! D(2) O number density (cm-3) +! D(3) N2 number density (cm-3) +! D(4) O2 number density (cm-3) +! D(5) Ar number density (cm-3) +! D(6) Total mass density (g/cm3) +! D(7) H number density (cm-3) +! D(8) N number density (cm-3) +! D(9) Anomalous oxygen number density (cm-3) +! D(10) NO number density (cm-3) +! T(1) Exospheric temperature (K) +! T(2) Temperature at altitude (K) +! +! NOTES ON OUTPUT VARIABLES: +! - Missing density values are returned as 9.999e-38 +! - Species included in mass density calculation are set in MSISINIT +! +!!! ========================================================================= + +!================================================================================================== +! GTD8D: Legacy wrapper +!================================================================================================== +subroutine gtd8d(iyd,sec,alt,glat,glong,stl,f107a,f107,ap,mass,d,t) + + use msis_constants, only : rp, dmissing + use msis_init, only : msisinit + use msis_calc, only : msiscalc + + implicit none + + ! MSIS Legacy subroutine arguments + integer, intent(in) :: iyd + real(4), intent(in) :: sec + real(4), intent(in) :: alt + real(4), intent(in) :: glat + real(4), intent(in) :: glong + real(4), intent(in) :: stl + real(4), intent(in) :: f107a + real(4), intent(in) :: f107 + real(4), intent(in) :: ap(7) + integer, intent(in) :: mass + real(4), intent(out) :: d(10), t(2) + + ! MSIS 1.97 subroutine arguments + real(kind=rp) :: xday + real(kind=rp) :: xutsec + real(kind=rp) :: xalt + real(kind=rp) :: xlat + real(kind=rp) :: xlon + real(kind=rp) :: xsfluxavg, xsflux + real(kind=rp) :: xap(1:7) + real(kind=rp) :: xtn + real(kind=rp) :: xdn(1:10) + real(kind=rp) :: xtex + + ! Convert the legacy input arguments to the new interface values and precision + xday = mod(iyd,1000) + xutsec = sec + xalt = alt + xlat = glat + xlon = glong + xsfluxavg = f107a + xsflux = f107 + xap = ap + + ! Call the new subroutine + call msiscalc(xday,xutsec,xalt,xlat,xlon,xsfluxavg,xsflux,xap,xtn,xdn,tex=xtex) + + ! Convert the output arguments to the legacy format (mks to cgs, re-order species) + t(1) = sngl(xtex) ! Expospheric temperature + t(2) = sngl(xtn) ! Temperature at altitude + where (xdn .ne. dmissing) xdn = xdn*1d-6 + if (xdn(1) .ne. dmissing) xdn(1) = xdn(1)*1e3_rp + d(1) = sngl(xdn(5)) ! [He] + d(2) = sngl(xdn(4)) ! [O] + d(3) = sngl(xdn(2)) ! [N2] + d(4) = sngl(xdn(3)) ! [O2] + d(5) = sngl(xdn(7)) ! [Ar] + d(6) = sngl(xdn(1)) ! Mass density + d(7) = sngl(xdn(6)) ! [H] + d(8) = sngl(xdn(8)) ! [N] + d(9) = sngl(xdn(9)) ! [Anomalous O] + d(10) = sngl(xdn(10)) ! [NO] + + return + +end subroutine gtd8d \ No newline at end of file diff --git a/sorc/chgres_cube.fd/msis2.1.fd/msis_init.F90 b/sorc/chgres_cube.fd/msis2.1.fd/msis_init.F90 new file mode 100644 index 000000000..e6dd54b25 --- /dev/null +++ b/sorc/chgres_cube.fd/msis2.1.fd/msis_init.F90 @@ -0,0 +1,638 @@ +!####################################################################### +! MSIS� (NRL-SOF-014-1) SOFTWARE +! NRLMSIS� empirical atmospheric model software. Use is governed by the +! Open Source Academic Research License Agreement contained in the file +! nrlmsis2.1_license.txt, which is part of this software package. BY +! USING OR MODIFYING THIS SOFTWARE, YOU ARE AGREEING TO THE TERMS AND +! CONDITIONS OF THE LICENSE. +!####################################################################### + +!!! =========================================================================== +!!! NRLMSIS 2.1: +!!! Neutral atmosphere empirical model from the surface to lower exosphere +!!! =========================================================================== +!!! +!!! MSISINIT: Initialization of MSIS parameters, switches, and options. +! +! PREREQUISITES: +! MSIS binary parameter file (msis207.parm) +! +! CALLING SEQUENCE: +! CALL MSISINIT([OPTIONAL ARGUMENTS]) +! +! OPTIONAL ARGUMENTS: +! parmpath File path pointing to the MSIS parameter file. +! Default: Null string (current directory) +! parmfile Name of MSIS parameter file. +! Default: 'msis21.parm' +! iun File unit number for reading parameter file. +! Default: 67 +! switch_gfn Logical array of 512 swtiches for individual terms. For +! advanced users. +! Default values: True (all switches on) +! switch_legacy Floating point array (1:25) of legacy switches that +! control groups of terms: +! 1 - F10.7 +! 2 - Time independent +! 3 - Symmetrical annual +! 4 - Symmetrical semiannual +! 5 - Asymmetrical annual +! 6 - Asymmetrical semiannual +! 7 - Diurnal +! 8 - Semidiurnal +! 9 - Geomagnetic activity: +! 1.0 = Daily Ap mode +! -1.0 = Storm-time ap mode +! 10 - All UT/long effects +! 11 - Longitudinal +! 12 - UT and mixed UT/long +! 13 - Mixed Ap/UT/long +! 14 - Terdiurnal +! 15-25 - Not used in NRLMSIS 2.07 +! For all switches: +! 0.0 = Off +! 1.0 = On +! 2.0 = Main effects off, cross terms on +! Default values: 1.0 +! lzalt_type Logical flag for altitude input type: +! True = Geodetic altitude (km) +! False = Geopotential height (km) +! Default: True (Geodetic altitude) +! lspec_select Logical array (1:10) flagging which densities to +! calculate. +! True = Calculate, False = Do not calculate +! 1 - Mass density +! 2 - N2 +! 3 - O2 +! 4 - O +! 5 - He +! 6 - H +! 7 - Ar +! 8 - N +! 9 - Anomalous O +! 10 - NO +! Default values: True +! lmass_include Logical array (1:10) flagging which species to include +! in mass density calculation. Same ordering as +! lspec_select. +! Default values: True +! lN2_msis00 Logical flag for retrieving NRLMSISE-00 upper +! thermospheric N2 variation. See paper for details. +! False: Thermospheric N2 determined entirely by +! temperature profile and the constant mixing ratio +! of N2 in the lower atmosphere. +! True: Upper thermospheric N2 relaxes to NRLMSISE-00 +! Values. +! Default: False +! +! NOTES: +! - The switch_legacy optional argument performs the same function as +! TSELEC(SW) in NRLSMSISE-00, except that switches 15-25 are not used in +! NRLMSIS 2.07. The change in the switch-setting call is illustrated as +! follows, where SW is the 25-element array of switches: +! NRLMSISE-00: CALL TSELEC(SW) +! NRLMSIS 2.07: call msisinit(switch_legacy=SW) +! +!!! =========================================================================== + +!************************************************************************************************** +! MSIS_INIT Module: Contains initialization subroutines, model options, and model parameters +!************************************************************************************************** +module msis_init + + use msis_constants, only : rp, nspec, nl, maxnbf, mbf + + implicit none + + !Model flags + logical :: initflag = .false. !Flags whether model has been initialized + logical :: haveparmspace = .false. !Flags whether parameter space has been initialized and allocated + logical :: zaltflag = .true. !true: height input is geometric, false: height input is geopotential + logical :: specflag(1:nspec-1) = .true. !Array flagging which species densities are required + logical :: massflag(1:nspec-1) = .true. !Array flagging which species should be included in mass density + logical :: N2Rflag = .false. !Flag for retrieving NRLMSISE-00 thermospheric N2 variations + logical :: zsfx(0:mbf) = .false. !Flags zonal mean terms to be modulated by F1 (MSISE-00 legacy multiplier) + logical :: tsfx(0:mbf) = .false. !Flags tide terms to be modulated by F2 (MSISE-00 legacy multiplier) + logical :: psfx(0:mbf) = .false. !Flags SPW terms to be modulated by F3 (MSISE-00 legacy multiplier) + logical :: smod(0:nl) = .false. !Flags which temperature levels get solar flux modulation; loadparmset turns flags on based on parameter values + logical :: swg(0:maxnbf-1) = .true. !Switch array for globe subroutine. + real(kind=rp) :: masswgt(1:nspec-1) = 0.0_rp !Weights for calculating mass density + real(4) :: swleg(1:25)=1.0, swc(1:25), sav(1:25) !Legacy switch arrays + + ! Model parameter arrays + type basissubset + sequence + character(8) :: name + integer :: bl,nl + real(kind=rp), allocatable :: beta(:,:) + logical, allocatable :: active(:,:) + integer, allocatable :: fitb(:,:) + end type basissubset + type (basissubset) :: TN + type (basissubset) :: PR + type (basissubset) :: N2 + type (basissubset) :: O2 + type (basissubset) :: O1 + type (basissubset) :: HE + type (basissubset) :: H1 + type (basissubset) :: AR + type (basissubset) :: N1 + type (basissubset) :: OA !Anomalous O + type (basissubset) :: NO + integer :: nvertparm + + ! Reciprocal node difference arrays (constant values needed for B-spline calculations) + real(kind=rp) :: etaTN(0:30,2:6) = 0.0_rp + real(kind=rp) :: etaO1(0:30,2:6) = 0.0_rp + real(kind=rp) :: etaNO(0:30,2:6) = 0.0_rp + + ! C1 constraint terms for O and NO related to the tapered logistic correction + real(kind=rp) :: HRfactO1ref, dHRfactO1ref, HRfactNOref, dHRfactNOref + +contains + + !================================================================================================== + ! MSISINIT: Entry point for initializing model and loading parameters + !================================================================================================== + subroutine msisinit(parmpath,parmfile,iun,switch_gfn,switch_legacy, & + lzalt_type,lspec_select,lmass_include,lN2_msis00) + + use msis_constants, only : specmass, nspec, maxnbf + + implicit none + + character(len=*), intent(in), optional :: parmpath !Path to parameter file + character(len=*), intent(in), optional :: parmfile !Parameter file name + integer, intent(in), optional :: iun !File unit number for reading parameter file + logical, intent(in), optional :: switch_gfn(0:maxnbf-1) !Switch array for globe subroutine. + real(4), intent(in), optional :: switch_legacy(1:25) !Legacy switch array + logical, intent(in), optional :: lzalt_type !true: height input is geometric, false: height input is geopotential + logical, intent(in), optional :: lspec_select(1:nspec-1) !Array flagging which species densities are required + logical, intent(in), optional :: lmass_include(1:nspec-1) !Array flagging which species should be included in mass density + logical, intent(in), optional :: lN2_msis00 !Flag for retrieving NRLMSISE-00 thermospheric N2 variations + + character(len=128) :: parmpath1 + character(len=300) :: parmfile1 + integer :: iun1 + + ! Path to parameter file + if (present(parmpath)) then + parmpath1 = parmpath + else + parmpath1 = '' + endif + + ! Parameter file name + if (present(parmfile)) then + parmfile1 = parmfile + else + parmfile1 = 'msis21.parm' + endif + + ! Initialize model parameter space + if (.not. haveparmspace) call initparmspace() + + ! Load parameter set + if (present(iun)) then + iun1 = iun + else + iun1 = 67 + endif + call loadparmset(trim(parmpath1)//trim(parmfile1),iun1) + + ! Set switches + swg(:) = .true. + swleg(:) = 1.0 + if (present(switch_gfn)) then + swg = switch_gfn + else + if (present(switch_legacy)) then + swleg = switch_legacy + call tselec(swleg) + endif + endif + + ! Input altitude type flag + if (present(lzalt_type)) then + zaltflag = lzalt_type + else + zaltflag = .true. + endif + + ! Species flags for number density and mass density + if (present(lspec_select)) then + specflag = lspec_select + else + specflag(:) = .true. + endif + if (specflag(1)) then + if (present(lmass_include)) then + massflag = lmass_include + else + massflag(:) = .true. + endif + else + massflag(:) = .false. + endif + where(massflag) specflag = .true. + masswgt(:) = 0.0_rp + where(massflag) masswgt = 1.0_rp + masswgt(1) = 0.0_rp + masswgt = masswgt * specmass + masswgt(10) = 0.0_rp + + ! Flag for retrieving NRLMSISE-00 thermospheric N2 variations + if (present(lN2_msis00)) then + N2Rflag = lN2_msis00 + else + N2Rflag = .false. + endif + + ! Set model initialization flag + initflag = .true. + + return + + end subroutine msisinit + + !================================================================================================== + ! INITPARMSPACE: Initialize and allocate the model parameter space + !================================================================================================== + subroutine initparmspace() + + use msis_constants, only : nl, nls, nodesTN, ndO1, nsplO1, nodesO1, nsplNO, ndNO, nodesNO, & + zetagamma, Hgamma, zetarefO1, zetarefNO, maxnbf, ctide, cspw + + implicit none + + integer :: n, m, j, k + real(kind=rp) :: gammaterm0 + + ! Vertical parameter counter (number of vertical parameters in the parmeter file) + nvertparm = 0 + + ! Model formulation parameter subsets + call initsubset(TN,0,nl, maxnbf,'TN') + call initsubset(PR,0,nl, maxnbf,'PR') + call initsubset(N2,0,nls, maxnbf,'N2') + call initsubset(O2,0,nls, maxnbf,'O2') + call initsubset(O1,0,nls+nsplO1,maxnbf,'O1') + call initsubset(HE,0,nls, maxnbf,'HE') + call initsubset(H1,0,nls, maxnbf,'H1') + call initsubset(AR,0,nls, maxnbf,'AR') + call initsubset(N1,0,nls, maxnbf,'N1') + call initsubset(OA,0,nls, maxnbf,'OA') + call initsubset(NO,0,nls+nsplNO,maxnbf,'NO') + + ! Add the surface pressure parameter to the vertical parameter counter + nvertparm = nvertparm + 1 + + ! Set solar flux modulation flags + zsfx(:) = .false. + tsfx(:) = .false. + psfx(:) = .false. + ! F1, solar flux modulation of the zonal mean asymmetric annual terms + zsfx(9:10) = .true. !Pl(1,0) annual terms + zsfx(13:14) = .true. !Pl(3,0) annual terms + zsfx(17:18) = .true. !Pl(5,0) annual terms + ! F2, solar sflux modulation of the tides + tsfx(ctide:cspw-1) = .true. + ! F3, solar sflux modulation of stationary planetary wave 1 + psfx(cspw:cspw+59) = .true. + + ! Calculate reciprocal node difference arrays + do k = 2, 6 + do j = 0, nl + etaTN(j,k) = 1.0_rp / (nodesTN(j+k-1) - nodesTN(j)) + enddo + enddo + do k = 2, 4 + do j = 0, ndO1-k+1 + etaO1(j,k) = 1.0_rp / (nodesO1(j+k-1) - nodesO1(j)) + enddo + do j = 0, ndNO-k+1 + etaNO(j,k) = 1.0_rp / (nodesNO(j+k-1) - nodesNO(j)) + enddo + enddo + + ! Calculate C1 constraint terms for O and NO related to the tapered logistic correction + gammaterm0 = tanh((zetarefO1 - zetagamma)*Hgamma) + HRfactO1ref = 0.5_rp * (1.0_rp + gammaterm0) + dHRfactO1ref = (1.0_rp - (zetarefO1 - zetagamma)*(1.0_rp - gammaterm0)*Hgamma) / HRfactO1ref + gammaterm0 = tanh((zetarefNO - zetagamma)*Hgamma) + HRfactNOref = 0.5_rp * (1.0_rp + gammaterm0) + dHRfactNOref = (1.0_rp - (zetarefNO - zetagamma)*(1.0_rp - gammaterm0)*Hgamma) / HRfactNOref + + ! Set parameter space initialization flag + haveparmspace = .true. + + return + + contains + + !-------------------------------------------------------------------------------------------------- + ! INITSUBSET: Initialize and allocate a parameter subset + !-------------------------------------------------------------------------------------------------- + subroutine initsubset(subset,bl,nl,maxnbf,name) + + implicit none + + type (basissubset), intent(inout) :: subset + integer, intent(in) :: bl + integer, intent(in) :: nl + integer, intent(in) :: maxnbf + character(2), intent(in) :: name + + integer :: iz + + ! Allocate and initialize subset structure + subset%name = name + subset%bl = bl + subset%nl = nl + allocate(subset%beta(0:maxnbf-1,bl:nl), & + subset%active(0:maxnbf-1,bl:nl), & + subset%fitb(0:maxnbf-1,bl:nl)) + subset%beta = 0.0_rp + subset%active = .false. + subset%fitb = 0 + + ! Increment vertical parameter counter except for pressure + if (name .ne. 'PR') nvertparm = nvertparm + nl - bl + 1 + + return + + end subroutine initsubset + + end subroutine initparmspace + + !================================================================================================== + ! LOADPARMSET: Read in a parameter file + !================================================================================================== + subroutine loadparmset(name,iun) + + use mpi + + use msis_constants, only : maxnbf, csfxmod + + implicit none + + character(len=*), intent(in) :: name + integer, intent(in) :: iun + + integer :: i0, i1 + integer :: ierr + logical :: havefile + real(8), allocatable :: parmin(:,:) + + ! Check if file exists + inquire(file=trim(name),exist=havefile) + if (havefile) then + open(unit=iun,file=trim(name),status='old',access='stream',convert='little_endian') + else + print *,"FATAL ERROR: MSIS parameter set ",trim(name)," not found. Stopping." + call mpi_abort(mpi_comm_world, 999, ierr) + endif + + ! Read in parameter values into temporary double-precision array + allocate(parmin(0:maxnbf-1,0:nvertparm-1)) + read(iun) parmin + close(iun) + + ! Transfer parameters to structures + i0 = 0 + i1 = TN%nl - TN%bl + TN%beta = parmin(:,i0:i1) + i0 = i1 + 1 + i1 = i0 + PR%beta(:,0) = parmin(:,i0) + i0 = i1 + 1 + i1 = i0 + N2%nl - N2%bl + N2%beta = parmin(:,i0:i1) + i0 = i1 + 1 + i1 = i0 + O2%nl - O2%bl + O2%beta = parmin(:,i0:i1) + i0 = i1 + 1 + i1 = i0 + O1%nl - O1%bl + O1%beta = parmin(:,i0:i1) + i0 = i1 + 1 + i1 = i0 + HE%nl - HE%bl + HE%beta = parmin(:,i0:i1) + i0 = i1 + 1 + i1 = i0 + H1%nl - H1%bl + H1%beta = parmin(:,i0:i1) + i0 = i1 + 1 + i1 = i0 + AR%nl - AR%bl + AR%beta = parmin(:,i0:i1) + i0 = i1 + 1 + i1 = i0 + N1%nl - N1%bl + N1%beta = parmin(:,i0:i1) + i0 = i1 + 1 + i1 = i0 + OA%nl - OA%bl + OA%beta = parmin(:,i0:i1) + i0 = i1 + 1 + i1 = i0 + NO%nl - NO%bl + NO%beta = parmin(:,i0:i1) + + !Set solar flux modulation flags; if on for a given vertical parameter, then sfluxmod is called by tfnparm + smod(:) = .false. + where((Tn%beta(csfxmod+0,:) .ne. 0) .or. & + (Tn%beta(csfxmod+1,:) .ne. 0) .or. & + (Tn%beta(csfxmod+2,:) .ne. 0)) smod = .true. + + ! Compute log pressure spline coefficients from temperature spline coeffcients + call pressparm() + + return + + end subroutine loadparmset + + !================================================================================================== + ! PRESSPARM: Compute log pressure spline coefficients from temperature spline coeffcients + !================================================================================================== + subroutine pressparm() + + use msis_constants, only : Mbarg0divkB, izfmx, mbf, gwht + + implicit none + + integer :: j, b, iz + real(kind=rp) :: lnz + + !Integrate pressure on nodes up to the last fully mixed level + do j = 0, mbf + lnz = 0.0 + do b = 0, 3 + lnz = lnz + TN%beta(j,b)*gwht(b)*Mbarg0divkB + enddo + PR%beta(j,1) = -lnz + do iz = 1, izfmx + lnz = 0.0 + do b = 0, 3 + lnz = lnz + TN%beta(j,iz+b)*gwht(b)*Mbarg0divkB + enddo + PR%beta(j,iz+1) = PR%beta(j,iz) - lnz + enddo + enddo + + return + + end subroutine pressparm + + !================================================================================================== + ! TSELEC: Legacy switches and mapping to new switches + !================================================================================================== + subroutine tselec(sv) + + use msis_constants, only : nsfx, nsfxmod, nut, cspw, csfx, csfxmod, cmag, cut + + implicit none + + real(4), intent(in) :: sv(1:25) + + integer :: i + + !Set cross-terms flags + do i = 1, 25 + sav(i) = sv(i) + swleg(i) = amod(sv(i), 2.0) + if(abs(sv(i)) .eq. 1.0 .or. abs(sv(i)) .eq. 2.0) then + swc(i) = 1.0 + else + swc(i) = 0.0 + endif + enddo + + !Main effects + swg(0) = .true. !Global term must be on + swg(csfx:csfx+nsfx-1) = (swleg(1) .eq. 1.0) !Solar flux + swg(310) = (swleg(1) .eq. 1.0) !Solar flux (truncated quadratic F10.7a function) + swg(1:6) = (swleg(2) .eq. 1.0) !Time independent + swg(304:305) = (swleg(2) .eq. 1.0) !Time independent (extra, F10.7a modulated terms) + swg(311:312) = (swleg(2) .eq. 1.0) !Time independent (extra, truncated quadratic F10.7a modulated terms) + swg(313:314) = (swleg(2) .eq. 1.0) !Time independent (extra, dF10.7 modulated terms) + swg((/7,8,11,12,15,16,19,20/)) = (swleg(3) .eq. 1.0) !Symmetric annual + swg(306:307) = (swleg(3) .eq. 1.0) !Global AO (extra, solar-flux modulated terms) + swg((/21,22,25,26,29,30,33,34/)) = (swleg(4) .eq. 1.0) !Symmetric semiannual + swg(308:309) = (swleg(4) .eq. 1.0) !Global SAO (extra, solar-flux modulated terms) + swg((/9,10,13,14,17,18/)) = (swleg(5) .eq. 1.0) !Asymmetric annual + swg((/23,24,27,28,31,32/)) = (swleg(6) .eq. 1.0) !Asymmetric semiannual + swg(35:94) = (swleg(7) .eq. 1.0) !Diurnal + swg(300:303) = (swleg(7) .eq. 1.0) !Solar zenith angle + swg(95:144) = (swleg(8) .eq. 1.0) !Semidiurnal + swg(145:184) = (swleg(14) .eq. 1.0) !Terdiurnal + swg(cmag:cmag+1) = .false. !Geomagnetic activity mode master switch + if((swleg(9) .gt. 0) .or. (swleg(13) .eq. 1)) swg(cmag:cmag+1) = (/.true.,.true./) !Daily mode master switch + if(swleg(9) .lt. 0) swg(cmag:cmag+1) = (/.false.,.true./) !Storm-time mode master switch + swg(cmag+2:cmag+12) = (swleg(9) .eq. 1.0) !Daily geomagnetic activity terms + swg(cmag+28:cmag+40) = (swleg(9) .eq. -1.0) !Storm-time geomagnetic activity terms + swg(cspw:csfx-1) = ((swleg(11) .eq. 1.0) .and. (swleg(10) .eq. 1.0)) !Longitudinal + swg(cut:cut+nut-1) = ((swleg(12) .eq. 1.0) .and. (swleg(10) .eq. 1.0)) !UT/Lon + swg(cmag+13:cmag+25) = ((swleg(13) .eq. 1.0) .and. (swleg(10) .eq. 1.0)) !Mixed UT/Lon/Geomag (Daily mode terms) + swg(cmag+41:cmag+53) = ((swleg(13) .eq. 1.0) .and. (swleg(10) .eq. 1.0)) !Mixed UT/Lon/Geomag (Storm-time mode terms) + + !Cross terms + swg(csfxmod:csfxmod+nsfxmod-1) = (swc(1) .eq. 1.0) !Solar activity modulation + if (swc(1) .eq. 0) then !Solar activity modulation + swg(302:303) = .false. !Solar zenith angle + swg(304:305) = .false. !Time independent + swg(306:307) = .false. !Global AO + swg(308:309) = .false. !Global SAO + swg(311:314) = .false. !Time independent + swg(447) = .false. !UT/Lon + swg(454) = .false. !UT/Lon + endif + if (swc(2) .eq. 0) then !Time independent (latitude terms) (in MSISE-00, SWC(2) is not used - latitude modulations are always on) + swg(9:20) = .false. !AO + swg(23:34) = .false. !SAO + swg(35:184) = .false. !All tides + swg(185:294) = .false. !All SPW + swg(392:414) = .false. !Daily geomagnetic activity + swg(420:442) = .false. !Storm-time geomagnetic activity + swg(449:453) = .false. !UT/Lon + endif + if (swc(3) .eq. 0) then !Symmetric annual + swg(201:204) = .false. !SPW1 (2,1) + swg(209:212) = .false. !SPW1 (4,1) + swg(217:220) = .false. !SPW1 (6,1) + swg(255:258) = .false. !SPW2 (2,2) + swg(263:266) = .false. !SPW2 (4,2) + swg(271:274) = .false. !SPW2 (6,2) + swg(306:307) = .false. !Global AO solar flux modulation + endif + if (swc(4) .eq. 0) then !Symmetric semiannual + swg(225:228) = .false. !SPW1 (2,1) + swg(233:236) = .false. !SPW1 (4,1) + swg(241:244) = .false. !SPW1 (6,1) + swg(275:278) = .false. !SPW2 (2,2) + swg(283:286) = .false. !SPW2 (4,2) + swg(291:294) = .false. !SPW2 (6,2) + swg(308:309) = .false. !Global SAO solar flux modulation + endif + if (swc(5) .eq. 0) then !Asymmetric annual + swg(47:50) = .false. !Diurnal (1,1) + swg(51:54) = .false. !Diurnal (2,1) !In MSISE-00, swc(5) is applied to all annual modulated tides + swg(55:58) = .false. !Diurnal (3,1) + swg(59:62) = .false. !Diurnal (4,1) + swg(63:66) = .false. !Diurnal (5,1) + swg(67:70) = .false. !Diurnal (6,1) + swg(105:108) = .false. !Semidiurnal (2,2) + swg(109:112) = .false. !Semidiurnal (3,2) + swg(113:116) = .false. !Semidiurnal (4,2) + swg(117:120) = .false. !Semidiurnal (5,2) + swg(121:124) = .false. !Semidiurnal (6,2) + swg(153:156) = .false. !Terdiurnal (3,3) + swg(157:160) = .false. !Terdiurnal (4,3) + swg(161:164) = .false. !Terdiurnal (5,3) + swg(165:168) = .false. !Terdiurnal (6,3) + swg(197:200) = .false. !SPW1 (1,1) + swg(205:208) = .false. !SPW1 (3,1) + swg(213:216) = .false. !SPW1 (5,1) + swg(259:262) = .false. !SPW2 (3,2) + swg(267:270) = .false. !SPW2 (5,2) + swg(394:397) = .false. !Geomag (Daily mode terms) + swg(407:410) = .false. !Mixed UT/Lon/Geomag (Daily mode terms) + swg(422:425) = .false. !Geomag (Storm-time mode terms) + swg(435:438) = .false. !Mixed UT/Lon/Geomag (Storm-time mode terms) + swg(446) = .false. !UT/Lon + endif + if (swc(6) .eq. 0) then !Asymmetric semiannual + swg(221:224) = .false. !SPW1 (1,1) + swg(229:232) = .false. !SPW1 (3,1) + swg(237:240) = .false. !SPW1 (5,1) + swg(279:282) = .false. !SPW2 (3,2) + swg(287:290) = .false. !SPW2 (5,2) + endif + if (swc(7) .eq. 0) then !Diurnal + swg(398:401) = .false. !Geomag (Daily mode terms) + swg(426:429) = .false. !Geomag (Storm-time mode terms) + endif + if (swc(11) .eq. 0) then !Longitude + swg(402:410) = .false. !Mixed UT/Lon/Geomag (Daily mode terms) + swg(430:438) = .false. !Mixed UT/Lon/Geomag (Storm-time mode terms) + swg(452:453) = .false. !UT/Lon + endif + if (swc(12) .eq. 0) then !UT/Lon + swg(411:414) = .false. !Mixed UT/Lon/Geomag (Daily mode terms) + swg(439:440) = .false. !Mixed UT/Lon/Geomag (Storm-time mode terms) + endif + + end subroutine tselec + + !================================================================================================== + ! TRETRV: Legacy routine for retrieving switch settings + !================================================================================================== + subroutine tretrv(svv) + + implicit none + + real(4), intent(out) :: svv(1:25) + + integer :: i + + do i = 1, 25 + svv(i) = sav(i) + enddo + + end subroutine tretrv + +end module msis_init diff --git a/sorc/chgres_cube.fd/msis2.1.fd/msis_tfn.F90 b/sorc/chgres_cube.fd/msis2.1.fd/msis_tfn.F90 new file mode 100644 index 000000000..6f601799b --- /dev/null +++ b/sorc/chgres_cube.fd/msis2.1.fd/msis_tfn.F90 @@ -0,0 +1,176 @@ +!####################################################################### +! MSIS� (NRL-SOF-014-1) SOFTWARE +! NRLMSIS� empirical atmospheric model software. Use is governed by the +! Open Source Academic Research License Agreement contained in the file +! nrlmsis2.1_license.txt, which is part of this software package. BY +! USING OR MODIFYING THIS SOFTWARE, YOU ARE AGREEING TO THE TERMS AND +! CONDITIONS OF THE LICENSE. +!####################################################################### + +!!! =========================================================================== +!!! NRLMSIS 2.1: +!!! Neutral atmosphere empirical model from the surface to lower exosphere +!!! =========================================================================== + +!************************************************************************************************** +! MSIS_TFN Module: Contains vertical temperature profile parameters and subroutines, including +! temperature integration terms. +!************************************************************************************************** +module msis_tfn + + use msis_constants, only : rp, nl + + type tnparm + sequence + real(kind=rp) :: cf(0:nl) ! Spline coefficients + real(kind=rp) :: tzetaF ! Tn at zetaF + real(kind=rp) :: tzetaA ! Tn at zetaA (reference altitude for O1, H1) + real(kind=rp) :: dlntdzA ! log-temperature gradient at zetaA (km^-1) + real(kind=rp) :: lndtotF ! ln total number density at zetaF (m^-3) + real(kind=rp) :: tex + real(kind=rp) :: tgb0 + real(kind=rp) :: tb0 + real(kind=rp) :: sigma + real(kind=rp) :: sigmasq + real(kind=rp) :: b ! b = 1-tb0/tex + real(kind=rp) :: beta(0:nl) ! 1st integration coefficients on k=5 splines + real(kind=rp) :: gamma(0:nl) ! 2nd integration coefficients on k=6 splines + real(kind=rp) :: cVs ! 1st integration constant (spline portion) + real(kind=rp) :: cVb ! 1st integration constant (Bates portion) + real(kind=rp) :: cWs ! 2nd integration constant (spline portion) + real(kind=rp) :: cWb ! 2nd integration constant (Bates portion) + real(kind=rp) :: VzetaF ! 1st indefinite integral at zetaF + real(kind=rp) :: VzetaA ! 1st indefinite integral at zetaA + real(kind=rp) :: WzetaA ! 2nd indefinite integral at zetaA + real(kind=rp) :: Vzeta0 ! 1st indefinite integral at zeta=0 (needed for pressure calculation) + end type tnparm + + contains + + !================================================================================================== + ! TFNPARM: Compute the vertical temperature and species-independent profile parameters + !================================================================================================== + subroutine tfnparm(gf,tpro) + + use msis_constants, only : kB, lnP0, Mbarg0divkB, zetaB, zetaA, izfx, izax, itex, itgb0, itb0, c2tn, & + maxnbf, mbf, nmag, nut, cmag, cut, & + wbeta, wgamma, S5zetaB, S6zetaB, wghtAxdz, S4zetaA, S5zetaA, S6zetaA, & + S4zetaF, S5zetaF, S5zeta0 + use msis_init, only : smod, TN, PR + use msis_gfn, only : sfluxmod, geomag, utdep + use msis_utils, only : dilog + + implicit none + + real(kind=rp), intent(in) :: gf(0:maxnbf-1) ! Array of horizontal and temporal basis function terms + type(tnparm), intent(out) :: tpro ! Output structure containing temperature vertical profile parameters + + integer(4) :: ix + real(kind=rp) :: bc(3) + + ! Unconstrained spline coefficients + do ix = 0, itb0-1 + tpro%cf(ix) = dot_product(TN%beta(0:mbf,ix),gf(0:mbf)) + enddo + do ix = 0, itb0-1 + if (smod(ix)) then + tpro%cf(ix) = tpro%cf(ix) + sfluxmod(ix,gf,TN,1.0_rp/TN%beta(0,ix)) !sfluxmod adds F10.7 modulation of tides + endif + enddo + + ! Exospheric temperature + tpro%tex = dot_product(TN%beta(0:mbf,itex),gf(0:mbf)) + tpro%tex = tpro%tex + sfluxmod(itex,gf,TN,1.0_rp/TN%beta(0,itex)) + tpro%tex = tpro%tex + geomag(TN%beta(cmag:cmag+nmag-1,itex),gf(cmag:cmag+12),gf(cmag+13:cmag+26)) + tpro%tex = tpro%tex + utdep(TN%beta(cut:cut+nut-1,itex),gf(cut:cut+8)) + + ! Temperature gradient at zetaB (122.5 km) + tpro%tgb0 = dot_product(TN%beta(0:mbf,itgb0),gf(0:mbf)) + if (smod(itgb0)) tpro%tgb0 = tpro%tgb0 + sfluxmod(itgb0,gf,TN,1.0_rp/TN%beta(0,itgb0)) + tpro%tgb0 = tpro%tgb0 + geomag(TN%beta(cmag:cmag+nmag-1,itgb0),gf(cmag:cmag+12),gf(cmag+13:cmag+26)) + + ! Temperature at zetaB (122.5 km) + tpro%tb0 = dot_product(TN%beta(0:mbf,itb0),gf(0:mbf)) + if (smod(itb0)) tpro%tb0 = tpro%tb0 + sfluxmod(itb0,gf,TN,1.0_rp/TN%beta(0,itb0)) + tpro%tb0 = tpro%tb0 + geomag(TN%beta(cmag:cmag+nmag-1,itb0),gf(cmag:cmag+12),gf(cmag+13:cmag+26)) + + ! Shape factor + tpro%sigma = tpro%tgb0/(tpro%tex-tpro%tb0) + + ! Constrain top three spline coefficients for C2 continuity + bc(1) = 1.0_rp/tpro%tb0 + bc(2) = -tpro%tgb0/(tpro%tb0*tpro%tb0) + bc(3) = -bc(2)*(tpro%sigma + 2.0_rp*tpro%tgb0/tpro%tb0) + tpro%cf(itb0:itex) = matmul(bc, c2tn) + + ! Reference temperature at zetaF (70 km) + tpro%tzetaF = 1.0_rp / dot_product(tpro%cf(izFx:izFx+2),S4zetaF) + + ! Reference temperature and gradient at zetaA (85 km) + tpro%tzetaA = 1.0_rp / dot_product(tpro%cf(izAx:izAx+2),S4zetaA) + tpro%dlntdzA = -dot_product(tpro%cf(izAx:izAx+2),wghtAxdz) * tpro%tzetaA + + ! Calculate spline coefficients for first and second 1/T integrals + tpro%beta(0) = tpro%cf(0)*wbeta(0) + do ix = 1, nl + tpro%beta(ix) = tpro%beta(ix-1) + tpro%cf(ix)*wbeta(ix) + enddo + tpro%gamma(0) = tpro%beta(0)*wgamma(0) + do ix = 1, nl + tpro%gamma(ix) = tpro%gamma(ix-1) + tpro%beta(ix)*wgamma(ix) + enddo + + ! Integration terms and constants + tpro%b = 1 - tpro%tb0 / tpro%tex + tpro%sigmasq = tpro%sigma * tpro%sigma + tpro%cVS = -dot_product(tpro%beta(itb0-1:itb0+2),S5zetaB) + tpro%cWS = -dot_product(tpro%gamma(itb0-2:itb0+2),S6zetaB) + tpro%cVB = -log(1-tpro%b) / (tpro%sigma * tpro%tex) + tpro%cWB = -dilog(tpro%b) / (tpro%sigmasq * tpro%tex) + tpro%VzetaF = dot_product(tpro%beta(izfx-1:izfx+2),S5zetaF) + tpro%cVS + tpro%VzetaA = dot_product(tpro%beta(izax-1:izax+2),S5zetaA) + tpro%cVS + tpro%WzetaA = dot_product(tpro%gamma(izax-2:izax+2),S6zetaA) + tpro%cVS*(zetaA-zetaB) + tpro%cWS + tpro%Vzeta0 = dot_product(tpro%beta(0:2),S5zeta0) + tpro%cVS + + ! Compute total number density at zetaF + tpro%lndtotF = lnP0 - Mbarg0divkB*(tpro%VzetaF - tpro%Vzeta0) - log(kB*tpro%TzetaF) + + return + + end subroutine tfnparm + + !================================================================================================== + ! TFNX: Compute the temperature at specified geopotential height + !================================================================================================== + real(kind=rp) function tfnx(z,iz,wght,tpro) + + use msis_constants, only : zetaB + + implicit none + + real(kind=rp), intent(in) :: z ! Geopotential height + integer, intent(in) :: iz ! Bspline reference index + real(kind=rp), intent(in) :: wght(-3:0) ! Bspline weights + type(tnparm), intent(in) :: tpro ! Structure containing temperature vertical profile parameters + + integer :: i, j + + if (z .lt. zetaB) then + ! Spline region + i = max(iz-3,0) + if (iz .lt. 3) then + j = -iz + else + j = -3 + endif + tfnx = 1.0_rp / dot_product(tpro%cf(i:iz),wght(j:0)) + else + ! Bates profile region + tfnx = tpro%tex - (tpro%tex - tpro%tb0)*exp(-tpro%sigma * (z - zetaB)) + endif + + return + + end function tfnx + +end module msis_tfn diff --git a/sorc/chgres_cube.fd/msis2.1.fd/msis_utils.F90 b/sorc/chgres_cube.fd/msis2.1.fd/msis_utils.F90 new file mode 100644 index 000000000..522dcd769 --- /dev/null +++ b/sorc/chgres_cube.fd/msis2.1.fd/msis_utils.F90 @@ -0,0 +1,282 @@ +!####################################################################### +! MSIS� (NRL-SOF-014-1) SOFTWARE +! NRLMSIS� empirical atmospheric model software. Use is governed by the +! Open Source Academic Research License Agreement contained in the file +! nrlmsis2.1_license.txt, which is part of this software package. BY +! USING OR MODIFYING THIS SOFTWARE, YOU ARE AGREEING TO THE TERMS AND +! CONDITIONS OF THE LICENSE. +!####################################################################### + +!!! =========================================================================== +!!! NRLMSIS 2.1: +!!! Neutral atmosphere empirical model from the surface to lower exosphere +!!! =========================================================================== + +!************************************************************************************************** +! MSIS_UTILS Module: Contains the following auxiliary subroutines: +! alt2gph: Converts geodetic altitude to geopotential height +! gph2alt: Converts geopotential height to geodetic altitude +! bspline: Computes B-splines using input nodes and up to specified order +! dilog: Computes dilogarithm function (expansion truncated at order 3, error < 1E-5) +!************************************************************************************************** + +module msis_utils + +contains + + !================================================================================================== + ! ALT2GPH: Altitude to Geopotential Height + ! References: + ! DMA Technical Report TR8350.2 (1987), + ! http://earth-info.nga.mil/GandG/publications/historic/historic.html + ! Featherstone, W. E., and S. J. Claessens (2008), Closed-form transformation between + ! geodetic and ellipsoidal coordinates, Studia Geophysica et Geodaetica, 52, 1-18 + ! Jekeli, C. (2009), Potential theory and static gravity field of the Earth, in + ! Treatise on Geophysics, ed. T. Herring, vol 3, 11-42 + ! NIMA Technical Report TR8350.2 (2000, 3rd edition, Amendment1), + ! http://earth-info.nga.mil/GandG/publications/tr8350.2/tr8350_2.html + !================================================================================================== + real(8) function alt2gph(lat,alt) + + implicit none + + ! Input variables + real(8), intent(in) :: lat !Geodetic latitude (deg) + real(8), intent(in) :: alt !Geodetic altitude (km) + + real(8), parameter :: deg2rad = 0.017453292519943295d0 + + ! WGS84 Defining parameters + real(8), parameter :: a = 6378.1370d0 * 1d3 !Semi-major axis of reference ellipsoid (m) + real(8), parameter :: finv = 298.257223563d0 ! 1/f = Reciprocal of flattening + real(8), parameter :: w = 7292115d-11 !Angular velocity of Earth rotation (rad/s) + real(8), parameter :: GM = 398600.4418 * 1d9 !Gravitational constant x Earth mass (m^3/s^2) + + ! WGS84 Derived parameters + real(8), parameter :: asq = a*a + real(8), parameter :: wsq = w*w + real(8), parameter :: f = 1.0d0 / finv + real(8), parameter :: esq = 2*f - f*f + real(8), parameter :: e = sqrt(esq) !Ellipsoid eccentricity + real(8), parameter :: Elin = a*e !Linear eccentricity of ellipsoid + real(8), parameter :: Elinsq = Elin*Elin + real(8), parameter :: epr = e / (1-f) !Second eccentricity + real(8), parameter :: q0 = ((1.0d0 + 3.0d0/(epr*epr))*atan(epr) - 3.0d0/epr)/2.0d0 !DMA Technical Report tr8350.2, Eq. 3-25 + real(8), parameter :: U0 = -GM*atan(epr)/Elin - wsq*asq/3d0 !Theoretical potential of reference ellipsoid (m^2/s^2) + real(8), parameter :: g0 = 9.80665d0 !Standard gravity (m/s^2), CGPM 1901; WMO + real(8), parameter :: GMdivElin = GM / Elin + + ! Parameters for centrifugal potential taper + real(8), parameter :: x0sq = 2d7**2 !Axial distance squared at which tapering begins (m^2) + real(8), parameter :: Hsq = 1.2d7**2 !Relaxation scale length of taper (m^2) + + ! Working variables + real(8) :: altm, sinsqlat, v, xsq, zsq + real(8) :: rsqminElinsq, usq, cossqdelta, epru, atanepru, q, U, Vc + + ! Compute Cartesian and ellipsoidal coordinates + altm = alt * 1000.0d0 + sinsqlat = sin(lat*deg2rad)**2 + v = a / sqrt(1-esq*sinsqlat) !Radius of curvature of the reference ellipsoid, Featherstone eq. 4 + xsq = (v + altm)**2 * (1 - sinsqlat) !Squared x-coordinate of geocentric system, Featherstone eq. 1 + zsq = (v*(1-esq) + altm)**2 * sinsqlat !Squared z-coordinate of geocentric system, Featherstone eq. 3 + rsqminElinsq = xsq + zsq - Elinsq + usq = rsqminElinsq/2.0d0 + sqrt(rsqminElinsq**2 / 4.0d0 + Elinsq*zsq) !Ellipsoidal distance coordinate, Featherstone eq. 19 + cossqdelta = zsq / usq !Ellipsoidal polar angle, Featherstone eq. 21 + + ! Compute gravitational potential + epru = Elin / sqrt(usq) !Second eccentricity at ellipsoidal coordinate u + atanepru = atan(epru) + q = ((1+3.0d0/(epru*epru))*atanepru - 3.0d0/epru)/2.0d0 !Jekeli, eq. 114 + U = -GMdivElin * atanepru - wsq * ( asq * q * (cossqdelta - 1/3.0d0) / q0 ) / 2.0d0 !Jekeli, eq. 113 + + ! Compute centrifugal potential and adjust total potential + if (xsq .le. x0sq) then + Vc = (wsq/2.0d0) * xsq + else + Vc = (wsq/2.0d0) * (Hsq*tanh((xsq-x0sq)/Hsq) + x0sq) !Centrifugal potential taper + endif + U = U - Vc + + ! Compute geopotential height + alt2gph = (U - U0) / g0 / 1000.0d0 + + return + + end function alt2gph + + !================================================================================================== + ! GPH2ALT: Geopotential Height to Altitude + !================================================================================================== + real(8) function gph2alt(theta,gph) + + implicit none + + real(8), intent(in) :: theta + real(8), intent(in) :: gph + + integer, parameter :: maxn = 10 + real(8), parameter :: epsilon = 0.0005 + + real(8) :: x,dx,y,dydz + integer :: n + + x = gph + n = 0 + dx = epsilon + epsilon + do while ((abs(dx) .gt. epsilon) .and. (n .lt. 10)) + y = alt2gph(theta,x) + dydz = (alt2gph(theta,x+dx) - y)/dx + dx = (gph - y)/dydz + x = x + dx + n = n + 1 + end do + + gph2alt = x + + end function gph2alt + + !================================================================================================== + ! BSPLINE: Returns array of nonzero b-spline values, for all orders up to specified order (max 6) + !================================================================================================== + subroutine bspline(x,nodes,nd,kmax,eta,S,i) + + use msis_constants, only: rp + + implicit none + + ! Input variables + real(kind=rp), intent(in) :: x !Location at which splines are to be evaluated + real(kind=rp),dimension(0:),intent(in) :: nodes !Spline node locations + integer, intent(in) :: nd !Number of spline nodes minus one (0:nd) + integer, intent(in) :: kmax !Maximum order (up to 6 allowed) of evaluated splines + real(kind=rp), intent(in) :: eta(0:30,2:6) !Precomputed weights for recursion (reciprocals of node differences) + ! Ouput variables + real(kind=rp), intent(out) :: S(-5:0,2:6) !b-spline values (spline index relative to i (-5:0), spline order (2:6)) + integer, intent(out) :: i !Index of last nonzero b-spline + + ! Working variables + integer :: j, k, l + integer :: low, high + real(kind=rp) :: w(-4:0) !Weights for recursion relation + + ! Initialize to zero + S(:,:) = 0.0_rp + + ! Find index of last (rightmost) nonzero spline + if (x .ge. nodes(nd)) then + i = nd + return + endif + if (x .le. nodes(0)) then + i = -1 + return + endif + low = 0 + high = nd + i = (low + high)/2 + do while (x .lt. nodes(i) .or. x .ge. nodes(i + 1)) + if (x .lt. nodes(i)) then + high = i + else + low = i + endif + i = (low + high)/2 + end do + + ! Initialize with linear splines + S(0,2) = (x - nodes(i)) * eta(i,2) + if (i .gt. 0) S(-1,2) = 1 - S(0,2) + if (i .ge. nd-1) S(0,2) = 0.0_rp !Reset out-of-bounds spline to zero + + ! k = 3 (quadratic splines) + w(:) = 0.0_rp + w(0) = (x - nodes(i)) * eta(i,3) + if (i .ne. 0) w(-1) = (x - nodes(i-1)) * eta(i-1,3) + if (i .lt. (nd-2)) S(0,3) = w(0)*S(0,2) + if ( ((i-1) .ge. 0) .and. ((i-1) .lt. (nd-2)) ) & + S(-1,3) = w(-1) * S(-1,2) + (1.0_rp - w(0))*S(0,2) + if ((i-2) .ge. 0) S(-2,3) = (1.0_rp - w(-1))*S(-1,2) + + ! k = 4 (cubic splines) + do l = 0, -2, -1 + j = i + l + if (j .lt. 0) exit !Skip out-of-bounds splines + w(l) = (x - nodes(j)) * eta(j,4) + enddo + if (i .lt. (nd-3)) S(0,4) = w(0)*S(0,3) + do l = -1, -2, -1 + if ( ((i+l) .ge. 0) .and. ((i+l) .lt. (nd-3)) ) & + S(l,4) = w(l)*S(l,3) + (1.0_rp - w(l+1))*S(l+1,3) + enddo + if ((i-3) .ge. 0) S(-3,4) = (1.0_rp - w(-2))*S(-2,3) + + ! k = 5 + do l = 0, -3, -1 + j = i + l + if (j .lt. 0) exit !Skip out-of-bounds splines + w(l) = (x - nodes(j)) * eta(j,5) + enddo + if (i .lt. (nd-4)) S(0,5) = w(0)*S(0,4) + do l = -1, -3, -1 + if ( ((i+l) .ge. 0) .and. ((i+l) .lt. (nd-4)) ) & + S(l,5) = w(l)*S(l,4) + (1.0_rp - w(l+1))*S(l+1,4) + enddo + if ((i-4) .ge. 0) S(-4,5) = (1.0_rp - w(-3))*S(-3,4) + if (kmax .eq. 5) return !Exit if only 5th order spline is needed + + ! k = 6 + do l = 0, -4, -1 + j = i + l + if (j .lt. 0) exit !Skip out-of-bounds splines + w(l) = (x - nodes(j)) * eta(j,6) + enddo + if (i .lt. (nd-5)) S(0,6) = w(0)*S(0,5) + do l = -1, -4, -1 + if ( ((i+l) .ge. 0) .and. ((i+l) .lt. (nd-5)) ) & + S(l,6) = w(l)*S(l,5) + (1.0_rp - w(l+1))*S(l+1,5) + enddo + if ((i-5) .ge. 0) S(-5,6) = (1.0_rp - w(-4))*S(-4,5) + + return + + end subroutine bspline + + !================================================================================================== + ! DILOG: Calculate dilogarithm in the domain [0,1) + ! Retains terms up to order 3 in the expansion, which results in relative errors less than 1E-5. + ! Reference: + ! Ginsberg, E. S., and D. Zaborowski (1975), The Dilogarithm function of a real argument, + ! Commun. ACM, 18, 200�202. + !================================================================================================== + real(kind=rp) function dilog(x0) + + use msis_constants, only : rp, pi + + implicit none + + real(kind=rp), intent(in) :: x0 + real(kind=rp), parameter :: pi2_6 = pi*pi / 6.0_rp + real(kind=rp) :: x, xx, x4, lnx + + x = x0 + if (x .gt. 0.5_rp) then + lnx = log(x) + x = 1.0_rp - x !Reflect argument into [0,0.5] range + xx = x*x + x4 = 4.0_rp*x + dilog = pi2_6 - lnx*log(x) & + - (4.0_rp*xx*(23.0_rp/16.0_rp + x/36.0_rp + xx/576.0_rp + xx*x/3600.0_rp) & + + x4 + 3.0_rp*(1.0_rp - xx)*lnx) / (1.0_rp + x4 + xx) + else + xx = x*x + x4 = 4.0_rp*x + dilog = (4.0_rp*xx*(23.0_rp/16.0_rp + x/36.0_rp + xx/576.0_rp + xx*x/3600.0_rp) & + + x4 + 3.0_rp*(1.0_rp - xx)*log(1.0_rp - x)) / (1.0_rp + x4 + xx) + endif + + return + + end function dilog + +end module msis_utils \ No newline at end of file diff --git a/sorc/chgres_cube.fd/msis2.1.fd/nrlmsis2.1_license.txt b/sorc/chgres_cube.fd/msis2.1.fd/nrlmsis2.1_license.txt new file mode 100644 index 000000000..244ab1922 --- /dev/null +++ b/sorc/chgres_cube.fd/msis2.1.fd/nrlmsis2.1_license.txt @@ -0,0 +1,71 @@ +MSIS� (NRL-SOF-014-1) SOFTWARE +OPEN SOURCE ACADEMIC RESEARCH LICENSE AGREEMENT + +1. Agreement. The MSIS� empirical atmospheric model software (hereinafter +�Software�) is property of The Government of the United States of America. This +software is being made available under the following terms and conditions. By +using, modifying, reproducing, or preparing a derivative work of this Software, +you agree to abide by the terms and conditions herein. + +2. License. In accordance with federal law, authorization is given to use, +reproduce, and modify the Software solely for research, academic, and non-profit +purposes and only in accordance with the terms and conditions in this Agreement. +Any commercial use is prohibited. No other rights or permissions are provided. + +3. Basis. The Software was written by employees of the U.S. Naval Research +Laboratory (NRL) and is property of the United States Government, as represented +by the Secretary of the Navy. MSIS� is a registered trademark of the Government +of the United States of America, as represented by the Secretary of the Navy. +Unauthorized use of the trademark is prohibited. + +4. Restrictions and Use. + +a. Sales. A user of the Software shall not sell, or license, or transfer for a +fee the Software or portion thereof, or any derivative work of the Software, or +any data products generated by the Software, without first obtaining the written +consent of IP Counsel for the Naval Research Laboratory. + +b. Modifications. All modifications to the Software and derivative works of the +Software (including translations to other programming languages) shall carry +prominent notices stating how the files were changed and the date of the change. +Any party who modifies the Software shall deliver the modified portion of the +Software to authors or NRL Code 7630, U.S. Naval Research Laboratory. Any +reproductions, modified versions of the Software, or derivative works shall be +made available to the public as open source software. A party who modifies the +Software or creates a derivative work of the Software hereby grants the +Government of the United States of America a non-exclusive, irrevocable, fully +paid-up license to such modifications and derivative works, and shall deliver +such derivative works, including any source code, data, or information that +pertains to such derivatives works, to Code 7630, U.S. Naval Research +Laboratory. If any modifications to the Software substantially change the model +output (including, but not limited to, alterations of the model formulation or +model parameter values), then the modified Software shall not be identified +�MSIS� without first obtaining the written consent of Counsel, Office of Naval +Research, Department of the Navy. In such cases, the MSIS acronym shall +nonetheless still appear in the individual files in order to document the +provenance of the modified Software. + +c. Notices. Each copy of the Software, any modified Software, or derivative +work shall include a file containing this Agreement. Any software package that +incorporates the MSIS� Software or derivative work shall include the following +statement: "This software incorporates the MSIS� empirical atmospheric model +software designed and provided by NRL. Use is governed by the Open Source +Academic Research License Agreement contained in the file +nrlmsis2.1_license.txt." + +5. Disclaimer of Warranty and Liability: As the owner of the MSIS� software, the +Government of the United States of America: (1) Disclaims any warranties, +express, or implied, including but not limited to any implied warranties of +merchantability, fitness for a particular purpose, title or non-infringement, +(2) Does not assume any legal liability or responsibility for the accuracy, +completeness, or usefulness of the software, (3) Does not represent that use of +the software would not infringe privately owned rights, (4) Does not warrant +that the software will function uninterrupted, that is error-free or that any +errors will be corrected. + +6. No Support. The Software is provided without any support or maintenance, and +without any obligation to provide modifications, improvements, enhancements, or +updates of the Software. No oral or written information or advice given by the +NRL authors shall create a warranty or in any way modify this agreement. Should +the Software prove defective, the user (and not NRL or any NRL representative) +assume the cost of all necessary correction. diff --git a/sorc/chgres_cube.fd/msis2.1.fd/readme.txt b/sorc/chgres_cube.fd/msis2.1.fd/readme.txt new file mode 100644 index 000000000..3cd759b41 --- /dev/null +++ b/sorc/chgres_cube.fd/msis2.1.fd/readme.txt @@ -0,0 +1,104 @@ +####################################################################### + MSIS® (NRL-SOF-014-1) SOFTWARE + NRLMSIS® empirical atmospheric model software. Use is governed by the + Open Source Academic Research License Agreement contained in the file + nrlmsis2.1_license.txt, which is part of this software package. BY + USING OR MODIFYING THIS SOFTWARE, YOU ARE AGREEING TO THE TERMS AND + CONDITIONS OF THE LICENSE. +####################################################################### + +NRLMSIS 2.1 Whole-Atmosphere Empirical Model of Temperature and Neutral Species + Densities + +VERSION HISTORY + 08 MAR 19 Version 1.97 (Beta version) + 26 MAY 20 Version 2.0 (Release version) + 04 APR 22 Version 2.1 (Release version with NO density) + +AUTHORS + John Emmert (john.emmert@nrl.navy.mil) + Douglas Drob (douglas.drob@nrl.navy.mil) + McArthur Jones Jr. (mcarthur.jones@nrl.navy.mil) + +REFERENCE FOR NRLMSIS 2.0 + Emmert, J. T., Drob, D. P., Picone, J. M., Siskind, D. E., Jones, M. Jr., + Mlynczak, M. G., et al. (2021). NRLMSIS 2.0: A whole-atmosphere empirical model + of temperature and neutral species densities. Earth and Space Science, 8, + e2020EA001321. https://doi.org/10.1029/2020EA001321 + +PACKAGE CONTENTS + readme.txt This file + nrlmsis2.1_license.txt Open Source Academic Research License Agreement + msis2.1_test.F90 Test program + msis_init.F90 Subroutines to initialize the model, set switches and + options, and load parameter file + msis_gtd8d.F90 Subroutine to evaluate the model using the legacy + interface + msis_calc.F90 Subroutine for evaluating the model using the new + interface + msis_constants.F90 Module containing model constants + msis_gfn.F90 Subroutines to calculate horizontal expansion + functions + msis_tfn.F90 Subroutines to calculate the vertical temperature + profile + msis_dfn.F90 Subroutines to calculate vertical density profiles + msis_utils.F90 Subroutines to convert between geodetic height and + geopotential height, and other support subroutines + msis21.parm Binary data file containing model parameters + msis2.1_test_in.txt ASCII file containing input for test program. + msis2.1_test_ref_dp.txt ASCII file containing expected output of test program + (double-precision internally) + +RELEASE NOTES: MODEL FORMULATION + Minor changes to the NRLMSIS 2.0 formulation include: + - Addition of new terms to support fitting of NO densities. + - Reorganization of support subroutines (alt2gph, gph2alt, bspline, dilog) + into msis_utils module. + +RELEASE NOTES: PARAMETER ESTIMATION + - NO density parameters were tuned to six NO data sets (ENVISAT/MIPAS, SNOE, + ACE/FTS, AIM/SOFIE, UARS/HALOE, and Odin/SMR). + - Temperature and all other species densities are the same as in NRLMSIS 2.0. + +COMPILING THE MODEL CODE + The model package was tested on Windows, Linux, and Mac systems using the + following Fortran compilers and compile statements: + gfortran 4.8.5, 7.5.0, 9.3.0 + gfortran -O3 -cpp -o msis2.1_test.exe msis_constants.F90 msis_utils.F90 + msis_init.F90 msis_gfn.F90 msis_tfn.F90 msis_dfn.F90 msis_calc.F90 + msis_gtd8d.F90 msis2.1_test.F90 + NOTES: + - The following optimization flags may improve performance: + -march=native -ffast-math + Intel 2017.2.163, 18.0.1.156, 2021.1 + ifort -O2 -fpp -o msis2.1_test.exe msis_constants.F90 msis_utils.F90 + msis_init.F90 msis_gfn.F90 msis_tfn.F90 msis_dfn.F90 msis_calc.F90 + msis_gtd8d.F90 msis2.1_test.F90 + NOTES: + - The following optimization flags may improve performance: + Windows: -Qipo -QxHost + Linux/macOS: -ipo -xHost + For double precision, add the flag -DDBLE. Double precision is not necessary + for most applications, but for testing purposes it ensures that the test + output exactly matches the expected output in msis2.1_test_ref_dp.txt, + regardless of the compiler or compiler settings. + +INITIALIZING AND RUNNING THE MODEL + - The model must be initialized using the MSISINIT subroutine, which sets + switches and options and loads the model parameter values from a file. + - The switch_legacy optional argument to MSISINIT performs the same function + as TSELEC(SW) in NRLSMSISE-00, except that switches 15-25 are not used in + NRLMSIS 2.1. The change in the switch-setting call is illustrated as + follows, where SW is the 25-element array of switches: + NRLMSISE-00: CALL TSELEC(SW) + NRLMSIS 2.1: call msisinit(switch_legacy=SW) + - The MSISCALC subroutine checks for initialization and does a default + initialization if necessary. This self-initialization will be removed in + future versions. + - The model can be called using either the legacy interface (subroutine + GTD8D) or the new interface (subroutine MSISCALC). + - Details of the input and output arguments of MSISINIT, GTD8D, and MSISCALC + are provided in the headers of the respective source code files. + +ACKNOWLEDGEMENTS + This work was supported by the Office of Naval Research and NASA. \ No newline at end of file diff --git a/sorc/chgres_cube.fd/program_setup.F90 b/sorc/chgres_cube.fd/program_setup.F90 index 1dcb4d22e..4be7940a6 100644 --- a/sorc/chgres_cube.fd/program_setup.F90 +++ b/sorc/chgres_cube.fd/program_setup.F90 @@ -80,6 +80,7 @@ module program_setup !! by this program. character(len=20), allocatable, public :: field_var_names(:) !< The GRIB2 variable name in the varmap table. + character(len=500), public :: wam_parm_file="msis21.parm" !< Full path to msis21.parm for WAM initialization integer, public :: cycle_year = -999 !< Cycle year. integer, public :: cycle_mon = -999 !< Cycle month. @@ -186,6 +187,7 @@ subroutine read_setup_namelist(filename) lai_from_climo, tg3_from_soil, & regional, input_type, & external_model, & + wam_parm_file, & atm_weight_file, tracers, & tracers_input, & halo_bndy, & diff --git a/sorc/chgres_cube.fd/wam_climo_data.f90 b/sorc/chgres_cube.fd/wam_climo_data.f90 index 32ca66a9d..6430c86d0 100644 --- a/sorc/chgres_cube.fd/wam_climo_data.f90 +++ b/sorc/chgres_cube.fd/wam_climo_data.f90 @@ -1,2797 +1,138 @@ !> @file !! @brief Process vertical profile climatologic data for WAM. !! -!! This file contains all data need to form exosphere and used -!! whole atmsopheric modeling (WAM). it has two modules and some -!! routines to compute the temperature and compositions of neutral -!! density in specific values. -!! the original package contains fortran 77 blockdata and common statement -!! they are all recoded to use modules and use-statements. -!! -!! @author Hann-Ming Henry Juang NCEP/EMC - -!----------------------------------------------------------------------- -!> Use moduke for blockdata gtd7bk -!! -!! All variables originalyl in blockdata used for this packahe are -!! getting from NRLMSISE-00. -!! NRLMSISE-00 is an empirical, global reference atmospheric model of -!! the Earth from ground to space. It models the temperatures and densities -!! of the atmosphere's components. -!! NRL stands for the US Naval Research Laboratory. MSIS stands for mass -!! spectrometer and incoherent scatter radar, the two primary data sources -!! for development of earlier versions of the model. E indicates that the -!! model extends from the ground through exosphere and 00 is the year of -!! release in 2000. Over the years since introduction, NRLMSISE-00 has -!! become the standard for international space research. (wikipedia) -!! -!! @author Hann-Ming Henry Juang - module wam_gtd7bk_mod -! msise-00 01-feb-02 -! - real :: pt1(50) !< block space data for temperature - real :: pt2(50) !< block space data for temperature - real :: pt3(50) !< block space data for temperature - real :: pa1(50) !< block space data for he denisity - real :: pa2(50) !< block space data for he denisity - real :: pa3(50) !< block space data for he denisity - real :: pb1(50) !< block space data for o density - real :: pb2(50) !< block space data for o density - real :: pb3(50) !< block space data for o density - real :: pc1(50) !< block space data for n2 density - real :: pc2(50) !< block space data for n2 density - real :: pc3(50) !< block space data for n2 density - real :: pd1(50) !< block space data for tlb - real :: pd2(50) !< block space data for tlb - real :: pd3(50) !< block space data for tlb - real :: pe1(50) !< block space data for o2 density - real :: pe2(50) !< block space data for o2 density - real :: pe3(50) !< block space data for o2 density - real :: pf1(50) !< block space data for ar density - real :: pf2(50) !< block space data for ar density - real :: pf3(50) !< block space data for ar density - real :: pg1(50) !< block space data for h density - real :: pg2(50) !< block space data for h density - real :: pg3(50) !< block space data for h density - real :: ph1(50) !< block space data for n density - real :: ph2(50) !< block space data for n density - real :: ph3(50) !< block space data for n density - real :: pi1(50) !< block space data for hot o density - real :: pi2(50) !< block space data for hot o density - real :: pi3(50) !< block space data for hot o density - real :: pj1(50) !< block space data for s param - real :: pj2(50) !< block space data for s param - real :: pj3(50) !< block space data for s param - real :: pk1(50) !< block space data for turbo - real :: pl1(50) !< block space data for tn1(2) - real :: pl2(50) !< block space data for tn1(2) - real :: pm1(50) !< block space data for tn1(3) - real :: pm2(50) !< block space data for tn1(3) - real :: pn1(50) !< block space data for tn1(4) - real :: pn2(50) !< block space data for tn1(4) - real :: po1(50) !< block space data for tn1(5) tn2(1) - real :: po2(50) !< block space data for tn1(5) tn2(1) - real :: pp1(50) !< block space data for tn2(2) - real :: pp2(50) !< block space data for tn2(2) - real :: pq1(50) !< block space data for tn2(3) - real :: pq2(50) !< block space data for tn2(3) - real :: pr1(50) !< block space data for tn2(4) tn3(1) - real :: pr2(50) !< block space data for tn2(4) tn3(1) - real :: ps1(50) !< block space data for tn3(2) - real :: ps2(50) !< block space data for tn3(2) - real :: pu1(50) !< block space data for tn3(3) - real :: pu2(50) !< block space data for tn3(3) - real :: pv1(50) !< block space data for tn3(4) - real :: pv2(50) !< block space data for tn3(4) - real :: pw1(50) !< block space data for tn3(5) surface temperature tsl - real :: pw2(50) !< block space data for tn3(5) surface temperature tsl - real :: px1(50) !< block space data for tgn3(2) surface grad tslg - real :: px2(50) !< block space data for tgn3(2) surface grad tslg - real :: py1(50) !< block space data for tgn2(1) tgn1(2) - real :: py2(50) !< block space data for tgn2(1) tgn1(2) - real :: pz1(50) !< block space data for tgn3(1) tgn2(2) - real :: pz2(50) !< block space data for tgn3(1) tgn2(2) - real :: paa1(50) !< block space data for semiannual mult sam - real :: paa2(50) !< block space data for semiannual mult sam -! - real :: ptm(10) !< block space data for lower boundary - real :: pdm(10,8) !< block space data for lower boundary -! - real :: pavgm(10) !< block space data for middle atmosphere averages -! - character*4:: isdate(3) !< define date - character*4:: istime(2) !< define time - character*4:: name(2) !< define data name -! - integer :: imr !< define version -! - real :: pr65(2,65) !< define pressures - real :: pr151(2,151) !< define pressures - - data imr/0/ - data isdate/'01-f','eb-0','2 '/,istime/'15:4','9:27'/ - data name/'msis','e-00'/ -! temperature - data pt1/ & - 9.86573e-01, 1.62228e-02, 1.55270e-02,-1.04323e-01,-3.75801e-03,& - -1.18538e-03,-1.24043e-01, 4.56820e-03, 8.76018e-03,-1.36235e-01,& - -3.52427e-02, 8.84181e-03,-5.92127e-03,-8.61650e+00, 0.00000e+00,& - 1.28492e-02, 0.00000e+00, 1.30096e+02, 1.04567e-02, 1.65686e-03,& - -5.53887e-06, 2.97810e-03, 0.00000e+00, 5.13122e-03, 8.66784e-02,& - 1.58727e-01, 0.00000e+00, 0.00000e+00, 0.00000e+00,-7.27026e-06,& - 0.00000e+00, 6.74494e+00, 4.93933e-03, 2.21656e-03, 2.50802e-03,& - 0.00000e+00, 0.00000e+00,-2.08841e-02,-1.79873e+00, 1.45103e-03,& - 2.81769e-04,-1.44703e-03,-5.16394e-05, 8.47001e-02, 1.70147e-01,& - 5.72562e-03, 5.07493e-05, 4.36148e-03, 1.17863e-04, 4.74364e-03/ - data pt2/ & - 6.61278e-03, 4.34292e-05, 1.44373e-03, 2.41470e-05, 2.84426e-03,& - 8.56560e-04, 2.04028e-03, 0.00000e+00,-3.15994e+03,-2.46423e-03,& - 1.13843e-03, 4.20512e-04, 0.00000e+00,-9.77214e+01, 6.77794e-03,& - 5.27499e-03, 1.14936e-03, 0.00000e+00,-6.61311e-03,-1.84255e-02,& - -1.96259e-02, 2.98618e+04, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 6.44574e+02, 8.84668e-04, 5.05066e-04, 0.00000e+00, 4.02881e+03,& - -1.89503e-03, 0.00000e+00, 0.00000e+00, 8.21407e-04, 2.06780e-03,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - -1.20410e-02,-3.63963e-03, 9.92070e-05,-1.15284e-04,-6.33059e-05,& - -6.05545e-01, 8.34218e-03,-9.13036e+01, 3.71042e-04, 0.00000e+00/ - data pt3/ & - 4.19000e-04, 2.70928e-03, 3.31507e-03,-4.44508e-03,-4.96334e-03,& - -1.60449e-03, 3.95119e-03, 2.48924e-03, 5.09815e-04, 4.05302e-03,& - 2.24076e-03, 0.00000e+00, 6.84256e-03, 4.66354e-04, 0.00000e+00,& - -3.68328e-04, 0.00000e+00, 0.00000e+00,-1.46870e+02, 0.00000e+00,& - 0.00000e+00, 1.09501e-03, 4.65156e-04, 5.62583e-04, 3.21596e+00,& - 6.43168e-04, 3.14860e-03, 3.40738e-03, 1.78481e-03, 9.62532e-04,& - 5.58171e-04, 3.43731e+00,-2.33195e-01, 5.10289e-04, 0.00000e+00,& - 0.00000e+00,-9.25347e+04, 0.00000e+00,-1.99639e-03, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00/ -! he density - data pa1/ & - 1.09979e+00,-4.88060e-02,-1.97501e-01,-9.10280e-02,-6.96558e-03,& - 2.42136e-02, 3.91333e-01,-7.20068e-03,-3.22718e-02, 1.41508e+00,& - 1.68194e-01, 1.85282e-02, 1.09384e-01,-7.24282e+00, 0.00000e+00,& - 2.96377e-01,-4.97210e-02, 1.04114e+02,-8.61108e-02,-7.29177e-04,& - 1.48998e-06, 1.08629e-03, 0.00000e+00, 0.00000e+00, 8.31090e-02,& - 1.12818e-01,-5.75005e-02,-1.29919e-02,-1.78849e-02,-2.86343e-06,& - 0.00000e+00,-1.51187e+02,-6.65902e-03, 0.00000e+00,-2.02069e-03,& - 0.00000e+00, 0.00000e+00, 4.32264e-02,-2.80444e+01,-3.26789e-03,& - 2.47461e-03, 0.00000e+00, 0.00000e+00, 9.82100e-02, 1.22714e-01,& - -3.96450e-02, 0.00000e+00,-2.76489e-03, 0.00000e+00, 1.87723e-03/ - data pa2/ & - -8.09813e-03, 4.34428e-05,-7.70932e-03, 0.00000e+00,-2.28894e-03,& - -5.69070e-03,-5.22193e-03, 6.00692e-03,-7.80434e+03,-3.48336e-03,& - -6.38362e-03,-1.82190e-03, 0.00000e+00,-7.58976e+01,-2.17875e-02,& - -1.72524e-02,-9.06287e-03, 0.00000e+00, 2.44725e-02, 8.66040e-02,& - 1.05712e-01, 3.02543e+04, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - -6.01364e+03,-5.64668e-03,-2.54157e-03, 0.00000e+00, 3.15611e+02,& - -5.69158e-03, 0.00000e+00, 0.00000e+00,-4.47216e-03,-4.49523e-03,& - 4.64428e-03, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 4.51236e-02, 2.46520e-02, 6.17794e-03, 0.00000e+00, 0.00000e+00,& - -3.62944e-01,-4.80022e-02,-7.57230e+01,-1.99656e-03, 0.00000e+00/ - data pa3/ & - -5.18780e-03,-1.73990e-02,-9.03485e-03, 7.48465e-03, 1.53267e-02,& - 1.06296e-02, 1.18655e-02, 2.55569e-03, 1.69020e-03, 3.51936e-02,& - -1.81242e-02, 0.00000e+00,-1.00529e-01,-5.10574e-03, 0.00000e+00,& - 2.10228e-03, 0.00000e+00, 0.00000e+00,-1.73255e+02, 5.07833e-01,& - -2.41408e-01, 8.75414e-03, 2.77527e-03,-8.90353e-05,-5.25148e+00,& - -5.83899e-03,-2.09122e-02,-9.63530e-03, 9.77164e-03, 4.07051e-03,& - 2.53555e-04,-5.52875e+00,-3.55993e-01,-2.49231e-03, 0.00000e+00,& - 0.00000e+00, 2.86026e+01, 0.00000e+00, 3.42722e-04, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00/ -! o density - data pb1/ & - 1.02315e+00,-1.59710e-01,-1.06630e-01,-1.77074e-02,-4.42726e-03,& - 3.44803e-02, 4.45613e-02,-3.33751e-02,-5.73598e-02, 3.50360e-01,& - 6.33053e-02, 2.16221e-02, 5.42577e-02,-5.74193e+00, 0.00000e+00,& - 1.90891e-01,-1.39194e-02, 1.01102e+02, 8.16363e-02, 1.33717e-04,& - 6.54403e-06, 3.10295e-03, 0.00000e+00, 0.00000e+00, 5.38205e-02,& - 1.23910e-01,-1.39831e-02, 0.00000e+00, 0.00000e+00,-3.95915e-06,& - 0.00000e+00,-7.14651e-01,-5.01027e-03, 0.00000e+00,-3.24756e-03,& - 0.00000e+00, 0.00000e+00, 4.42173e-02,-1.31598e+01,-3.15626e-03,& - 1.24574e-03,-1.47626e-03,-1.55461e-03, 6.40682e-02, 1.34898e-01,& - -2.42415e-02, 0.00000e+00, 0.00000e+00, 0.00000e+00, 6.13666e-04/ - data pb2/ & - -5.40373e-03, 2.61635e-05,-3.33012e-03, 0.00000e+00,-3.08101e-03,& - -2.42679e-03,-3.36086e-03, 0.00000e+00,-1.18979e+03,-5.04738e-02,& - -2.61547e-03,-1.03132e-03, 1.91583e-04,-8.38132e+01,-1.40517e-02,& - -1.14167e-02,-4.08012e-03, 1.73522e-04,-1.39644e-02,-6.64128e-02,& - -6.85152e-02,-1.34414e+04, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 6.07916e+02,-4.12220e-03,-2.20996e-03, 0.00000e+00, 1.70277e+03,& - -4.63015e-03, 0.00000e+00, 0.00000e+00,-2.25360e-03,-2.96204e-03,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 3.92786e-02, 1.31186e-02,-1.78086e-03, 0.00000e+00, 0.00000e+00,& - -3.90083e-01,-2.84741e-02,-7.78400e+01,-1.02601e-03, 0.00000e+00/ - data pb3/ & - -7.26485e-04,-5.42181e-03,-5.59305e-03, 1.22825e-02, 1.23868e-02,& - 6.68835e-03,-1.03303e-02,-9.51903e-03, 2.70021e-04,-2.57084e-02,& - -1.32430e-02, 0.00000e+00,-3.81000e-02,-3.16810e-03, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00,-9.05762e-04,-2.14590e-03,-1.17824e-03, 3.66732e+00,& - -3.79729e-04,-6.13966e-03,-5.09082e-03,-1.96332e-03,-3.08280e-03,& - -9.75222e-04, 4.03315e+00,-2.52710e-01, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00/ -! n2 density - data pc1/ & - 1.16112e+00, 0.00000e+00, 0.00000e+00, 3.33725e-02, 0.00000e+00,& - 3.48637e-02,-5.44368e-03, 0.00000e+00,-6.73940e-02, 1.74754e-01,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 1.74712e+02, 0.00000e+00,& - 1.26733e-01, 0.00000e+00, 1.03154e+02, 5.52075e-02, 0.00000e+00,& - 0.00000e+00, 8.13525e-04, 0.00000e+00, 0.00000e+00, 8.66784e-02,& - 1.58727e-01, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00,-2.50482e+01, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,-2.48894e-03,& - 6.16053e-04,-5.79716e-04, 2.95482e-03, 8.47001e-02, 1.70147e-01,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00/ - data pc2/ & - 0.00000e+00, 2.47425e-05, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00/ - data pc3/ & - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00/ -! tlb - data pd1/ & - 9.44846e-01, 0.00000e+00, 0.00000e+00,-3.08617e-02, 0.00000e+00,& - -2.44019e-02, 6.48607e-03, 0.00000e+00, 3.08181e-02, 4.59392e-02,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 1.74712e+02, 0.00000e+00,& - 2.13260e-02, 0.00000e+00,-3.56958e+02, 0.00000e+00, 1.82278e-04,& - 0.00000e+00, 3.07472e-04, 0.00000e+00, 0.00000e+00, 8.66784e-02,& - 1.58727e-01, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 3.83054e-03, 0.00000e+00, 0.00000e+00,& - -1.93065e-03,-1.45090e-03, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00,-1.23493e-03, 1.36736e-03, 8.47001e-02, 1.70147e-01,& - 3.71469e-03, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00/ - data pd2/ & - 5.10250e-03, 2.47425e-05, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 3.68756e-03, 0.00000e+00, 0.00000e+00, 0.00000e+00/ - data pd3/ & - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00/ -! o2 density - data pe1/ & - 1.35580e+00, 1.44816e-01, 0.00000e+00, 6.07767e-02, 0.00000e+00,& - 2.94777e-02, 7.46900e-02, 0.00000e+00,-9.23822e-02, 8.57342e-02,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 2.38636e+01, 0.00000e+00,& - 7.71653e-02, 0.00000e+00, 8.18751e+01, 1.87736e-02, 0.00000e+00,& - 0.00000e+00, 1.49667e-02, 0.00000e+00, 0.00000e+00, 8.66784e-02,& - 1.58727e-01, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00,-3.67874e+02, 5.48158e-03, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 8.47001e-02, 1.70147e-01,& - 1.22631e-02, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00/ - data pe2/ & - 8.17187e-03, 3.71617e-05, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,-2.10826e-03,& - -3.13640e-03, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - -7.35742e-02,-5.00266e-02, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 1.94965e-02, 0.00000e+00, 0.00000e+00, 0.00000e+00/ - data pe3/ & - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00/ -! ar density - data pf1/ & - 1.04761e+00, 2.00165e-01, 2.37697e-01, 3.68552e-02, 0.00000e+00,& - 3.57202e-02,-2.14075e-01, 0.00000e+00,-1.08018e-01,-3.73981e-01,& - 0.00000e+00, 3.10022e-02,-1.16305e-03,-2.07596e+01, 0.00000e+00,& - 8.64502e-02, 0.00000e+00, 9.74908e+01, 5.16707e-02, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 8.66784e-02,& - 1.58727e-01, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 3.46193e+02, 1.34297e-02, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,-3.48509e-03,& - -1.54689e-04, 0.00000e+00, 0.00000e+00, 8.47001e-02, 1.70147e-01,& - 1.47753e-02, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00/ - data pf2/ & - 1.89320e-02, 3.68181e-05, 1.32570e-02, 0.00000e+00, 0.00000e+00,& - 3.59719e-03, 7.44328e-03,-1.00023e-03,-6.50528e+03, 0.00000e+00,& - 1.03485e-02,-1.00983e-03,-4.06916e-03,-6.60864e+01,-1.71533e-02,& - 1.10605e-02, 1.20300e-02,-5.20034e-03, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - -2.62769e+03, 7.13755e-03, 4.17999e-03, 0.00000e+00, 1.25910e+04,& - 0.00000e+00, 0.00000e+00, 0.00000e+00,-2.23595e-03, 4.60217e-03,& - 5.71794e-03, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - -3.18353e-02,-2.35526e-02,-1.36189e-02, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 2.03522e-02,-6.67837e+01,-1.09724e-03, 0.00000e+00/ - data pf3/ & - -1.38821e-02, 1.60468e-02, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 1.51574e-02,& - -5.44470e-04, 0.00000e+00, 7.28224e-02, 6.59413e-02, 0.00000e+00,& - -5.15692e-03, 0.00000e+00, 0.00000e+00,-3.70367e+03, 0.00000e+00,& - 0.00000e+00, 1.36131e-02, 5.38153e-03, 0.00000e+00, 4.76285e+00,& - -1.75677e-02, 2.26301e-02, 0.00000e+00, 1.76631e-02, 4.77162e-03,& - 0.00000e+00, 5.39354e+00, 0.00000e+00,-7.51710e-03, 0.00000e+00,& - 0.00000e+00,-8.82736e+01, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00/ -! h density - data pg1/ & - 1.26376e+00,-2.14304e-01,-1.49984e-01, 2.30404e-01, 2.98237e-02,& - 2.68673e-02, 2.96228e-01, 2.21900e-02,-2.07655e-02, 4.52506e-01,& - 1.20105e-01, 3.24420e-02, 4.24816e-02,-9.14313e+00, 0.00000e+00,& - 2.47178e-02,-2.88229e-02, 8.12805e+01, 5.10380e-02,-5.80611e-03,& - 2.51236e-05,-1.24083e-02, 0.00000e+00, 0.00000e+00, 8.66784e-02,& - 1.58727e-01,-3.48190e-02, 0.00000e+00, 0.00000e+00, 2.89885e-05,& - 0.00000e+00, 1.53595e+02,-1.68604e-02, 0.00000e+00, 1.01015e-02,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 2.84552e-04,& - -1.22181e-03, 0.00000e+00, 0.00000e+00, 8.47001e-02, 1.70147e-01,& - -1.04927e-02, 0.00000e+00, 0.00000e+00, 0.00000e+00,-5.91313e-03/ - data pg2/ & - -2.30501e-02, 3.14758e-05, 0.00000e+00, 0.00000e+00, 1.26956e-02,& - 8.35489e-03, 3.10513e-04, 0.00000e+00, 3.42119e+03,-2.45017e-03,& - -4.27154e-04, 5.45152e-04, 1.89896e-03, 2.89121e+01,-6.49973e-03,& - -1.93855e-02,-1.48492e-02, 0.00000e+00,-5.10576e-02, 7.87306e-02,& - 9.51981e-02,-1.49422e+04, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 2.65503e+02, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 6.37110e-03, 3.24789e-04,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 6.14274e-02, 1.00376e-02,-8.41083e-04, 0.00000e+00, 0.00000e+00,& - 0.00000e+00,-1.27099e-02, 0.00000e+00, 0.00000e+00, 0.00000e+00/ - data pg3/ & - -3.94077e-03,-1.28601e-02,-7.97616e-03, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00,-6.71465e-03,-1.69799e-03, 1.93772e-03, 3.81140e+00,& - -7.79290e-03,-1.82589e-02,-1.25860e-02,-1.04311e-02,-3.02465e-03,& - 2.43063e-03, 3.63237e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00/ -! n density - data ph1/ & - 7.09557e+01,-3.26740e-01, 0.00000e+00,-5.16829e-01,-1.71664e-03,& - 9.09310e-02,-6.71500e-01,-1.47771e-01,-9.27471e-02,-2.30862e-01,& - -1.56410e-01, 1.34455e-02,-1.19717e-01, 2.52151e+00, 0.00000e+00,& - -2.41582e-01, 5.92939e-02, 4.39756e+00, 9.15280e-02, 4.41292e-03,& - 0.00000e+00, 8.66807e-03, 0.00000e+00, 0.00000e+00, 8.66784e-02,& - 1.58727e-01, 9.74701e-02, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 6.70217e+01,-1.31660e-03, 0.00000e+00,-1.65317e-02,& - 0.00000e+00, 0.00000e+00, 8.50247e-02, 2.77428e+01, 4.98658e-03,& - 6.15115e-03, 9.50156e-03,-2.12723e-02, 8.47001e-02, 1.70147e-01,& - -2.38645e-02, 0.00000e+00, 0.00000e+00, 0.00000e+00, 1.37380e-03/ - data ph2/ & - -8.41918e-03, 2.80145e-05, 7.12383e-03, 0.00000e+00,-1.66209e-02,& - 1.03533e-04,-1.68898e-02, 0.00000e+00, 3.64526e+03, 0.00000e+00,& - 6.54077e-03, 3.69130e-04, 9.94419e-04, 8.42803e+01,-1.16124e-02,& - -7.74414e-03,-1.68844e-03, 1.42809e-03,-1.92955e-03, 1.17225e-01,& - -2.41512e-02, 1.50521e+04, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 1.60261e+03, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00,-3.54403e-04,-1.87270e-02,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 2.76439e-02, 6.43207e-03,-3.54300e-02, 0.00000e+00, 0.00000e+00,& - 0.00000e+00,-2.80221e-02, 8.11228e+01,-6.75255e-04, 0.00000e+00/ - data ph3/ & - -1.05162e-02,-3.48292e-03,-6.97321e-03, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00,-1.45546e-03,-1.31970e-02,-3.57751e-03,-1.09021e+00,& - -1.50181e-02,-7.12841e-03,-6.64590e-03,-3.52610e-03,-1.87773e-02,& - -2.22432e-03,-3.93895e-01, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00/ -! hot o density - data pi1/ & - 6.04050e-02, 1.57034e+00, 2.99387e-02, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,-1.51018e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00,-8.61650e+00, 1.26454e-02,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 5.50878e-03, 0.00000e+00, 0.00000e+00, 8.66784e-02,& - 1.58727e-01, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 6.23881e-02, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 8.47001e-02, 1.70147e-01,& - -9.45934e-02, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00/ - data pi2/ & - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00/ - data pi3/ & - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00/ -! s param - data pj1/ & - 9.56827e-01, 6.20637e-02, 3.18433e-02, 0.00000e+00, 0.00000e+00,& - 3.94900e-02, 0.00000e+00, 0.00000e+00,-9.24882e-03,-7.94023e-03,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 1.74712e+02, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 2.74677e-03, 0.00000e+00, 1.54951e-02, 8.66784e-02,& - 1.58727e-01, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00,-6.99007e-04, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 1.24362e-02,-5.28756e-03, 8.47001e-02, 1.70147e-01,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00/ - data pj2/ & - 0.00000e+00, 2.47425e-05, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00/ - data pj3/ & - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00/ -! turbo - data pk1/ & - 1.09930e+00, 3.90631e+00, 3.07165e+00, 9.86161e-01, 1.63536e+01,& - 4.63830e+00, 1.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 1.28840e+00, 3.10302e-02, 1.18339e-01,& - 1.00000e+00, 7.00000e-01, 1.15020e+00, 3.44689e+00, 1.28840e+00,& - 1.00000e+00, 1.08738e+00, 1.22947e+00, 1.10016e+00, 7.34129e-01,& - 1.15241e+00, 2.22784e+00, 7.95046e-01, 4.01612e+00, 4.47749e+00,& - 1.23435e+02,-7.60535e-02, 1.68986e-06, 7.44294e-01, 1.03604e+00,& - 1.72783e+02, 1.15020e+00, 3.44689e+00,-7.46230e-01, 9.49154e-01/ -! lower boundary - data ptm/ & - 1.04130e+03, 3.86000e+02, 1.95000e+02, 1.66728e+01, 2.13000e+02,& - 1.20000e+02, 2.40000e+02, 1.87000e+02,-2.00000e+00, 0.00000e+00/ - data pdm/ & - 2.45600e+07, 6.71072e-06, 1.00000e+02, 0.00000e+00, 1.10000e+02,& - 1.00000e+01, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 8.59400e+10, 1.00000e+00, 1.05000e+02,-8.00000e+00, 1.10000e+02,& - 1.00000e+01, 9.00000e+01, 2.00000e+00, 0.00000e+00, 0.00000e+00,& - 2.81000e+11, 0.00000e+00, 1.05000e+02, 2.80000e+01, 2.89500e+01,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 3.30000e+10, 2.68270e-01, 1.05000e+02, 1.00000e+00, 1.10000e+02,& - 1.00000e+01, 1.10000e+02,-1.00000e+01, 0.00000e+00, 0.00000e+00,& - 1.33000e+09, 1.19615e-02, 1.05000e+02, 0.00000e+00, 1.10000e+02,& - 1.00000e+01, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 1.76100e+05, 1.00000e+00, 9.50000e+01,-8.00000e+00, 1.10000e+02,& - 1.00000e+01, 9.00000e+01, 2.00000e+00, 0.00000e+00, 0.00000e+00,& - 1.00000e+07, 1.00000e+00, 1.05000e+02,-8.00000e+00, 1.10000e+02,& - 1.00000e+01, 9.00000e+01, 2.00000e+00, 0.00000e+00, 0.00000e+00,& - 1.00000e+06, 1.00000e+00, 1.05000e+02,-8.00000e+00, 5.50000e+02,& - 7.60000e+01, 9.00000e+01, 2.00000e+00, 0.00000e+00, 4.00000e+03/ -! tn1(2) - data pl1/ & - 1.00858e+00, 4.56011e-02,-2.22972e-02,-5.44388e-02, 5.23136e-04,& - -1.88849e-02, 5.23707e-02,-9.43646e-03, 6.31707e-03,-7.80460e-02,& - -4.88430e-02, 0.00000e+00, 0.00000e+00,-7.60250e+00, 0.00000e+00,& - -1.44635e-02,-1.76843e-02,-1.21517e+02, 2.85647e-02, 0.00000e+00,& - 0.00000e+00, 6.31792e-04, 0.00000e+00, 5.77197e-03, 8.66784e-02,& - 1.58727e-01, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00,-8.90272e+03, 3.30611e-03, 3.02172e-03, 0.00000e+00,& - -2.13673e-03,-3.20910e-04, 0.00000e+00, 0.00000e+00, 2.76034e-03,& - 2.82487e-03,-2.97592e-04,-4.21534e-03, 8.47001e-02, 1.70147e-01,& - 8.96456e-03, 0.00000e+00,-1.08596e-02, 0.00000e+00, 0.00000e+00/ - data pl2/ & - 5.57917e-03, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 9.65405e-03, 0.00000e+00, 0.00000e+00, 2.00000e+00/ -! tn1(3) - data pm1/ & - 9.39664e-01, 8.56514e-02,-6.79989e-03, 2.65929e-02,-4.74283e-03,& - 1.21855e-02,-2.14905e-02, 6.49651e-03,-2.05477e-02,-4.24952e-02,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 1.19148e+01, 0.00000e+00,& - 1.18777e-02,-7.28230e-02,-8.15965e+01, 1.73887e-02, 0.00000e+00,& - 0.00000e+00, 0.00000e+00,-1.44691e-02, 2.80259e-04, 8.66784e-02,& - 1.58727e-01, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 2.16584e+02, 3.18713e-03, 7.37479e-03, 0.00000e+00,& - -2.55018e-03,-3.92806e-03, 0.00000e+00, 0.00000e+00,-2.89757e-03,& - -1.33549e-03, 1.02661e-03, 3.53775e-04, 8.47001e-02, 1.70147e-01,& - -9.17497e-03, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00/ - data pm2/ & - 3.56082e-03, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00,-1.00902e-02, 0.00000e+00, 0.00000e+00, 2.00000e+00/ -! tn1(4) - data pn1/ & - 9.85982e-01,-4.55435e-02, 1.21106e-02, 2.04127e-02,-2.40836e-03,& - 1.11383e-02,-4.51926e-02, 1.35074e-02,-6.54139e-03, 1.15275e-01,& - 1.28247e-01, 0.00000e+00, 0.00000e+00,-5.30705e+00, 0.00000e+00,& - -3.79332e-02,-6.24741e-02, 7.71062e-01, 2.96315e-02, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 6.81051e-03,-4.34767e-03, 8.66784e-02,& - 1.58727e-01, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 1.07003e+01,-2.76907e-03, 4.32474e-04, 0.00000e+00,& - 1.31497e-03,-6.47517e-04, 0.00000e+00,-2.20621e+01,-1.10804e-03,& - -8.09338e-04, 4.18184e-04, 4.29650e-03, 8.47001e-02, 1.70147e-01,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00/ - data pn2/ & - -4.04337e-03, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,-9.52550e-04,& - 8.56253e-04, 4.33114e-04, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 1.21223e-03,& - 2.38694e-04, 9.15245e-04, 1.28385e-03, 8.67668e-04,-5.61425e-06,& - 1.04445e+00, 3.41112e+01, 0.00000e+00,-8.40704e-01,-2.39639e+02,& - 7.06668e-01,-2.05873e+01,-3.63696e-01, 2.39245e+01, 0.00000e+00,& - -1.06657e-03,-7.67292e-04, 1.54534e-04, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 2.00000e+00/ -! tn1(5) tn2(1) - data po1/ & - 1.00320e+00, 3.83501e-02,-2.38983e-03, 2.83950e-03, 4.20956e-03,& - 5.86619e-04, 2.19054e-02,-1.00946e-02,-3.50259e-03, 4.17392e-02,& - -8.44404e-03, 0.00000e+00, 0.00000e+00, 4.96949e+00, 0.00000e+00,& - -7.06478e-03,-1.46494e-02, 3.13258e+01,-1.86493e-03, 0.00000e+00,& - -1.67499e-02, 0.00000e+00, 0.00000e+00, 5.12686e-04, 8.66784e-02,& - 1.58727e-01,-4.64167e-03, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 4.37353e-03,-1.99069e+02, 0.00000e+00,-5.34884e-03, 0.00000e+00,& - 1.62458e-03, 2.93016e-03, 2.67926e-03, 5.90449e+02, 0.00000e+00,& - 0.00000e+00,-1.17266e-03,-3.58890e-04, 8.47001e-02, 1.70147e-01,& - 0.00000e+00, 0.00000e+00, 1.38673e-02, 0.00000e+00, 0.00000e+00/ - data po2/ & - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 1.60571e-03,& - 6.28078e-04, 5.05469e-05, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,-1.57829e-03,& - -4.00855e-04, 5.04077e-05,-1.39001e-03,-2.33406e-03,-4.81197e-04,& - 1.46758e+00, 6.20332e+00, 0.00000e+00, 3.66476e-01,-6.19760e+01,& - 3.09198e-01,-1.98999e+01, 0.00000e+00,-3.29933e+02, 0.00000e+00,& - -1.10080e-03,-9.39310e-05, 1.39638e-04, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 2.00000e+00/ -! tn2(2) - data pp1/ & - 9.81637e-01,-1.41317e-03, 3.87323e-02, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,-3.58707e-02,& - -8.63658e-03, 0.00000e+00, 0.00000e+00,-2.02226e+00, 0.00000e+00,& - -8.69424e-03,-1.91397e-02, 8.76779e+01, 4.52188e-03, 0.00000e+00,& - 2.23760e-02, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00,-7.07572e-03, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - -4.11210e-03, 3.50060e+01, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00,-8.36657e-03, 1.61347e+01, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00,-1.45130e-02, 0.00000e+00, 0.00000e+00/ - data pp2/ & - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 1.24152e-03,& - 6.43365e-04, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 1.33255e-03,& - 2.42657e-03, 1.60666e-03,-1.85728e-03,-1.46874e-03,-4.79163e-06,& - 1.22464e+00, 3.53510e+01, 0.00000e+00, 4.49223e-01,-4.77466e+01,& - 4.70681e-01, 8.41861e+00,-2.88198e-01, 1.67854e+02, 0.00000e+00,& - 7.11493e-04, 6.05601e-04, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 2.00000e+00/ -! tn2(3) - data pq1/ & - 1.00422e+00,-7.11212e-03, 5.24480e-03, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,-5.28914e-02,& - -2.41301e-02, 0.00000e+00, 0.00000e+00,-2.12219e+01,-1.03830e-02,& - -3.28077e-03, 1.65727e-02, 1.68564e+00,-6.68154e-03, 0.00000e+00,& - 1.45155e-02, 0.00000e+00, 8.42365e-03, 0.00000e+00, 0.00000e+00,& - 0.00000e+00,-4.34645e-03, 0.00000e+00, 0.00000e+00, 2.16780e-02,& - 0.00000e+00,-1.38459e+02, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 7.04573e-03,-4.73204e+01, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 1.08767e-02, 0.00000e+00, 0.00000e+00/ - data pq2/ & - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,-8.08279e-03,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 5.21769e-04,& - -2.27387e-04, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 3.26769e-03,& - 3.16901e-03, 4.60316e-04,-1.01431e-04, 1.02131e-03, 9.96601e-04,& - 1.25707e+00, 2.50114e+01, 0.00000e+00, 4.24472e-01,-2.77655e+01,& - 3.44625e-01, 2.75412e+01, 0.00000e+00, 7.94251e+02, 0.00000e+00,& - 2.45835e-03, 1.38871e-03, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 2.00000e+00/ -! tn2(4) tn3(1) - data pr1/ & - 1.01890e+00,-2.46603e-02, 1.00078e-02, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,-6.70977e-02,& - -4.02286e-02, 0.00000e+00, 0.00000e+00,-2.29466e+01,-7.47019e-03,& - 2.26580e-03, 2.63931e-02, 3.72625e+01,-6.39041e-03, 0.00000e+00,& - 9.58383e-03, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00,-1.85291e-03, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 1.39717e+02, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 9.19771e-03,-3.69121e+02, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00,-1.57067e-02, 0.00000e+00, 0.00000e+00/ - data pr2/ & - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,-7.07265e-03,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,-2.92953e-03,& - -2.77739e-03,-4.40092e-04, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 2.47280e-03,& - 2.95035e-04,-1.81246e-03, 2.81945e-03, 4.27296e-03, 9.78863e-04,& - 1.40545e+00,-6.19173e+00, 0.00000e+00, 0.00000e+00,-7.93632e+01,& - 4.44643e-01,-4.03085e+02, 0.00000e+00, 1.15603e+01, 0.00000e+00,& - 2.25068e-03, 8.48557e-04,-2.98493e-04, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 2.00000e+00/ -! tn3(2) - data ps1/ & - 9.75801e-01, 3.80680e-02,-3.05198e-02, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 3.85575e-02,& - 5.04057e-02, 0.00000e+00, 0.00000e+00,-1.76046e+02, 1.44594e-02,& - -1.48297e-03,-3.68560e-03, 3.02185e+01,-3.23338e-03, 0.00000e+00,& - 1.53569e-02, 0.00000e+00,-1.15558e-02, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 4.89620e-03, 0.00000e+00, 0.00000e+00,-1.00616e-02,& - -8.21324e-03,-1.57757e+02, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 6.63564e-03, 4.58410e+01, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00,-2.51280e-02, 0.00000e+00, 0.00000e+00/ - data ps2/ & - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 9.91215e-03,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,-8.73148e-04,& - -1.29648e-03,-7.32026e-05, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,-4.68110e-03,& - -4.66003e-03,-1.31567e-03,-7.39390e-04, 6.32499e-04,-4.65588e-04,& - -1.29785e+00,-1.57139e+02, 0.00000e+00, 2.58350e-01,-3.69453e+01,& - 4.10672e-01, 9.78196e+00,-1.52064e-01,-3.85084e+03, 0.00000e+00,& - -8.52706e-04,-1.40945e-03,-7.26786e-04, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 2.00000e+00/ -! tn3(3) - data pu1/ & - 9.60722e-01, 7.03757e-02,-3.00266e-02, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 2.22671e-02,& - 4.10423e-02, 0.00000e+00, 0.00000e+00,-1.63070e+02, 1.06073e-02,& - 5.40747e-04, 7.79481e-03, 1.44908e+02, 1.51484e-04, 0.00000e+00,& - 1.97547e-02, 0.00000e+00,-1.41844e-02, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 5.77884e-03, 0.00000e+00, 0.00000e+00, 9.74319e-03,& - 0.00000e+00,-2.88015e+03, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00,-4.44902e-03,-2.92760e+01, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 2.34419e-02, 0.00000e+00, 0.00000e+00/ - data pu2/ & - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 5.36685e-03,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,-4.65325e-04,& - -5.50628e-04, 3.31465e-04, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,-2.06179e-03,& - -3.08575e-03,-7.93589e-04,-1.08629e-04, 5.95511e-04,-9.05050e-04,& - 1.18997e+00, 4.15924e+01, 0.00000e+00,-4.72064e-01,-9.47150e+02,& - 3.98723e-01, 1.98304e+01, 0.00000e+00, 3.73219e+03, 0.00000e+00,& - -1.50040e-03,-1.14933e-03,-1.56769e-04, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 2.00000e+00/ -! tn3(4) - data pv1/ & - 1.03123e+00,-7.05124e-02, 8.71615e-03, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,-3.82621e-02,& - -9.80975e-03, 0.00000e+00, 0.00000e+00, 2.89286e+01, 9.57341e-03,& - 0.00000e+00, 0.00000e+00, 8.66153e+01, 7.91938e-04, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 4.68917e-03, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 7.86638e-03, 0.00000e+00, 0.00000e+00, 9.90827e-03,& - 0.00000e+00, 6.55573e+01, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00,-4.00200e+01, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 7.07457e-03, 0.00000e+00, 0.00000e+00/ - data pv2/ & - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 5.72268e-03,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,-2.04970e-04,& - 1.21560e-03,-8.05579e-06, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,-2.49941e-03,& - -4.57256e-04,-1.59311e-04, 2.96481e-04,-1.77318e-03,-6.37918e-04,& - 1.02395e+00, 1.28172e+01, 0.00000e+00, 1.49903e-01,-2.63818e+01,& - 0.00000e+00, 4.70628e+01,-2.22139e-01, 4.82292e-02, 0.00000e+00,& - -8.67075e-04,-5.86479e-04, 5.32462e-04, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 2.00000e+00/ -! tn3(5) surface temp tsl - data pw1/ & - 1.00828e+00,-9.10404e-02,-2.26549e-02, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,-2.32420e-02,& - -9.08925e-03, 0.00000e+00, 0.00000e+00, 3.36105e+01, 0.00000e+00,& - 0.00000e+00, 0.00000e+00,-1.24957e+01,-5.87939e-03, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 2.79765e+01, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 2.01237e+03, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00,-1.75553e-02, 0.00000e+00, 0.00000e+00/ - data pw2/ & - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 3.29699e-03,& - 1.26659e-03, 2.68402e-04, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 1.17894e-03,& - 1.48746e-03, 1.06478e-04, 1.34743e-04,-2.20939e-03,-6.23523e-04,& - 6.36539e-01, 1.13621e+01, 0.00000e+00,-3.93777e-01, 2.38687e+03,& - 0.00000e+00, 6.61865e+02,-1.21434e-01, 9.27608e+00, 0.00000e+00,& - 1.68478e-04, 1.24892e-03, 1.71345e-03, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 2.00000e+00/ -! tgn3(2) surface grad tslg - data px1/ & - 1.57293e+00,-6.78400e-01, 6.47500e-01, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,-7.62974e-02,& - -3.60423e-01, 0.00000e+00, 0.00000e+00, 1.28358e+02, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 4.68038e+01, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00,-1.67898e-01, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 2.90994e+04, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 3.15706e+01, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00/ - data px2/ & - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 2.00000e+00/ -! tgn2(1) tgn1(2) - data py1/ & - 8.60028e-01, 3.77052e-01, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,-1.17570e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 7.77757e-03, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 1.01024e+02, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 6.54251e+02, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00/ - data py2/ & - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,-1.56959e-02,& - 1.91001e-02, 3.15971e-02, 1.00982e-02,-6.71565e-03, 2.57693e-03,& - 1.38692e+00, 2.82132e-01, 0.00000e+00, 0.00000e+00, 3.81511e+02,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 2.00000e+00/ -! tgn3(1) tgn2(2) - data pz1/ & - 1.06029e+00,-5.25231e-02, 3.73034e-01, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 3.31072e-02,& - -3.88409e-01, 0.00000e+00, 0.00000e+00,-1.65295e+02,-2.13801e-01,& - -4.38916e-02,-3.22716e-01,-8.82393e+01, 1.18458e-01, 0.00000e+00,& - -4.35863e-01, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00,-1.19782e-01, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 2.62229e+01, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00,-5.37443e+01, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00,-4.55788e-01, 0.00000e+00, 0.00000e+00/ - data pz2/ & - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 3.84009e-02,& - 3.96733e-02, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 5.05494e-02,& - 7.39617e-02, 1.92200e-02,-8.46151e-03,-1.34244e-02, 1.96338e-02,& - 1.50421e+00, 1.88368e+01, 0.00000e+00, 0.00000e+00,-5.13114e+01,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 5.11923e-02, 3.61225e-02, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 2.00000e+00/ -! semiannual mult sam - data paa1/ & - 1.00000e+00, 1.00000e+00, 1.00000e+00, 1.00000e+00, 1.00000e+00,& - 1.00000e+00, 1.00000e+00, 1.00000e+00, 1.00000e+00, 1.00000e+00,& - 1.00000e+00, 1.00000e+00, 1.00000e+00, 1.00000e+00, 1.00000e+00,& - 1.00000e+00, 1.00000e+00, 1.00000e+00, 1.00000e+00, 1.00000e+00,& - 1.00000e+00, 1.00000e+00, 1.00000e+00, 1.00000e+00, 1.00000e+00,& - 1.00000e+00, 1.00000e+00, 1.00000e+00, 1.00000e+00, 1.00000e+00,& - 1.00000e+00, 1.00000e+00, 1.00000e+00, 1.00000e+00, 1.00000e+00,& - 1.00000e+00, 1.00000e+00, 1.00000e+00, 1.00000e+00, 1.00000e+00,& - 1.00000e+00, 1.00000e+00, 1.00000e+00, 1.00000e+00, 1.00000e+00,& - 1.00000e+00, 1.00000e+00, 1.00000e+00, 1.00000e+00, 1.00000e+00/ - data paa2/ & - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00,& - 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00, 0.00000e+00/ -! middle atmosphere averages - data pavgm/ & - 2.61000e+02, 2.64000e+02, 2.29000e+02, 2.17000e+02, 2.17000e+02,& - 2.23000e+02, 2.86760e+02,-2.93940e+00, 2.50000e+00, 0.00000e+00/ - end module wam_gtd7bk_mod - -!----------------------------------------------------------------------- -!> Use moduke for common blocks -!! -!! All variables under this module are originalyl in common block used -!! for subroutine gettemp and others in this package. -!! -!! @author Hann-Ming Henry Juang - module gettemp_mod -! - real :: tlb !< labeled temperature - real :: s !< scale inverse to temperature difference - real :: db04 !< diffusive density at zlb for g4 - real :: db16 !< diffusive density at zlb for g18 - real :: db28 !< diffusive density at zlb for g28 - real :: db32 !< diffusive density at zlb for g32 - real :: db40 !< diffusive density at zlb for g40 - real :: db48 !< diffusive density at zlb for g48 - real :: db01 !< diffusive density at zlb for g01 - real :: za !< joining altitude of bates and spline - real :: t0 !< initial temperature - real :: z0 !< initial height - real :: g0 !< initial gradient variations - real :: rl !< correction to specified mixing ratio at ground - real :: dd !< diffusive density at alt - real :: db14 !< diffusive density at zlb for g14 - real :: tr12 !< try factor 1 or 2 -! - real :: tn1(5) !< temperature at node 1 (~mesosphere) - real :: tn2(4) !< temperature at node 2 (~stratosphere) - real :: tn3(5) !< temperature at node 3 (~troposphere) - real :: tgn1(2) !< temperature gradient at node 1 (~mesosphere) - real :: tgn2(2) !< temperature gradient at node 2 (~stratosphere) - real :: tgn3(2) !< temperature gradient at node 3 (~troposphere) -! - real :: pt(150) !< temperature - real :: pd(150,9) !< he density - real :: ps(150) !< s parameter - real :: pdl(25,2) !< turbo - real :: ptl(100,4) !< upper temperature - real :: pma(100,10) !< middle and low temperature - real :: sam(100) !< semiannual mult sam -! - real :: sw(25) !< weighting - real :: swc(25) !< weighting -! - real :: dm04 !< mixed density at alt04 - real :: dm16 !< mixed density at alt16 - real :: dm28 !< mixed density at alt28 - real :: dm32 !< mixed density at alt32 - real :: dm40 !< mixed density at alt40 - real :: dm01 !< mixed density at alt01 - real :: dm14 !< mixed density at alt14 -! - real :: gsurf !< surface gravitation force at given latitude - real :: re !< referenced height related to gsurf -! - real :: tinfg !< startinf referenced point for tt - real :: tt(15) !< referenced temperature -! - real :: plg(9,4) !< Legendre polynomial points - real :: ctloc !< cosine of the location - real :: stloc !< sine of the location - real :: c2tloc !< cosine of 2 time location - real :: s2tloc !< sine of 2 time location - real :: c3tloc !< cosine of 3 time location - real :: s3tloc !< sine of 3 time location - real :: day !< day in a year - real :: df !< the difference of f10.7 effect - real :: dfa !< the difference to reference value - real :: apd !< parameter calcumate for magnetic activity - real :: apdf !< the same as apd - real :: apt(4) !< daily magnetic activity - real :: xlong !< a given longitude -! - integer :: isw !< indix for sw - integer :: iyr !< integer for a given year -! - end module gettemp_mod - -! ---------------------------------------------------------------------- -!> Entry routine to get WAM needed temperature and composition profiles. -!! -!! Calculate temperature at each grid point useing nrlmsise00_sub -!! @param[in] iday calendat date with array dimension of nday -!! @param[in] nday dimension length of iday -!! @param[in] xlat latitudes with dimension nlat -!! @param[in] nlat dimension length of xlat -!! @param[in] pr pressure in vertical with dimension of np -!! @param[in] np dimension length of pr -!! @param[out] temp temperature -!! @param[out] n_o single oxygen number -!! @param[out] n_o2 oxygen number -!! @param[out] n_n2 nitrogen number -!! -!! @author Hann-Ming Henry Juang NCEP/EMC - subroutine gettemp(iday,nday,xlat,nlat,pr,np,temp,n_o,n_o2,n_n2) - implicit none - integer, intent(in) :: nday ! number of days - integer, intent(in) :: nlat ! number of latitudes - integer, intent(in) :: np ! number of pressure layer - real, intent(in) :: pr(np) ! pressure in mb - real, intent(in) :: xlat(nlat) ! latitude in degree - integer, intent(in) :: iday(nday) ! calender day - real, intent(out) :: temp(np,nlat,nday) ! temperature - real, intent(out) :: n_o(np,nlat,nday) ! number density of o - real, intent(out) :: n_o2(np,nlat,nday) ! number density of o2 - real, intent(out) :: n_n2(np,nlat,nday) ! number density of n2 - real :: alt(np,nlat,nday) ! altitude in km - real :: d(9),t(2),sw(25),ap(7),ut,xlong,xlst,f107, & - f107a - integer :: k,il,ip -! set magnetic index average value - data ap/7*9./ -! set swich 7,8,10,14 zero to avoid diurnal changes in output temperatu -! swich #7 is for diurnal,#8 is for semidiurnal,# 10 is for all ut/longi -! effect,#14 is for terdiurnal - data sw/1.,1.,1.,1.,1.,1.,0.,0.,1.,0.,1.,1.,1.,0.,1.,1.,1.,1.,1., & - 1.,1.,1.,1.,1.,1./ -! set 10.7cm flux be average value - f107=150. - f107a=150. -! turn on swich - call tselec(sw) -! set longitude, ut, local time , it should not make difference to outpu - ut=0. - xlong=0. - xlst=ut/3600.+xlong/15. -! calculate temperature for each lat,pres level,day - do k=1,nday - do il=1,nlat - do ip=1,np - call ghp7(iday(k),ut,alt(ip,il,k),xlat(il),xlong,xlst,f107a,f107, & - ap,d,t,pr(ip)) - temp(ip,il,k)=t(2) - n_o(ip,il,k)=d(2) - n_o2(ip,il,k)=d(4) - n_n2(ip,il,k)=d(3) - enddo - enddo - enddo - end subroutine gettemp - -!----------------------------------------------------------------------- -!> The nrlmsise-00 subroutine gtd7. -!! -!! Neutral atmosphere empirical model from the surface to lower exosphere. -!! -!! New features: -!! Extensive satellite drag database used in model generation -!! Revised o2 (and o) in lower thermosphere -!! Additional nonlinear solar activity term -!! "anomalous oxygen" number density, output d(9) -!! at high altitudes (> 500 km), hot atomic oxygen or ionized -!! oxygen can become appreciable for some ranges of subroutine -!! inputs, thereby affecting drag on satellites and debris. we -!! group these species under the term "anomalous oxygen," since -!! their individual variations are not presently separable with -!! the drag data used to define this model component. -!! And d(6) is the sum of the mass densities of t -!! species labeled by indices 1-5 and 7-8 in output variable d. -!! this includes he, o, n2, o2, ar, h, and n but does not includ -!! anomalous oxygen (species index 9). -!! -!! Notes on input variables: -!! ut, local time, and longitude are used independently in the -!! model and are not of equal importance for every situation. -!! for the most physically realistic calculation these three -!! variables should be consistent (stl=sec/3600+glong/15). -!! the equation of time departures from the above formula -!! for apparent local time can be included if available but -!! are of minor importance. -!! -!! f107 and f107a values used to generate the model correspond -!! to the 10.7 cm radio flux at the actual distance of the earth -!! from the sun rather than the radio flux at 1 au. the following -!! site provides both classes of values: -!! ftp://ftp.ngdc.noaa.gov/stp/solar_data/solar_radio/flux/ -!! -!! f107, f107a, and ap effects are neither large nor well -!! established below 80 km and these parameters should be set to -!! 150., 150., and 4. respectively. -!! -!! Subroutines for special outputs: -!! High altitude drag: effective total mass density -!! (subroutine gtd7d, output d(6)) -!! for atmospheric drag calculations at altitudes above 500 km, -!! call subroutine gtd7d to compute the "effective total mass -!! density" by including contributions from "anomalous oxygen." -!! see "notes on output variables" below on d(6). -!! Pressure grid (subroutine ghp7) -!! see subroutine ghp7 to specify outputs at a pressure level -!! rather than at an altitude. -!! Output in m-3 and kg/m3: call meters(.true.) -!! -!! Notes on output variables: -!! To get output in m-3 and kg/m3: call meters(.true.) -!! o, h, and n are set to zero below 72.5 km -!! t(1), exospheric temperature, is set to global average for -!! altitudes below 120 km. the 120 km gradient is left at global -!! average value for altitudes below 72 km. -!! d(6), total mass density, is not the same for subroutines gtd7 -!! and gtd7d -!! -!! -!! Switches: the following is for test and special purposes: -!! To turn on and off particular variations call tselec(sw), -!! where sw is a 25 element array containing 0. for off, 1. -!! for on, or 2. for main effects off but cross terms on -!! for the following variations -!! 1 f10.7 effect on mean -!! 2 time independent -!! 3 symmetrical annual -!! 4 symmetrical semiannual -!! 5 asymmetrical annual -!! 6 asymmetrical semiannual -!! 7 diurnal -!! 8 semidiurnal -!! 9 daily ap -!! 10 all ut/long effects -!! 11 longitudinal -!! 12 ut and mixed ut/long -!! 13 mixed ap/ut/long -!! 14 terdiurnal -!! 15 departures from diffusive equilibrium -!! 16 all tinf var -!! 17 all tlb var -!! 18 all tn1 var -!! 19 all s var -!! 20 all tn2 var -!! 21 all nlb var -!! 22 all tn3 var -!! 23 turbo scale height var -!! -!! @param[in] iyd year and day as yyddd (day of year from 1 to 365 or 366) -!! @param[in] sec ut(sec) -!! @param[in] alt altitude(km) -!! @param[in] glat geodetic latitude(deg) -!! @param[in] glong geodetic longitude(deg) -!! @param[in] stl local apparent solar time(hrs; see note below) -!! @param[in] f107a 81 day average of f10.7 flux (centered on day ddd) -!! @param[in] f107 daily f10.7 flux for previous day -!! @param[in] ap magnetic index(daily) or when sw(9)=-1. : -!! array containing: -!! ap(1) daily ap -!! ap(2) 3 hr ap index for current time -!! ap(3) 3 hr ap index for 3 hrs before current time -!! ap(4) 3 hr ap index for 6 hrs before current time -!! ap(5) 3 hr ap index for 9 hrs before current time -!! ap(6) average of eight 3 hr ap indicies from 12 to 33 hrs pr -!! to current time -!! ap(7) average of eight 3 hr ap indicies from 36 to 57 hrs pr -!! to current time -!! @param[in] mass mass number (only density for selected gas is -!! calculated. mass 0 is temperature. mass 48 for all. -!! mass 17 is anomalous o only.) -!! -!! @param[out] d size of 9 with following definition. -!! d(1) he number density(cm-3) -!! d(2) o number density(cm-3) -!! d(3) n2 number density(cm-3) -!! d(4) o2 number density(cm-3) -!! d(5) ar number density(cm-3) -!! d(6) total mass density(gm/cm3) -!! d(7) h number density(cm-3) -!! d(8) n number density(cm-3) -!! d(9) anomalous oxygen number density(cm-3) -!! @param[out] t - size of 2 array with following definition. -!! t(1) exospheric temperature -!! t(2) temperature at alt -!! -!! @author Hann-Ming Henry Juang - subroutine gtd7(iyd,sec,alt,glat,glong,stl,f107a,f107,ap,mass,d,t) - use wam_gtd7bk_mod - use gettemp_mod, only: dd, tn1,tn2,tn3,tgn1,tgn2,tgn3, & - pt,pd,ps,pdl,ptl,pma,sam,sw,isw,& - dm28,gsurf,re - - dimension d(9),t(2),ap(7),ds(9),ts(2) - dimension zn3(5),zn2(4),sv(25) -! - save - data mn3/5/,zn3/32.5,20.,15.,10.,0./ - data mn2/4/,zn2/72.5,55.,45.,32.5/ - data zmix/62.5/,alast/99999./,mssl/-999/ - data sv/25*1./ -! ==== assign common/parm7/ - pt(1:50) =pt1(1:50); pt(51:100) =pt2(1:50); pt(101:150) =pt3(1:50) - pd(1:50,1)=pa1(1:50); pd(51:100,1)=pa2(1:50); pd(101:150,1)=pa3(1:50) - pd(1:50,2)=pb1(1:50); pd(51:100,2)=pb2(1:50); pd(101:150,2)=pb3(1:50) - pd(1:50,3)=pc1(1:50); pd(51:100,3)=pc2(1:50); pd(101:150,3)=pc3(1:50) - pd(1:50,4)=pd1(1:50); pd(51:100,4)=pd2(1:50); pd(101:150,4)=pd3(1:50) - pd(1:50,5)=pe1(1:50); pd(51:100,5)=pe2(1:50); pd(101:150,5)=pe3(1:50) - pd(1:50,6)=pf1(1:50); pd(51:100,6)=pf2(1:50); pd(101:150,6)=pf3(1:50) - pd(1:50,7)=pg1(1:50); pd(51:100,7)=pg2(1:50); pd(101:150,7)=pg3(1:50) - pd(1:50,8)=ph1(1:50); pd(51:100,8)=ph2(1:50); pd(101:150,8)=ph3(1:50) - pd(1:50,9)=pi1(1:50); pd(51:100,9)=pi2(1:50); pd(101:150,9)=pi3(1:50) - ps(1:50) =pj1(1:50); ps(51:100) =pj2(1:50); ps(101:150) =pj3(1:50) - pdl(1:25,1)=pk1(1:25); pdl(1:25,2)=pk1(26:50) - ptl(1:50,1)=pl1(1:50); ptl(51:100,1)=pl2(1:50) - ptl(1:50,2)=pm1(1:50); ptl(51:100,2)=pm2(1:50) - ptl(1:50,3)=pn1(1:50); ptl(51:100,3)=pn2(1:50) - ptl(1:50,4)=po1(1:50); ptl(51:100,4)=po2(1:50) - pma(1:50,1)=pp1(1:50); pma(51:100,1)=pp2(1:50) - pma(1:50,2)=pq1(1:50); pma(51:100,2)=pq2(1:50) - pma(1:50,3)=pr1(1:50); pma(51:100,3)=pr2(1:50) - pma(1:50,4)=ps1(1:50); pma(51:100,4)=ps2(1:50) - pma(1:50,5)=pu1(1:50); pma(51:100,5)=pu2(1:50) - pma(1:50,6)=pv1(1:50); pma(51:100,6)=pv2(1:50) - pma(1:50,7)=pw1(1:50); pma(51:100,7)=pw2(1:50) - pma(1:50,8)=px1(1:50); pma(51:100,8)=px2(1:50) - pma(1:50,9)=py1(1:50); pma(51:100,9)=py2(1:50) - pma(1:50,10)=pz1(1:50); pma(51:100,10)=pz2(1:50) - sam(1:50)=paa1(1:50); sam(51:100)=paa2(1:50) -! - if(isw.ne.64999) call tselec(sv) -! -! test for changed input - v1=vtst7(iyd,sec,glat,glong,stl,f107a,f107,ap,1) -! latitude variation of gravity (none for sw(2)=0) - xlat=glat - if(sw(2).eq.0) xlat=45. - call glatf(xlat,gsurf,re) -! - xmm=pdm(5,3) -! -! thermosphere/mesosphere (above zn2(1)) - altt=amax1(alt,zn2(1)) - mss=mass -! only calculate n2 in thermosphere if alt in mixed region - if(alt.lt.zmix.and.mass.gt.0) mss=28 -! only calculate thermosphere if input parameters changed -! or altitude above zn2(1) in mesosphere - if(v1.eq.1..or.alt.gt.zn2(1).or.alast.gt.zn2(1).or.mss.ne.mssl) then - call gts7(iyd,sec,altt,glat,glong,stl,f107a,f107,ap,mss,ds,ts) - dm28m=dm28 -! metric adjustment - if(imr.eq.1) dm28m=dm28*1.e6 - mssl=mss - endif - t(1)=ts(1) - t(2)=ts(2) - if(alt.ge.zn2(1)) then - do 5 j=1,9 - d(j)=ds(j) - 5 continue - goto 10 - endif -! -! lower mesosphere/upper stratosphere [between zn3(1) and zn2(1)] -! temperature at nodes and gradients at end nodes -! inverse temperature a linear function of spherical harmonics -! only calculate nodes if input changed - if(v1.eq.1..or.alast.ge.zn2(1)) then - tgn2(1)=tgn1(2) - tn2(1)=tn1(5) - tn2(2)=pma(1,1)*pavgm(1)/(1.-sw(20)*glob7s(pma(1,1))) - tn2(3)=pma(1,2)*pavgm(2)/(1.-sw(20)*glob7s(pma(1,2))) - tn2(4)=pma(1,3)*pavgm(3)/(1.-sw(20)*sw(22)*glob7s(pma(1,3))) - tgn2(2)=pavgm(9)*pma(1,10)*(1.+sw(20)*sw(22)*glob7s(pma(1,10))) & - *tn2(4)*tn2(4)/(pma(1,3)*pavgm(3))**2 - tn3(1)=tn2(4) - endif - if(alt.ge.zn3(1)) goto 6 -! -! lower stratosphere and troposphere [below zn3(1)] -! temperature at nodes and gradients at end nodes -! inverse temperature a linear function of spherical harmonics -! only calculate nodes if input changed - if(v1.eq.1..or.alast.ge.zn3(1)) then - tgn3(1)=tgn2(2) - tn3(2)=pma(1,4)*pavgm(4)/(1.-sw(22)*glob7s(pma(1,4))) - tn3(3)=pma(1,5)*pavgm(5)/(1.-sw(22)*glob7s(pma(1,5))) - tn3(4)=pma(1,6)*pavgm(6)/(1.-sw(22)*glob7s(pma(1,6))) - tn3(5)=pma(1,7)*pavgm(7)/(1.-sw(22)*glob7s(pma(1,7))) - tgn3(2)=pma(1,8)*pavgm(8)*(1.+sw(22)*glob7s(pma(1,8))) & - *tn3(5)*tn3(5)/(pma(1,7)*pavgm(7))**2 - endif - 6 continue - if(mass.eq.0) goto 50 -! linear transition to full mixing below zn2(1) - dmc=0 - if(alt.gt.zmix) dmc=1.-(zn2(1)-alt)/(zn2(1)-zmix) - dz28=ds(3) -! ***** n2 density **** - dmr=ds(3)/dm28m-1. - d(3)=densm(alt,dm28m,xmm,tz,mn3,zn3,tn3,tgn3,mn2,zn2,tn2,tgn2) - d(3)=d(3)*(1.+dmr*dmc) -! ***** he density **** - d(1)=0 - if(mass.ne.4.and.mass.ne.48) goto 204 - dmr=ds(1)/(dz28*pdm(2,1))-1. - d(1)=d(3)*pdm(2,1)*(1.+dmr*dmc) - 204 continue -! **** o density **** - d(2)=0 - d(9)=0 -! ***** o2 density **** - d(4)=0 - if(mass.ne.32.and.mass.ne.48) goto 232 - dmr=ds(4)/(dz28*pdm(2,4))-1. - d(4)=d(3)*pdm(2,4)*(1.+dmr*dmc) - 232 continue -! ***** ar density **** - d(5)=0 - if(mass.ne.40.and.mass.ne.48) goto 240 - dmr=ds(5)/(dz28*pdm(2,5))-1. - d(5)=d(3)*pdm(2,5)*(1.+dmr*dmc) - 240 continue -! ***** hydrogen density **** - d(7)=0 -! ***** atomic nitrogen density **** - d(8)=0 -! -! total mass density -! - if(mass.eq.48) then - d(6) = 1.66e-24*(4.*d(1)+16.*d(2)+28.*d(3)+32.*d(4)+40.*d(5)+ & - d(7)+14.*d(8)) - if(imr.eq.1) d(6)=d(6)/1000. - endif - t(2)=tz - 10 continue - goto 90 - 50 continue - dd=densm(alt,1.,0.,tz,mn3,zn3,tn3,tgn3,mn2,zn2,tn2,tgn2) - t(2)=tz - 90 continue - alast=alt - return - end subroutine gtd7 - -!----------------------------------------------------------------------- -!> The nrlmsise-00 subroutine gtd7d -!! -!! This subroutine provides effective total mass density for -!! output d(6) which includes contributions from "anomalous -!! oxygen" which can affect satellite drag above 500 km. this -!! subroutine is part of the distribution package for the -!! neutral atmosphere empirical model from the surface to lower -!! exosphere. see subroutine gtd7 for more extensive comments. -!! And d(6) is the "effective total mass density -!! for drag" and is the sum of the mass densities of all species -!! in this model, including anomalous oxygen. -!! -!! @param[in] iyd year and day as yyddd (day of year from 1 to 365 (or 366) -!! @param[in] sec ut(sec) -!! @param[in] alt altitude(km) -!! @param[in] glat geodetic latitude(deg) -!! @param[in] glong geodetic longitude(deg) -!! @param[in] stl local apparent solar time(hrs; see note below) -!! @param[in] f107a 81 day average of f10.7 flux (centered on day ddd) -!! @param[in] f107 daily f10.7 flux for previous day -!! @param[in] ap magnetic index(daily) or when sw(9)=-1. : -!! ap array containing: -!! ap(1) daily ap -!! ap(2) 3 hr ap index for current time -!! ap(3) 3 hr ap index for 3 hrs before current time -!! ap(4) 3 hr ap index for 6 hrs before current time -!! ap(5) 3 hr ap index for 9 hrs before current time -!! ap(6) average of eight 3 hr ap indicies from 12 to 33 hrs pr -!! to current time -!! ap(7) average of eight 3 hr ap indicies from 36 to 57 hrs pr -!! to current time -!! @param[in] mass mass number (only density for selected gas is -!! calculated. mass 0 is temperature. mass 48 for all. -!! mass 17 is anomalous o only.) -!! -!! @param[out] d density array with length of 9 -!! @param[out] t temperature array with length of 2 -!! d array contains: -!! d(1) he number density(cm-3) -!! d(2) o number density(cm-3) -!! d(3) n2 number density(cm-3) -!! d(4) o2 number density(cm-3) -!! d(5) ar number density(cm-3) -!! d(6) total mass density(gm/cm3) [includes anomalous oxygen] -!! d(7) h number density(cm-3) -!! d(8) n number density(cm-3) -!! d(9) anomalous oxygen number density(cm-3) -!! t array conyains: -!! t(1) exospheric temperature -!! t(2) temperature at alt -!! -!! @author Hann-Ming Henry Juang - subroutine gtd7d(iyd,sec,alt,glat,glong,stl,f107a,f107,ap,mass,d,t) - use wam_gtd7bk_mod, only: imr -! - dimension d(9),t(2),ap(7) - call gtd7(iyd,sec,alt,glat,glong,stl,f107a,f107,ap,mass,d,t) -! total mass density -! - if(mass.eq.48) then - d(6) = 1.66e-24*(4.*d(1)+16.*d(2)+28.*d(3)+32.*d(4)+40.*d(5)+ & - d(7)+14.*d(8)+16.*d(9)) - if(imr.eq.1) d(6)=d(6)/1000. - endif - return - end subroutine gtd7d - -!----------------------------------------------------------------------- -!> Find altitude of pressure surface (press) from gtd7 -!! -!! input: -!! @param[in] iyd year and day as yyddd -!! @param[in] sec ut(sec) -!! @param[in] glat geodetic latitude(deg) -!! @param[in] glong geodetic longitude(deg) -!! @param[in] stl local apparent solar time(hrs) -!! @param[in] f107a 3 month average of f10.7 flux -!! @param[in] f107 daily f10.7 flux for previous day -!! @param[in] ap magnetic index(daily) or when sw(9)=-1. : -!! array containing: -!! ap(1) daily ap -!! ap(2) 3 hr ap index for current time -!! ap(3) 3 hr ap index for 3 hrs before current time -!! ap(4) 3 hr ap index for 6 hrs before current time -!! ap(5) 3 hr ap index for 9 hrs before current time -!! ap(6) average of eight 3 hr ap indicies from 12 to 33 hrs pr -!! to current time -!! ap(7) average of eight 3 hr ap indicies from 36 to 59 hrs pr -!! to current time -!! @param[in] press pressure level(mb) -!! output: -!! @param[out] alt altitude(km) -!! @param[out] d density array with length of 8 -!! d(1) he number density(cm-3) -!! d(2) o number density(cm-3) -!! d(3) n2 number density(cm-3) -!! d(4) o2 number density(cm-3) -!! d(5) ar number density(cm-3) -!! d(6) total mass density(gm/cm3) -!! d(7) h number density(cm-3) -!! d(8) n number density(cm-3) -!! d(9) hot o number density(cm-3) -!! @param[out] t temperature array with length of 2 -!! t(1) exospheric temperature -!! t(2) temperature at alt -!! -!! @author Hann-Ming Henry Juang - subroutine ghp7(iyd,sec,alt,glat,glong,stl,f107a,f107,ap,d,t,press) - use gettemp_mod, only: gsurf,re - use wam_gtd7bk_mod, only: imr -! - dimension d(9),t(2),ap(7) - save - data bm/1.3806e-19/,rgas/831.4/ - data test/.00043/,ltest/12/ -!! bm=1.3806e-19; rgas=831.4 -!! test=.00043; ltest=12 - pl=alog10(press) -! initial altitude estimate - if(pl.ge.-5.) then - if(pl.gt.2.5) zi=18.06*(3.00-pl) - if(pl.gt..75.and.pl.le.2.5) zi=14.98*(3.08-pl) - if(pl.gt.-1..and.pl.le..75) zi=17.8*(2.72-pl) - if(pl.gt.-2..and.pl.le.-1.) zi=14.28*(3.64-pl) - if(pl.gt.-4..and.pl.le.-2.) zi=12.72*(4.32-pl) - if(pl.le.-4.) zi=25.3*(.11-pl) - iday=mod(iyd,1000) - cl=glat/90. - cl2=cl*cl - if(iday.lt.182) cd=1.-iday/91.25 - if(iday.ge.182) cd=iday/91.25-3. - ca=0 - if(pl.gt.-1.11.and.pl.le.-.23) ca=1.0 - if(pl.gt.-.23) ca=(2.79-pl)/(2.79+.23) - if(pl.le.-1.11.and.pl.gt.-3.) ca=(-2.93-pl)/(-2.93+1.11) - z=zi-4.87*cl*cd*ca-1.64*cl2*ca+.31*ca*cl - endif - if(pl.lt.-5.) z=22.*(pl+4.)**2+110 -! iteration loop - l=0 - 10 continue - l=l+1 - call gtd7(iyd,sec,z,glat,glong,stl,f107a,f107,ap,48,d,t) - xn=d(1)+d(2)+d(3)+d(4)+d(5)+d(7)+d(8) - p=bm*xn*t(2) - if(imr.eq.1) p=p*1.e-6 - diff=pl-alog10(p) - if(abs(diff).lt.test .or. l.eq.ltest) goto 20 - xm=d(6)/xn/1.66e-24 - if(imr.eq.1) xm = xm*1.e3 - g=gsurf/(1.+z/re)**2 - sh=rgas*t(2)/(xm*g) -! new altitude estimate using scale height - if(l.lt.6) then - z=z-sh*diff*2.302 - else - z=z-sh*diff - endif - goto 10 - 20 continue - if(l.eq.ltest) write(6,100) press,diff - 100 format(1x,29hghp7 not converging for press, 1pe12.2,e12.2) - alt=z - return - end subroutine ghp7 - -!----------------------------------------------------------------------- -!> Calculate latitude variable. -!! -!! @param[in] lat latitude in degree -!! @param[out] gv gravity -!! @param[out] reff effective radius -!! -!! @author Hann-Ming Henry Juang - subroutine glatf(lat,gv,reff) - real lat - save - data dgtr/1.74533e-2/ -!! dgtr=1.74533e-2 - c2 = cos(2.*dgtr*lat) - gv = 980.616*(1.-.0026373*c2) - reff = 2.*gv/(3.085462e-6 + 2.27e-9*c2)*1.e-5 - return - end subroutine glatf - -!----------------------------------------------------------------------- -!> Test variable condition. -!! -!! Test if geophysical variables or switches changed and save -!! return 0 if unchanged and 1 if changed -!! -!! @param[in] iyd year and day as yyddd -!! @param[in] sec ut(sec) -!! @param[in] glat geodetic latitude(deg) -!! @param[in] glong geodetic longitude(deg) -!! @param[in] stl local apparent solar time(hrs) -!! @param[in] f107a 3 month average of f10.7 flux -!! @param[in] f107 daily f10.7 flux for previous day -!! @param[in] ap magnetic index(daily) or when sw(9)=-1. : -!! array containing: -!! ap(1) daily ap -!! ap(2) 3 hr ap index for current time -!! ap(3) 3 hr ap index for 3 hrs before current time -!! ap(4) 3 hr ap index for 6 hrs before current time -!! ap(5) 3 hr ap index for 9 hrs before current time -!! ap(6) average of eight 3 hr ap indicies from 12 to 33 hrs pr -!! to current time -!! ap(7) average of eight 3 hr ap indicies from 36 to 59 hrs pr -!! to current time -!! @param[in] ic initial point -!! @return vtst7 tested value -!! -!! @author Hann-Ming Henry Juang - function vtst7(iyd,sec,glat,glong,stl,f107a,f107,ap,ic) - use gettemp_mod, only: sw,swc -! - dimension ap(7),iydl(2),secl(2),glatl(2),gll(2),stll(2) - dimension fal(2),fl(2),apl(7,2),swl(25,2),swcl(25,2) - save - data iydl/2*-999/,secl/2*-999./,glatl/2*-999./,gll/2*-999./ - data stll/2*-999./,fal/2*-999./,fl/2*-999./,apl/14*-999./ - data swl/50*-999./,swcl/50*-999./ - vtst7=0 - if(iyd.ne.iydl(ic)) goto 10 - if(sec.ne.secl(ic)) goto 10 - if(glat.ne.glatl(ic)) goto 10 - if(glong.ne.gll(ic)) goto 10 - if(stl.ne.stll(ic)) goto 10 - if(f107a.ne.fal(ic)) goto 10 - if(f107.ne.fl(ic)) goto 10 - do 5 i=1,7 - if(ap(i).ne.apl(i,ic)) goto 10 - 5 end do - do 7 i=1,25 - if(sw(i).ne.swl(i,ic)) goto 10 - if(swc(i).ne.swcl(i,ic)) goto 10 - 7 end do - goto 20 - 10 continue - vtst7=1 - iydl(ic)=iyd - secl(ic)=sec - glatl(ic)=glat - gll(ic)=glong - stll(ic)=stl - fal(ic)=f107a - fl(ic)=f107 - do 15 i=1,7 - apl(i,ic)=ap(i) - 15 end do - do 16 i=1,25 - swl(i,ic)=sw(i) - swcl(i,ic)=swc(i) - 16 end do - 20 continue - return - end function vtst7 - -!----------------------------------------------------------------------- -!> Thermospheric portion of nrlmsise-00 -!! -!! See gtd7 for more extensive comments -!! Output in m-3 and kg/m3: call meters(.true.) -!! -!! @param[in] iyd year and day as yyddd (day of year from 1 to 365 or 366 -!! @param[in] sec ut(sec) -!! @param[in] alt altitude(km) (>72.5 km) -!! @param[in] glat geodetic latitude(deg) -!! @param[in] glong geodetic longitude(deg) -!! @param[in] stl local apparent solar time(hrs) -!! @param[in] f107a 3 month average of f10.7 flux -!! @param[in] f107 daily f10.7 flux for previous day -!! @param[in] ap magnetic index(daily) or when sw(9)=-1. : -!! array containing: -!! ap(1) daily ap -!! ap(2) 3 hr ap index for current time -!! ap(3) 3 hr ap index for 3 hrs before current time -!! ap(4) 3 hr ap index for 6 hrs before current time -!! ap(5) 3 hr ap index for 9 hrs before current time -!! ap(6) average of eight 3 hr ap indicies from 12 to 33 hrs pr -!! to current time -!! ap(7) average of eight 3 hr ap indicies from 36 to 59 hrs pr -!! to current time -!! @param[in] mass - mass number (only density for selected gas is -!! calculated. mass 0 is temperature. mass 48 for all. -!! mass 17 is anomalous o only.) -!! @param[out] d density array with length of 8 -!! d(1) he number density(cm-3) -!! d(2) o number density(cm-3) -!! d(3) n2 number density(cm-3) -!! d(4) o2 number density(cm-3) -!! d(5) ar number density(cm-3) -!! d(6) total mass density(gm/cm3) -!! d(7) h number density(cm-3) -!! d(8) n number density(cm-3) -!! d(9) anomalous oxygen number density(cm-3) -!! @param[out] t temperature array with length of 2 -!! t(1) exospheric temperature -!! t(2) temperature at alt -!! -!! @author Hann-Ming Henry Juang - subroutine gts7(iyd,sec,alt,glat,glong,stl,f107a,f107,ap,mass,d,t) - use wam_gtd7bk_mod, only: & - ptm,pdm, & - imr - - use gettemp_mod, only: tlb,s,db04,db16,db28,db32,db40,db48,db01,za,t0, & - z0,g0,rl,dd,db14,tr12,tn1,tgn1, & - pt,pd,ps,pdl,ptl,pma,sw, & - dm04,dm16,dm28,dm32,dm40,dm01,dm14 - - dimension zn1(5),alpha(9) - dimension d(9),t(2),mt(11),ap(*),altl(8) - save - data mt/48,0,4,16,28,32,40,1,49,14,17/ - data altl/200.,300.,160.,250.,240.,450.,320.,450./ - data mn1/5/,zn1/120.,110.,100.,90.,72.5/ - data dgtr/1.74533e-2/,dr/1.72142e-2/,alast/-999./ - data alpha/-0.38,0.,0.,0.,0.17,0.,-0.38,0.,0./ -! test for changed input - v2=vtst7(iyd,sec,glat,glong,stl,f107a,f107,ap,2) -! - yrd=iyd - za=pdl(16,2) - zn1(1)=za - do 2 j=1,9 - d(j)=0. - 2 end do -! tinf variations not important below za or zn1(1) - if(alt.gt.zn1(1)) then - if(v2.eq.1..or.alast.le.zn1(1)) tinf=ptm(1)*pt(1) & - *(1.+sw(16)*globe7(yrd,sec,glat,glong,stl,f107a,f107,ap,pt)) - else - tinf=ptm(1)*pt(1) - endif - t(1)=tinf -! gradient variations not important below zn1(5) - if(alt.gt.zn1(5)) then - if(v2.eq.1.or.alast.le.zn1(5)) g0=ptm(4)*ps(1) & - *(1.+sw(19)*globe7(yrd,sec,glat,glong,stl,f107a,f107,ap,ps)) - else - g0=ptm(4)*ps(1) - endif -! calculate these temperatures only if input changed - if(v2.eq.1. .or. alt.lt.300.) & - tlb=ptm(2)*(1.+sw(17)*globe7(yrd,sec,glat,glong,stl, & - f107a,f107,ap,pd(1,4)))*pd(1,4) - s=g0/(tinf-tlb) -! lower thermosphere temp variations not significant for -! density above 300 km - if(alt.lt.300.) then - if(v2.eq.1..or.alast.ge.300.) then - tn1(2)=ptm(7)*ptl(1,1)/(1.-sw(18)*glob7s(ptl(1,1))) - tn1(3)=ptm(3)*ptl(1,2)/(1.-sw(18)*glob7s(ptl(1,2))) - tn1(4)=ptm(8)*ptl(1,3)/(1.-sw(18)*glob7s(ptl(1,3))) - tn1(5)=ptm(5)*ptl(1,4)/(1.-sw(18)*sw(20)*glob7s(ptl(1,4))) - tgn1(2)=ptm(9)*pma(1,9)*(1.+sw(18)*sw(20)*glob7s(pma(1,9))) & - *tn1(5)*tn1(5)/(ptm(5)*ptl(1,4))**2 - endif - else - tn1(2)=ptm(7)*ptl(1,1) - tn1(3)=ptm(3)*ptl(1,2) - tn1(4)=ptm(8)*ptl(1,3) - tn1(5)=ptm(5)*ptl(1,4) - tgn1(2)=ptm(9)*pma(1,9) & - *tn1(5)*tn1(5)/(ptm(5)*ptl(1,4))**2 - endif -! - z0=zn1(4) - t0=tn1(4) - tr12=1. -! - if(mass.eq.0) go to 50 -! n2 variation factor at zlb - g28=sw(21)*globe7(yrd,sec,glat,glong,stl,f107a,f107, & - ap,pd(1,3)) - day=amod(yrd,1000.) -! variation of turbopause height - zhf=pdl(25,2) & - *(1.+sw(5)*pdl(25,1)*sin(dgtr*glat)*cos(dr*(day-pt(14)))) - yrd=iyd - t(1)=tinf - xmm=pdm(5,3) - z=alt -! - do 10 j = 1,11 - if(mass.eq.mt(j)) go to 15 - 10 end do - write(6,100) mass - go to 90 - 15 if(z.gt.altl(6).and.mass.ne.28.and.mass.ne.48) go to 17 -! -! **** n2 density **** -! -! diffusive density at zlb - db28 = pdm(1,3)*exp(g28)*pd(1,3) -! diffusive density at alt - d(3)=densu(z,db28,tinf,tlb, 28.,alpha(3),t(2),ptm(6),s,mn1,zn1, & - tn1,tgn1) - dd=d(3) -! turbopause - zh28=pdm(3,3)*zhf - zhm28=pdm(4,3)*pdl(6,2) - xmd=28.-xmm -! mixed density at zlb - b28=densu(zh28,db28,tinf,tlb,xmd,alpha(3)-1.,tz,ptm(6),s,mn1, & - zn1,tn1,tgn1) - if(z.gt.altl(3).or.sw(15).eq.0.) go to 17 -! mixed density at alt - dm28=densu(z,b28,tinf,tlb,xmm,alpha(3),tz,ptm(6),s,mn1, & - zn1,tn1,tgn1) -! net density at alt - d(3)=dnet(d(3),dm28,zhm28,xmm,28.) - 17 continue - go to (20,50,20,25,90,35,40,45,25,48,46), j - 20 continue -! -! **** he density **** -! -! density variation factor at zlb - g4 = sw(21)*globe7(yrd,sec,glat,glong,stl,f107a,f107,ap,pd(1,1)) -! diffusive density at zlb - db04 = pdm(1,1)*exp(g4)*pd(1,1) -! diffusive density at alt - d(1)=densu(z,db04,tinf,tlb, 4.,alpha(1),t(2),ptm(6),s,mn1,zn1, & - tn1,tgn1) - dd=d(1) - if(z.gt.altl(1).or.sw(15).eq.0.) go to 24 -! turbopause - zh04=pdm(3,1) -! mixed density at zlb - b04=densu(zh04,db04,tinf,tlb,4.-xmm,alpha(1)-1., & - t(2),ptm(6),s,mn1,zn1,tn1,tgn1) -! mixed density at alt - dm04=densu(z,b04,tinf,tlb,xmm,0.,t(2),ptm(6),s,mn1,zn1,tn1,tgn1) - zhm04=zhm28 -! net density at alt - d(1)=dnet(d(1),dm04,zhm04,xmm,4.) -! correction to specified mixing ratio at ground - rl=alog(b28*pdm(2,1)/b04) - zc04=pdm(5,1)*pdl(1,2) - hc04=pdm(6,1)*pdl(2,2) -! net density corrected at alt - d(1)=d(1)*ccor(z,rl,hc04,zc04) - 24 continue - if(mass.ne.48) go to 90 - 25 continue -! -! **** o density **** -! -! density variation factor at zlb - g16= sw(21)*globe7(yrd,sec,glat,glong,stl,f107a,f107,ap,pd(1,2)) -! diffusive density at zlb - db16 = pdm(1,2)*exp(g16)*pd(1,2) -! diffusive density at alt - d(2)=densu(z,db16,tinf,tlb, 16.,alpha(2),t(2),ptm(6),s,mn1, & - zn1,tn1,tgn1) - dd=d(2) - if(z.gt.altl(2).or.sw(15).eq.0.) go to 34 -! corrected from pdm(3,1) to pdm(3,2) 12/2/85 -! turbopause - zh16=pdm(3,2) -! mixed density at zlb - b16=densu(zh16,db16,tinf,tlb,16-xmm,alpha(2)-1., & - t(2),ptm(6),s,mn1,zn1,tn1,tgn1) -! mixed density at alt - dm16=densu(z,b16,tinf,tlb,xmm,0.,t(2),ptm(6),s,mn1,zn1,tn1,tgn1) - zhm16=zhm28 -! net density at alt - d(2)=dnet(d(2),dm16,zhm16,xmm,16.) -! 3/16/99 change form to match o2 departure from diff equil near 150 -! km and add dependence on f10.7 -! rl=alog(b28*pdm(2,2)*abs(pdl(17,2))/b16) - rl=pdm(2,2)*pdl(17,2)*(1.+sw(1)*pdl(24,1)*(f107a-150.)) - hc16=pdm(6,2)*pdl(4,2) - zc16=pdm(5,2)*pdl(3,2) - hc216=pdm(6,2)*pdl(5,2) - d(2)=d(2)*ccor2(z,rl,hc16,zc16,hc216) -! chemistry correction - hcc16=pdm(8,2)*pdl(14,2) - zcc16=pdm(7,2)*pdl(13,2) - rc16=pdm(4,2)*pdl(15,2) -! net density corrected at alt - d(2)=d(2)*ccor(z,rc16,hcc16,zcc16) - 34 continue - if(mass.ne.48.and.mass.ne.49) go to 90 - 35 continue -! -! **** o2 density **** -! -! density variation factor at zlb - g32= sw(21)*globe7(yrd,sec,glat,glong,stl,f107a,f107,ap,pd(1,5)) -! diffusive density at zlb - db32 = pdm(1,4)*exp(g32)*pd(1,5) -! diffusive density at alt - d(4)=densu(z,db32,tinf,tlb, 32.,alpha(4),t(2),ptm(6),s,mn1, & - zn1,tn1,tgn1) - if(mass.eq.49) then - dd=dd+2.*d(4) - else - dd=d(4) - endif - if(sw(15).eq.0.) go to 39 - if(z.gt.altl(4)) go to 38 -! turbopause - zh32=pdm(3,4) -! mixed density at zlb - b32=densu(zh32,db32,tinf,tlb,32.-xmm,alpha(4)-1., & - t(2),ptm(6),s,mn1,zn1,tn1,tgn1) -! mixed density at alt - dm32=densu(z,b32,tinf,tlb,xmm,0.,t(2),ptm(6),s,mn1,zn1,tn1,tgn1) - zhm32=zhm28 -! net density at alt - d(4)=dnet(d(4),dm32,zhm32,xmm,32.) -! correction to specified mixing ratio at ground - rl=alog(b28*pdm(2,4)/b32) - hc32=pdm(6,4)*pdl(8,2) - zc32=pdm(5,4)*pdl(7,2) - d(4)=d(4)*ccor(z,rl,hc32,zc32) - 38 continue -! correction for general departure from diffusive equilibrium above - hcc32=pdm(8,4)*pdl(23,2) - hcc232=pdm(8,4)*pdl(23,1) - zcc32=pdm(7,4)*pdl(22,2) - rc32=pdm(4,4)*pdl(24,2)*(1.+sw(1)*pdl(24,1)*(f107a-150.)) -! net density corrected at alt - d(4)=d(4)*ccor2(z,rc32,hcc32,zcc32,hcc232) - 39 continue - if(mass.ne.48) go to 90 - 40 continue -! -! **** ar density **** -! -! density variation factor at zlb - g40= sw(21)*globe7(yrd,sec,glat,glong,stl,f107a,f107,ap,pd(1,6)) -! diffusive density at zlb - db40 = pdm(1,5)*exp(g40)*pd(1,6) -! diffusive density at alt - d(5)=densu(z,db40,tinf,tlb, 40.,alpha(5),t(2),ptm(6),s,mn1,zn1,tn1,tgn1) - dd=d(5) - if(z.gt.altl(5).or.sw(15).eq.0.) go to 44 -! turbopause - zh40=pdm(3,5) -! mixed density at zlb - b40=densu(zh40,db40,tinf,tlb,40.-xmm,alpha(5)-1., & - t(2),ptm(6),s,mn1,zn1,tn1,tgn1) -! mixed density at alt - dm40=densu(z,b40,tinf,tlb,xmm,0.,t(2),ptm(6),s,mn1,zn1,tn1,tgn1) - zhm40=zhm28 -! net density at alt - d(5)=dnet(d(5),dm40,zhm40,xmm,40.) -! correction to specified mixing ratio at ground - rl=alog(b28*pdm(2,5)/b40) - hc40=pdm(6,5)*pdl(10,2) - zc40=pdm(5,5)*pdl(9,2) -! net density corrected at alt - d(5)=d(5)*ccor(z,rl,hc40,zc40) - 44 continue - if(mass.ne.48) go to 90 - 45 continue -! -! **** hydrogen density **** -! -! density variation factor at zlb - g1 = sw(21)*globe7(yrd,sec,glat,glong,stl,f107a,f107,ap,pd(1,7)) -! diffusive density at zlb - db01 = pdm(1,6)*exp(g1)*pd(1,7) -! diffusive density at alt - d(7)=densu(z,db01,tinf,tlb,1.,alpha(7),t(2),ptm(6),s,mn1,zn1,tn1,tgn1) - dd=d(7) - if(z.gt.altl(7).or.sw(15).eq.0.) go to 47 -! turbopause - zh01=pdm(3,6) -! mixed density at zlb - b01=densu(zh01,db01,tinf,tlb,1.-xmm,alpha(7)-1., & - t(2),ptm(6),s,mn1,zn1,tn1,tgn1) -! mixed density at alt - dm01=densu(z,b01,tinf,tlb,xmm,0.,t(2),ptm(6),s,mn1,zn1,tn1,tgn1) - zhm01=zhm28 -! net density at alt - d(7)=dnet(d(7),dm01,zhm01,xmm,1.) -! correction to specified mixing ratio at ground - rl=alog(b28*pdm(2,6)*abs(pdl(18,2))/b01) - hc01=pdm(6,6)*pdl(12,2) - zc01=pdm(5,6)*pdl(11,2) - d(7)=d(7)*ccor(z,rl,hc01,zc01) -! chemistry correction - hcc01=pdm(8,6)*pdl(20,2) - zcc01=pdm(7,6)*pdl(19,2) - rc01=pdm(4,6)*pdl(21,2) -! net density corrected at alt - d(7)=d(7)*ccor(z,rc01,hcc01,zcc01) - 47 continue - if(mass.ne.48) go to 90 - 48 continue -! -! **** atomic nitrogen density **** -! -! density variation factor at zlb - g14 = sw(21)*globe7(yrd,sec,glat,glong,stl,f107a,f107,ap,pd(1,8)) -! diffusive density at zlb - db14 = pdm(1,7)*exp(g14)*pd(1,8) -! diffusive density at alt - d(8)=densu(z,db14,tinf,tlb,14.,alpha(8),t(2),ptm(6),s,mn1, & - zn1,tn1,tgn1) - dd=d(8) - if(z.gt.altl(8).or.sw(15).eq.0.) go to 49 -! turbopause - zh14=pdm(3,7) -! mixed density at zlb - b14=densu(zh14,db14,tinf,tlb,14.-xmm,alpha(8)-1., & - t(2),ptm(6),s,mn1,zn1,tn1,tgn1) -! mixed density at alt - dm14=densu(z,b14,tinf,tlb,xmm,0.,t(2),ptm(6),s,mn1,zn1,tn1,tgn1) - zhm14=zhm28 -! net density at alt - d(8)=dnet(d(8),dm14,zhm14,xmm,14.) -! correction to specified mixing ratio at ground - rl=alog(b28*pdm(2,7)*abs(pdl(3,1))/b14) - hc14=pdm(6,7)*pdl(2,1) - zc14=pdm(5,7)*pdl(1,1) - d(8)=d(8)*ccor(z,rl,hc14,zc14) -! chemistry correction - hcc14=pdm(8,7)*pdl(5,1) - zcc14=pdm(7,7)*pdl(4,1) - rc14=pdm(4,7)*pdl(6,1) -! net density corrected at alt - d(8)=d(8)*ccor(z,rc14,hcc14,zcc14) - 49 continue - if(mass.ne.48) go to 90 - 46 continue -! -! **** anomalous oxygen density **** -! - g16h = sw(21)*globe7(yrd,sec,glat,glong,stl,f107a,f107,ap,pd(1,9)) - db16h = pdm(1,8)*exp(g16h)*pd(1,9) - tho=pdm(10,8)*pdl(7,1) - dd=densu(z,db16h,tho,tho,16.,alpha(9),t2,ptm(6),s,mn1, & - zn1,tn1,tgn1) - zsht=pdm(6,8) - zmho=pdm(5,8) - zsho=scalh(zmho,16.,tho) - d(9)=dd*exp(-zsht/zsho*(exp(-(z-zmho)/zsht)-1.)) - if(mass.ne.48) go to 90 -! -! total mass density -! - d(6) = 1.66e-24*(4.*d(1)+16.*d(2)+28.*d(3)+32.*d(4)+40.*d(5)+ & - d(7)+14.*d(8)) - db48=1.66e-24*(4.*db04+16.*db16+28.*db28+32.*db32+40.*db40+db01+ & - 14.*db14) - go to 90 -! temperature at altitude - 50 continue - z=abs(alt) - ddum = densu(z,1., tinf,tlb,0.,0.,t(2),ptm(6),s,mn1,zn1,tn1,tgn1) - 90 continue -! adjust densities from cgs to kgm - if(imr.eq.1) then - do 95 i=1,9 - d(i)=d(i)*1.e6 - 95 continue - d(6)=d(6)/1000. - endif - alast=alt - return - 100 format(1x,'mass', i5, ' not valid') - end subroutine gts7 - -!----------------------------------------------------------------------- -!> Convert outputs to kg & meters if meter true. -!! @param[in] meter logical true or false -!! @author Hann-Ming Henry Juang - subroutine meters(meter) - use wam_gtd7bk_mod, only: imr -! - logical meter - save - imr=0 - if(meter) imr=1 - end subroutine meters - -!----------------------------------------------------------------------- -!> Calculate scale height (km) -!! @param[in] alt altitude [km] -!! @param[in] xm molecular weihjt -!! @param[in] temp temperature -!! @return scalh scale height -!! -!! @author Hann-Ming Henry Juang - function scalh(alt,xm,temp) - use gettemp_mod, only: gsurf,re -! - save - data rgas/831.4/ - g=gsurf/(1.+alt/re)**2 - scalh=rgas*temp/(g*xm) - return - end function scalh - -!----------------------------------------------------------------------- -!> Calculate g(l) function for upper thermosphere parameters -!! @param[in] yrd year and day as yyddd -!! @param[in] sec ut(sec) -!! @param[in] lat geodetic latitude(deg) -!! @param[in] long geodetic longitude(deg) -!! @param[in] tloc local apparent solar time(hrs) -!! @param[in] f107a 3 month average of f10.7 flux -!! @param[in] f107 daily f10.7 flux for previous day -!! @param[in] ap magnetic index(daily) or when sw(9)=-1. : -!! array containing: -!! ap(1) daily ap -!! ap(2) 3 hr ap index for current time -!! ap(3) 3 hr ap index for 3 hrs before current time -!! ap(4) 3 hr ap index for 6 hrs before current time -!! ap(5) 3 hr ap index for 9 hrs before current time -!! ap(6) average of eight 3 hr ap indicies from 12 to 33 hrs pr -!! to current time -!! ap(7) average of eight 3 hr ap indicies from 36 to 59 hrs pr -!! to current time -!! @param[in] p pressure level(mb) -!! @return globe7 version of global -!! -!! @author Hann-Ming Henry Juang - function globe7(yrd,sec,lat,long,tloc,f107a,f107,ap,p) - use gettemp_mod, only: tinf=>tinfg,t=>tt, & - sw,swc,isw, & - plg,ctloc,stloc,c2tloc,s2tloc,c3tloc,s3tloc, & - day,df,dfa,apd,apdf,apt,xlong,iyr - real lat, long - dimension p(*),sv(25),ap(*) -!---- functions ------ -! 3hr magnetic activity functions -! eq. a24d - g0(a)=(a-4.+(p(26)-1.)*(a-4.+(exp(-abs(p(25))*(a-4.))-1.)/ & - abs(p(25)))) -! eq. a24c - sumex(ex)=1.+(1.-ex**19)/(1.-ex)*ex**(.5) -! eq. a24a - sg0(ex)=(g0(ap(2))+(g0(ap(3))*ex+g0(ap(4))*ex*ex+g0(ap(5))*ex**3 & - +(g0(ap(6))*ex**4+g0(ap(7))*ex**12)*(1.-ex**8)/(1.-ex)) & - )/sumex(ex) -!--------------------- - save - data dgtr/1.74533e-2/,dr/1.72142e-2/, xl/1000./,tll/1000./ - data sw9/1./,dayl/-1./,p14/-1000./,p18/-1000./,p32/-1000./ - data hr/.2618/,sr/7.2722e-5/,sv/25*1./,nsw/14/,p39/-1000./ - if(isw.ne.64999) call tselec(sv) - do 10 j=1,14 - t(j)=0 - 10 end do - if(sw(9).gt.0) sw9=1. - if(sw(9).lt.0) sw9=-1. - iyr = nint(yrd/1000.) - day = yrd - iyr*1000. - xlong=long -! eq. a22 (remainder of code) - if(xl.eq.lat) go to 15 -! calculate legendre polynomials - c = sin(lat*dgtr) - s = cos(lat*dgtr) - c2 = c*c - c4 = c2*c2 - s2 = s*s - plg(2,1) = c - plg(3,1) = 0.5*(3.*c2 -1.) - plg(4,1) = 0.5*(5.*c*c2-3.*c) - plg(5,1) = (35.*c4 - 30.*c2 + 3.)/8. - plg(6,1) = (63.*c2*c2*c - 70.*c2*c + 15.*c)/8. - plg(7,1) = (11.*c*plg(6,1) - 5.*plg(5,1))/6. -! plg(8,1) = (13.*c*plg(7,1) - 6.*plg(6,1))/7. - plg(2,2) = s - plg(3,2) = 3.*c*s - plg(4,2) = 1.5*(5.*c2-1.)*s - plg(5,2) = 2.5*(7.*c2*c-3.*c)*s - plg(6,2) = 1.875*(21.*c4 - 14.*c2 +1.)*s - plg(7,2) = (11.*c*plg(6,2)-6.*plg(5,2))/5. -! plg(8,2) = (13.*c*plg(7,2)-7.*plg(6,2))/6. -! plg(9,2) = (15.*c*plg(8,2)-8.*plg(7,2))/7. - plg(3,3) = 3.*s2 - plg(4,3) = 15.*s2*c - plg(5,3) = 7.5*(7.*c2 -1.)*s2 - plg(6,3) = 3.*c*plg(5,3)-2.*plg(4,3) - plg(7,3)=(11.*c*plg(6,3)-7.*plg(5,3))/4. - plg(8,3)=(13.*c*plg(7,3)-8.*plg(6,3))/5. - plg(4,4) = 15.*s2*s - plg(5,4) = 105.*s2*s*c - plg(6,4)=(9.*c*plg(5,4)-7.*plg(4,4))/2. - plg(7,4)=(11.*c*plg(6,4)-8.*plg(5,4))/3. - xl=lat - 15 continue - if(tll.eq.tloc) go to 16 - if(sw(7).eq.0.and.sw(8).eq.0.and.sw(14).eq.0) goto 16 - stloc = sin(hr*tloc) - ctloc = cos(hr*tloc) - s2tloc = sin(2.*hr*tloc) - c2tloc = cos(2.*hr*tloc) - s3tloc = sin(3.*hr*tloc) - c3tloc = cos(3.*hr*tloc) - tll = tloc - 16 continue - if(day.ne.dayl.or.p(14).ne.p14) cd14=cos(dr*(day-p(14))) - if(day.ne.dayl.or.p(18).ne.p18) cd18=cos(2.*dr*(day-p(18))) - if(day.ne.dayl.or.p(32).ne.p32) cd32=cos(dr*(day-p(32))) - if(day.ne.dayl.or.p(39).ne.p39) cd39=cos(2.*dr*(day-p(39))) - dayl = day - p14 = p(14) - p18 = p(18) - p32 = p(32) - p39 = p(39) -! f10.7 effect - df = f107 - f107a - dfa=f107a-150. - t(1) = p(20)*df*(1.+p(60)*dfa) + p(21)*df*df + p(22)*dfa & - + p(30)*dfa**2 - f1 = 1. + (p(48)*dfa +p(20)*df+p(21)*df*df)*swc(1) - f2 = 1. + (p(50)*dfa+p(20)*df+p(21)*df*df)*swc(1) -! time independent - t(2) = & - (p(2)*plg(3,1) + p(3)*plg(5,1)+p(23)*plg(7,1)) & - +(p(15)*plg(3,1))*dfa*swc(1) & - +p(27)*plg(2,1) -! symmetrical annual - t(3) = & - (p(19) )*cd32 -! symmetrical semiannual - t(4) = & - (p(16)+p(17)*plg(3,1))*cd18 -! asymmetrical annual - t(5) = f1* & - (p(10)*plg(2,1)+p(11)*plg(4,1))*cd14 -! asymmetrical semiannual - t(6) = p(38)*plg(2,1)*cd39 -! diurnal - if(sw(7).eq.0) goto 200 - t71 = (p(12)*plg(3,2))*cd14*swc(5) - t72 = (p(13)*plg(3,2))*cd14*swc(5) - t(7) = f2* & - ((p(4)*plg(2,2) + p(5)*plg(4,2) + p(28)*plg(6,2) & - + t71)*ctloc & - + (p(7)*plg(2,2) + p(8)*plg(4,2) +p(29)*plg(6,2) & - + t72)*stloc) - 200 continue -! semidiurnal - if(sw(8).eq.0) goto 210 - t81 = (p(24)*plg(4,3)+p(36)*plg(6,3))*cd14*swc(5) - t82 = (p(34)*plg(4,3)+p(37)*plg(6,3))*cd14*swc(5) - t(8) = f2* & - ((p(6)*plg(3,3) + p(42)*plg(5,3) + t81)*c2tloc & - +(p(9)*plg(3,3) + p(43)*plg(5,3) + t82)*s2tloc) - 210 continue -! terdiurnal - if(sw(14).eq.0) goto 220 - t(14) = f2* & - ((p(40)*plg(4,4)+(p(94)*plg(5,4)+p(47)*plg(7,4))*cd14*swc(5))* & - s3tloc & - +(p(41)*plg(4,4)+(p(95)*plg(5,4)+p(49)*plg(7,4))*cd14*swc(5))* & - c3tloc) - 220 continue -! magnetic activity based on daily ap - - if(sw9.eq.-1.) go to 30 - apd=(ap(1)-4.) - p44=p(44) - p45=p(45) - if(p44.lt.0) p44=1.e-5 - apdf = apd+(p45-1.)*(apd+(exp(-p44 *apd)-1.)/p44) - if(sw(9).eq.0) goto 40 - t(9)=apdf*(p(33)+p(46)*plg(3,1)+p(35)*plg(5,1)+ & - (p(101)*plg(2,1)+p(102)*plg(4,1)+p(103)*plg(6,1))*cd14*swc(5)+ & - (p(122)*plg(2,2)+p(123)*plg(4,2)+p(124)*plg(6,2))*swc(7)* & - cos(hr*(tloc-p(125)))) - go to 40 - 30 continue - if(p(52).eq.0) go to 40 - exp1 = exp(-10800.*abs(p(52))/(1.+p(139)*(45.-abs(lat)))) - if(exp1.gt..99999) exp1=.99999 - if(p(25).lt.1.e-4) p(25)=1.e-4 - apt(1)=sg0(exp1) -! apt(2)=sg2(exp1) -! apt(3)=sg0(exp2) -! apt(4)=sg2(exp2) - if(sw(9).eq.0) goto 40 - t(9) = apt(1)*(p(51)+p(97)*plg(3,1)+p(55)*plg(5,1)+ & - (p(126)*plg(2,1)+p(127)*plg(4,1)+p(128)*plg(6,1))*cd14*swc(5)+ & - (p(129)*plg(2,2)+p(130)*plg(4,2)+p(131)*plg(6,2))*swc(7)* & - cos(hr*(tloc-p(132)))) - 40 continue - if(sw(10).eq.0.or.long.le.-1000.) go to 49 -! longitudinal - if(sw(11).eq.0) goto 230 - t(11)= (1.+p(81)*dfa*swc(1))* & - ((p(65)*plg(3,2)+p(66)*plg(5,2)+p(67)*plg(7,2) & - +p(104)*plg(2,2)+p(105)*plg(4,2)+p(106)*plg(6,2) & - +swc(5)*(p(110)*plg(2,2)+p(111)*plg(4,2)+p(112)*plg(6,2))*cd14)* & - cos(dgtr*long) & - +(p(91)*plg(3,2)+p(92)*plg(5,2)+p(93)*plg(7,2) & - +p(107)*plg(2,2)+p(108)*plg(4,2)+p(109)*plg(6,2) & - +swc(5)*(p(113)*plg(2,2)+p(114)*plg(4,2)+p(115)*plg(6,2))*cd14)* & - sin(dgtr*long)) - 230 continue -! ut and mixed ut,longitude - if(sw(12).eq.0) goto 240 - t(12)=(1.+p(96)*plg(2,1))*(1.+p(82)*dfa*swc(1))* & - (1.+p(120)*plg(2,1)*swc(5)*cd14)* & - ((p(69)*plg(2,1)+p(70)*plg(4,1)+p(71)*plg(6,1))* & - cos(sr*(sec-p(72)))) - t(12)=t(12)+swc(11)* & - (p(77)*plg(4,3)+p(78)*plg(6,3)+p(79)*plg(8,3))* & - cos(sr*(sec-p(80))+2.*dgtr*long)*(1.+p(138)*dfa*swc(1)) - 240 continue -! ut,longitude magnetic activity - if(sw(13).eq.0) goto 48 - if(sw9.eq.-1.) go to 45 - t(13)= apdf*swc(11)*(1.+p(121)*plg(2,1))* & - ((p( 61)*plg(3,2)+p( 62)*plg(5,2)+p( 63)*plg(7,2))* & - cos(dgtr*(long-p( 64)))) & - +apdf*swc(11)*swc(5)* & - (p(116)*plg(2,2)+p(117)*plg(4,2)+p(118)*plg(6,2))* & - cd14*cos(dgtr*(long-p(119))) & - + apdf*swc(12)* & - (p( 84)*plg(2,1)+p( 85)*plg(4,1)+p( 86)*plg(6,1))* & - cos(sr*(sec-p( 76))) - goto 48 - 45 continue - if(p(52).eq.0) goto 48 - t(13)=apt(1)*swc(11)*(1.+p(133)*plg(2,1))* & - ((p(53)*plg(3,2)+p(99)*plg(5,2)+p(68)*plg(7,2))* & - cos(dgtr*(long-p(98)))) & - +apt(1)*swc(11)*swc(5)* & - (p(134)*plg(2,2)+p(135)*plg(4,2)+p(136)*plg(6,2))* & - cd14*cos(dgtr*(long-p(137))) & - +apt(1)*swc(12)* & - (p(56)*plg(2,1)+p(57)*plg(4,1)+p(58)*plg(6,1))* & - cos(sr*(sec-p(59))) - 48 continue -! parms not used: 83, 90,100,140-150 - 49 continue - tinf=p(31) - do i = 1,nsw - tinf = tinf + abs(sw(i))*t(i) - enddo - globe7 = tinf - return - end function globe7 - -!----------------------------------------------------------------------- -!> Set switches. -!! -!! Output in sw(25),isw,swc(25) -!! The sw for main terms, swc for cross terms -!! To turn on and off particular variations call tselec(sv), -!! where sv is a 25 element array containing 0. for off, 1. -!! for on, or 2. for main effects off but cross terms on -!! To get current values of sw: call tretrv(sw) -!! @param[in] sv array contains switches. -!! -!! @author Hann-Ming Henry Juang - subroutine tselec(sv) - use gettemp_mod, only: sw,swc,isw -! - dimension sv(*),sav(25),svv(*) - save - do 100 i = 1,25 - sav(i)=sv(i) - sw(i)=amod(sv(i),2.) - if(abs(sv(i)).eq.1.or.abs(sv(i)).eq.2.) then - swc(i)=1. - else - swc(i)=0. - endif - 100 end do - isw=64999 - return - entry tretrv(svv) - do 200 i=1,25 - svv(i)=sav(i) - 200 end do - end subroutine tselec - -!----------------------------------------------------------------------- -!> Version of globe for lower atmosphere -!! -!! @param[in] p pressure (mb) -!! @return glob7s version of global -!! -!! @author Hann-Ming Henry Juang - function glob7s(p) - use mpi - use gettemp_mod, only:plg,ctloc,stloc,c2tloc,s2tloc,c3tloc,s3tloc, & - day,dfa,apdf,apt,long=>xlong,sw,swc - dimension p(*),t(14) -! - integer :: rc - save - data dr/1.72142e-2/,dgtr/1.74533e-2/,pset/2./ - data dayl/-1./,p32,p18,p14,p39/4*-1000./ - if(p(100).eq.0) p(100)=pset - if(p(100).ne.pset) then - write(6,900) pset,p(100) - 900 format(1x,'FATAL ERROR: Wrong parameter set for glob7s',3f10.1) - call mpi_abort(mpi_comm_world, 999, rc) - endif - do 10 j=1,14 - t(j)=0. - 10 end do - if(day.ne.dayl.or.p32.ne.p(32)) cd32=cos(dr*(day-p(32))) - if(day.ne.dayl.or.p18.ne.p(18)) cd18=cos(2.*dr*(day-p(18))) - if(day.ne.dayl.or.p14.ne.p(14)) cd14=cos(dr*(day-p(14))) - if(day.ne.dayl.or.p39.ne.p(39)) cd39=cos(2.*dr*(day-p(39))) - dayl=day - p32=p(32) - p18=p(18) - p14=p(14) - p39=p(39) -! -! f10.7 - t(1)=p(22)*dfa -! time independent - t(2)=p(2)*plg(3,1)+p(3)*plg(5,1)+p(23)*plg(7,1) & - +p(27)*plg(2,1)+p(15)*plg(4,1)+p(60)*plg(6,1) -! symmetrical annual - t(3)=(p(19)+p(48)*plg(3,1)+p(30)*plg(5,1))*cd32 -! symmetrical semiannual - t(4)=(p(16)+p(17)*plg(3,1)+p(31)*plg(5,1))*cd18 -! asymmetrical annual - t(5)=(p(10)*plg(2,1)+p(11)*plg(4,1)+p(21)*plg(6,1))*cd14 -! asymmetrical semiannual - t(6)=(p(38)*plg(2,1))*cd39 -! diurnal - if(sw(7).eq.0) goto 200 - t71 = p(12)*plg(3,2)*cd14*swc(5) - t72 = p(13)*plg(3,2)*cd14*swc(5) - t(7) = & - ((p(4)*plg(2,2) + p(5)*plg(4,2) & - + t71)*ctloc & - + (p(7)*plg(2,2) + p(8)*plg(4,2) & - + t72)*stloc) - 200 continue -! semidiurnal - if(sw(8).eq.0) goto 210 - t81 = (p(24)*plg(4,3)+p(36)*plg(6,3))*cd14*swc(5) - t82 = (p(34)*plg(4,3)+p(37)*plg(6,3))*cd14*swc(5) - t(8) = & - ((p(6)*plg(3,3) + p(42)*plg(5,3) + t81)*c2tloc & - +(p(9)*plg(3,3) + p(43)*plg(5,3) + t82)*s2tloc) - 210 continue -! terdiurnal - if(sw(14).eq.0) goto 220 - t(14) = p(40)*plg(4,4)*s3tloc +p(41)*plg(4,4)*c3tloc - 220 continue -! magnetic activity - if(sw(9).eq.0) goto 40 - if(sw(9).eq.1) & - t(9)=apdf*(p(33)+p(46)*plg(3,1)*swc(2)) - if(sw(9).eq.-1) & - t(9)=(p(51)*apt(1)+p(97)*plg(3,1)*apt(1)*swc(2)) - 40 continue - if(sw(10).eq.0.or.sw(11).eq.0.or.long.le.-1000.) go to 49 -! longitudinal - t(11)= (1.+plg(2,1)*(p(81)*swc(5)*cos(dr*(day-p(82))) & - +p(86)*swc(6)*cos(2.*dr*(day-p(87)))) & - +p(84)*swc(3)*cos(dr*(day-p(85))) & - +p(88)*swc(4)*cos(2.*dr*(day-p(89)))) & - *((p(65)*plg(3,2)+p(66)*plg(5,2)+p(67)*plg(7,2) & - +p(75)*plg(2,2)+p(76)*plg(4,2)+p(77)*plg(6,2) & - )*cos(dgtr*long) & - +(p(91)*plg(3,2)+p(92)*plg(5,2)+p(93)*plg(7,2) & - +p(78)*plg(2,2)+p(79)*plg(4,2)+p(80)*plg(6,2) & - )*sin(dgtr*long)) - 49 continue - tt=0. - do i=1,14 - tt=tt+abs(sw(i))*t(i) - enddo - glob7s=tt - return - end function glob7s - -!-------------------------------------------------------------------- -!> Calculate temperature and density profiles. -!! New lower thermo polynomial 10/30/89 -!! -!! @param[in] alt altitude (km) -!! @param[in] dlb altitude (km) -!! @param[in] tinf initial guess -!! @param[in] tlb molecular weight -!! @param[in] xm molecular weight -!! @param[in] alpha initial guess -!! @param[in] tz temperature -!! @param[in] zlb altitude (km) -!! @param[in] s2 altitude (km) -!! @param[in] mn1 size of array zn2 and tn2 -!! @param[in] zn1 altitude (km) -!! @param[in] tn1 temperature -!! @param[in] tgn1 end point temperature -!! @return densu density -!! -!! @author Hann-Ming Henry Juang - function densu(alt,dlb,tinf,tlb,xm,alpha,tz,zlb,s2, & - mn1,zn1,tn1,tgn1) - use gettemp_mod, only: gsurf,re -! - dimension zn1(mn1),tn1(mn1),tgn1(2),xs(5),ys(5),y2out(5) -!function - zeta(zz,zl)=(zz-zl)*(re+zl)/(re+zz) - save - data rgas/831.4/ -!! rgas=831.4 -!cccccwrite(6,*) 'db',alt,dlb,tinf,tlb,xm,alpha,zlb,s2,mn1,zn1,tn1 - densu=1. -! joining altitude of bates and spline - za=zn1(1) - z=amax1(alt,za) -! geopotential altitude difference from zlb - zg2=zeta(z,zlb) -! bates temperature - tt=tinf-(tinf-tlb)*exp(-s2*zg2) - ta=tt - tz=tt - densu=tz - if(alt.ge.za) go to 10 -! -! calculate temperature below za -! temperature gradient at za from bates profile - dta=(tinf-ta)*s2*((re+zlb)/(re+za))**2 - tgn1(1)=dta - tn1(1)=ta - z=amax1(alt,zn1(mn1)) - mn=mn1 - z1=zn1(1) - z2=zn1(mn) - t1=tn1(1) - t2=tn1(mn) -! geopotental difference from z1 - zg=zeta(z,z1) - zgdif=zeta(z2,z1) -! set up spline nodes - do 20 k=1,mn - xs(k)=zeta(zn1(k),z1)/zgdif - ys(k)=1./tn1(k) - 20 end do -! end node derivatives - yd1=-tgn1(1)/(t1*t1)*zgdif - yd2=-tgn1(2)/(t2*t2)*zgdif*((re+z2)/(re+z1))**2 -! calculate spline coefficients - call spline(xs,ys,mn,yd1,yd2,y2out) - x=zg/zgdif - call splint(xs,ys,y2out,mn,x,y) -! temperature at altitude - tz=1./y - densu=tz - 10 if(xm.eq.0.) go to 50 -! -! calculate density above za - glb=gsurf/(1.+zlb/re)**2 - gamma=xm*glb/(s2*rgas*tinf) - expl=exp(-s2*gamma*zg2) - if(expl.gt.50.or.tt.le.0.) then - expl=50. - endif -! density at altitude - densa=dlb*(tlb/tt)**(1.+alpha+gamma)*expl - densu=densa - if(alt.ge.za) go to 50 -! -! calculate density below za - glb=gsurf/(1.+z1/re)**2 - gamm=xm*glb*zgdif/rgas -! integrate spline temperatures - call splini(xs,ys,y2out,mn,x,yi) - expl=gamm*yi - if(expl.gt.50..or.tz.le.0.) then - expl=50. - endif -! density at altitude - densu=densu*(t1/tz)**(1.+alpha)*exp(-expl) - 50 continue - return - end function densu - -!-------------------------------------------------------------------- -!> Calculate temperature and density profiles for lower atmos. -!! -!! @param[in] alt altitude (km) -!! @param[in] d0 initial guess -!! @param[in] xm molecular weight -!! @param[out] tz temperature -!! @param[in] mn3 size of array zn3 amd tn3 -!! @param[in] zn3 altitude (km) -!! @param[in] tn3 temperature -!! @param[in] tgn3 altitude (km) -!! @param[in] mn2 size of array zn2 and tn2 -!! @param[in] zn2 altitude (km) -!! @param[in] tn2 temperature -!! @param[in] tgn2 end point temperature -!! @return densm density -!! -!! @author Hann-Ming Henry Juang - function densm(alt,d0,xm,tz,mn3,zn3,tn3,tgn3,mn2,zn2,tn2,tgn2) - use gettemp_mod, only: gsurf,re -! - dimension zn3(mn3),tn3(mn3),tgn3(2),xs(10),ys(10),y2out(10) - dimension zn2(mn2),tn2(mn2),tgn2(2) -! function - zeta(zz,zl)=(zz-zl)*(re+zl)/(re+zz) - save - data rgas/831.4/ -!! rgas=831.4 - densm=d0 - if(alt.gt.zn2(1)) goto 50 -! stratosphere/mesosphere temperature - z=amax1(alt,zn2(mn2)) - mn=mn2 - z1=zn2(1) - z2=zn2(mn) - t1=tn2(1) - t2=tn2(mn) - zg=zeta(z,z1) - zgdif=zeta(z2,z1) -! set up spline nodes - do 210 k=1,mn - xs(k)=zeta(zn2(k),z1)/zgdif - ys(k)=1./tn2(k) - 210 end do - yd1=-tgn2(1)/(t1*t1)*zgdif - yd2=-tgn2(2)/(t2*t2)*zgdif*((re+z2)/(re+z1))**2 -! calculate spline coefficients - call spline(xs,ys,mn,yd1,yd2,y2out) - x=zg/zgdif - call splint(xs,ys,y2out,mn,x,y) -! temperature at altitude - tz=1./y - if(xm.eq.0.) go to 20 -! -! calculate stratosphere/mesosphere density - glb=gsurf/(1.+z1/re)**2 - gamm=xm*glb*zgdif/rgas -! integrate temperature profile - call splini(xs,ys,y2out,mn,x,yi) - expl=gamm*yi - if(expl.gt.50.) expl=50. -! density at altitude - densm=densm*(t1/tz)*exp(-expl) - 20 continue - if(alt.gt.zn3(1)) goto 50 -! -! troposphere/stratosphere temperature - z=alt - mn=mn3 - z1=zn3(1) - z2=zn3(mn) - t1=tn3(1) - t2=tn3(mn) - zg=zeta(z,z1) - zgdif=zeta(z2,z1) -! set up spline nodes - do 220 k=1,mn - xs(k)=zeta(zn3(k),z1)/zgdif - ys(k)=1./tn3(k) - 220 end do - yd1=-tgn3(1)/(t1*t1)*zgdif - yd2=-tgn3(2)/(t2*t2)*zgdif*((re+z2)/(re+z1))**2 -! calculate spline coefficients - call spline(xs,ys,mn,yd1,yd2,y2out) - x=zg/zgdif - call splint(xs,ys,y2out,mn,x,y) -! temperature at altitude - tz=1./y - if(xm.eq.0.) go to 30 -! -! calculate tropospheric/stratosphere density -! - glb=gsurf/(1.+z1/re)**2 - gamm=xm*glb*zgdif/rgas -! integrate temperature profile - call splini(xs,ys,y2out,mn,x,yi) - expl=gamm*yi - if(expl.gt.50.) expl=50. -! density at altitude - densm=densm*(t1/tz)*exp(-expl) - 30 continue - 50 continue - if(xm.eq.0) densm=tz - return - end function densm - -!----------------------------------------------------------------------- -!> Calculate 2nd derivatives of cubic spline interp function. -!! -!! Adapted from numerical recipes by press et al. -!! @param[in] x arrays of tabulated function in ascending order by x -!! @param[in] y arrays of tabulated function in ascending order by x -!! @param[in] n size of arrays x,y -!! @param[in] yp1 specified derivatives at x(1) -!! @param[in] ypn specified derivatives at x(n) -!! values >= 1e30 signal signal second derivative zero. -!! @param[out] y2 output array of second derivatives -!! -!! @author Hann-Ming Henry Juang - subroutine spline(x,y,n,yp1,ypn,y2) - parameter (nmax=100) - dimension x(n),y(n),y2(n),u(nmax) - save - if(yp1.gt..99e30) then - y2(1)=0 - u(1)=0 - else - y2(1)=-.5 - u(1)=(3./(x(2)-x(1)))*((y(2)-y(1))/(x(2)-x(1))-yp1) - endif - do 11 i=2,n-1 - sig=(x(i)-x(i-1))/(x(i+1)-x(i-1)) - p=sig*y2(i-1)+2. - y2(i)=(sig-1.)/p - u(i)=(6.*((y(i+1)-y(i))/(x(i+1)-x(i))-(y(i)-y(i-1)) & - /(x(i)-x(i-1)))/(x(i+1)-x(i-1))-sig*u(i-1))/p - 11 end do - if(ypn.gt..99e30) then - qn=0 - un=0 - else - qn=.5 - un=(3./(x(n)-x(n-1)))*(ypn-(y(n)-y(n-1))/(x(n)-x(n-1))) - endif - y2(n)=(un-qn*u(n-1))/(qn*y2(n-1)+1.) - do 12 k=n-1,1,-1 - y2(k)=y2(k)*y2(k+1)+u(k) - 12 end do - return - end subroutine spline - -!----------------------------------------------------------------------- -!> Calculate cubic spline interp value. -!! -!! Adapted from numerical recipes by press et al. -!! @param[in] xa arrays of tabulated function in ascending order by x -!! @param[in] ya arrays of tabulated function in ascending order by x -!! @param[in] y2a array of second derivatives -!! @param[in] n size of arrays xa,ya,y2a -!! @param[in] x abscissa for interpolation -!! @param[out] y output value -!! -!! @author Hann-Ming Henry Juang - subroutine splint(xa,ya,y2a,n,x,y) - dimension xa(n),ya(n),y2a(n) - save - klo=1 - khi=n - 1 continue - if(khi-klo.gt.1) then - k=(khi+klo)/2 - if(xa(k).gt.x) then - khi=k - else - klo=k - endif - goto 1 - endif - h=xa(khi)-xa(klo) - if(h.eq.0) write(6,*) 'bad xa input to splint' - a=(xa(khi)-x)/h - b=(x-xa(klo))/h - y=a*ya(klo)+b*ya(khi)+ & - ((a*a*a-a)*y2a(klo)+(b*b*b-b)*y2a(khi))*h*h/6. - return - end subroutine splint - -!----------------------------------------------------------------------- -!> Integrate cubic spline function. -!! -!! @param[in] xa arrays of tabulated function in ascending order by x -!! @param[in] ya arrays of tabulated function in ascending order by x -!! @param[in] y2a array of second derivatives -!! @param[in] n size of arrays xa,ya,y2a -!! @param[in] x abscissa endpoint for integration -!! @param[out] yi output value -!! -!! @author Hann-Ming Henry Juang - subroutine splini(xa,ya,y2a,n,x,yi) - dimension xa(n),ya(n),y2a(n) - save - yi=0 - klo=1 - khi=2 - 1 continue - if(x.gt.xa(klo).and.khi.le.n) then - xx=x - if(khi.lt.n) xx=amin1(x,xa(khi)) - h=xa(khi)-xa(klo) - a=(xa(khi)-xx)/h - b=(xx-xa(klo))/h - a2=a*a - b2=b*b - yi=yi+((1.-a2)*ya(klo)/2.+b2*ya(khi)/2.+ & - ((-(1.+a2*a2)/4.+a2/2.)*y2a(klo)+ & - (b2*b2/4.-b2/2.)*y2a(khi))*h*h/6.)*h - klo=klo+1 - khi=khi+1 - goto 1 - endif - return - end subroutine splini - -!----------------------------------------------------------------------- -!> Turbopause correction. -!! -!! @param[in] dd diffusive density -!! @param[in] dm full mixed density -!! @param[in] zhm transition scale length -!! @param[in] xmm full mixed molecular weight -!! @param[in] xm species molecular weight -!! @return dnet combined density -!! -!! @author Hann-Ming Henry Juang - function dnet(dd,dm,zhm,xmm,xm) - save - a=zhm/(xmm-xm) - if(dm.gt.0.and.dd.gt.0) goto 5 - write(6,*) 'dnet log error',dm,dd,xm - if(dd.eq.0.and.dm.eq.0) dd=1. - if(dm.eq.0) goto 10 - if(dd.eq.0) goto 20 - 5 continue - ylog=a*alog(dm/dd) - if(ylog.lt.-10.) go to 10 - if(ylog.gt.10.) go to 20 - dnet=dd*(1.+exp(ylog))**(1/a) - go to 50 - 10 continue - dnet=dd - go to 50 - 20 continue - dnet=dm - go to 50 - 50 continue - return - end function dnet - -!----------------------------------------------------------------------- -!> Chemistry/dissociation correction. -!! -!! @param[in] alt altitude -!! @param[in] r target ratio -!! @param[in] h1 transition scale length -!! @param[in] zh altitude of 1/2 r -!! @return ccor correction -!! -!! @author Hann-Ming Henry Juang - function ccor(alt, r,h1,zh) - save - e=(alt-zh)/h1 - if(e.gt.70.) go to 20 - if(e.lt.-70.) go to 10 - ex=exp(e) - ccor=r/(1.+ex) - go to 50 - 10 ccor=r - go to 50 - 20 ccor=0. - go to 50 - 50 continue - ccor=exp(ccor) - return - end function ccor - -!----------------------------------------------------------------------- -!> O and O2 chemistry/dissociation correction. -!! -!! @param[in] alt altitude -!! @param[in] r target ratio -!! @param[in] h1 transition scale length 1 -!! @param[in] zh altitude of 1/2 r -!! @param[in] h2 transition scale length 2 -!! @return ccor2 correction -!! -!! @author Hann-Ming Henry Juang - function ccor2(alt, r,h1,zh,h2) - e1=(alt-zh)/h1 - e2=(alt-zh)/h2 - if(e1.gt.70. .or. e2.gt.70.) go to 20 - if(e1.lt.-70. .and. e2.lt.-70) go to 10 - ex1=exp(e1) - ex2=exp(e2) - ccor2=r/(1.+.5*(ex1+ex2)) - go to 50 - 10 ccor2=r - go to 50 - 20 ccor2=0. - go to 50 - 50 continue - ccor2=exp(ccor2) - return - end function ccor2 +!! This software incorporates the MSIS empirical atmospheric model software +!! designed and provided by NRL. Use is governed by the Open Source Academic +!! research License Agreement contained in the file msis2.1/nrlmsis2.1_license.txt +!! +!! @author Adam Kubaryk NCEP/SWPC + +!> Routine that computes temperature and neutral density values utilizing MSIS 2.1. +!! +!! @param[in] iday Calendar day. +!! @param[in] xlat Latitude (degrees). +!! @param[in] pr Pressure in hPa. +!! @param[in] pf Path to parmfile for msisinit. +!! @param[in] np Number of pressure layers. +!! @param[out] temp Temperature (K). +!! @param[out] n_o Number density of o. +!! @param[out] n_o2 Number density of o2. +!! @param[out] n_n2 Number density of n2 +!! +!! @author Adam Kubaryk NCEP/SWPC + subroutine gettemp(iday,xlat,pr,np,pf,temp,n_o,n_o2,n_n2) + use msis_init, only: msisinit + use msis_constants, only: rp + use esmf, only: esmf_kind_r8 + + implicit none + + integer, intent(in) :: iday ! calender day + real(kind=esmf_kind_r8), intent(in) :: xlat ! latitude (degrees) + real(kind=esmf_kind_r8), intent(in) :: pr(np) ! pressure (hPa) + integer, intent(in) :: np ! number of pressure layers + character(*), intent(in) :: pf ! path to parmfile for msisinit + real(kind=esmf_kind_r8), intent(out) :: temp(np) ! temperature (K) + real(kind=esmf_kind_r8), intent(out) :: n_o(np) ! number density of o + real(kind=esmf_kind_r8), intent(out) :: n_o2(np) ! number density of o2 + real(kind=esmf_kind_r8), intent(out) :: n_n2(np) ! number density of n2 +! Local variables + real(kind=rp), parameter :: alt=100, ut=0, f107=150, f107a=150, ap(7)=9, xlong=0 + real(kind=rp) :: t, d(10), zkm + integer :: ip + real(4) :: switch_legacy(1:25) + +! set swich 7,8,10,14 to zero to avoid diurnal changes in output tempe +! #7 is for diurnal, #8 for semidiurnal, #10 is for all ut/longitudinal +! effect, #14 is for terdiurnal + switch_legacy(:) = 1. + switch_legacy(7) = 0. + switch_legacy(8) = 0. + switch_legacy(10) = 0. + switch_legacy(14) = 0. + + call msisinit(parmfile=pf, switch_legacy=switch_legacy) +! calculate temperature, species, for each pres level + do ip=1,np + call ghp8(real(iday, rp), ut, alt, real(xlat, rp), & + xlong , f107a, f107, ap, real(pr(ip), rp), & + zkm, d, t) + temp(ip)=real(t, esmf_kind_r8) + n_n2(ip)=real(d(2), esmf_kind_r8) + n_o2(ip)=real(d(3), esmf_kind_r8) + n_o( ip)=real(d(4), esmf_kind_r8) + enddo + + end subroutine gettemp + +!> Wrapper routine for calls to MSIS 2.1 for computing temperature and neutral density at +!> a given pressure level. +!! +!! @param[in] day Calendar day. +!! @param[in] utsec Seconds into UTC day. +!! @param[in] z0 Initial guess for altitude in km. +!! @param[in] glat Latitude in degrees east. +!! @param[in] glon Longitude in degrees north. +!! @param[in] f107a 41-day average of F10.7 Solar Flux. +!! @param[in] f107 Current day F10.7 Solar Flux. +!! @param[in] ap Array of Ap inputs to MSIS 2.1, documented within MSIS 2.1. +!! @param[in] pres Pressure level at which to solve for temp/den values. +!! @param[out] alt Altitude at which the outputs are valid. +!! @param[out] dn Array of neutral density values, documented within MSIS 2.1. +!! @param[out] tn Temperature in K. +!! +!! @author Adam Kubaryk NCEP/SWPC + subroutine ghp8(day,utsec,z0,glat,glon,f107a,f107,ap,pres,alt,dn,tn) + + use msis_constants, only: kB, NA, g0, rp + use msis_calc, only: msiscalc + use msis_utils, only: alt2gph + + implicit none + + real(kind=rp),intent(in) :: day + real(kind=rp),intent(in) :: utsec + real(kind=rp),intent(in) :: z0 !! first guess + real(kind=rp),intent(in) :: glat,glon + real(kind=rp),intent(in) :: f107a,f107 + real(kind=rp),intent(in) :: ap(7) + real(kind=rp),intent(in) :: pres !!! pressure in hPa + real(kind=rp),intent(out) :: alt + real(kind=rp),intent(out) :: dn(10) + real(kind=rp),intent(out) :: tn +! Local variables + real, parameter :: tol = 0.000043 + integer, parameter :: maxit = 30 + real :: plog,delta + real(kind=rp) :: tex,zkm,pzkm + real :: xn,gz,xmbar,scl + integer :: n + real(8) :: xlat,alt0,alt1 + + plog = log10(pres*100.0_rp) + zkm = z0 + delta = 1.0_rp + + n = 0 + + do while ( abs(delta) .ge. tol .and. n .le. maxit ) + n = n + 1 + + call msiscalc(day,utsec,zkm,glat,glon,f107a,f107,ap,tn,dn,tex) + + xn = sum(dn(2:8)) + pzkm = kB * xn * tn + delta = plog - log10(pzkm) + xmbar = dn(1) / xn / 1.66E-24_rp + xlat = dble(glat) + alt0 = dble(zkm) + alt1 = alt0 + 1.0d0 + gz = real((alt2gph(xlat,alt1) - alt2gph(xlat,alt0)) * g0) + scl = Na * kB * tn / (xmbar * gz) + + ! difference + zkm = zkm - scl * delta / 1000.0_rp + end do + alt = zkm + + end subroutine ghp8 diff --git a/tests/chgres_cube/CMakeLists.txt b/tests/chgres_cube/CMakeLists.txt index d6d46f95a..47c7d7e9e 100644 --- a/tests/chgres_cube/CMakeLists.txt +++ b/tests/chgres_cube/CMakeLists.txt @@ -42,6 +42,10 @@ execute_process( COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/data/config_spectral_sigio.nml ${CMAKE_CURRENT_BINARY_DIR}/data/config_spectral_sigio.nml) execute_process( COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/data/GFSphys_varmap.txt ${CMAKE_CURRENT_BINARY_DIR}/data/GFSphys_varmap.txt) +execute_process( COMMAND ${CMAKE_COMMAND} -E copy + ${CMAKE_SOURCE_DIR}/parm/msis_lib/msis21.parm ${CMAKE_CURRENT_BINARY_DIR}/data/msis21.parm) +execute_process( COMMAND ${CMAKE_COMMAND} -E copy + ${CMAKE_CURRENT_SOURCE_DIR}/data/msis2.1_test_ref_dp.txt ${CMAKE_CURRENT_BINARY_DIR}/data/msis2.1_test_ref_dp.txt) # This one does not end up in the data directory. execute_process( COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/data/config_gaussian_nemsio.nml ${CMAKE_CURRENT_BINARY_DIR}/fort.41) @@ -222,6 +226,14 @@ add_executable(ftst_read_vcoord ftst_read_vcoord.F90) target_link_libraries(ftst_read_vcoord chgres_cube_lib) add_test(NAME chgres_cube-ftst_read_vcoord COMMAND ftst_read_vcoord) +add_executable(ftst_msis_lib ftst_msis2.1_lib.F90) +target_link_libraries(ftst_msis_lib msis2) +# Cause test to be run with MPI. +add_mpi_test(chgres_cube-ftst_msis_lib + EXECUTABLE ${CMAKE_CURRENT_BINARY_DIR}/ftst_msis_lib + NUMPROCS 1 + TIMEOUT 60) + add_executable(ftst_example ftst_example.F90) target_link_libraries(ftst_example chgres_cube_lib) add_test(NAME chgres_cube-ftst_example COMMAND ftst_example) diff --git a/tests/chgres_cube/data/msis2.1_test_ref_dp.txt b/tests/chgres_cube/data/msis2.1_test_ref_dp.txt new file mode 100644 index 000000000..0ed522bf8 --- /dev/null +++ b/tests/chgres_cube/data/msis2.1_test_ref_dp.txt @@ -0,0 +1,201 @@ + iyd sec alt glat glong stl f107a f107 Ap He O N2 O2 Ar rho H N O* NO T + 70178 64800 0.2 50.0 55.0 21.67 153.3 146.5 35.0 0.1255E+15 0.9999E-37 0.1884E+20 0.5052E+19 0.2252E+18 0.1160E-02 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 294.10 + 70022 64800 0.6 -15.0 35.0 20.33 163.8 182.8 5.0 0.1190E+15 0.9999E-37 0.1787E+20 0.4792E+19 0.2136E+18 0.1100E-02 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 296.25 + 70280 43200 0.8 -10.0 160.0 22.67 149.4 128.1 4.0 0.1174E+15 0.9999E-37 0.1763E+20 0.4727E+19 0.2107E+18 0.1085E-02 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 293.36 + 70305 21600 1.0 -65.0 230.0 21.33 155.9 171.1 2.0 0.1254E+15 0.9999E-37 0.1884E+20 0.5051E+19 0.2251E+18 0.1160E-02 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 264.78 + 70281 0 1.0 -70.0 5.0 0.33 150.0 133.5 2.0 0.1308E+15 0.9999E-37 0.1964E+20 0.5267E+19 0.2347E+18 0.1209E-02 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 252.35 + 70036 43200 1.0 45.0 105.0 19.00 165.1 122.9 10.0 0.1241E+15 0.9999E-37 0.1863E+20 0.4997E+19 0.2227E+18 0.1147E-02 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 268.25 + 70184 21600 1.3 75.0 305.0 2.33 149.9 182.8 24.0 0.1181E+15 0.9999E-37 0.1773E+20 0.4755E+19 0.2119E+18 0.1091E-02 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 271.81 + 70003 21600 1.8 -90.0 55.0 9.67 152.9 149.5 9.0 0.1170E+15 0.9999E-37 0.1757E+20 0.4712E+19 0.2100E+18 0.1082E-02 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 254.18 + 70239 0 2.0 25.0 230.0 15.33 142.0 132.9 12.0 0.1039E+15 0.9999E-37 0.1561E+20 0.4185E+19 0.1865E+18 0.9608E-03 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 287.80 + 70069 0 3.1 40.0 275.0 18.33 168.7 166.8 7.0 0.9564E+14 0.9999E-37 0.1436E+20 0.3851E+19 0.1716E+18 0.8841E-03 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 269.19 + 70148 43200 3.1 -20.0 100.0 18.67 159.2 151.2 45.0 0.9350E+14 0.9999E-37 0.1404E+20 0.3765E+19 0.1678E+18 0.8643E-03 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 279.82 + 70070 64800 3.2 -70.0 320.0 15.33 168.2 160.5 3.0 0.9843E+14 0.9999E-37 0.1478E+20 0.3964E+19 0.1766E+18 0.9099E-03 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 251.74 + 70084 0 3.5 45.0 155.0 10.33 166.7 170.8 3.0 0.9349E+14 0.9999E-37 0.1404E+20 0.3765E+19 0.1678E+18 0.8642E-03 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 258.34 + 70054 0 4.2 70.0 290.0 19.33 167.1 187.0 4.0 0.8809E+14 0.9999E-37 0.1323E+20 0.3547E+19 0.1581E+18 0.8143E-03 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 242.78 + 70363 43200 4.6 -65.0 225.0 3.00 156.8 121.3 12.0 0.8310E+14 0.9999E-37 0.1248E+20 0.3346E+19 0.1491E+18 0.7682E-03 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 249.43 + 70011 43200 4.9 75.0 125.0 20.33 156.3 139.1 4.0 0.8178E+14 0.9999E-37 0.1228E+20 0.3293E+19 0.1468E+18 0.7560E-03 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 233.91 + 70206 0 5.9 -5.0 300.0 20.00 148.8 158.9 92.0 0.6919E+14 0.9999E-37 0.1039E+20 0.2786E+19 0.1242E+18 0.6396E-03 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 268.30 + 70062 21600 7.4 20.0 325.0 3.67 169.1 176.1 15.0 0.5974E+14 0.9999E-37 0.8971E+19 0.2406E+19 0.1072E+18 0.5522E-03 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 253.08 + 70332 43200 7.7 50.0 115.0 19.67 157.6 138.8 8.0 0.5819E+14 0.9999E-37 0.8738E+19 0.2343E+19 0.1044E+18 0.5379E-03 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 229.60 + 70180 43200 11.8 -60.0 310.0 8.67 151.7 155.3 6.0 0.3240E+14 0.9999E-37 0.4865E+19 0.1305E+19 0.5814E+17 0.2995E-03 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 209.01 + 70363 43200 12.2 -55.0 35.0 14.33 156.8 121.3 12.0 0.3096E+14 0.9999E-37 0.4650E+19 0.1247E+19 0.5557E+17 0.2862E-03 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 219.78 + 70068 43200 12.2 -30.0 260.0 5.33 169.1 175.4 47.0 0.3456E+14 0.9999E-37 0.5190E+19 0.1392E+19 0.6203E+17 0.3195E-03 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 218.03 + 70133 64800 14.4 -5.0 145.0 3.67 162.9 176.6 7.0 0.2714E+14 0.9999E-37 0.4075E+19 0.1093E+19 0.4870E+17 0.2509E-03 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 203.16 + 70252 39617 16.4 -78.5 74.2 15.95 139.5 154.6 5.0 0.1424E+14 0.9999E-37 0.2138E+19 0.5732E+18 0.2555E+17 0.1316E-03 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 186.14 + 70285 43200 18.6 -25.0 140.0 21.33 151.7 143.3 16.0 0.1290E+14 0.9999E-37 0.1937E+19 0.5194E+18 0.2315E+17 0.1192E-03 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 206.54 + 70303 21600 23.7 -55.0 320.0 3.33 155.1 191.6 9.0 0.4852E+13 0.9999E-37 0.7285E+18 0.1954E+18 0.8707E+16 0.4485E-04 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 219.18 + 70252 64800 26.4 -15.0 145.0 3.67 139.5 154.6 5.0 0.3449E+13 0.9999E-37 0.5180E+18 0.1389E+18 0.6190E+16 0.3188E-04 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 219.71 + 70090 0 26.5 -10.0 235.0 15.67 163.5 149.8 51.0 0.3345E+13 0.9999E-37 0.5023E+18 0.1347E+18 0.6003E+16 0.3092E-04 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 222.71 + 70211 43200 34.2 50.0 45.0 15.00 147.2 156.2 7.0 0.1124E+13 0.9999E-37 0.1688E+18 0.4527E+17 0.2017E+16 0.1039E-04 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 242.73 + 70248 27142 35.3 35.7 -28.5 5.64 140.9 160.7 8.0 0.9091E+12 0.9999E-37 0.1365E+18 0.3661E+17 0.1631E+16 0.8403E-05 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 237.05 + 70230 48384 38.9 -66.1 165.5 0.47 141.4 147.9 36.0 0.3396E+12 0.9999E-37 0.5099E+17 0.1367E+17 0.6094E+15 0.3139E-05 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 239.15 + 70008 33536 39.1 56.1 54.7 12.96 154.0 116.9 6.0 0.3887E+12 0.9999E-37 0.5838E+17 0.1565E+17 0.6977E+15 0.3594E-05 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 245.01 + 70087 0 39.5 -45.0 295.0 19.67 165.2 159.9 21.0 0.4759E+12 0.9999E-37 0.7146E+17 0.1916E+17 0.8540E+15 0.4399E-05 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 248.07 + 70165 6144 41.0 -42.9 -7.2 1.22 158.1 194.2 8.0 0.3296E+12 0.9999E-37 0.4950E+17 0.1327E+17 0.5916E+15 0.3047E-05 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 239.29 + 70312 62592 41.3 67.5 -74.7 12.41 156.7 153.4 8.0 0.2890E+12 0.9999E-37 0.4340E+17 0.1164E+17 0.5186E+15 0.2671E-05 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 228.28 + 70013 0 42.3 -15.0 125.0 8.33 157.7 177.4 4.0 0.3018E+12 0.9999E-37 0.4531E+17 0.1215E+17 0.5415E+15 0.2789E-05 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 255.20 + 70297 64800 42.5 -55.0 5.0 18.33 151.5 150.5 14.0 0.2805E+12 0.9999E-37 0.4212E+17 0.1129E+17 0.5034E+15 0.2593E-05 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 267.26 + 70151 39040 43.7 -3.0 -135.9 1.78 159.6 159.3 6.0 0.2611E+12 0.9999E-37 0.3920E+17 0.1051E+17 0.4685E+15 0.2413E-05 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 261.94 + 70035 16786 44.0 13.3 30.5 6.70 165.3 127.3 13.0 0.2378E+12 0.9999E-37 0.3571E+17 0.9576E+16 0.4268E+15 0.2198E-05 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 258.97 + 70046 38400 44.2 40.0 39.3 13.28 165.5 201.2 8.0 0.2243E+12 0.9999E-37 0.3368E+17 0.9032E+16 0.4026E+15 0.2073E-05 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 261.12 + 70024 61055 44.9 -75.5 -13.5 16.06 164.6 158.3 7.0 0.2516E+12 0.9999E-37 0.3778E+17 0.1013E+17 0.4515E+15 0.2326E-05 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 280.78 + 70072 26161 45.4 -80.8 322.4 4.76 167.5 166.5 8.0 0.1993E+12 0.9999E-37 0.2993E+17 0.8027E+16 0.3578E+15 0.1843E-05 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 259.96 + 70355 49246 45.9 -57.1 207.5 3.51 159.6 160.8 4.0 0.2119E+12 0.9999E-37 0.3183E+17 0.8534E+16 0.3804E+15 0.1959E-05 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 272.06 + 70035 35265 47.1 -18.2 132.1 18.60 165.3 127.3 13.0 0.1591E+12 0.9999E-37 0.2388E+17 0.6405E+16 0.2854E+15 0.1470E-05 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 267.41 + 70365 13741 51.9 -65.4 324.5 1.45 155.2 133.4 2.0 0.1054E+12 0.3340E+10 0.1583E+17 0.4246E+16 0.1892E+15 0.9747E-06 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 280.96 + 70301 20270 52.0 -23.8 183.9 17.89 153.9 194.2 15.0 0.8959E+11 0.4934E+10 0.1345E+17 0.3607E+16 0.1608E+15 0.8281E-06 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 260.58 + 70338 71881 52.1 66.3 259.3 13.25 158.3 152.4 5.0 0.5788E+11 0.3613E+10 0.8691E+16 0.2331E+16 0.1039E+15 0.5350E-06 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 250.34 + 70225 29883 53.1 -25.3 139.5 17.60 142.7 133.3 7.0 0.7391E+11 0.4328E+10 0.1110E+17 0.2976E+16 0.1326E+15 0.6832E-06 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 254.87 + 70037 32896 53.4 7.4 -110.3 1.78 164.9 124.5 4.0 0.7137E+11 0.5163E+08 0.1072E+17 0.2874E+16 0.1281E+15 0.6597E-06 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 262.98 + 70250 16640 53.6 68.9 115.0 12.29 139.8 159.0 6.0 0.7479E+11 0.5117E+10 0.1123E+17 0.3012E+16 0.1342E+15 0.6914E-06 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 259.74 + 70293 70912 53.8 -16.3 87.8 1.55 150.5 140.1 7.0 0.7193E+11 0.5082E+08 0.1080E+17 0.2896E+16 0.1291E+15 0.6649E-06 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 257.37 + 70135 39420 54.1 -69.4 348.6 10.19 162.2 192.6 10.0 0.3717E+11 0.4207E+10 0.5582E+16 0.1497E+16 0.6671E+14 0.3436E-06 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 257.12 + 11360 44281 55.0 -46.0 208.7 2.21 136.6 144.3 1.0 0.6618E+11 0.7561E+08 0.9938E+16 0.2665E+16 0.1188E+15 0.6118E-06 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 261.28 + 70339 26112 55.2 77.8 56.0 10.99 158.3 158.6 8.0 0.3235E+11 0.2078E+09 0.4857E+16 0.1302E+16 0.5805E+14 0.2990E-06 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 259.93 + 70254 54016 56.1 -81.3 91.4 21.10 139.6 141.9 1.0 0.3185E+11 0.1706E+09 0.4783E+16 0.1283E+16 0.5716E+14 0.2944E-06 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 266.13 + 70123 60787 56.9 -6.8 348.1 16.09 160.7 158.2 10.0 0.5061E+11 0.6843E+10 0.7600E+16 0.2038E+16 0.9083E+14 0.4679E-06 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 252.08 + 10338 58684 58.5 -48.1 70.3 20.99 84.0 86.9 1.0 0.4501E+11 0.2287E+09 0.6759E+16 0.1813E+16 0.8078E+14 0.4161E-06 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 255.21 + 70333 82943 58.9 36.7 117.3 6.86 158.0 153.0 3.0 0.3356E+11 0.4720E+10 0.5039E+16 0.1351E+16 0.6022E+14 0.3102E-06 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 238.67 + 13365 68019 60.8 -81.2 42.8 21.75 154.3 142.9 5.0 0.4022E+11 0.6157E+10 0.6040E+16 0.1620E+16 0.7218E+14 0.3718E-06 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 271.28 + 70042 59285 62.0 -47.1 143.9 2.06 164.2 174.9 3.0 0.2824E+11 0.4085E+08 0.4241E+16 0.1137E+16 0.5069E+14 0.2611E-06 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 237.73 + 70016 64466 62.6 52.7 104.9 0.90 159.6 186.0 17.0 0.1889E+11 0.5651E+08 0.2837E+16 0.7608E+15 0.3391E+14 0.1746E-06 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 227.49 + 70052 38015 62.6 28.1 110.4 17.92 167.4 201.0 2.0 0.2291E+11 0.4590E+10 0.3440E+16 0.9225E+15 0.4111E+14 0.2118E-06 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 229.00 + 70114 32400 62.9 -74.9 9.2 9.62 161.3 128.7 16.0 0.1356E+11 0.8568E+10 0.2036E+16 0.5458E+15 0.2433E+14 0.1253E-06 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 243.58 + 12355 50214 65.4 35.6 168.5 1.18 121.4 113.5 8.0 0.1400E+11 0.5491E+08 0.2102E+16 0.5637E+15 0.2512E+14 0.1294E-06 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 224.08 + 70242 13960 68.1 50.3 269.5 21.85 142.3 145.8 5.0 0.1239E+11 0.7528E+08 0.1860E+16 0.4988E+15 0.2223E+14 0.1145E-06 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 213.34 + 70054 61659 69.0 -17.9 18.0 18.33 167.1 187.0 4.0 0.1002E+11 0.5316E+10 0.1505E+16 0.4037E+15 0.1799E+14 0.9267E-07 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 218.60 + 70269 70016 69.1 45.9 -93.6 13.21 145.7 154.9 6.0 0.9175E+10 0.7994E+10 0.1378E+16 0.3695E+15 0.1647E+14 0.8481E-07 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 211.10 + 12104 45507 71.5 10.5 270.6 6.68 117.3 95.3 20.0 0.7022E+10 0.6242E+10 0.1054E+16 0.2828E+15 0.1260E+14 0.6491E-07 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 199.16 + 70361 6656 71.6 64.7 16.8 2.97 158.0 126.5 8.0 0.4047E+10 0.3846E+09 0.6077E+15 0.1630E+15 0.7262E+13 0.3741E-07 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 234.81 + 70128 75684 72.2 6.2 47.0 0.16 162.9 159.5 4.0 0.6653E+10 0.1136E+09 0.9991E+15 0.2679E+15 0.1194E+14 0.6150E-07 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 194.11 + 70026 46656 72.6 39.3 274.8 7.28 165.4 154.3 3.0 0.4518E+10 0.6878E+10 0.6785E+15 0.1819E+15 0.8109E+13 0.4177E-07 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 217.67 + 11137 43521 73.0 41.7 286.1 7.16 101.2 92.2 9.0 0.5741E+10 0.5860E+10 0.8621E+15 0.2312E+15 0.1030E+14 0.5307E-07 0.9999E-37 0.9999E-37 0.9999E-37 0.9999E-37 203.13 + 70132 15320 73.6 -72.0 283.0 23.12 163.1 172.7 15.0 0.2809E+10 0.5839E+09 0.4218E+15 0.1131E+15 0.5040E+13 0.2596E-07 0.9999E-37 0.9999E-37 0.9999E-37 0.4027E+08 227.21 + 70007 66215 75.3 -17.4 312.2 15.21 153.6 121.6 5.0 0.3833E+10 0.6183E+10 0.5756E+15 0.1544E+15 0.6879E+13 0.3543E-07 0.9999E-37 0.9999E-37 0.9999E-37 0.1596E+08 210.49 + 70253 28950 76.3 -30.3 -70.7 3.33 139.5 155.0 6.0 0.2961E+10 0.4547E+09 0.4445E+15 0.1192E+15 0.5313E+13 0.2737E-07 0.1642E+08 0.9999E-37 0.9999E-37 0.1425E+08 201.00 + 11146 37212 77.4 -13.4 321.4 7.77 98.4 80.3 6.0 0.2494E+10 0.7867E+10 0.3739E+15 0.1003E+15 0.4468E+13 0.2302E-07 0.1406E+09 0.9999E-37 0.9999E-37 0.8067E+07 194.94 + 70301 81666 77.8 52.1 53.6 2.26 154.6 194.2 15.0 0.2156E+10 0.1033E+10 0.3227E+15 0.8652E+14 0.3856E+13 0.1986E-07 0.5184E+08 0.9999E-37 0.9999E-37 0.2183E+08 200.27 + 70362 38908 77.9 -20.8 94.5 17.10 157.5 123.9 18.0 0.2614E+10 0.7854E+10 0.3915E+15 0.1050E+15 0.4679E+13 0.2410E-07 0.1368E+09 0.9999E-37 0.9999E-37 0.1497E+08 200.80 + 70232 25110 78.2 -30.3 -70.7 2.26 141.4 142.0 4.0 0.2124E+10 0.8911E+09 0.3177E+15 0.8520E+14 0.3797E+13 0.1956E-07 0.7304E+08 0.9999E-37 0.9999E-37 0.1219E+08 198.61 + 70079 2581 78.2 -82.5 74.6 5.69 167.9 131.3 4.0 0.2396E+10 0.4817E+10 0.3578E+15 0.9595E+14 0.4276E+13 0.2203E-07 0.9640E+08 0.9999E-37 0.9999E-37 0.1477E+08 193.48 + 70090 72448 78.6 57.6 -108.2 12.91 163.1 149.8 51.0 0.2017E+10 0.1130E+11 0.3010E+15 0.8071E+14 0.3597E+13 0.1853E-07 0.1265E+09 0.9999E-37 0.9999E-37 0.2024E+08 209.59 + 70145 20790 78.7 -30.3 -70.7 1.06 158.4 158.5 7.0 0.1994E+10 0.1194E+10 0.2976E+15 0.7981E+14 0.3557E+13 0.1832E-07 0.9840E+08 0.9999E-37 0.9999E-37 0.1090E+08 194.19 + 70335 24360 79.9 40.1 -105.2 23.75 158.3 156.8 1.0 0.1571E+10 0.3066E+10 0.2329E+15 0.6245E+14 0.2783E+13 0.1434E-07 0.1186E+09 0.9999E-37 0.9999E-37 0.1637E+08 200.91 + 70284 2730 80.9 -30.3 -70.7 20.05 151.5 148.0 15.0 0.1524E+10 0.8263E+10 0.2242E+15 0.6013E+14 0.2680E+13 0.1380E-07 0.1624E+09 0.9999E-37 0.9999E-37 0.1475E+08 195.86 + 70036 82500 80.9 69.3 16.8 0.03 164.9 122.9 10.0 0.1170E+10 0.2033E+11 0.1721E+15 0.4616E+14 0.2057E+13 0.1060E-07 0.8159E+08 0.9999E-37 0.9999E-37 0.4236E+08 215.14 + 70010 38912 81.4 75.5 -102.5 3.98 155.5 123.7 6.0 0.9669E+09 0.4276E+11 0.1417E+15 0.3800E+14 0.1694E+13 0.8725E-08 0.6366E+08 0.9999E-37 0.9999E-37 0.5969E+08 221.12 + 70077 30600 81.9 40.6 -105.1 1.49 167.7 135.0 6.0 0.1282E+10 0.8586E+10 0.1869E+15 0.5011E+14 0.2233E+13 0.1150E-07 0.1621E+09 0.9999E-37 0.9999E-37 0.1830E+08 197.55 + 10353 32086 82.3 -55.9 137.8 18.10 83.7 80.6 2.0 0.1785E+10 0.1083E+11 0.2582E+15 0.6907E+14 0.3078E+13 0.1589E-07 0.3759E+09 0.9999E-37 0.9999E-37 0.8302E+07 168.45 + 70081 28740 82.6 -30.3 -70.7 3.27 167.8 150.8 2.0 0.1153E+10 0.1250E+11 0.1668E+15 0.4472E+14 0.1993E+13 0.1027E-07 0.2162E+09 0.9999E-37 0.9999E-37 0.1291E+08 194.71 + 70325 32728 82.8 11.8 328.4 6.99 156.8 177.9 30.0 0.1089E+10 0.1731E+11 0.1574E+15 0.4220E+14 0.1881E+13 0.9688E-08 0.1896E+09 0.9999E-37 0.9999E-37 0.9564E+07 195.15 + 70060 16800 83.2 69.3 15.2 5.68 168.5 177.4 22.0 0.8831E+09 0.4533E+11 0.1271E+15 0.3407E+14 0.1519E+13 0.7823E-08 0.1105E+09 0.9999E-37 0.9999E-37 0.3571E+08 217.95 + 70250 12570 83.6 -30.3 -70.7 22.78 139.8 159.0 6.0 0.9437E+09 0.4746E+11 0.1349E+15 0.3618E+14 0.1612E+13 0.8307E-08 0.1626E+09 0.9999E-37 0.9999E-37 0.1545E+08 196.29 + 9029 33427 84.1 -48.2 245.3 1.64 69.7 69.5 4.0 0.1097E+10 0.2454E+11 0.1549E+15 0.4146E+14 0.1848E+13 0.9530E-08 0.3311E+09 0.9999E-37 0.9999E-37 0.1020E+08 172.72 + 12339 43649 88.8 -67.7 266.6 5.90 120.4 96.7 4.0 0.6003E+09 0.9982E+11 0.7589E+14 0.1981E+14 0.8791E+12 0.4644E-08 0.2212E+09 0.9999E-37 0.9999E-37 0.1097E+08 149.16 + 13160 72325 89.3 41.8 136.9 5.22 120.5 103.2 7.0 0.3940E+09 0.2631E+12 0.4948E+14 0.1306E+14 0.5791E+12 0.3041E-08 0.1439E+09 0.9999E-37 0.9999E-37 0.2458E+08 173.97 + 11147 66312 95.0 -44.6 11.8 19.21 98.0 82.7 11.0 0.2004E+09 0.5130E+12 0.1857E+14 0.4897E+13 0.2120E+12 0.1152E-08 0.4393E+08 0.8685E+05 0.9999E-37 0.3888E+08 186.96 + 12139 6690 95.0 -55.0 59.8 5.84 119.9 136.3 8.0 0.1977E+09 0.5809E+12 0.1811E+14 0.4782E+13 0.2067E+12 0.1126E-08 0.4016E+08 0.2289E+05 0.9999E-37 0.9528E+08 184.66 + 12104 37819 96.0 50.9 210.5 0.54 117.3 95.3 20.0 0.1987E+09 0.8001E+12 0.1815E+14 0.4681E+13 0.2031E+12 0.1128E-08 0.6931E+08 0.5275E+05 0.9999E-37 0.5162E+08 191.36 + 13135 34150 97.5 63.4 226.0 0.56 123.6 147.9 8.0 0.1516E+09 0.6957E+12 0.1218E+14 0.3018E+13 0.1290E+12 0.7540E-09 0.6854E+08 0.9230E+05 0.9999E-37 0.6886E+08 181.81 + 13319 80974 102.0 -82.3 66.2 2.91 145.6 175.7 10.0 0.8703E+08 0.2131E+12 0.4486E+13 0.1024E+13 0.4243E+11 0.2715E-09 0.3175E+08 0.1761E+06 0.9999E-37 0.9512E+08 198.98 + 8174 36372 110.0 62.7 2.3 10.25 66.5 64.9 3.0 0.2948E+08 0.5349E+11 0.1020E+13 0.2081E+12 0.7436E+10 0.6041E-10 0.1402E+08 0.2850E+06 0.9999E-37 0.2643E+08 280.27 + 11154 26650 115.0 10.6 42.1 10.21 95.8 111.6 3.0 0.4479E+08 0.9400E+11 0.5959E+12 0.1122E+12 0.3433E+10 0.3641E-10 0.8157E+07 0.1084E+07 0.9999E-37 0.3748E+08 277.19 + 10249 6525 115.0 -70.8 117.4 9.64 80.1 82.1 8.0 0.4178E+08 0.6777E+11 0.4989E+12 0.1107E+12 0.3340E+10 0.3111E-10 0.5642E+07 0.3614E+06 0.9999E-37 0.5196E+08 291.22 + 10169 72244 125.0 20.9 -147.3 10.25 74.8 70.4 5.0 0.2032E+08 0.3165E+11 0.1482E+12 0.2452E+11 0.6237E+09 0.9080E-11 0.4132E+07 0.2274E+07 0.4160E-34 0.1452E+08 408.06 + 95300 44459 127.7 -10.9 31.2 14.43 75.4 73.9 6.0 0.2568E+08 0.3500E+11 0.1392E+12 0.1792E+11 0.4983E+09 0.8391E-11 0.2762E+07 0.3840E+07 0.7857E-33 0.1266E+08 475.70 + 11104 81874 135.0 61.8 173.4 10.30 107.8 117.7 4.0 0.1712E+08 0.2051E+11 0.5937E+11 0.8120E+10 0.2130E+09 0.3753E-11 0.1394E+07 0.6171E+07 0.2433E-28 0.2022E+08 555.61 + 76028 53610 147.6 19.7 24.5 16.53 72.4 69.3 5.0 0.1332E+08 0.1133E+11 0.2604E+11 0.3006E+10 0.5427E+08 0.1676E-11 0.9610E+06 0.1420E+08 0.6838E-24 0.5771E+07 626.17 + 76032 25650 148.9 18.9 143.2 16.67 72.3 71.2 24.0 0.1364E+08 0.1175E+11 0.2514E+11 0.2919E+10 0.4852E+08 0.1640E-11 0.8669E+06 0.1511E+08 0.6140E-23 0.6665E+07 646.00 + 6264 42650 155.0 80.8 150.2 21.86 77.7 70.9 3.0 0.1190E+08 0.8226E+10 0.1279E+11 0.1803E+10 0.3382E+08 0.9118E-12 0.8136E+06 0.1051E+08 0.2784E-20 0.4776E+07 638.85 + 76264 1515 155.6 15.0 97.8 6.94 74.1 72.7 51.0 0.2021E+08 0.1449E+11 0.1781E+11 0.2266E+10 0.3527E+08 0.1337E-11 0.1204E+07 0.1234E+08 0.5298E-20 0.6786E+07 614.99 + 11014 39689 160.0 60.6 -11.5 10.26 87.1 79.5 9.0 0.2815E+08 0.9050E+10 0.1251E+11 0.1614E+10 0.1989E+08 0.9099E-12 0.5920E+06 0.1080E+08 0.3170E-19 0.4497E+07 665.88 + 11114 50370 160.0 -86.6 -172.3 2.50 104.5 119.1 6.0 0.2003E+08 0.8499E+10 0.9658E+10 0.1296E+10 0.2552E+08 0.7460E-12 0.4934E+06 0.1161E+08 0.1007E-18 0.5032E+07 719.60 + 74274 80445 164.3 -17.1 120.5 6.38 90.2 91.2 28.0 0.1822E+08 0.1123E+11 0.1111E+11 0.1152E+10 0.2032E+08 0.8781E-12 0.6999E+06 0.1209E+08 0.2760E-17 0.6054E+07 668.95 + 75363 7425 166.8 9.4 107.4 9.22 75.0 73.9 15.0 0.1435E+08 0.7864E+10 0.7174E+10 0.9580E+09 0.1118E+08 0.5948E-12 0.8260E+06 0.1731E+08 0.7202E-17 0.3533E+07 655.36 + 75340 54408 170.1 61.8 -91.8 8.99 77.0 79.7 7.0 0.3017E+08 0.6139E+10 0.6620E+10 0.9442E+09 0.7810E+07 0.5222E-12 0.5901E+06 0.9089E+07 0.3503E-16 0.1849E+07 673.94 + 74043 46665 173.1 36.8 -6.9 12.50 82.0 79.6 40.0 0.1626E+08 0.6683E+10 0.6990E+10 0.8224E+09 0.9916E+07 0.5479E-12 0.3933E+06 0.3412E+08 0.6431E-15 0.3714E+07 759.42 + 75352 6704 174.9 8.3 95.9 8.26 77.0 72.8 6.0 0.1417E+08 0.6281E+10 0.4974E+10 0.5970E+09 0.6109E+07 0.4308E-12 0.7802E+06 0.1665E+08 0.8094E-15 0.2585E+07 657.44 + 9305 984 175.0 -59.3 143.7 9.85 72.9 75.1 3.0 0.5159E+07 0.3857E+10 0.6177E+10 0.7613E+09 0.1300E+08 0.4316E-12 0.4432E+06 0.1940E+08 0.5799E-14 0.3472E+07 767.16 + 85081 56707 177.7 2.9 286.6 10.86 74.1 76.7 4.0 0.1461E+08 0.5862E+10 0.4701E+10 0.4549E+09 0.4967E+07 0.4000E-12 0.6748E+06 0.4291E+08 0.4412E-14 0.2051E+07 696.39 + 79095 21358 183.1 -1.7 64.0 10.20 178.5 183.4 52.0 0.2041E+08 0.1075E+11 0.5777E+10 0.2764E+09 0.7521E+07 0.5719E-12 0.1334E+06 0.9529E+08 0.6279E-12 0.4659E+07 955.08 + 83289 36443 188.9 -35.5 2.5 10.29 105.6 127.7 13.0 0.1056E+08 0.5027E+10 0.4041E+10 0.3369E+09 0.5457E+07 0.3411E-12 0.2095E+06 0.5389E+08 0.8709E-11 0.3690E+07 872.35 + 74024 62940 198.2 47.4 -35.8 15.09 83.4 83.6 5.0 0.1671E+08 0.3320E+10 0.2357E+10 0.1945E+09 0.1320E+07 0.2090E-12 0.2602E+06 0.2593E+08 0.1650E-09 0.7691E+06 768.89 + 75350 79275 199.6 44.4 154.6 8.33 77.1 74.1 14.0 0.3068E+08 0.3512E+10 0.1482E+10 0.1439E+09 0.7484E+06 0.1705E-12 0.5498E+06 0.1292E+08 0.3098E-09 0.5050E+06 659.39 + 75112 24270 205.5 -17.1 -118.0 22.88 70.7 67.5 15.0 0.1291E+08 0.2340E+10 0.9880E+09 0.8133E+08 0.6113E+06 0.1131E-12 0.6543E+06 0.2054E+08 0.7539E-08 0.1122E+06 675.00 + 86130 22044 206.1 -21.6 99.3 12.74 72.5 68.5 6.0 0.1548E+08 0.2475E+10 0.1321E+10 0.9257E+08 0.6884E+06 0.1330E-12 0.3871E+06 0.3281E+08 0.4674E-08 0.6358E+06 771.75 + 75354 3090 209.2 17.5 86.2 6.61 76.7 71.4 3.0 0.1560E+08 0.2515E+10 0.9402E+09 0.8276E+08 0.4616E+06 0.1153E-12 0.7340E+06 0.8241E+07 0.1078E-07 0.3860E+06 632.22 + 74057 42345 209.8 63.4 -59.9 7.77 79.6 80.2 28.0 0.7989E+07 0.1610E+10 0.1598E+10 0.2343E+09 0.2321E+07 0.1300E-12 0.2355E+06 0.1078E+08 0.3597E-07 0.1142E+07 848.01 + 83249 19422 211.3 44.1 -108.6 22.16 120.1 115.7 5.0 0.4982E+07 0.2162E+10 0.1551E+10 0.1033E+09 0.1202E+07 0.1358E-12 0.1970E+06 0.2709E+08 0.1413E-06 0.4008E+06 860.57 + 75293 34770 213.1 4.9 -143.6 0.09 77.7 78.6 5.0 0.1006E+08 0.2004E+10 0.8006E+09 0.5252E+08 0.4118E+06 0.9371E-13 0.5450E+06 0.1464E+08 0.7468E-07 0.1031E+06 699.22 + 76291 42555 216.1 18.5 -8.0 11.29 74.1 77.5 31.0 0.1359E+08 0.2381E+10 0.1022E+10 0.7755E+08 0.5683E+06 0.1157E-12 0.3251E+06 0.2658E+08 0.6768E-06 0.5305E+06 813.88 + 88326 66224 217.5 -2.8 -155.9 8.00 174.3 150.2 6.0 0.1335E+08 0.3726E+10 0.1532E+10 0.5897E+08 0.1081E+07 0.1743E-12 0.1125E+06 0.3451E+08 0.4010E-06 0.1193E+07 938.21 + 76071 5820 218.4 10.6 26.2 3.36 74.4 69.3 27.0 0.1157E+08 0.2085E+10 0.9462E+09 0.5764E+08 0.3605E+06 0.1029E-12 0.6757E+06 0.1198E+08 0.1605E-05 0.1238E+06 696.96 + 73133 57798 220.9 -19.5 -18.7 14.81 98.0 85.0 20.0 0.1107E+08 0.2172E+10 0.1235E+10 0.5663E+08 0.5149E+06 0.1191E-12 0.2021E+06 0.3627E+08 0.2093E-05 0.7819E+06 898.64 + 79092 38525 222.2 8.8 172.0 22.17 179.9 202.9 36.0 0.1030E+08 0.4115E+10 0.1283E+10 0.4988E+08 0.1406E+07 0.1732E-12 0.7511E+05 0.5864E+08 0.7476E-05 0.5215E+06 1034.56 + 73210 50056 224.2 81.3 -115.6 6.20 88.2 81.7 18.0 0.7411E+06 0.7382E+09 0.1286E+10 0.1239E+09 0.2027E+07 0.8649E-13 0.1452E+06 0.1491E+08 0.3483E-04 0.2907E+07 928.00 + 79080 80550 227.7 50.7 -10.0 21.71 185.9 185.6 5.0 0.7981E+07 0.3078E+10 0.1271E+10 0.4912E+08 0.1022E+07 0.1449E-12 0.6748E+05 0.5642E+08 0.5558E-04 0.3604E+06 1055.90 + 13191 22400 230.3 -10.7 -160.3 19.53 113.2 120.0 26.0 0.4724E+07 0.1330E+10 0.6968E+09 0.4537E+08 0.5419E+06 0.7073E-13 0.1580E+06 0.2178E+08 0.4874E-04 0.2705E+06 927.80 + 76010 17820 234.5 -7.7 27.0 6.75 73.8 71.8 47.0 0.6670E+07 0.1353E+10 0.4653E+09 0.3054E+08 0.2352E+06 0.5947E-13 0.3903E+06 0.7669E+07 0.4170E-03 0.2080E+06 740.34 + 83309 45247 234.6 -38.2 155.5 22.93 103.0 104.8 3.0 0.4593E+07 0.1351E+10 0.6432E+09 0.3321E+08 0.3116E+06 0.6799E-13 0.2208E+06 0.1534E+08 0.1949E-03 0.1360E+06 834.08 + 79079 49127 244.1 -1.1 129.0 22.25 186.6 179.2 6.0 0.7753E+07 0.2428E+10 0.5497E+09 0.1787E+08 0.3751E+06 0.9184E-13 0.8699E+05 0.3156E+08 0.6802E-03 0.2045E+06 1003.37 + 13111 770 244.6 39.3 112.5 7.71 123.6 104.9 2.0 0.1026E+08 0.1503E+10 0.3869E+09 0.1858E+08 0.1443E+06 0.5931E-13 0.2146E+06 0.1401E+08 0.2138E-02 0.2533E+06 866.25 + 75031 30540 245.1 18.2 -142.4 22.99 76.1 72.7 17.0 0.7704E+07 0.8550E+09 0.1676E+09 0.1168E+08 0.5647E+05 0.3136E-13 0.4222E+06 0.7561E+07 0.1371E-02 0.2046E+05 706.18 + 12167 1526 250.0 -12.7 -74.9 19.43 126.8 148.6 2.0 0.3677E+07 0.9591E+09 0.3812E+09 0.1966E+08 0.2151E+06 0.4471E-13 0.1234E+06 0.1764E+08 0.1383E-02 0.1459E+06 977.84 + 6239 55200 250.0 -84.7 -135.0 6.33 77.6 75.7 17.0 0.7384E+07 0.6516E+09 0.3185E+09 0.3178E+08 0.2516E+06 0.3395E-13 0.2499E+06 0.2698E+07 0.3264E-02 0.2498E+06 844.92 + 12178 13881 250.0 -6.9 -38.6 1.29 127.6 88.5 7.0 0.5180E+07 0.8139E+09 0.2842E+09 0.9765E+07 0.6544E+05 0.3556E-13 0.2933E+06 0.6650E+07 0.2493E-02 0.6681E+05 790.58 + 3187 68511 250.0 35.8 -51.9 15.57 127.9 141.9 9.0 0.1885E+07 0.1008E+10 0.6118E+09 0.2417E+08 0.3941E+06 0.5711E-13 0.6923E+05 0.2358E+08 0.1396E-01 0.7170E+06 1086.84 + 12213 82495 250.0 -6.9 -38.6 20.34 124.0 136.0 5.0 0.3330E+07 0.8950E+09 0.3111E+09 0.1721E+08 0.1824E+06 0.3949E-13 0.1418E+06 0.1277E+08 0.2153E-02 0.1003E+06 919.74 + 11328 8432 250.0 -6.9 -38.6 23.77 146.0 140.0 7.0 0.6764E+07 0.1439E+10 0.4399E+09 0.1501E+08 0.2008E+06 0.5989E-13 0.1324E+06 0.1473E+08 0.3472E-02 0.1122E+06 925.86 + 1139 7200 250.0 -86.4 0.0 2.00 163.0 138.3 10.0 0.1612E+08 0.1425E+10 0.4153E+09 0.2281E+08 0.2930E+06 0.5870E-13 0.1073E+06 0.7848E+07 0.9576E-02 0.2186E+06 960.11 + 6332 20181 250.0 -40.3 47.8 8.79 83.8 82.4 6.0 0.2946E+07 0.7570E+09 0.3711E+09 0.2490E+08 0.2128E+06 0.3898E-13 0.2068E+06 0.1090E+08 0.1057E-01 0.2254E+06 876.85 + 1126 47520 250.0 -86.4 45.0 16.20 169.2 160.7 5.0 0.1483E+08 0.1643E+10 0.4238E+09 0.2139E+08 0.3016E+06 0.6501E-13 0.9266E+05 0.1670E+08 0.1513E-01 0.1912E+06 1002.65 + 11200 75960 250.0 -84.7 -135.0 12.10 96.6 101.9 15.0 0.1808E+08 0.8168E+09 0.3198E+09 0.2454E+08 0.1615E+06 0.3809E-13 0.1727E+06 0.3440E+07 0.2348E-02 0.1917E+06 819.83 + 12261 81339 250.0 -6.9 -38.6 20.02 119.6 97.3 4.0 0.5152E+07 0.1048E+10 0.3016E+09 0.1473E+08 0.1554E+06 0.4304E-13 0.1801E+06 0.1419E+08 0.2213E-02 0.7333E+05 871.90 + 3069 10185 250.0 18.6 -175.0 15.17 125.9 152.8 16.0 0.7605E+07 0.1771E+10 0.7297E+09 0.2538E+08 0.3149E+06 0.8350E-13 0.8199E+05 0.4731E+08 0.5290E-02 0.5348E+06 1096.31 + 5335 78829 250.0 -48.0 154.4 8.19 85.9 94.6 17.0 0.1761E+07 0.6933E+09 0.4949E+09 0.3780E+08 0.5402E+06 0.4376E-13 0.1526E+06 0.1130E+08 0.1825E-01 0.4543E+06 974.05 + 5188 2905 250.0 5.5 -137.9 15.61 93.8 123.0 6.0 0.3046E+07 0.8589E+09 0.5194E+09 0.2057E+08 0.2165E+06 0.4862E-13 0.1283E+06 0.2230E+08 0.3178E-02 0.3946E+06 988.27 + 84302 25808 252.2 -10.6 103.9 14.09 75.0 69.5 8.0 0.6351E+07 0.1056E+10 0.4034E+09 0.1579E+08 0.1355E+06 0.4822E-13 0.2337E+06 0.2127E+08 0.6348E-02 0.1795E+06 859.40 + 77111 85830 258.0 -16.9 132.0 8.64 77.9 79.6 12.0 0.1509E+08 0.8928E+09 0.1280E+09 0.8772E+07 0.3171E+05 0.3048E-13 0.4004E+06 0.1011E+08 0.1871E-01 0.6265E+05 739.54 + 12016 83330 260.0 5.8 118.1 7.02 126.0 133.5 9.0 0.8242E+07 0.1146E+10 0.2341E+09 0.1184E+08 0.7976E+05 0.4222E-13 0.1771E+06 0.8696E+07 0.2242E-01 0.1606E+06 839.40 + 11081 11310 260.5 -7.2 52.8 6.66 110.9 101.0 8.0 0.1234E+08 0.1149E+10 0.1850E+09 0.8527E+07 0.4700E+05 0.3990E-13 0.2778E+06 0.9466E+07 0.2667E-01 0.9275E+05 770.48 + 12100 50610 260.9 -3.3 -105.8 7.01 116.5 93.2 3.0 0.1278E+08 0.1072E+10 0.1686E+09 0.7456E+07 0.3882E+05 0.3703E-13 0.2935E+06 0.9359E+07 0.1663E-01 0.8717E+05 755.67 + 11153 83910 262.3 -1.1 112.0 6.78 95.8 113.6 7.0 0.9570E+07 0.7905E+09 0.1508E+09 0.7562E+07 0.3638E+05 0.2863E-13 0.2957E+06 0.6273E+07 0.3264E-01 0.8837E+05 758.94 + 82137 51096 262.3 -78.1 154.2 0.47 161.1 135.9 12.0 0.9939E+07 0.9501E+09 0.3455E+09 0.1944E+08 0.2441E+06 0.4256E-13 0.1005E+06 0.5660E+07 0.9367E-01 0.1500E+06 1043.96 + 11168 39830 262.6 15.5 114.2 18.68 93.5 103.3 9.0 0.2792E+07 0.5658E+09 0.2222E+09 0.9478E+07 0.7593E+05 0.2613E-13 0.1632E+06 0.1013E+08 0.6652E-01 0.9797E+05 913.77 + 77034 71895 263.1 -18.1 170.3 7.33 79.3 84.5 11.0 0.4812E+07 0.6461E+09 0.1268E+09 0.7319E+07 0.3094E+05 0.2361E-13 0.3469E+06 0.5334E+07 0.7900E-01 0.5738E+05 749.17 + 82227 25107 266.4 -82.1 -2.1 6.83 165.8 172.3 3.0 0.1033E+08 0.8907E+09 0.2841E+09 0.1170E+08 0.1230E+06 0.3772E-13 0.1081E+06 0.6153E+07 0.3539E+00 0.9858E+05 977.90 + 10197 40860 269.5 9.0 47.7 14.53 77.9 75.9 3.0 0.3026E+07 0.5413E+09 0.1759E+09 0.7112E+07 0.4472E+05 0.2321E-13 0.2323E+06 0.1067E+08 0.9918E-01 0.1020E+06 839.61 + 11302 66860 272.0 -27.4 -178.3 6.68 146.7 133.9 0.0 0.8937E+07 0.9496E+09 0.1867E+09 0.6176E+07 0.4044E+05 0.3447E-13 0.1576E+06 0.6999E+07 0.2144E+00 0.1164E+06 913.36 + 75327 8157 278.9 5.5 -150.5 16.23 77.1 83.6 8.0 0.4994E+07 0.5543E+09 0.1616E+09 0.5794E+07 0.3604E+05 0.2288E-13 0.1674E+06 0.1262E+08 0.4711E+00 0.7356E+05 900.71 + 77181 8775 279.7 17.8 -6.3 2.02 84.9 108.3 9.0 0.2330E+07 0.3447E+09 0.8224E+08 0.3348E+07 0.1287E+05 0.1326E-13 0.3248E+06 0.3503E+07 0.1078E+01 0.1510E+05 753.03 + 81129 8805 281.1 -17.9 131.4 11.21 195.2 218.3 39.0 0.1200E+08 0.1659E+10 0.3441E+09 0.8960E+07 0.1225E+06 0.6159E-13 0.4364E+05 0.4049E+08 0.1912E+01 0.2924E+06 1266.07 + 10351 42720 282.6 -72.0 -99.4 5.24 83.8 84.1 4.0 0.8600E+06 0.2953E+09 0.1505E+09 0.6250E+07 0.4845E+05 0.1527E-13 0.1573E+06 0.3418E+07 0.8356E+01 0.1038E+06 927.16 + 77278 14894 284.6 -19.4 -31.6 2.03 96.5 98.7 8.0 0.6995E+07 0.4713E+09 0.8106E+08 0.2704E+07 0.1034E+05 0.1658E-13 0.3229E+06 0.4067E+07 0.1417E+01 0.1174E+05 769.75 + 9328 55200 285.1 -65.4 58.3 19.22 75.0 75.7 8.0 0.1117E+07 0.3260E+09 0.1354E+09 0.8942E+07 0.7431E+05 0.1560E-13 0.1387E+06 0.6693E+07 0.7123E+01 0.9259E+05 930.37 + 75293 83456 285.7 26.6 175.0 10.85 77.6 78.6 5.0 0.1030E+08 0.4707E+09 0.5603E+08 0.2925E+07 0.8701E+04 0.1551E-13 0.2859E+06 0.7707E+07 0.9017E+00 0.2273E+05 799.18 + 9051 37540 318.9 28.8 55.6 14.13 69.7 69.0 5.0 0.5466E+07 0.2037E+09 0.1965E+08 0.7426E+06 0.1708E+04 0.6509E-14 0.2708E+06 0.4589E+07 0.2562E+02 0.6157E+04 799.02 + 81306 49104 322.0 -55.0 94.3 19.93 221.5 225.9 5.0 0.3083E+07 0.7991E+09 0.2070E+09 0.4455E+07 0.1090E+06 0.3174E-13 0.2331E+05 0.2642E+08 0.9384E+03 0.8630E+05 1381.34 + 73067 40394 337.7 -68.6 71.1 15.96 101.0 93.6 7.0 0.2350E+07 0.1867E+09 0.3070E+08 0.1443E+07 0.6374E+04 0.6574E-14 0.9943E+05 0.4072E+07 0.5570E+03 0.1707E+05 991.25 + 76138 83955 349.9 4.2 -20.6 21.95 72.4 77.4 4.0 0.2403E+07 0.5468E+08 0.2015E+07 0.6723E+05 0.1157E+03 0.1586E-14 0.3428E+06 0.8322E+06 0.2325E+03 0.1785E+03 720.00 + 73185 12398 354.2 82.3 102.8 10.30 87.4 90.4 5.0 0.4449E+06 0.7518E+08 0.1681E+08 0.5234E+06 0.2550E+04 0.2862E-14 0.9986E+05 0.2226E+07 0.3868E+04 0.1544E+05 932.61 + 6283 41080 358.8 46.2 160.7 22.13 79.3 75.0 2.0 0.5110E+07 0.5670E+08 0.1630E+07 0.4404E+05 0.6111E+02 0.1644E-14 0.3725E+06 0.1066E+07 0.3756E+03 0.9071E+02 708.57 + 78227 81675 374.5 -8.8 32.6 0.86 134.4 129.3 3.0 0.3137E+07 0.7951E+08 0.3852E+07 0.7351E+05 0.1660E+03 0.2342E-14 0.1718E+06 0.1088E+07 0.4769E+03 0.7267E+03 847.45 + 76191 38513 374.6 25.0 -28.0 8.83 70.9 67.4 10.0 0.1239E+07 0.3609E+08 0.1448E+07 0.4714E+05 0.5998E+02 0.1054E-14 0.3019E+06 0.7240E+06 0.2005E+04 0.5502E+03 751.93 + 78040 76395 377.8 -24.9 108.2 4.43 133.6 161.3 16.0 0.2582E+07 0.1205E+09 0.8593E+07 0.1982E+06 0.7541E+03 0.3654E-14 0.9619E+05 0.1056E+07 0.2907E+04 0.2969E+04 962.02 + 78279 63960 379.2 -8.1 14.2 18.71 156.5 138.7 4.0 0.3138E+07 0.1962E+09 0.1783E+08 0.3375E+06 0.2317E+04 0.6206E-14 0.6862E+05 0.5332E+07 0.7463E+03 0.6193E+04 1126.46 + 74001 19005 379.8 -10.4 -124.4 20.99 83.9 74.5 17.0 0.1805E+07 0.4271E+08 0.1421E+07 0.3939E+05 0.7362E+02 0.1230E-14 0.2221E+06 0.6489E+06 0.2487E+04 0.1450E+03 779.97 + 80314 38265 386.7 -2.3 -94.8 4.31 213.6 271.4 9.0 0.6457E+07 0.2770E+09 0.1970E+08 0.1976E+06 0.1413E+04 0.8412E-14 0.4221E+05 0.3536E+07 0.1369E+04 0.9894E+04 1068.84 + 77229 78825 386.7 22.6 -89.7 15.92 87.8 85.1 29.0 0.1579E+07 0.7584E+08 0.5775E+07 0.1567E+06 0.4801E+03 0.2361E-14 0.1249E+06 0.2496E+07 0.4726E+04 0.3318E+04 967.82 + 77183 77580 397.2 63.6 56.4 1.31 85.1 98.7 11.0 0.4244E+06 0.2643E+08 0.2960E+07 0.7171E+05 0.1914E+03 0.8587E-15 0.1310E+06 0.4969E+06 0.1163E+05 0.1831E+04 884.34 + 74213 39510 399.1 -24.4 119.1 18.91 86.5 84.8 6.0 0.2531E+07 0.3257E+08 0.9459E+06 0.2968E+05 0.3580E+02 0.9457E-15 0.1936E+06 0.7635E+06 0.1112E+04 0.1780E+03 818.12 + 80228 60210 400.6 15.2 -112.7 9.21 180.0 186.9 5.0 0.3359E+07 0.1405E+09 0.1002E+08 0.1912E+06 0.8973E+03 0.4354E-14 0.5674E+05 0.5328E+07 0.2083E+04 0.6673E+04 1119.06 + 3338 77110 407.0 -47.8 0.9 21.48 136.1 123.8 6.0 0.1301E+07 0.8276E+08 0.6961E+07 0.1327E+06 0.6410E+03 0.2586E-14 0.7832E+05 0.2045E+07 0.1436E+05 0.2280E+04 1033.99 + 73081 82086 414.7 -78.1 23.7 0.38 102.1 88.1 53.0 0.2390E+07 0.4905E+08 0.3307E+07 0.1790E+06 0.4793E+03 0.1493E-14 0.8172E+05 0.4432E+06 0.4898E+04 0.2268E+04 979.00 + 88156 58563 434.6 3.0 -4.3 15.98 129.9 145.2 3.0 0.1808E+07 0.7268E+08 0.5764E+07 0.8466E+05 0.3325E+03 0.2289E-14 0.6491E+05 0.3160E+07 0.2337E+04 0.3254E+04 1166.44 + 79201 34500 448.1 15.5 -101.5 2.82 167.5 139.0 18.0 0.1493E+07 0.2899E+08 0.9769E+06 0.1097E+05 0.2810E+02 0.8370E-15 0.8473E+05 0.4491E+06 0.1196E+05 0.2836E+03 929.98 + 79026 70695 468.8 -19.5 44.6 22.61 193.1 212.7 28.0 0.1824E+07 0.7145E+08 0.2655E+07 0.3112E+05 0.1968E+03 0.2079E-14 0.3660E+05 0.1830E+07 0.2300E+05 0.6894E+03 1139.71 + 89039 31499 500.0 42.6 -71.5 3.98 225.1 216.4 14.0 0.4757E+07 0.3637E+08 0.6486E+06 0.5766E+04 0.1359E+02 0.1034E-14 0.4667E+05 0.2132E+06 0.1455E+05 0.1051E+03 1036.90 + 3128 34273 500.0 6.5 96.0 15.92 125.8 110.2 39.0 0.2853E+07 0.3467E+08 0.9328E+06 0.1061E+05 0.2437E+02 0.1017E-14 0.7232E+05 0.1378E+07 0.2465E+05 0.4057E+03 1116.07 + 6257 18301 500.0 -47.6 125.3 13.44 77.6 82.9 4.0 0.2489E+07 0.6229E+07 0.4587E+05 0.9514E+03 0.3957E+00 0.1879E-15 0.1415E+06 0.1426E+06 0.6172E+04 0.1105E+02 838.19 + 6022 4328 500.0 22.0 130.3 9.89 82.1 93.9 6.0 0.2537E+07 0.4276E+07 0.1299E+05 0.2828E+03 0.7444E-01 0.1339E-15 0.2284E+06 0.1003E+06 0.3559E+04 0.3811E+01 777.86 diff --git a/tests/chgres_cube/ftst_msis2.1_lib.F90 b/tests/chgres_cube/ftst_msis2.1_lib.F90 new file mode 100644 index 000000000..1e804c5e2 --- /dev/null +++ b/tests/chgres_cube/ftst_msis2.1_lib.F90 @@ -0,0 +1,150 @@ +program msistest + +! Test the MSIS library. This test is based on the test that +! is part of the library. It was modified slightly so it could +! be run under Github actions. +! +! It reads a text file (that is also part of the library) of 200 test +! cases. The file contains variables input to routine gtd8d and +! the check values of the variables output from that routine. +! If the computed values differ from the check values by a small +! threshold, the test fails. +! +! @author George.Gayno@noaa.gov + +!####################################################################### +! MSIS (NRL-SOF-014-1) SOFTWARE +! NRLMSIS empirical atmospheric model software. Use is governed by the +! Open Source Academic Research License Agreement contained in the file +! nrlmsis2.1_license.txt, which is part of this software package. BY +! USING OR MODIFYING THIS SOFTWARE, YOU ARE AGREEING TO THE TERMS AND +! CONDITIONS OF THE LICENSE. +!####################################################################### + +!!! =========================================================================== +!!! NRLMSIS 2.1: +!!! Neutral atmosphere empirical model from the surface to lower exosphere +!!! =========================================================================== + +!================================================================================================== +! MSISTEST: Test program for NRLMSIS 2.1 +!================================================================================================== + + use msis_init, only : msisinit + + implicit none + + integer :: i, iyd, isec + integer :: mass ! Not use by v2. + + real(4) :: sec, alt, glat, glong, stl, f107a, f107, ap(7), apd + real(4) :: d(10), t(2), d_check(10), t_check + + print*,'Starting test of msis library.' + + !Initialize model + call msisinit(parmpath='./data/',parmfile='msis21.parm') + +! Open file that contains the variables input to routine +! gtd8d and the check values for the variables output from +! that routine. + + open(78,file='./data/msis2.1_test_ref_dp.txt',status='old') + read(78,*) ! Ignore first line of file. + +! Loop through all 200 records. + + do i = 1,200 + + read(78,'(2i7,3f7.1,f7.2,3f7.1,10e13.4,1e13.4,f8.2)') & + iyd,isec,alt,glat,glong,stl,f107a,f107,apd,d_check,t_check + + ap(1) = apd + sec = float(isec) + +! Input variables are: +! +! iyd - year and day +! sec - seconds +! alt - altitude in km +! glat - latitude in deg +! glong - longitude in deg +! stl - local solar time +! f107a - 81 day average of solar activity index +! f107 - daily solar activity indiex +! ap - daily geomagnetic activity index + + call gtd8d(iyd,sec,alt,glat,glong,stl,f107a,f107,ap,mass,d,t) + + print*,'Check case ',i + +! Check He number density + call checkit(d(1), d_check(1), 'He') + +! Check O number density. + call checkit(d(2), d_check(2), 'O') + +! Check N2 number density. + call checkit(d(3), d_check(3), 'N2') + +! Check O2 number density. + call checkit(d(4), d_check(4), 'O2') + +! Check Ar number density. + call checkit(d(5), d_check(5), 'Ar') + +! Check Total mass density. + call checkit(d(6), d_check(6), 'TMD') + +! Check H number density. + call checkit(d(7), d_check(7), 'H') + +! Check N number density. + call checkit(d(8), d_check(8), 'N') + +! Check Anomalous oxygen number density. + call checkit(d(9), d_check(9), 'AO') + +! Check NO number density. + call checkit(d(10), d_check(10), 'NO') + +! Check temperature at altitude. + if ( abs(t(2)-t_check) > 0.01) stop 28 + + enddo + + close(78) + + print*,"OK" + print*,"SUCCESS!" + +end program msistest + +! Routine to check the calculated values against the +! check values. A percentage threshold is used. Some +! fields contain missing values (flag value 9.99e-38). + +subroutine checkit(calc_val, check_val, field) + + implicit none + + character(len=*), intent(in) :: field + + real(4), intent(in) :: calc_val, check_val + + real :: epsilon + + if (check_val > 1) then ! Check value is not missing. + epsilon = abs(calc_val-check_val) / check_val + if (epsilon > 0.001) then + print*,'Bad value of ', field + stop 8 + endif + else ! Check value is missing. Is computed value also missing? + if (calc_val > 1) then + print*,'Value not missing for field ', field + stop 9 + endif + endif + +end subroutine checkit diff --git a/ush/chgres_cube.sh b/ush/chgres_cube.sh index 40d91f543..7b1d983ce 100755 --- a/ush/chgres_cube.sh +++ b/ush/chgres_cube.sh @@ -156,8 +156,15 @@ GEOGRID_FILE_INPUT=${GEOGRID_FILE_INPUT:-NULL} # be located in FIXfv3. # # THOMPSON_AEROSOL_FILE = Location of Thompson aerosol climatology file. +# +# WAM_COLD_START = Set to .true. if coldstarting for the Whole Atmosphere +# Model (WAM). +# +# WAM_PARM_FILE = Location of the parameter file used by the WAM function. #---------------------------------------------------------------------------- +WAM_PARM_FILE=${WAM_PARM_FILE:-NULL} + VARMAP_FILE=${VARMAP_FILE:-NULL} TRACERS_TARGET=${TRACERS_TARGET:-'"sphum","liq_wat","o3mr","ice_wat","rainwat","snowwat","graupel"'} @@ -262,6 +269,7 @@ cat << EOF > ./fort.41 grib2_file_input_grid="${GRIB2_FILE_INPUT}" geogrid_file_input_grid="${GEOGRID_FILE_INPUT}" varmap_file="${VARMAP_FILE}" + wam_parm_file="${WAM_PARM_FILE}" cycle_year=$iy cycle_mon=$im cycle_day=$id