diff --git a/.github/workflows/tests.yml b/.github/workflows/tests.yml index d8a4d68c9..ee29f791d 100644 --- a/.github/workflows/tests.yml +++ b/.github/workflows/tests.yml @@ -36,7 +36,7 @@ jobs: strategy: matrix: os: [ubuntu-latest] # , macos-latest] - python-version: ['3.9'] + python-version: ['3.12'] steps: - name: Checkout source @@ -46,7 +46,7 @@ jobs: uses: conda-incubator/setup-miniconda@v2 with: python-version: ${{ matrix.python-version }} - environment-file: ci/environment-py${{ matrix.python-version }}.yml + environment-file: ci/environment-py${{ matrix.python-version }}_frozen.yml miniforge-variant: Mambaforge miniforge-version: "latest" use-mamba: true diff --git a/ReadMe.md b/ReadMe.md index 9f59ce350..46dbc6359 100644 --- a/ReadMe.md +++ b/ReadMe.md @@ -78,10 +78,10 @@ $ cd Isca 3. **Create a conda environment** -Requirements for Isca can be installed via the .yml file included with the model in `Isca/ci/environment-py3.9.yml` +Requirements for Isca can be installed via the .yml file included with the model in `Isca/ci/environment-py3.12_frozen.yml` Navigate to the downloaded Isca folder, and create a conda environment `isca_env` containing the required packages using: ```{bash} -$ conda env create -f ci/environment-py3.9.yml +$ conda env create -f ci/environment-py3.12_frozen.yml ``` Then activate the environment; you'll need to do this each time you launch a new bash session. ```{bash} @@ -100,33 +100,35 @@ Successfully installed Isca ### Compiling for the first time -At Exeter University, Isca is compiled using: - -* Intel Compiler Suite 14.0 -* OpenMPI 10.0.1 -* NetCDF 4.3.3.1 -* git 2.1.2 +By installing Isca using the `ci/environment-py3.12_frozen.yml` file, you will have installed everything you need to run Isca, including the gfortran compiler, openmpi and netcdf. Whilst this may not be the optimal way of running Isca on your machine, it should work without too much extra effort. -Different workstations/servers at different institutions will have different compilers and libraries available. The Isca framework assumes you have something similar to our stack at Exeter, but provides a hook for you to configure the environment in which the model is run. +Before Isca is compiled/run, an environment is first configured which loads the specific compilers and libraries necessary to build the code. This done by setting the environment variable `GFDL_ENV` in your session. There is an option within Isca to use set `GFDL_ENV=ubuntu_conda`, which is setup to use the gfortran compiler you installed via the environment file. -Before Isca is compiled/run, an environment is first configured which loads the specific compilers and libraries necessary to build the code. This done by setting the environment variable `GFDL_ENV` in your session. - -For example, on the EMPS workstations at Exeter, I have the following in my `~/.bashrc`: +To make use of this environment, you should add a version of the following to your `~/.bashrc`: ```{bash} # directory of the Isca source code export GFDL_BASE=/scratch/jamesp/Isca -# "environment" configuration for emps-gv4 -export GFDL_ENV=emps-gv +# "environment" configuration for use with ubuntu-conda +export GFDL_ENV=ubuntu_conda # temporary working directory used in running the model -export GFDL_WORK=/scratch/jamesp/gfdl_work +export GFDL_WORK=/scratch/jamesp/isca_work # directory for storing model output -export GFDL_DATA=/scratch/jamesp/gfdl_data +export GFDL_DATA=/scratch/jamesp/isca_data ``` -The value of `GFDL_ENV` corresponds to a file in `src/extra/env` that is sourced before each run or compilation. For an example that you could adapt to work on your machine, see `src/extra/env/emps-gv`. +The value of `GFDL_ENV` corresponds to a file in `src/extra/env` that is sourced before each run or compilation. + +You may wish to configure your own way to run Isca using locally available compilers, e.g. the Intel compilers. An example using such a setup is available here - `src/extra/env/emps-gv`. + +At Exeter University, Isca is compiled using: + +* Intel Compiler Suite 14.0 +* OpenMPI 10.0.1 +* NetCDF 4.3.3.1 +* git 2.1.2 -We are not able to provide support in configuring your environment at other institutions other than Exeter University - we suggest that you contact your friendly local sysops technician for guidance in getting the compilers and libraries collated if you are not sure how to proceed. +Different workstations/servers at different institutions will have different compilers and libraries available. The Isca framework should run 'out of the box' using the gfortran compilers installed from the environment file. However, if you want to install the model using your own configuration then we are not able to provide support in configuring your environment. We suggest that you contact your friendly local sysops technician for guidance in getting the compilers and libraries collated if you are not sure how to proceed. If you work at another large institution and have successfully compiled and run Isca, we welcome you to commit your own environment config to `/src/extra/env/my-new-env` for future scientists to benefit from and avoid the pain of debugging compilation! diff --git a/ci/environment-py3.9.yml b/ci/environment-py.yml similarity index 89% rename from ci/environment-py3.9.yml rename to ci/environment-py.yml index 169e3adef..d9bc44bc6 100644 --- a/ci/environment-py3.9.yml +++ b/ci/environment-py.yml @@ -10,9 +10,9 @@ dependencies: - libgfortran - netcdf-fortran - numpy -- openmpi +- openmpi=4.* - pandas -- python=3.9 +- python - pip - pytest - sh diff --git a/ci/environment-py3.12_frozen.yml b/ci/environment-py3.12_frozen.yml new file mode 100644 index 000000000..1caa81d60 --- /dev/null +++ b/ci/environment-py3.12_frozen.yml @@ -0,0 +1,20 @@ +name: isca_env +channels: +- conda-forge +dependencies: +- dask=2024.1.0 +- f90nml=1.4.4 +- fortran-compiler=1.7.0 +- ipykernel=6.29.0 +- jinja2=3.1.3 +- libgfortran=3.0.0 +- netcdf-fortran=4.6.1 +- numpy=1.26.3 +- openmpi=4.1.6 +- pandas=2.2.0 +- python=3.12.1 +- pip=23.3.2 +- pytest=7.4.4 +- sh=2.0.6 +- tqdm=4.66.1 +- xarray=2024.1.1 diff --git a/docs/source/begginers_guide.rst b/docs/source/begginers_guide.rst index 039d4faf6..2752d2813 100644 --- a/docs/source/begginers_guide.rst +++ b/docs/source/begginers_guide.rst @@ -1,7 +1,7 @@ Isca Beginner's Guide ==================== -Below is a list of reading and activites that will help you get comfortable using Isca. Be assured that your supervisor/tutor will not expect you to be fluent with this when you start using Isca, but it will help to have an idea of what to expect when you start running the model. +Below is a list of reading and activities that will help you get comfortable using Isca. Be assured that your supervisor/tutor will not expect you to be fluent with this when you start using Isca, but it will help to have an idea of what to expect when you start running the model. This document is essentially a suggestion of signposts. With this kind of work, self-study and initiative is very important. It is up to you to go and research the topics until you feel comfortable. @@ -112,7 +112,7 @@ Now you have made plots – or indeed any file you want to transfer between the *SFTP (SSH File Transfer Protocol)* is one, it will work on all operating systems and is the easiest for windows. One way of using SFTP is with an *SFTP client*, many are available. One of them is `Cyberduck `_. It will require setting up but it is fairly straight forward. These clients tend to have a GUI so you can just drag and drop the files you want to transfer. It is also possible to view and transfer files using the native file browser if you're using Linux or macOS, using their built-in functions to connect via SFTP. -Other option is to use a command line function, for example ``scp``. This is a secure file copy protol, which uses SSH. The usage is simple, for example on the computer you want to transfer the file to, type: +Other option is to use a command line function, for example ``scp``. This is a secure file copy protocol, which uses SSH. The usage is simple, for example on the computer you want to transfer the file to, type: ``scp USER@COMPUTERNAME.ex.ac.uk:/path_to_file/file.png /path_to_destination/`` diff --git a/docs/source/bve_swe_equations.rst b/docs/source/bve_swe_equations.rst new file mode 100644 index 000000000..10929e792 --- /dev/null +++ b/docs/source/bve_swe_equations.rst @@ -0,0 +1,13 @@ +Barotropic Vorticity and Shallow Water Equation Solvers +======================================================= +We would like to direct people interested into these equation solvers in Isca to the original documentation written by GFDL. + +Barotropic Vorticty Equation +---------------------------- + + `Here `_ + +Shallow Water Equation +---------------------- + + `Here `_ diff --git a/docs/source/index.rst b/docs/source/index.rst index 569933c35..3110053aa 100644 --- a/docs/source/index.rst +++ b/docs/source/index.rst @@ -131,6 +131,7 @@ Contents changelog contributing testing/index.rst + bve_swe_equations references remote_access diff --git a/docs/source/modules/damping_driver.rst b/docs/source/modules/damping_driver.rst new file mode 100644 index 000000000..6e4755b4e --- /dev/null +++ b/docs/source/modules/damping_driver.rst @@ -0,0 +1,141 @@ +Damping Driver +====================== + +Summary +------- +The ``damping_driver`` module is called by the ``idealized_moist_phys`` module by setting ``do_damping`` to true. It controls the upper level momentum damping in Isca. It controls 4 optional functions: + +1. **Rayleigh friction** which acts on levels ``1`` to ``kbot``. This function is located in ``damping_driver`` itself. +2. A (orographic) **mountain gravity wave drag** module (``cg_drag``) may be called. +3. A (non orographic) **convective gravity wave drag** module (``mg_drag``) may be called. +4. A **time independent drag** may be called. This function is located in ``damping_driver`` itself. + +Another module (``topo_drag``) is referenced in the code, but is not available in Isca at present. + +It is located at: ``Isca/src/atmos_param/damping_driver/damping_driver.f90`` + +Namelist options +---------------- +``trayfric`` - (for Rayleigh friction) damping time in seconds for Rayleigh damping momentum in the top model layers, the number of which is specified by ``nlev_rayfric`` (non namelist parameter, automatically determined in code). If ``trayfric`` < 0 then time in days. Default 0. + +``do_rayleigh`` - On/Off switch for doing Rayleigh friction. Default False + +``sponge_pbottom`` - (for Rayleigh friction) used to calculate ``nlev_rayfric``, it specifies the bottom level where the Rayleigh friction starts. Default 50Pa. + +``do_cg_drag`` - On/Off switch for doing mountain gravity wave drag. Default False. + +``do_topo_drag`` - On/Off switch for doing the topo_drag module which is currently unavailable. Default False. + +``do_mg_drag`` - On/Off switch for doing convective gravity wave drag. Default False. + +``do_conserve_energy`` - (for Rayleigh friction) On/Off switch for also calculating the temperature tendency (if True). Default False. + +``do_const_drag`` - On/Off switch for doing the constant drag. Default False. + +``const_drag_amp`` - (for constant drag) Parameter for adjusting drag. Default 3.e-04. + +``const_drag_off`` - (for constant drag) Parameter for adjusting drag. Default 0. + +For a typical idealized Earth set up there is no parameterised gravity wave drag and Rayleigh damping is only needed to keep the model stable. The namelist would then look like:: + ``'do_rayleigh': True, + 'trayfric': -0.25, + 'sponge_pbottom': 50., + 'do_conserve_energy': True`` + +Diagnostics +----------- +There are many diagnostics either in or passed by damping driver. + +**Rayleigh friction:** + ++-----------------------+------------------------------------+------------------------+ +| Name | Description | Units | +| | | | ++=======================+====================================+========================+ +| ``udt_rdamp`` | u wind tendency |:math:`m s^{-2}` | ++-----------------------+------------------------------------+------------------------+ +| ``vdt_rdamp`` | v wind tendency |:math:`m s^{-2}` | ++-----------------------+------------------------------------+------------------------+ +| ``tdt_diss_rdamp`` | dissipative heating |:math:`K s^{-1}` | ++-----------------------+------------------------------------+------------------------+ +| ``diss_heat_rdamp`` | integrated dissipative heating |:math:`W m^{-2}` | ++-----------------------+------------------------------------+------------------------+ + +**Mountain GWD:** + ++-----------------------+------------------------------------+------------------------+ +| Name | Description | Units | +| | | | ++=======================+====================================+========================+ +| ``udt_gwd`` | u wind tendency |:math:`m s^{-2}` | ++-----------------------+------------------------------------+------------------------+ +| ``vdt_gwd`` | v wind tendency |:math:`m s^{-2}` | ++-----------------------+------------------------------------+------------------------+ +| ``taubx`` | x base flux |:math:`kg m^{-1} s^{-2}`| ++-----------------------+------------------------------------+------------------------+ +| ``tauby`` | y base flux |:math:`kg m^{-1} s^{-2}`| ++-----------------------+------------------------------------+------------------------+ +| ``taus`` | saturation flux |:math:`kg m^{-1} s^{-2}`| ++-----------------------+------------------------------------+------------------------+ +| ``tdt_diss_gwd`` | dissipative heating |:math:`K s^{-1}` | ++-----------------------+------------------------------------+------------------------+ +| ``diss_heat_gwd`` | integrated dissipative heating |:math:`W s^{-2}` | ++-----------------------+------------------------------------+------------------------+ +| ``sgsmtn`` | sub-grid scale topography variance |:math:`m` | ++-----------------------+------------------------------------+------------------------+ + +**Convective GWD:** + ++-----------------------+------------------------------------+------------------------+ +| Name | Description | Units | +| | | | ++=======================+====================================+========================+ +| ``udt_cgwd`` | u wind tendency |:math:`m s^{-2}` | ++-----------------------+------------------------------------+------------------------+ + +**Constant Drag:** + ++-----------------------+------------------------------------+------------------------+ +| Name | Description | Units | +| | | | ++=======================+====================================+========================+ +| ``udt_cnstd`` | u wind tendency |:math:`m s^{-2}` | ++-----------------------+------------------------------------+------------------------+ + +**topo_drag:** + +Note: These are not currently available + ++-----------------------+------------------------------------+------------------------+ +| Name | Description | Units | +| | | | ++=======================+====================================+========================+ +| ``udt_topo`` | u wind tendency |:math:`m s^{-2}` | ++-----------------------+------------------------------------+------------------------+ +| ``vdt_topo`` | v wind tendency |:math:`m s^{-2}` | ++-----------------------+------------------------------------+------------------------+ + +Relevant modules and subroutines +-------------------------------- +The code is split into 4 subroutines; ``damping_driver``, ``damping_driver_init``, ``damping_driver_end`` and ``rayleigh``. The ``_init`` and ``_end`` subroutines are for initializing and closing the module. The majority of the ``damping driver`` code is just a switchboard with the exception of the Rayleigh and constant drag calculations. The calculations for the other drag schemes are given in their own documentation. + +**Rayleigh Drag** + +Located in the ``rayleigh`` subroutine. This code damps the momentum toward zero in the specified upper model levels. The zonal/meridional tendency for each grid cell is calculated my multiplying the zonal/meridional velocity by a factor determined by the pressure and Rayleigh parameters. The damping is therefor proportional to the wind velocity. + +The temperature tendency is calculated using the wind velocities, wind tendencies, and the heat capacity of air. + +**Constant Drag** + +Located in the ``damping_driver`` subroutine. This is modelled on Alexander-Dunkerton winter average, it uses a 3rd order polynomial and the constant drag parameters to calculate a time invariant drag. This set up is modelled on Earth's atmosphere and therefore not recommended for other planets. + + +References +---------- +Convective Gravity Wave Drag (cg_drag) [Pierrehumbert1986]_ + +Orographic Gravity Wave Drag (mg_drag) [Alexander1999]_ + +Authors +------- +This documentation was written by Ross Castle, peer reviewed by Stephen Thomson, and quality controlled by Matthew Henry. diff --git a/docs/source/modules/idealised_moist_phys.rst b/docs/source/modules/idealised_moist_phys.rst index d34084c27..6a3f8b9ae 100644 --- a/docs/source/modules/idealised_moist_phys.rst +++ b/docs/source/modules/idealised_moist_phys.rst @@ -11,6 +11,8 @@ Here is a guide on reST formatting: https://www.sphinx-doc.org/en/master/usage/restructuredtext/basics.html +.. _idealized_moist_phys: + Moist physics driver: idealized_moist_phys.F90 ============================================== diff --git a/docs/source/modules/index.rst b/docs/source/modules/index.rst index c4fee55f6..4e59bb60e 100644 --- a/docs/source/modules/index.rst +++ b/docs/source/modules/index.rst @@ -12,10 +12,13 @@ Components of Isca physics constants output + damping_driver idealised_moist_phys two_stream_gray_rad convection_simple_betts_miller + lscale_cond + topography socrates + mixedlayer surface_flux - diag_manager_mod - + diag_manager_mod \ No newline at end of file diff --git a/docs/source/modules/lscale_cond.rst b/docs/source/modules/lscale_cond.rst new file mode 100644 index 000000000..f34943fad --- /dev/null +++ b/docs/source/modules/lscale_cond.rst @@ -0,0 +1,48 @@ +Large Scale Condensation and Precipitation +========================================== + +Summary +------- + +The module computes the large scale temperature and specific humidity adjustments needed in model layers where the relative humidity exceeds a threshold relative humidity, and returns the mass of rain and snow (or other frozen precipitation) that reaches the ground. The module also outputs the temperature tendency and the specific humidity tendency. Features include the option for the re-evaporation of falling precipitation and energetically consistent adjustment with precipitation type. + +See [Frierson2006a]_ (Section 2e) for a detailed description `here `_. + +Namelist options +---------------- + +There are three namelist variables. + +:hc: The relative humidity at which large scale condensation, where :math:`0.0 <= hc <= 1.0`. Default is :math:`hc=1.0`. +:do_evap: The flag for the re-evaporation of moisture in sub-saturated layers below, if ``True`` then re-evaporation is performed. Default is ``False``. +:do_simple: If ``True`` then all precipitation is rain/liquid precipitation, there is no snow/frozen precipitation. Default is ``False``. + +Diagnostics +----------- +The diagnostics are not sent out within the call to convection but are sent out from ``idealized_moist_phys.F90`` with the module name ``atmosphere``. The diagnostics relevant to the lscale_cond module are set out below: + ++-------------------+--------------------------------------+------------------------------+ +| Name | Description | Units | ++===================+======================================+==============================+ +| cond_dt_qg | Moisture tendency |:math:`kg~kg^{-1}~s^{-1}` | ++-------------------+--------------------------------------+------------------------------+ +| cond_dt_tg | Temperature tendency |:math:`K~s^{-1}` | ++-------------------+--------------------------------------+------------------------------+ +| cond_rain | Rain from condensation |:math:`kg~m^{-2}~s^{-1}` | ++-------------------+--------------------------------------+------------------------------+ +| precip | Rain and Snow from resolved and |:math:`kg~m^{-2}~s^{-1}` | +| | parameterised condensation/convection| | ++-------------------+--------------------------------------+------------------------------+ + +Relevant Modules and Subroutines +-------------------------------- +Relevant modules are: sat_vapor_pres_mod, utilities_mod, constants_mod. + +References +---------- + +The reference list within this docs page are: [Frierson2006a]_ + +Authors +------- +This documentation was written by Ross Castle and reviewed by Ruth Geen diff --git a/docs/source/modules/mixedlayer.rst b/docs/source/modules/mixedlayer.rst new file mode 100644 index 000000000..cec4398ef --- /dev/null +++ b/docs/source/modules/mixedlayer.rst @@ -0,0 +1,286 @@ +Mixed layer module +===================== + +Summary +---------------------- +This module updates the sea surface temperature (SST) noted as :math:`T_s` below. + +SST boundary condition options +----------------------- + +The SST options are: + - prescribe SST from an input file (``do_sc_sst`` namelist option). + - prescribe SST to follow an AquaPlanet Experiment protocol (APE) analytic form (``do_ape_sst`` namelist option). + - calculate SST based on the surface fluxes and mixed layer depth of a **slab ocean**, with the option of including a Q-flux (either analytic or read from a file). + +Note that only the final case will generate a closed surface energy budget. Each of these options are discussed below, followed by an outline of the implicit time-stepping process used when SST is not prescribed. + +Input SST file +----------------------- +Set ``do_sc_sst`` to True if you want to specify the SST field. The SST field will be read in from a NetCDF file with a file name specified by the ``sst_file`` variable. +Using an input SST field is useful, for example, when you want to add a temperature anomaly. The file is read in during the initialisation (i.e. within the call to ``mixed_layer_init`` from within ``idealized_moist_phys``). +The input file can be time independent (i.e. no diurnal or seasonal cycle or any changes in the SST from one time step to another) or vary with time. More information can be found in the Diagnostics section below. + +APE aquaplanet (analytic SST) +----------------------- +The prescribed SST for the APE aquaplanet protocol is given by: + +.. math:: + T_s = 27 \left( 1 - \sin^2\left( \frac{3}{2} \lambda \right) \right), + +between 60N-60S, equation 1 of Neele and Hoskins 2004 [NealeHoskins2004]_, and 0 deg C poleward of 60N/S. + +Slab ocean +----------------------- +To allow the SST to evolve based on the surface fluxes, the atmosphere can be coupled to a slab ocean, whose depth is specified by the namelist parameter ``depth``. This also allows a closed surface energy budget, useful for e.g. simulations with increased greenhouse gases. + +In this case, during the initialisation, if there is no restart file to open, the surface temperature is set to the prescribed initial distribution (``prescribe_initial_dist = True``): + +.. math:: + T_s = T_{surf} -\frac{1}{3} dT \left(3\sin(\lambda)^2-1\right), + +where the default values we use in the trip test for the Frierson test case (``exp/test_cases/frierson/frierson_test_case.py``) are: :math:`T_{surf} = 285 K` and :math:`dT = 40 K`. + +This form of :math:`T_{surf}` is similar to a 2nd legendre polynomial, it is a parabola that maximises at the equator. + +Implicit timestepping procedure +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +The mixed layer module calculates the evolution of surface temperature using an implicit timestep. +Whereas an explicit method uses the current state of the system to calculate the state of the system +at the next timestep, an implicit method uses the inferred state of the system at the next timestep. + +The net flux into the surface is given by:: + + net_surf_sw_down + surf_lw_down - flux_r - SH - LH + ocean_qflux + +where ``net_surf_sw_down`` is the net shortwave radiation into the surface, ``surf_lw_down`` the downwelling longwave radiation into the surface, and ``flux_r`` the upwelling longwave radiation at the +surface. The sensible heat (``SH``) is the sum of the surface sensible heat flux and the temperature diffusion flux. The latent heat (``LH``) is the sum of the surface latent heat and the +moisture diffusion flux (only included if ``evaporation`` is true). The ``ocean_flux`` is an optional term and is zero if the Q-flux is not used. + +If ``do_calc_eff_heat_cap`` is True, the ``land_sea_heat_capacity`` is used at each timestep to compute the surface temperature using the following equation:: + + land_sea_heat_capacity * dTs/dt = - corrected_flux - t_surf_dependence * dTs + +The change in surface temperature in this timestep (``dTs/dt``) times the heat capacity of the surface is equal to the net flux into the surface at the given timestep (``- corrected_flux``) plus the change in the net flux +into the surface caused by the change in surface temperature (``- t_surf_dependence * dTs``). + +This is simplified by defining ``eff_heat_capacity`` as ``land_sea_heat_capacity + t_surf_dependence * dt``, and then ``Ts`` is updated using:: + + eff_heat_capacity * dTs/dt = - corrected_flux + +Optional Q-flux +^^^^^^^^^^^^^^^ +The slab ocean model only communicates between grid-boxes in the vertical (i.e. air-sea exchange) but does not represent any horizontal transport (i.e. no north-south or east-west communications between grid cells). +An idealised horizontal transport can be included using an ocean heat flux (Q-flux). Atmospheric heat transport is more realistic with an ocean heat transport. + +Isca is able to calculate an analytic Q-flux, appropriate to an aquaplanet, following Merlis et al 2013 [MerlisEtAl2013] if ``do_qflux`` is True. Additionally, an analytic warmpool can be added by setting ``do_warmpool``. The warmpool structure is set in ``Isca/src/atmos_param/qflux/qflux.f90``. Alternatively an arbitrary Q-flux may be read from a file if ``load_qflux`` is True. + +In the case where both a specific SST distribution (e.g. AMIP climatology) and closed surface energy budget are desired, a Q-flux input file can be generated by running a control experiment with the prescribed SST, creating a NetCDF Q-flux file offline and then passing this file to the model via the python interface run script. + +1. Run a prescribed experiment (i.e. a control) using either observations, AMIP or similar. + +2. Using the prescribed SST field and the surface fluxes from step 1, create the Q-flux file. This is an offline script that is run independently of the model. An example script is shown in: ``src/extra/python/scripts/calculate_qflux/calculate_qflux.py`` but you can create your own script to do this depending on your application. + +3. Add the Q-Flux file to the ``inputfiles`` in the python run script (same as you would for ozone, land etc). Then in the ``mixed_layer_nml`` namelist in the python run script set ``load_qflux`` to True, ``qflux_file_name`` to the name of the input file (don't include the .nc extension) and ``qflux_field_name`` is the Q-flux variable name in the file. + + +See Q-flux options below for namelist options. Note that the Q-flux is only relevant for slab ocean experiments (not fixed or prescribed SST runs). Also note that if the MiMA radiation code is used then the Q-flux is implemented following Merlis et al 2013 [MerlisEtAl2013]_ + +More information on the method for Q-flux can be found in Russel et al 1985 [RusselEtAl1985]_ + + +Namelist options +---------------- + ++-------------------+------------------------------------------------------------+---------+ +| Option | Summary |Default | ++===================+============================================================+=========+ +|``evaporation`` |Switch for surface evaporation. |``True`` | ++-------------------+------------------------------------------------------------+---------+ +|``depth`` |Mixed layer depth. | ``40.0``| ++-------------------+------------------------------------------------------------+---------+ + +Q-flux options +^^^^^^^^^^^^^^^^^^^^ +If ``do_qflux`` is True, use ``qflux_amp`` and ``qflux_width`` to calculate a time-independent surface Q-flux. + ++-------------------+----------------------------------------------------------------+---------+ +| Option | Summary |Default | ++===================+================================================================+=========+ +|``do_qflux`` | Switch to calculate time-independent Q-flux. |``False``| ++-------------------+----------------------------------------------------------------+---------+ +|``qflux_amp`` | Amplitude of time-independent Q-flux if ``do_qflux`` is True. | ``0.0`` | ++-------------------+----------------------------------------------------------------+---------+ +|``qflux_width`` | Width of time-independent Q-flux if ``do_qflux`` is True. | ``16.0``| ++-------------------+----------------------------------------------------------------+---------+ + +If ``load_qflux`` is True, use input file to load in a time-independent or time-dependent Q-flux. + ++----------------------+-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+-----------------+ +| Option | Summary |Default | ++======================+=============================================================================================================================================================================+=================+ +|``load_qflux`` | Switch to use input file to get Q-flux. | ``False`` | ++----------------------+-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+-----------------+ +|``qflux_file_name`` | Name of file among input files, from which to get Q-flux. | ``ocean_qflux`` | ++----------------------+-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+-----------------+ +|``qflux_field_name`` | Name of field name in Q-flux file name, from which to get Q-flux. This is only used when ``time_varying_qflux`` is False. Otherwise the code assumes field_name = file_name.| ``ocean_qflux`` | ++----------------------+-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+-----------------+ +|``time_varying_qflux``| Flag that determines whether input Q-flux file is time dependent. | ``False`` | ++----------------------+-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+-----------------+ + +Initialize surface temperature +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + ++-------------------------------+----------------------------------------------------------------------------------+-----------+ +| Option | Summary |Default | ++===============================+==================================================================================+===========+ +|``prescribe_initial_dist`` | Switch to turn on setting the initial surface temperature distribution. | ``305.0`` | ++-------------------------------+----------------------------------------------------------------------------------+-----------+ +|``tconst`` | Initial surface temperature following formula in ``Slab ocean`` section. | ``305.0`` | ++-------------------------------+----------------------------------------------------------------------------------+-----------+ +|``delta_T`` | Initial surface temperature gradient following formula in ``Slab ocean`` section.| ``40.0`` | ++-------------------------------+----------------------------------------------------------------------------------+-----------+ +|``do_read_sst`` | Flag to use fixed SSTs, prescribed from input file (``sst_file``). | ``False`` | ++-------------------------------+----------------------------------------------------------------------------------+-----------+ +|``sst_file`` | Name of file containing fixed SSTs. | ``False`` | ++-------------------------------+----------------------------------------------------------------------------------+-----------+ +|``do_sc_sst`` | Flag to use fixed SSTs, prescribed from input file (``sst_file``). | ``False`` | ++-------------------------------+----------------------------------------------------------------------------------+-----------+ +|``specify_sst_over_ocean_only``| Flag to specify SSTs only over ocean, only works if ``do_sc_sst`` is True. | ``False`` | ++-------------------------------+----------------------------------------------------------------------------------+-----------+ +|``do_ape_sst`` | Flag to set prescribed SST according to the APE aquaplanet analytic form | ``False`` | ++-------------------------------+----------------------------------------------------------------------------------+-----------+ +|``add_latent_heat_flux_anom`` | Flag to add an anomalous latent heat flux | ``False`` | ++-------------------------------+----------------------------------------------------------------------------------+-----------+ +|``do_warmpool`` | Flag to call warmpool module, which returns ``ocean_qflux``. | ``False`` | ++-------------------------------+----------------------------------------------------------------------------------+-----------+ + +Surface albedo options +^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +There are 5 options for setting the surface albedo, determined by the value of ``albedo_choice``. + - 1: Surface albedo is a constant (``albedo_value``). + - 2: Glacier with higher albedo in one hemisphere only. If ``lat_glacier`` >0, albedo = ``higher_albedo`` North of ``lat_glacier``. If ``lat_glacier`` <0, albedo = ``higher_albedo`` South of ``lat_glacier``. + - 3: Glacier with higher albedo in both hemispheres. Albedo = ``higher_albedo`` where latitude > ``|lat_glacier|``. + - 4: Albedo set by ``albedo_value + (higher_albedo - albedo_value) (lat/90) ^ albedo_exp``. + - 5: Tanh increase around ``albedo_cntr`` with ``albedo_wdth``:: + + albedo(lat) = albedo_value + (higher_albedo-albedo_value)* 0.5 *(1+tanh((lat-albedo_cntr)/albedo_wdth)). + ++-------------------+-----------------------------------------------------------------------------+---------+ +| Option | Summary |Default | ++===================+=============================================================================+=========+ +|``albedo_choice`` | Switch to choose surface albedo option described above. | ``1`` | ++-------------------+-----------------------------------------------------------------------------+---------+ +|``albedo_value`` | Parameter that sets surface albedo depending on albedo choice. | ``0.06``| ++-------------------+-----------------------------------------------------------------------------+---------+ +|``higher_albedo`` | Parameter that sets surface albedo depending on albedo choice. | ``0.10``| ++-------------------+-----------------------------------------------------------------------------+---------+ +|``lat_glacier`` | Parameter that sets the glacier latitude for albedo choices 2 and 3. | ``60.0``| ++-------------------+-----------------------------------------------------------------------------+---------+ +|``albedo_exp`` | Parameter that sets surface albedo latitude dependence for albedo choice 4. | ``2.`` | ++-------------------+-----------------------------------------------------------------------------+---------+ +|``albedo_cntr`` | Parameter that sets surface albedo for albedo choice 5. | ``45.0``| ++-------------------+-----------------------------------------------------------------------------+---------+ +|``albedo_wdth`` | Parameter that sets surface albedo for albedo choice 5. | ``10`` | ++-------------------+-----------------------------------------------------------------------------+---------+ + +Land options +^^^^^^^^^^^^^^^^ + +There are 4 options for setting up the land, determined by the value of ``land_option``. + - ``none``: No land. + - ``input``: Use input file to determine land mask. + - ``zsurf``: The surface heat capacity is set to ``land_capacity`` where the surface geopotential is greater than 10. + - ``lonlat``: The surface heat capacity is set to ``land_capacity`` in the longitude / latitude boxes set by [slandlon(k), elandlon(k)] and [slandlat(k), elandlat(k)] for all k's. + ++------------------------------+---------------------------------------------------------------------------------------------------------+----------+ +| Option | Summary | Default | ++==============================+=========================================================================================================+==========+ +|``land_option`` | Switch to choose land option as described above. | ``none`` | ++------------------------------+---------------------------------------------------------------------------------------------------------+----------+ +|``land_depth`` | Value of land mixed layer depth. | ``-1`` | ++------------------------------+---------------------------------------------------------------------------------------------------------+----------+ +|``slandlon`` | Vector determining lower bounds of longitudes for land masses. | ``0`` | ++------------------------------+---------------------------------------------------------------------------------------------------------+----------+ +|``slandlat`` | Vector determining lower bounds of latitudes for land masses. | ``0`` | ++------------------------------+---------------------------------------------------------------------------------------------------------+----------+ +|``elandlon`` | Vector determining higher bounds of longitudes for land masses. | ``-1`` | ++------------------------------+---------------------------------------------------------------------------------------------------------+----------+ +|``elandlat`` | Vector determining higher bounds of latitudes for land masses. | ``-1`` | ++------------------------------+---------------------------------------------------------------------------------------------------------+----------+ +|``land_h_capacity_prefactor`` | Factor by which to multiply ocean heat capacity to get land heat capacity if ``input`` option is used. | ``1.0`` | ++------------------------------+---------------------------------------------------------------------------------------------------------+----------+ +|``land_albedo_prefactor`` | Factor by which to multiply ocean albedo to get land albedo if ``input`` option is used. | ``1.0`` | ++------------------------------+---------------------------------------------------------------------------------------------------------+----------+ + +Ice options +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ++-------------------------------+-------------------------------------------------------------------------------------------------------------+----------------------+ +| Option | Summary |Default | ++===============================+=============================================================================================================+======================+ +|``update_albedo_from_ice`` | Flag to set the surface albedo to ``ice_albedo_value`` where there is ice as specified by ``ice_file_name`` | ``False`` | ++-------------------------------+-------------------------------------------------------------------------------------------------------------+----------------------+ +|``ice_albedo_value`` | Value for ice albedo when ``update_albedo_from_ice`` is True. | ``0.7`` | ++-------------------------------+-------------------------------------------------------------------------------------------------------------+----------------------+ +|``ice_file_name`` | Name of file containing sea ice concentration. | ``siconc_clim_amip`` | ++-------------------------------+-------------------------------------------------------------------------------------------------------------+----------------------+ +|``ice_concentration_threshold``| Value of sea ice concentration above which albedo should be set to ``ice_albedo_value``. | ``0.5`` | ++-------------------------------+-------------------------------------------------------------------------------------------------------------+----------------------+ +|``ice_file_name`` | Name of file containing sea ice concentration. | ``siconc_clim_amip`` | ++-------------------------------+-------------------------------------------------------------------------------------------------------------+----------------------+ + +Diagnostics +------------------- ++---------------------------+-------------------------------------+----------------------------------------------+ +| Name | Description | Units | ++===========================+=====================================+==============================================+ +| ``t_surf`` | Surface temperature | K | ++---------------------------+-------------------------------------+----------------------------------------------+ +| ``delta_t_surf`` | Surface temperature change | K | ++---------------------------+-------------------------------------+----------------------------------------------+ +| ``flux_t`` | Surface sensible heat flux | :math:`\text{W}\,\text{m}^{-2}` | ++---------------------------+-------------------------------------+----------------------------------------------+ +| ``flux_lhe`` | Surface latent heat flux | :math:`\text{W}\,\text{m}^{-2}` | ++---------------------------+-------------------------------------+----------------------------------------------+ +| ``flux_oceanq`` | Ocean heat flux | :math:`\text{W}\,\text{m}^{-2}` | ++---------------------------+-------------------------------------+----------------------------------------------+ +| ``ice_conc`` | Sea ice concentration | 0-1 | ++---------------------------+-------------------------------------+----------------------------------------------+ +| ``albedo`` | Surface albedo | 0-1 | ++---------------------------+-------------------------------------+----------------------------------------------+ +| ``land_sea_heat_capacity``| Heat capacity of land and sea | :math:`\text{J}\,\text{m}^{-2},\text{K}^{-1}`| ++---------------------------+-------------------------------------+----------------------------------------------+ + + +Relevant modules and subroutines +-------------------------------- +.. List the names of relevant modules, subroutines, functions, etc. +.. You can add also code snippets, using Sphinx code formatting + +The mixed layer code is located in: ``src/atmos_spectral/driver/solo/mixed_layer.F90``. The name of this file reflects the fact that the code determines the properties of the single layer (either a slab ocean model +or prescribed SST) below the air-sea interface. + +The mixed layer ocean is initialised and called by: ``src/atmos_spectral/driver/solo/idealized_moist_phys.F90``. + +Relevant routines which are called by the mixed layer ocean: + - The SST input file is read in using the interpolator module found here: ``src/atmos_shared/interpolator/interpolator.F90``. + - The Q-flux and warmpool components use the Q-flux module: ``src/atmos_param/qflux/qflux.f90``. + +References +---------- +.. + Add relevant references. This is done in 2 steps: + 1. Add the reference itself to docs/source/references.rst + 2. Insert the citation key here, e.g. [Vallis2017]_ + + See the Contributing guide for more info. +[Vallis2017]_ +[NealeHoskins2004]_ +[MerlisEtAl2013]_ +[RusselEtAl1985]_ + +Authors +---------- +.. +This documentation was written by Matthew Henry and Penelope Maher, peer reviewed by Stephen Thomson, and quality controlled by Ruth Geen. diff --git a/docs/source/modules/topography.rst b/docs/source/modules/topography.rst new file mode 100644 index 000000000..cd3db1139 --- /dev/null +++ b/docs/source/modules/topography.rst @@ -0,0 +1,129 @@ +Topography and Land Masks in Isca +================== + +This guide covers: + +1. How to implement a land mask and/or topography (using the T42 land mask provided). +2. How to create/modify topography to suit your own needs (using the python tools included in Isca). +3. The ``topography.F90`` module, which used to control land masks/topography but has now been superceeded. It still retains some useful functions however. + +1 - Implementing Topography in Isca +----------------------------------- + +This is relatively simple to do, assuming that the topography/land mask you are using has already been interpolated to the same spectral grid you are running the model at. If running at T42, you can use the one provided (``input/land_masks/era_land_t42.nc``). If not, you can interpolate fairly easily from any high resolution data, or for configurations of Earth continents, please refer to section 2 of this guide. + +- The land mask is a binary field the size of the spectral model grid (e.g. 64 x 128 for T42) that contains a ``1`` if that grid box is designated as being land or a ``0`` if it is not. +- Topography is a separate field, again the size of the spectral model grid, containing the surface height for that grid box in meters. +- Often a 'land mask' will contain both these fields. + +**Can I have land without topography?** Yes - For idealized modelling sometimes it is useful to have the land/sea contrasts (different albedo, no ocean exchange and different surface parameters) without the complexity of topography. It is also possible to have topography without land (aquamountains). + +Implementing these options require different namelist values. There are two namelists that need to be told about land and topograhy; ``idealized_moist_phys_nml`` (land mask) and ``spectral_init_cond_nml`` (topography). + +idealized_moist_phys +^^^^^^^^^^^^^^^^^^^^ +NOTE: see the :ref:`idealized moist phys ` documentation for additional guidance on this namelist. + +The ``idealized_moist_phys`` module is primarily concerned with the land mask. Its job is to pass the information about the land mask to other modules, which in the first instance are the ``mixed_layer`` and the ``surface_flux`` modules, which deal with ocean and surface exchanges with the atmosphere respectively. Both modules need to know where there is ocean/land so correct physics can be computed in the correct location. In addition to passing this information, ``idealized_moist_phys`` will also use the land mask for some other model features, for example some land based parameters and calculating buckets if using bucket hydrology. + +The ``idealized_moist_phys`` namelist options to include the appropriate land mask are: + +| ``land_option : 'input'`` (the default is ``'none'``, - this is essentially the on switch) +| ``land_file_name : 'INPUT/era_land_t42.nc'`` (using the example of the provided land file) +| ``land_field_name : 'land_mask'`` (this is the default and doesn't need to be specified if that is correct) + +spectral_init_cond +^^^^^^^^^^^^^^^^^^ +Now there is a land mask, topography can be included if desired. If not, this step can be ignored. + +The namelist options below are to include topography from the same file as the land mask. It can be a different file, as long as the grid size is still correct and the height units is meters. There are multiple other options for including topography, some of which are unused at the moment. + +| ``topography_option : 'input'`` (Tell model to get topography from input file) +| ``topog_file_name : 'era_land_t42.nc'`` (Again, we use the provided file as the example) +| ``topog_field_name : 'zsurf'`` (The height field name) +| ``land_field_name : 'land_mask'`` (The land field name) + +NOTE: ``zsurf`` and ``land_mask`` are the default values in Isca and these are the names used in the provided land mask so does not need to be included when using it. + +This set up is the standard way to use topography in Isca, using the ``spectral_init_cond`` module. The module deals with topography, setting up the shape of the model boundary layer. + +Other ``topography_option`` options are available, but not widely used by the Isca team: + +- No topography - the default. +- Flat topography - the surface geopotential is 0. +- Interpolated topography - where it will call the ``topography`` module below, however this set up is not currently used. +- Gaussian Topography - Simple Gaussian-shaped mountains are generated from specified parameters. + +2 - Creating Custom Topography +------------------------------ + +We provide python code that allows land files to be generated for a range of scenarios. This code is found in ``src/extra/python/isca/land_generator_fn.py``. Some tweaking of the code will be needed to suit the users requirements. + +Land Options +^^^^^^^^^^^^ +- 'square' (default) Square block of land with boundaries specified by boundaries keyword, a list of 4 floats in the form [S,N,W,E] +- 'continents_old' Choose continents from the original continent set-up adapted from the Sauliere 2012 paper (Jan 16), including North and South America, Eurasia, and Africa. +- 'continents' Choose continents from a newer continet set-up allowing addition of India, Australia, and South East Asia. +- If continents keyword is set to 'all' (default), then this will include all possibilities for the given set-up. Alternatively, continents can be set to a list of strings allowing any combination of continents. Instructions for this are available in the code. + +Topography Options: +^^^^^^^^^^^^^^^^^^^ +- 'none' (default) Topography set to zero everywhere +- 'sauliere2012' Choose mountains from [Sauliere2012]_ configuration using mountains keyword. Default is 'all', alternatively only 'rockys' or 'tibet' may be specified +- 'gaussian' Use parameters specified in topo_gauss keyword to set up a Gaussian mountain. topo_gauss should be a list in the form: [central_lat, central_lon, radius_degrees, std_dev, height] + +3 - Topography Module (topography.F90) +-------------------------------------- + +Summary +^^^^^^^ +The ``topography`` module contains numerous routines for creating land surface topography fields and land-water masks for specified latitude-longitude grids. It does this by interpolating from a high resolution netCDF file, which is designated in the namelist. The module was originally written to work with the 1/6 degree Navy mean topography and water data sets. However, any netCDF file can be used as an input in the namelist, providing that the file contains grid box boundaries, (which should be named in the namelist) and whether degrees or radians is specified in the namelist. + +As mentioned above, this module is generally not called anymore, in the normal Isca set up, land masks are actually specified through the ``idealized_moist_phys`` module, and the model topography through the ``spectral_init_cond`` module. The main use of it is to provide the "subgrid topography" when using the orographic gravity wave drag scheme (``mg_drag``). + +The fields that can be generated with this module are mean and standard deviation of topography within the specified grid boxes; and land-ocean (or water) mask and fractional area. The interpolation conserves the area weighted average of the input data by using the ``horiz_interp`` module. + +Namelist options +^^^^^^^^^^^^^^^^ +| ``topog_file`` - The topography file that you wish to use. +| ``water_file`` - The water data file (not commonly used, not provided in the Isca release) + +For a typical Earth set up the namelist would simply be: + +``'topog_file': navy_topography.nc`` + +This essentially just points the ``topography`` module to this file when it is asked for by another subroutine, e.g. ``mg_drag``. + +Diagnostics +^^^^^^^^^^^ +There are no diagnostics available directly through this module. The subgrid topography variance can be obtained through damping driver by asking for ``sgsmtn`` (``mg_drag`` must be turned on). + +Relevant subroutines +^^^^^^^^^^^^^^^^^^^^ + +NOTE: Some subroutines have dimensional variants, e.g. interp_topog has both a 1d and 2d variant. + +**Public Subroutines** + +These subroutines are used by the topography module to produce the land-masks etc that are being asked for by the user. They are largely self explanatory. + +| ``get_topog_mean`` returns the mean height from a region of the topography file so that that value can be used as the value when interpolating onto a smaller grid. +| ``get_topog_stdev`` returns the standard deviation from a region of the topography file so that that value can be assoiated with the same region when interpolating onto a smaller grid. +| ``get_ocean_frac`` returns the fraction of the land mask that is covered by ocean. +| ``get_ocean_mask`` returns an ocean/land mask +| ``get_water_frac`` returns the fraction of the land mask that is covered by water. +| ``get_water_mask`` returns a water/land mask +| ``gaussian_topog_init`` and ``get_gaussian_topog`` call the gaussian topography module. + +**Private Subroutines** + +There are other subroutines called by the above. These are listed below: +``open_topog_file``, ``interp_topog``, ``find_indices``, ``input_data``, ``interp_water``, ``determine_ocean_points``, ``read_namelist``. + +References +---------- +See [Sauliere2012]_ for the topography option in ``land_generator_fn.py``. + +Authors +------- +This documentation was written by Ross Castle, peer reviewed by Ruth Geen, and quality controlled by Marianne Pietschnig. diff --git a/docs/source/references.rst b/docs/source/references.rst index e8f5da73e..f0f9e6206 100644 --- a/docs/source/references.rst +++ b/docs/source/references.rst @@ -1,7 +1,10 @@ References ========== - +.. [Alexander1999] Alexander, M. J., & Dunkerton, T. J. (1999). A spectral parameterization of + mean-flow forcing due to breaking gravity waves. Journal of the Atmospheric Sciences, + 56(24), 4167-4182. 2.0.CO;2>`_. + .. [Betts1986] Betts, A. K., 1986: A new convective adjustment scheme. Part I: Observational and theoretical basis. *Quarterly Journal of the Royal Meteorological Society*, @@ -73,10 +76,20 @@ References *Monthly Weather Review*, **120(6)**, 978--1002, doi: 10.1175/1520-0493(1992)120<0978:RASAPO>2.0.CO;2 + +.. [Pierrehumbert1986] Pierrehumbert, R. T. (1986, September). An essay on the parameterization + of orographic gravity wave drag. In Proc. Seminar/Workshop on Observation, Theory and + Modeling of Orographic Effects (Vol. 1, pp. 251-282). .. [Ricchiazzi1998] Ricchiazzi, P., Yang, S., Gautier, C., and Sowle, D., 1998: SBDART: A research and teaching software tool for plane-parallel radiative transfer in the Earth’s atmosphere, *B. Am. Meteorol. Soc.*, **79**, 2101–2114, doi. + +.. [Sauliere2012] Saulière, J., Brayshaw, D. J., Hoskins, B., & Blackburn, M. (2012): + Further investigation of the impact of idealized continents and SST distributions on the Northern Hemisphere storm tracks. + *J. Atmos. Sci.*, + **69(3)**, 840-856, + doi: `10.1175/JAS-D-11-0113.1 `_. .. [Schneider2006] Schneider, T., Walker, C. C., 2006: Self-Organization of Atmospheric Macroturbulence into Critical States of Weak Nonlinear Eddy–Eddy Interactions. @@ -90,7 +103,19 @@ References .. [Thomson_and_Vallis2019] Thomson, S. I. and Vallis, G. K., 2019. Hierarchical Modeling of Solar System Planets with Isca. *Atmosphere*, **10 (12)**, 803, doi: `10.3390/atmos10120803 `_. - + +.. [NealeHoskins2004] Neale, R. B. and Hoskins, B. K., 2000. A standard test for AGCMs including their physical parametrizations: I: the proposal + *Atmospheric Science Letters*, + **1(2)**, 101-107 + +.. [MerlisEtAl2013] Merlis, Timothy M., et al. 2013. Hadley circulation response to orbital precession. Part I: Aquaplanets. + *Journal of Climate*, + **26(3)**, 740-753 + +.. [RusselEtAl1985] Russell, Gary L., James R. Miller, and Lie-Ching Tsang. 1985. Seasonal oceanic heat transports computed from an atmospheric model. + *Dynamics of atmospheres and Oceans* + **9(3)**, 253-271. + .. [Vallis2017] Vallis, G. K., 2017: **Atmospheric and Oceanic Fluid Dynamics. Fundamentals and Large-Scale Circulation**. 2nd ed. Cambridge University Press. doi: `10.1017/9781107588417 `_. @@ -101,7 +126,7 @@ References other planets at varying levels of complexity. *Geoscientific Model Development*, **11(3)**, 843-859, doi: `10.5194/gmd-11-843-2018 `_. - + .. [Williams2011] Williams, P. D., 2011: The RAW Filter: An Improvement to the Robert-Asselin Filter in Semi-Implicit Integrations. *Mon. Wea. Rev.* @@ -113,8 +138,3 @@ References *Dynamics of Atmospheres and Oceans*, **73**, 10--33, doi: `10.1016/j.dynatmoce.2015.11.001 `_. - - - - - diff --git a/docs/source/remote_access.rst b/docs/source/remote_access.rst index b763ca067..97bb090e2 100644 --- a/docs/source/remote_access.rst +++ b/docs/source/remote_access.rst @@ -4,16 +4,16 @@ Remote Access Overview -------- This is a guide for how to edit remote files on a local text editor via port- -fowarding. By the end you should know: +forwarding. By the end you should know: * how to quickly login to your remote server using an SSH config file * how to edit remote files in a local text editor through ``rmate`` * how to edit remote python files in a local ``jupyter`` environment -Simplifying logins and port-fowarding +Simplifying logins and port-forwarding ------------------------------------- If you use a Unix-based operating system on your personal computer, you can make use -of an SSH config file to create shortcuts to your frequently used remote computers. We will take this one step further to simplify port-fowarding, a method which allows a user to redirect data from a specified remote host and port, through a secure tunnel, to a specified local port. Port-fowarding is helfpul because it will enable us to edit remote files locally. +of an SSH config file to create shortcuts to your frequently used remote computers. We will take this one step further to simplify port-forwarding, a method which allows a user to redirect data from a specified remote host and port, through a secure tunnel, to a specified local port. Port-forwarding is helpful because it will enable us to edit remote files locally. As an example without any fancy tricks, let's set up an SSH tunnel that maps ``localhost`` port 3039 on my local machine to 3039 on my remote machine (the number is arbitrary as long as its between 1024 and 49150): ``$ ssh -l localhost:3039:host:3039 user@host``. You will then be required to enter in your password. This is cumbersome to repeat everytime we log in. Our goal will be to shorten the command to : ``$ ssh hostalias`` and without having to enter in your password. We give some instructions below: @@ -51,12 +51,12 @@ You should not be able to log in simply by typing ``$ ssh hostalias``. Congratul Edit remote files in a local text editor using ``rmate`` -------------------------------------------------------- As an alternative to remote-based text editors such as ``vi`` and ``emacs``, we can -use port-fowarding to set up a `local-based text editor like Atom `_ which includes features such as syntax highlighting and code completion. For instructions to install ``rmate`` on your **local machine**, `click here `_. Then to specifically use Atom to edit remote files, `click here `_. You will need to add the following line to your ``~/.ssh/config`` file: ``RemoteForward 52698 localhost:52698``. +use port-forwarding to set up a `local-based text editor like Atom `_ which includes features such as syntax highlighting and code completion. For instructions to install ``rmate`` on your **local machine**, `click here `_. Then to specifically use Atom to edit remote files, `click here `_. You will need to add the following line to your ``~/.ssh/config`` file: ``RemoteForward 52698 localhost:52698``. Edit remote python files in a ``jupyter`` environment ----------------------------------------------------- -The ``jupyter`` environment is a great environent for data exploration and integrating +The ``jupyter`` environment is a great environment for data exploration and integrating your figures inline with your code. To open your first Jupyter notebook, log in to your **remote machine** and type: ``$ jupyter lab --no-browser --port=3039``. To make it even quicker, you can type the following on your **local machine**: ``$ssh remotehost "jupyter lab --no-browser --port=3039``. This should function because of all the work we put in during the port forwarding section. To shorten this command, add an alias to your ``~/.bashrc`` file on your **local machine**. I personally use the alias ``rjlab``. @@ -81,7 +81,7 @@ Your final ``~/.ssh/config`` file should look like this (making sure to replace * Do not use this with VPN, use ithome aka hashbang as proxy. If the connection is interrupted you can still reconnect, assuming the jupyter process is still running. But make sure not to leave zombie jupyter processes with open ports on remote hosts! -* Remember the port numbers chosen are arbitary. If you choose the same number as someone else on your network, their files may open up on your computer and vice versa! +* Remember the port numbers chosen are arbitrary. If you choose the same number as someone else on your network, their files may open up on your computer and vice versa! Authors ------- diff --git a/exp/test_cases/README.md b/exp/test_cases/README.md index fd1d07016..56b9bd6f0 100644 --- a/exp/test_cases/README.md +++ b/exp/test_cases/README.md @@ -6,6 +6,9 @@ `bucket_hydrology` * As described in Isca paper (Vallis et al., 2017) but without q-fluxes +`column_test_case` +* Single column configuration of Isca. Please cite McKim et al. (2024, submitted) () if you use the SCM. + `frierson` * Control case of the so-called `Frierson model` described in e.g. diff --git a/exp/test_cases/ape_aquaplanet/socrates_ape_aquaplanet_T42.py b/exp/test_cases/ape_aquaplanet/socrates_ape_aquaplanet_T42.py index 9c313b478..1df4b3633 100644 --- a/exp/test_cases/ape_aquaplanet/socrates_ape_aquaplanet_T42.py +++ b/exp/test_cases/ape_aquaplanet/socrates_ape_aquaplanet_T42.py @@ -107,8 +107,8 @@ 'do_read_ozone': True, 'ozone_file_name':'ozone_1990', 'ozone_field_name':'ozone_1990', - 'dt_rad':4320., - 'solday':90., #turn off seasonal cycle - diurnal by default + 'dt_rad':4320, + 'solday':90, #turn off seasonal cycle - diurnal by default 'co2_ppmv':348.0, 'store_intermediate_rad':True, 'chunk_size': 16, diff --git a/exp/test_cases/axisymmetric/axisymmetric_test_case.py b/exp/test_cases/axisymmetric/axisymmetric_test_case.py index f9f879e42..54884a989 100644 --- a/exp/test_cases/axisymmetric/axisymmetric_test_case.py +++ b/exp/test_cases/axisymmetric/axisymmetric_test_case.py @@ -140,6 +140,7 @@ 'do_read_ozone':True, 'ozone_file':'ozone_1990', 'dt_rad': 3600, #Set RRTM radiation timestep to 3600 seconds, meaning it runs every 5 atmospheric timesteps + }, # FMS Framework configuration @@ -184,4 +185,4 @@ exp.run(1, use_restart=False, num_cores=NCORES) for i in range(2,121): - exp.run(i, num_cores=NCORES) \ No newline at end of file + exp.run(i, num_cores=NCORES) diff --git a/exp/test_cases/column_test_case/column_test.py b/exp/test_cases/column_test_case/column_test.py new file mode 100644 index 000000000..32e655260 --- /dev/null +++ b/exp/test_cases/column_test_case/column_test.py @@ -0,0 +1,202 @@ +""" +This script configures a column model that uses Isca's columnwise physics routines. + +Single column configuration of Isca. Please cite McKim et al. (2024, submitted) (https://doi.org/10.22541/essoar.170904795.55675140/v1) if you use the SCM. + +Useful for testing new convection / radiation parametrizations, as the dynamical core is +bypassed so the model runs a gazillion times faster (especially if you're only simulating +one column). Can in principle simulate many (in lat and lon) at the same time. + +The wind is prescribed (it needs to be non-zero at the surface to allow for latent and +sensible surface heat fluxes). Currently the user can set a namelist variable 'surface_wind' +that sets u_surf and v_surf = surface_wind / sqrt(2), so that wind_surf = sqrt(u_surf**2 + +v_surf**2) = surface_wind. u and v at all other altitudes are set to zero (hardcoded). + +At the moment the model needs to use the vertical turbulent diffusion parameterization in order +for the mixed layer code to work. This is not very consistent as the u and v wind are prescribed +and so the u,v tendenency from the diffusion is thrown away. Hence an implicit assumption when +using the column model is that 'the dynamics' would restore the surface winds to their prescribed +speed, so that du/dt total is zero. + +The column model is currently initiated as a bit of a hack. The line + +'from isca import ColumnCodeBase' + +sets a compiler flag -DCOLUMN_MODEL that tells the model to use the following files: + +atmos_column/column.F90 +atmos_column/column_grid.F90 +atmos_column/column_init_cond.F90 +atmos_column/column_initialize_fields.F90 + +to initialize the model (including constructing the model grid), do the model timestepping +(using a leapfrog scheme as before), and handle input/output. + +Works with either hs_forcing, or the physics packages in idealized_moist_phys. Even when +multiple columns are simulated, the model can only run on 1 core at the moment (will endeavour +to fix this as some point). Also, the column model cannot read in topography input files. + +Any questions to Neil Lewis: +n.t.lewis@exeter.ac.uk +""" + + +import os + +import numpy as np + +from isca import ColumnCodeBase, DiagTable, Experiment, Namelist, GFDL_BASE + + +# column model only uses 1 core +NCORES = 1 + +# compile code +base_dir = os.path.dirname(os.path.realpath(__file__)) +cb = ColumnCodeBase.from_directory(GFDL_BASE) +cb.compile() + +# create an Experiment object to handle the configuration of model parameters +exp = Experiment('column_test_exp', codebase=cb) + +#Tell model how to write diagnostics +diag = DiagTable() +diag.add_file('atmos_monthly', 30, 'days', time_units='days') + +#Tell model which diagnostics to write +diag.add_field('column', 'ps', time_avg=True) +diag.add_field('column', 'bk') +diag.add_field('column', 'pk') +diag.add_field('atmosphere', 'precipitation', time_avg=True) +diag.add_field('mixed_layer', 't_surf', time_avg=True) +diag.add_field('mixed_layer', 'flux_lhe', time_avg=True) +diag.add_field('column', 'sphum', time_avg=True) +diag.add_field('column', 'ucomp', time_avg=True) +diag.add_field('column', 'vcomp', time_avg=True) +diag.add_field('column', 'temp', time_avg=True) +diag.add_field('two_stream', 'swdn_toa', time_avg=True) +diag.add_field('atmosphere', 'dt_ug_diffusion', time_avg=True) +diag.add_field('atmosphere', 'dt_vg_diffusion', time_avg=True) +exp.diag_table = diag + +#Empty the run directory ready to run +exp.clear_rundir() + +#Define values for the 'core' namelist +exp.namelist = namelist = Namelist({ + 'main_nml':{ + 'days' : 360, + 'hours' : 0, + 'minutes': 0, + 'seconds': 0, + 'dt_atmos':1440, + 'current_date' : [1,1,1,0,0,0], + 'calendar' : 'thirty_day' + }, + + 'atmosphere_nml': { + 'idealized_moist_model': True + }, + + 'column_nml': { + 'lon_max': 1, # number of columns in longitude, default begins at lon=0.0 + 'lat_max': 1, # number of columns in latitude, precise + # latitude can be set in column_grid_nml if only 1 lat used. + 'num_levels': 31, # number of levels + 'initial_sphum': 1e-3, + 'q_decrease_only':True, # constrain q in stratosphere + }, + + 'column_grid_nml': { + 'lat_value': np.rad2deg(np.arcsin(1/np.sqrt(3))) # set latitude to that which causes insolation in frierson p2 radiation to be insolation / 4. + #'global_average': True # don't use this option at the moment + }, + + # set initial condition, NOTE: currently there is not an option to read in initial condition from a file (aside from a restart file). + 'column_init_cond_nml': { + 'initial_temperature': 264., # initial atmospheric temperature + 'surf_geopotential': 0.0, # applied to all columns + 'surface_wind': 5. # as described above + }, + + 'idealized_moist_phys_nml': { + 'do_damping': False, # no damping in column model, surface wind prescribed + 'turb':True, + 'mixed_layer_bc':True, + 'do_simple': True, # simple RH calculation + 'roughness_mom': 3.21e-05, + 'roughness_heat':3.21e-05, + 'roughness_moist':3.21e-05, + 'two_stream_gray': True, #Use grey radiation + 'convection_scheme': 'SIMPLE_BETTS_MILLER', #Use the simple Betts Miller convection scheme + 'do_lcl_diffusivity_depth':True, # use convection scheme LCL height to set PBL depth + }, + + 'two_stream_gray_rad_nml': { + 'rad_scheme': 'frierson', #Select radiation scheme to use, which in this case is Frierson + 'do_seasonal': False, #do_seasonal=false uses the p2 insolation profile from Frierson 2006. do_seasonal=True uses the GFDL astronomy module to calculate seasonally-varying insolation. + 'atm_abs': 0.2, # default: 0.0 + }, + + 'qe_moist_convection_nml': { + 'rhbm':0.7, # rh criterion for convection + 'Tmin':160., # min temperature for convection scheme look up tables + 'Tmax':350. # max temperature for convection scheme look up tables + }, + + 'lscale_cond_nml': { + 'do_simple':True, # only rain + 'do_evap':False, # no re-evaporation of falling precipitation + }, + + 'surface_flux_nml': { + 'use_virtual_temp': True, # use virtual temperature for BL stability + 'do_simple': True, + 'old_dtaudv': True + }, + + 'vert_turb_driver_nml': { + 'do_mellor_yamada': False, # default: True + 'do_diffusivity': True, # default: False + 'do_simple': True, # default: False + 'constant_gust': 0.0, # default: 1.0 + 'use_tau': False + }, + + #Use a large mixed-layer depth, and the Albedo of the CTRL case in Jucker & Gerber, 2017 + 'mixed_layer_nml': { + 'tconst' : 285., + 'prescribe_initial_dist':False, + 'evaporation':True, + 'depth': 2.5, #Depth of mixed layer used + 'albedo_value': 0.30, #Albedo value used + }, + + 'sat_vapor_pres_nml': { + 'do_simple':True, + }, + + # define pressure coordinate + 'vert_coordinate_nml': { + 'bk': [0.000000, 0.0117665, 0.0196679, 0.0315244, 0.0485411, 0.0719344, 0.1027829, 0.1418581, 0.1894648, 0.2453219, 0.3085103, 0.3775033, 0.4502789, 0.5244989, 0.5977253, 0.6676441, 0.7322627, 0.7900587, 0.8400683, 0.8819111, 0.9157609, 0.9422770, 0.9625127, 0.9778177, 0.9897489, 1.0000000], + 'pk': [0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000], + }, + + # FMS Framework configuration + 'diag_manager_nml': { + 'mix_snapshot_average_fields': False # time avg fields are labelled with time in middle of window + }, + 'fms_nml': { + 'domains_stack_size': 600000 # default: 0 + }, + 'fms_io_nml': { + 'threading_write': 'single', # default: multi + 'fileset_write': 'single', # default: multi + }, +}) + +#Lets do a run! +if __name__=="__main__": + exp.run(1, use_restart=False, num_cores=NCORES, mpirun_opts='--bind-to socket') + for i in range(2,11): + exp.run(i, num_cores=NCORES, mpirun_opts='--bind-to socket') diff --git a/exp/test_cases/column_test_case/column_test_rrtm_ozone.py b/exp/test_cases/column_test_case/column_test_rrtm_ozone.py new file mode 100644 index 000000000..cffd83813 --- /dev/null +++ b/exp/test_cases/column_test_case/column_test_rrtm_ozone.py @@ -0,0 +1,223 @@ +""" +This script configures a column model that uses Isca's columnwise physics routines. + +Single column configuration of Isca. Please cite McKim et al. (2024, submitted) (https://doi.org/10.22541/essoar.170904795.55675140/v1) if you use the SCM. + +Useful for testing new convection / radiation parametrizations, as the dynamical core is +bypassed so the model runs a gazillion times faster (especially if you're only simulating +one column). Can in principle simulate many (in lat and lon) at the same time. + +The wind is prescribed (it needs to be non-zero at the surface to allow for latent and +sensible surface heat fluxes). Currently the user can set a namelist variable 'surface_wind' +that sets u_surf and v_surf = surface_wind / sqrt(2), so that wind_surf = sqrt(u_surf**2 + +v_surf**2) = surface_wind. u and v at all other altitudes are set to zero (hardcoded). + +At the moment the model needs to use the vertical turbulent diffusion parameterization in order +for the mixed layer code to work. This is not very consistent as the u and v wind are prescribed +and so the u,v tendenency from the diffusion is thrown away. Hence an implicit assumption when +using the column model is that 'the dynamics' would restore the surface winds to their prescribed +speed, so that du/dt total is zero. + +The column model is currently initiated as a bit of a hack. The line + +'from isca import ColumnCodeBase' + +sets a compiler flag -DCOLUMN_MODEL that tells the model to use the following files: + +atmos_column/column.F90 +atmos_column/column_grid.F90 +atmos_column/column_init_cond.F90 +atmos_column/column_initialize_fields.F90 + +to initialize the model (including constructing the model grid), do the model timestepping +(using a leapfrog scheme as before), and handle input/output. + +Works with either hs_forcing, or the physics packages in idealized_moist_phys. Even when +multiple columns are simulated, the model can only run on 1 core at the moment (will endeavour +to fix this as some point). Also, the column model cannot read in topography input files. + +Any questions to Neil Lewis: +n.t.lewis@exeter.ac.uk +""" + + +import os + +import numpy as np + +from isca import ColumnCodeBase, DiagTable, Experiment, Namelist, GFDL_BASE + +### to create ozone file: +from scm_interp_routine import scm_interp, global_average_lat_lon + +# column model only uses 1 core +NCORES = 1 + +# compile code +base_dir = os.path.dirname(os.path.realpath(__file__)) +cb = ColumnCodeBase.from_directory(GFDL_BASE) +cb.compile() + +# create an Experiment object to handle the configuration of model parameters +exp = Experiment('column_test_rrtm_ozone', codebase=cb) + + +#Tell model how to write diagnostics +diag = DiagTable() +diag.add_file('atmos_monthly', 30, 'days', time_units='days') + +#Tell model which diagnostics to write +diag.add_field('column', 'ps', time_avg=True) +diag.add_field('column', 'bk') +diag.add_field('column', 'pk') +diag.add_field('atmosphere', 'precipitation', time_avg=True) +diag.add_field('mixed_layer', 't_surf', time_avg=True) +diag.add_field('mixed_layer', 'flux_lhe', time_avg=True) +diag.add_field('column', 'sphum', time_avg=True) +diag.add_field('column', 'ucomp', time_avg=True) +diag.add_field('column', 'vcomp', time_avg=True) +diag.add_field('column', 'temp', time_avg=True) +diag.add_field('rrtm_radiation', 'toa_sw', time_avg=True) +diag.add_field('rrtm_radiation', 'olr', time_avg=True) +diag.add_field('rrtm_radiation', 'coszen', time_avg=True) +diag.add_field('rrtm_radiation', 'ozone', time_avg=True) +diag.add_field('atmosphere', 'dt_ug_diffusion', time_avg=True) +diag.add_field('atmosphere', 'dt_vg_diffusion', time_avg=True) +exp.diag_table = diag + +#Empty the run directory ready to run +exp.clear_rundir() + +#Define values for the 'core' namelist +exp.namelist = namelist = Namelist({ + 'main_nml':{ + 'days' : 360, + 'hours' : 0, + 'minutes': 0, + 'seconds': 0, + 'dt_atmos':7200, + 'current_date' : [1,1,1,0,0,0], + 'calendar' : 'thirty_day' + }, + + 'atmosphere_nml': { + 'idealized_moist_model': True + }, + + 'column_nml': { + 'lon_max': 1, # number of columns in longitude, default begins at lon=0.0 + 'lat_max': 1, # number of columns in latitude, precise + # latitude can be set in column_grid_nml if only 1 lat used. + 'num_levels': 50, # number of levels + 'initial_sphum': 1e-3, + 'vert_coord_option': 'even_sigma', + 'q_decrease_only':True # constrain q in stratosphere + }, + + 'column_grid_nml': { + #'lat_value': np.rad2deg(np.arcsin(1/np.sqrt(3))) # set latitude to that which causes insolation in frierson p2 radiation to be insolation / 4. + 'global_average': True # don't use this option at the moment + }, + + # set initial condition, NOTE: currently there is not an option to read in initial condition from a file (aside from a restart file). + 'column_init_cond_nml': { + 'initial_temperature': 264., # initial atmospheric temperature + 'surf_geopotential': 0.0, # applied to all columns + 'surface_wind': 5. # as described above + }, + + 'idealized_moist_phys_nml': { + 'do_damping': False, # no damping in column model, surface wind prescribed + 'turb':True, + 'mixed_layer_bc':True, + 'do_simple': True, # simple RH calculation + 'roughness_mom': 3.21e-05, + 'roughness_heat':3.21e-05, + 'roughness_moist':3.21e-05, + 'two_stream_gray': False, #Use grey radiation + 'do_rrtm_radiation': True, + 'convection_scheme': 'SIMPLE_BETTS_MILLER', #Use the simple Betts Miller convection scheme + 'do_lcl_diffusivity_depth':True, # use convection scheme LCL height to set PBL depth + }, + + 'rrtm_radiation_nml': { + 'solr_cnst': 1360, #s set solar constant to 1360, rather than default of 1368.22 + 'dt_rad': 7200, #Use long RRTM timestep + 'do_rad_time_avg':True, + 'dt_rad_avg':86400, + 'co2ppmv':400., + }, + + 'qe_moist_convection_nml': { + 'rhbm':0.7, # rh criterion for convection + 'Tmin':160., # min temperature for convection scheme look up tables + 'Tmax':350. # max temperature for convection scheme look up tables + }, + + 'lscale_cond_nml': { + 'do_simple':True, # only rain + 'do_evap':False, # no re-evaporation of falling precipitation + }, + + 'surface_flux_nml': { + 'use_virtual_temp': True, # use virtual temperature for BL stability + 'do_simple': True, + 'old_dtaudv': True + }, + + 'vert_turb_driver_nml': { + 'do_mellor_yamada': False, # default: True + 'do_diffusivity': True, # default: False + 'do_simple': True, # default: False + 'constant_gust': 0.0, # default: 1.0 + 'use_tau': False + }, + + #Use a large mixed-layer depth, and the Albedo of the CTRL case in Jucker & Gerber, 2017 + 'mixed_layer_nml': { + 'tconst' : 285., + 'prescribe_initial_dist':False, + 'evaporation':True, + 'depth': 2.5, #Depth of mixed layer used + 'albedo_value': 0.20, #Albedo value used + }, + + 'sat_vapor_pres_nml': { + 'do_simple':True, + }, + + # FMS Framework configuration + 'diag_manager_nml': { + 'mix_snapshot_average_fields': False # time avg fields are labelled with time in middle of window + }, + 'fms_nml': { + 'domains_stack_size': 600000 # default: 0 + }, + 'fms_io_nml': { + 'threading_write': 'single', # default: multi + 'fileset_write': 'single', # default: multi + }, + + + 'astronomy_nml': { + 'ecc' : 0.0, + 'obliq' : 0.0, + 'per' : 0.0 + }, + +}) + +#Lets do a run! +if __name__=="__main__": + + + ds = scm_interp(filename=os.path.join(GFDL_BASE,'input/rrtm_input_files/ozone_1990.nc'), + varname='ozone_1990', + nlevels=50) + global_average_lat_lon(ds, 'ozone_1990_interp') + exp.namelist['rrtm_radiation_nml']['do_scm_ozone'] = True + exp.namelist['rrtm_radiation_nml']['scm_ozone'] = np.squeeze(ds.ozone_1990_interp_area_av.mean('time').values).tolist() + + exp.run(1, use_restart=False, num_cores=NCORES, mpirun_opts='--bind-to socket') + for i in range(2,11): + exp.run(i, num_cores=NCORES, mpirun_opts='--bind-to socket') diff --git a/exp/test_cases/column_test_case/column_test_socrates_ozone.py b/exp/test_cases/column_test_case/column_test_socrates_ozone.py new file mode 100644 index 000000000..fb6a9193b --- /dev/null +++ b/exp/test_cases/column_test_case/column_test_socrates_ozone.py @@ -0,0 +1,241 @@ +""" +This script configures a column model that uses Isca's columnwise physics routines. + +Single column configuration of Isca. Please cite McKim et al. (2024, submitted) (https://doi.org/10.22541/essoar.170904795.55675140/v1) if you use the SCM. + +Useful for testing new convection / radiation parametrizations, as the dynamical core is +bypassed so the model runs a gazillion times faster (especially if you're only simulating +one column). Can in principle simulate many (in lat and lon) at the same time. + +The wind is prescribed (it needs to be non-zero at the surface to allow for latent and +sensible surface heat fluxes). Currently the user can set a namelist variable 'surface_wind' +that sets u_surf and v_surf = surface_wind / sqrt(2), so that wind_surf = sqrt(u_surf**2 + +v_surf**2) = surface_wind. u and v at all other altitudes are set to zero (hardcoded). + +At the moment the model needs to use the vertical turbulent diffusion parameterization in order +for the mixed layer code to work. This is not very consistent as the u and v wind are prescribed +and so the u,v tendenency from the diffusion is thrown away. Hence an implicit assumption when +using the column model is that 'the dynamics' would restore the surface winds to their prescribed +speed, so that du/dt total is zero. + +The column model is currently initiated as a bit of a hack. The line + +'from isca import ColumnCodeBase' + +sets a compiler flag -DCOLUMN_MODEL that tells the model to use the following files: + +atmos_column/column.F90 +atmos_column/column_grid.F90 +atmos_column/column_init_cond.F90 +atmos_column/column_initialize_fields.F90 + +to initialize the model (including constructing the model grid), do the model timestepping +(using a leapfrog scheme as before), and handle input/output. + +Works with either hs_forcing, or the physics packages in idealized_moist_phys. Even when +multiple columns are simulated, the model can only run on 1 core at the moment (will endeavour +to fix this as some point). Also, the column model cannot read in topography input files. + +Any questions to Neil Lewis: +n.t.lewis@exeter.ac.uk +""" + + +import os + +import numpy as np + +from isca import SocColumnCodeBase, DiagTable, Experiment, Namelist, GFDL_BASE + +### to create ozone file: +from scm_interp_routine import scm_interp, global_average_lat_lon + +# column model only uses 1 core +NCORES = 1 + +# compile code +base_dir = os.path.dirname(os.path.realpath(__file__)) +cb = SocColumnCodeBase.from_directory(GFDL_BASE) +cb.compile() + +# create an Experiment object to handle the configuration of model parameters +exp = Experiment('column_test_socrates_ozone', codebase=cb) + + +#Tell model how to write diagnostics +diag = DiagTable() +diag.add_file('atmos_monthly', 30, 'days', time_units='days') + +#Tell model which diagnostics to write +diag.add_field('column', 'ps', time_avg=True) +diag.add_field('column', 'bk') +diag.add_field('column', 'pk') +diag.add_field('atmosphere', 'precipitation', time_avg=True) +diag.add_field('mixed_layer', 't_surf', time_avg=True) +diag.add_field('mixed_layer', 'flux_lhe', time_avg=True) +diag.add_field('column', 'sphum', time_avg=True) +diag.add_field('column', 'ucomp', time_avg=True) +diag.add_field('column', 'vcomp', time_avg=True) +diag.add_field('column', 'temp', time_avg=True) +#radiative tendencies +diag.add_field('socrates', 'soc_tdt_lw', time_avg=True) +diag.add_field('socrates', 'soc_tdt_sw', time_avg=True) +diag.add_field('socrates', 'soc_tdt_rad', time_avg=True) + +#net (up) and down surface fluxes +diag.add_field('socrates', 'soc_surf_flux_lw', time_avg=True) +diag.add_field('socrates', 'soc_surf_flux_sw', time_avg=True) +diag.add_field('socrates', 'soc_surf_flux_lw_down', time_avg=True) +diag.add_field('socrates', 'soc_surf_flux_sw_down', time_avg=True) +#net (up) TOA and downard fluxes +diag.add_field('socrates', 'soc_olr', time_avg=True) +diag.add_field('socrates', 'soc_toa_sw', time_avg=True) +diag.add_field('socrates', 'soc_toa_sw_down', time_avg=True) +diag.add_field('atmosphere', 'dt_ug_diffusion', time_avg=True) +diag.add_field('atmosphere', 'dt_vg_diffusion', time_avg=True) +exp.diag_table = diag + +#Empty the run directory ready to run +exp.clear_rundir() + +#Define values for the 'core' namelist +exp.namelist = namelist = Namelist({ + 'main_nml':{ + 'days' : 360, + 'hours' : 0, + 'minutes': 0, + 'seconds': 0, + 'dt_atmos':7200, + 'current_date' : [1,1,1,0,0,0], + 'calendar' : 'thirty_day' + }, + + 'atmosphere_nml': { + 'idealized_moist_model': True + }, + + 'column_nml': { + 'lon_max': 1, # number of columns in longitude, default begins at lon=0.0 + 'lat_max': 1, # number of columns in latitude, precise + # latitude can be set in column_grid_nml if only 1 lat used. + 'num_levels': 50, # number of levels + 'initial_sphum': 1e-3, + 'vert_coord_option': 'even_sigma', + 'q_decrease_only':True, # constrain q in stratosphere + }, + + 'column_grid_nml': { + #'lat_value': np.rad2deg(np.arcsin(1/np.sqrt(3))) # set latitude to that which causes insolation in frierson p2 radiation to be insolation / 4. + 'global_average': True # don't use this option at the moment + }, + + # set initial condition, NOTE: currently there is not an option to read in initial condition from a file (aside from a restart file). + 'column_init_cond_nml': { + 'initial_temperature': 264., # initial atmospheric temperature + 'surf_geopotential': 0.0, # applied to all columns + 'surface_wind': 5. # as described above + }, + + 'idealized_moist_phys_nml': { + 'do_damping': False, # no damping in column model, surface wind prescribed + 'turb':True, + 'mixed_layer_bc':True, + 'do_simple': True, # simple RH calculation + 'roughness_mom': 3.21e-05, + 'roughness_heat':3.21e-05, + 'roughness_moist':3.21e-05, + 'two_stream_gray': False, #Use grey radiation + 'do_socrates_radiation': True, + 'convection_scheme': 'SIMPLE_BETTS_MILLER', #Use the simple Betts Miller convection scheme + 'do_lcl_diffusivity_depth':True, # use convection scheme LCL height to set PBL depth + }, + + + + 'socrates_rad_nml': { + 'stellar_constant':1370., + 'lw_spectral_filename':os.path.join(GFDL_BASE,'src/atmos_param/socrates/src/trunk/data/spectra/ga7/sp_lw_ga7'), + 'sw_spectral_filename':os.path.join(GFDL_BASE,'src/atmos_param/socrates/src/trunk/data/spectra/ga7/sp_sw_ga7'), + 'dt_rad':7200, + 'store_intermediate_rad':True, + 'chunk_size': 1, # MUST BE 1 FOR COLUMN MODEL + 'use_pressure_interp_for_half_levels':False, + 'tidally_locked':False, + 'do_rad_time_avg':True, + 'dt_rad_avg':86400, + #'solday': 90 + }, + + 'qe_moist_convection_nml': { + 'rhbm':0.7, # rh criterion for convection + 'Tmin':160., # min temperature for convection scheme look up tables + 'Tmax':350. # max temperature for convection scheme look up tables + }, + + 'lscale_cond_nml': { + 'do_simple':True, # only rain + 'do_evap':False, # no re-evaporation of falling precipitation + }, + + 'surface_flux_nml': { + 'use_virtual_temp': True, # use virtual temperature for BL stability + 'do_simple': True, + 'old_dtaudv': True + }, + + 'vert_turb_driver_nml': { + 'do_mellor_yamada': False, # default: True + 'do_diffusivity': True, # default: False + 'do_simple': True, # default: False + 'constant_gust': 0.0, # default: 1.0 + 'use_tau': False + }, + + #Use a large mixed-layer depth, and the Albedo of the CTRL case in Jucker & Gerber, 2017 + 'mixed_layer_nml': { + 'tconst' : 285., + 'prescribe_initial_dist':False, + 'evaporation':True, + 'depth': 2.5, #Depth of mixed layer used + 'albedo_value': 0.20, #Albedo value used + }, + + 'sat_vapor_pres_nml': { + 'do_simple':True, + }, + + # FMS Framework configuration + 'diag_manager_nml': { + 'mix_snapshot_average_fields': False # time avg fields are labelled with time in middle of window + }, + 'fms_nml': { + 'domains_stack_size': 600000 # default: 0 + }, + 'fms_io_nml': { + 'threading_write': 'single', # default: multi + 'fileset_write': 'single', # default: multi + }, + + + 'astronomy_nml': { + 'ecc' : 0.0, + 'obliq' : 0.0, + 'per' : 0.0 + }, + +}) + +#Lets do a run! +if __name__=="__main__": + + + ds = scm_interp(filename=os.path.join(GFDL_BASE,'input/rrtm_input_files/ozone_1990.nc'), + varname='ozone_1990', + nlevels=50) + global_average_lat_lon(ds, 'ozone_1990_interp') + exp.namelist['socrates_rad_nml']['do_scm_ozone'] = True + exp.namelist['socrates_rad_nml']['scm_ozone'] = np.squeeze(ds.ozone_1990_interp_area_av.mean('time').values).tolist() + + exp.run(1, use_restart=False, num_cores=NCORES, mpirun_opts='--bind-to socket') + for i in range(2,11): + exp.run(i, num_cores=NCORES, mpirun_opts='--bind-to socket') diff --git a/exp/test_cases/column_test_case/scm_interp_routine.py b/exp/test_cases/column_test_case/scm_interp_routine.py new file mode 100644 index 000000000..a82419e53 --- /dev/null +++ b/exp/test_cases/column_test_case/scm_interp_routine.py @@ -0,0 +1,242 @@ +import xarray as xr +import numpy as np +from isca import GFDL_BASE +import os + + + +def vinterp(data, vcoord, vlevels): + + """ vertical linear interpolation, credit ExeClim/ShareCode""" + + assert (vcoord.ndim == data.ndim or vcoord.ndim == 1 and data.ndim == 4 or + vcoord.ndim == 4 and data.ndim == 1) + if vcoord.ndim == 1 and data.ndim > 1: + # This handles the case where vcoord is 1D and data is N-D + v_dim = int(np.where(np.array(data.shape) == vcoord.shape[0])[0]) + # numpy.broadcast_to only works for the last axis of an array, + # swap our shape around so that vertical dimension is last, broadcast + # vcoord to it, then swap the axes back so vcoord.shape == data.shape + data_shape = list(data.shape) + data_shape[-1], data_shape[v_dim] = data_shape[v_dim], data_shape[-1] + + vcoord = np.broadcast_to(vcoord, data_shape) + vcoord = np.swapaxes(vcoord, -1, v_dim) + + vcoord_shape = list(vcoord.shape) + vcoord_shape.pop(1) + vcoord_shape = tuple(vcoord_shape) + + valid = np.min([np.prod(vcoord_shape) - + np.sum(np.isnan(vcoord[:, 0, ...])), + np.prod(vcoord_shape) - + np.sum(np.isnan(vcoord[:, -1, ...]))]) + + if np.sum(vcoord[:, 0, ...] > vcoord[:, -1, ...]) / valid > 0.80: + # Vcoord data is decreasing on interpolation axis, (at least 80% is) + idx_gt = 1 + idx_lt = 0 + else: + # Data is increasing on interpolation axis + idx_gt = 0 + idx_lt = 1 + + if data.ndim >= vcoord.ndim: + # Handle case where data has the same dimensions or data has more + # dimensions compared to vcoord (e.g. vcoord is 4D, data is 4D, + # or vcoord is 1D, data is 4D) + out_shape = list(data.shape) + else: + # Handle case where data has fewer dimensions than vcoord + # (e.g. data is 1-D vcoord is N-D) + out_shape = list(vcoord.shape) + out_shape[1] = vlevels.shape[0] + + out_shape = tuple(out_shape) + out_data = np.zeros(out_shape) + np.nan + + for lev_idx, lev in enumerate(vlevels): + if idx_gt == 0: + # Case where vcoord data is increasing, find index where + # vcoord below [:-1] is equal or less than desired lev, and + # vcoord above [1:] is greater than lev, this means for lev + # is between these points, use weight to determine exactly where + idx = np.where(np.logical_and(vcoord[:, :-1, ...] <= lev, + vcoord[:, 1:, ...] > lev)) + + else: + # This does the same, but where vcoord is decreasing with index, + # so find where vcoord below [:-1] is greater, and vcoord above + # [1:] is less or equal + idx = np.where(np.logical_and(vcoord[:, :-1, ...] > lev, + vcoord[:, 1:, ...] <= lev)) + # Reduce diminsions of `idx` + idx = np.squeeze(idx) + # Create copies of this index, so they can be modified for + # weighting functions and output array + idx_abve = idx.copy() + idx_belw = idx.copy() + out_idx = idx.copy() + + # The interpolation axis index (1) for output + # is the level index (lev_idx) + out_idx[1, :] = lev_idx + + # Weighting function 'above' is index +1 for decreasing, + # or index +0 for decr. + idx_abve[1, :] += idx_gt + # Weighting function 'below' is index +0 for decreasing, + # or index +1 for decr. + idx_belw[1, :] += idx_lt + + # Change indicies back into tuples so + # numpy.array.__getitem__ understands them + idx_abve = tuple(idx_abve) + idx_belw = tuple(idx_belw) + out_idx = tuple(out_idx) + + # Weighting function for distance above lev + wgt1 = ((lev - vcoord[idx_belw]) / + (vcoord[idx_abve] - vcoord[idx_belw])) + + # Weighting function for distance below lev + wgt0 = 1.0 - wgt1 + + if data.ndim >= vcoord.ndim: + # Handle case where data has same or more dimensions than vcoord + out_data[out_idx] = (wgt0 * data[idx_belw] + wgt1 * data[idx_abve]) + else: + # Handle case where data has fewer dimensions than vcoord + out_data[out_idx] = (wgt0 * data[idx_belw[1]] + + wgt1 * data[idx_abve[1]]) + + return np.squeeze(out_data) + +def global_average_lat_lon(ds_in, var_name, radius=6371.e3): + + try: + ds_in['area_array'] + except KeyError: + cell_area(ds_in, radius) + + + weighted_data = ds_in[var_name]*ds_in['area_array'] + + area_average = weighted_data.mean(('lat', 'lon')) / ds_in['area_array'].mean(('lat','lon')) + + var_in_dims = ds_in[var_name].dims + + var_out_dims = tuple(x for x in var_in_dims if x!='lat' and x!='lon') + + ds_in[var_name+'_area_av'] = (var_out_dims, area_average.data) + +def cell_area(dataset_in, radius = 6371.e3): + + lonb = dataset_in['lonb'] + latb = dataset_in['latb'] + + lonb_1 = lonb[1::].values + lonb_2 = lonb[0:-1].values + + delta_lon = lonb_1 - lonb_2 + + latb_1 = latb[1::].values + latb_2 = latb[0:-1].values + + delta_lat = latb_1 - latb_2 + + dataset_in['delta_lon'] = (('lon'), delta_lon) + dataset_in['delta_lat'] = (('lat'), delta_lat) + + dataset_in['latb_1'] = (('lat'), latb_1) + dataset_in['latb_2'] = (('lat'), latb_2) + + xsize = radius*np.absolute(np.deg2rad(dataset_in['delta_lon']))*(np.sin(np.deg2rad(dataset_in['latb_1']))-np.sin(np.deg2rad(dataset_in['latb_2']))) + ysize = radius + + area_array = xsize*ysize + + dataset_in['area_array'] = (('lat','lon'), area_array.transpose('lat','lon').data) + +def pkbk(coord_option, nlevels, surf_res=.1, exponent=2.5, scale_heights=4.): + + if coord_option == 'even_sigma': + pk = np.zeros(nlevels+1) + bk = np.zeros(nlevels+1) + for lvl in range(0, nlevels): + bk[lvl] = float(lvl) / float(nlevels) + bk[-1] = 1.0 + elif coord_option == 'uneven_sigma': + pk = np.zeros(nlevels+1) + bk = np.zeros(nlevels+1) + for lvl in range(0, nlevels): + zeta = (1. - (float(lvl)/float(nlevels))) + z = surf_res*zeta + (1. - surf_res)*(zeta**exponent) + bk[lvl] = np.exp(-z * scale_heights) + bk[-1] = 1.0 + bk[0] = 0.0 + else: + print('pkbk: '+coord_option+' is NOT a coordinate option supported by this script') + + return pk, bk + +def calc_pfull(pk, bk, psurf, diff_option): + + nhalflevels = len(pk) + phalf = np.zeros(nhalflevels) + ln_top_level_factor = -1.0 + + for lvl in range(0, nhalflevels): + phalf[lvl] = pk[lvl] + bk[lvl] * psurf + + lnphalf = np.zeros(nhalflevels) + lnpfull = np.zeros(nhalflevels-1) + if diff_option == 'simmons_and_burridge': + for lvl in range(1, nhalflevels): + lnphalf[lvl] = np.log(phalf[lvl]) + + for lvl in range(1, nhalflevels-1): + alpha = 1 - phalf[lvl]*(lnphalf[lvl+1] - lnphalf[lvl])/(phalf[lvl+1]-phalf[lvl]) + lnpfull[lvl] = lnphalf[lvl+1] - alpha + lnpfull[0] = lnphalf[1] + ln_top_level_factor + lnphalf[0] = 0.0 + pfull = np.exp(lnpfull) + else: + print('calc_pfull: '+diff_option+' is NOT a vertical differencing option supported by this script') + + + return pfull + +def scm_interp(filename, varname='ozone_1990', vcoord_option='even_sigma', nlevels=None, + vert_difference_option = 'simmons_and_burridge', psurf=1.e3, pk_input=None, bk_input=None): + + # psurf in hPa + + + ds = xr.open_dataset(filename, decode_times=False) + + if vcoord_option != 'input': + pk, bk = pkbk(vcoord_option, nlevels) + else: + pk = pk_input + bk = bk_input + + pfull = calc_pfull(pk, bk, psurf, vert_difference_option) + + + data = vinterp(ds[varname].values, ds.pfull.values, pfull) + + + ds.coords['pfull_new'] = pfull + ds[varname+'_interp'] = (('time', 'pfull_new', 'lat'), data) + + + return ds + +if __name__ == "__main__": + + scm_interp(filename=os.path.join(GFDL_BASE,'input/rrtm_input_files/ozone_1990.nc'), + varname='ozone_1990', + nlevels=31) + + \ No newline at end of file diff --git a/exp/test_cases/simple_clouds/input/era_land_t42_filtered.nc b/exp/test_cases/simple_clouds/input/era_land_t42_filtered.nc new file mode 100644 index 000000000..f4ec1d2c6 Binary files /dev/null and b/exp/test_cases/simple_clouds/input/era_land_t42_filtered.nc differ diff --git a/exp/test_cases/simple_clouds/input/siconc_clim_amip.nc b/exp/test_cases/simple_clouds/input/siconc_clim_amip.nc new file mode 120000 index 000000000..2b6bbfae9 --- /dev/null +++ b/exp/test_cases/simple_clouds/input/siconc_clim_amip.nc @@ -0,0 +1 @@ +../../realistic_continents/input/siconc_clim_amip.nc \ No newline at end of file diff --git a/exp/test_cases/simple_clouds/input/sst_clim_amip.nc b/exp/test_cases/simple_clouds/input/sst_clim_amip.nc new file mode 120000 index 000000000..fc0f86745 --- /dev/null +++ b/exp/test_cases/simple_clouds/input/sst_clim_amip.nc @@ -0,0 +1 @@ +../../realistic_continents/input/sst_clim_amip.nc \ No newline at end of file diff --git a/exp/test_cases/simple_clouds/socrates_simcloud.py b/exp/test_cases/simple_clouds/socrates_simcloud.py new file mode 100644 index 000000000..7fdaba0fa --- /dev/null +++ b/exp/test_cases/simple_clouds/socrates_simcloud.py @@ -0,0 +1,325 @@ +import os +import numpy as np +from isca import SocratesCodeBase, DiagTable, Experiment, Namelist, GFDL_BASE + +NCORES = 16 +NUM_LEVELS = 25 + +base_dir = os.path.dirname(os.path.realpath(__file__)) +# a CodeBase can be a directory on the computer, +# useful for iterative development +cb = SocratesCodeBase.from_directory(GFDL_BASE) + +# or it can point to a specific git repo and commit id. +# This method should ensure future, independent, reproducibility of results. +# cb = DryCodeBase.from_repo(repo='https://github.com/isca/isca', commit='isca1.1') + +# compilation depends on computer specific settings. The $GFDL_ENV +# environment variable is used to determine which `$GFDL_BASE/src/extra/env` file +# is used to load the correct compilers. The env file is always loaded from +# $GFDL_BASE and not the checked out git repo. + +# create an Experiment object to handle the configuration of model parameters +# and output diagnostics +exp = Experiment('soc_realistic_continents_fixed_sst_with_linear_cld_scheme', codebase=cb) + +# Tell model how to write diagnostics +diag = DiagTable() +diag.add_file('atmos_monthly', 30, 'days', time_units='days') + +# Tell model which diagnostics to write + +# need at least ps, pk, bk and zsurf to do vertical interpolation onto plevels from sigma +diag.add_field('dynamics', 'ps', time_avg=True) +diag.add_field('dynamics', 'bk') +diag.add_field('dynamics', 'pk') +diag.add_field('dynamics', 'zsurf') + +diag.add_field('dynamics', 'sphum', time_avg=True) +diag.add_field('dynamics', 'ucomp', time_avg=True) +diag.add_field('dynamics', 'vcomp', time_avg=True) +diag.add_field('dynamics', 'omega', time_avg=True) +diag.add_field('dynamics', 'temp', time_avg=True) +diag.add_field('dynamics', 'vor', time_avg=True) +diag.add_field('dynamics', 'div', time_avg=True) + +diag.add_field('atmosphere', 'precipitation', time_avg=True) +diag.add_field('mixed_layer', 't_surf', time_avg=True) +diag.add_field('mixed_layer', 'ice_conc', time_avg=True) +diag.add_field('mixed_layer', 'flux_lhe', time_avg=True) +diag.add_field('mixed_layer', 'flux_t', time_avg=True) + +# all-sky radiation fluxes at TOA and surface +diag.add_field('socrates', 'soc_flux_lw', time_avg=True) +diag.add_field('socrates', 'soc_flux_sw', time_avg=True) +diag.add_field('socrates', 'soc_olr', time_avg=True) +diag.add_field('socrates', 'soc_toa_sw', time_avg=True) +diag.add_field('socrates', 'soc_toa_sw_up', time_avg=True) +diag.add_field('socrates', 'soc_toa_sw_down', time_avg=True) + +diag.add_field('socrates', 'soc_surf_flux_lw', time_avg=True) +diag.add_field('socrates', 'soc_surf_flux_sw', time_avg=True) +diag.add_field('socrates', 'soc_surf_flux_lw_down', time_avg=True) +diag.add_field('socrates', 'soc_surf_flux_sw_down', time_avg=True) + +# clear-sky radiation fluxes at TOA and surface +diag.add_field('socrates', 'soc_olr_clr', time_avg=True) +diag.add_field('socrates', 'soc_toa_sw_clr', time_avg=True) +diag.add_field('socrates', 'soc_toa_sw_up_clr', time_avg=True) +diag.add_field('socrates', 'soc_flux_lw_clr', time_avg=True) +diag.add_field('socrates', 'soc_flux_sw_clr', time_avg=True) + +diag.add_field('socrates', 'soc_surf_flux_lw_clr', time_avg=True) +diag.add_field('socrates', 'soc_surf_flux_sw_clr', time_avg=True) +diag.add_field('socrates', 'soc_surf_flux_lw_down_clr', time_avg=True) +diag.add_field('socrates', 'soc_surf_flux_sw_down_clr', time_avg=True) + +# Cloud related diagnostics +diag.add_field('cloud_simple', 'cf', time_avg=True) +diag.add_field('cloud_simple', 'reff_rad', time_avg=True) +diag.add_field('cloud_simple', 'frac_liq', time_avg=True) +diag.add_field('cloud_simple', 'qcl_rad', time_avg=True) +diag.add_field('cloud_simple', 'rh_in_cf', time_avg=True) +#diag.add_field('ls_cloud', 'rhcrit', time_avg=True) + +diag.add_field('cloud_cover', 'tot_cld_amt', time_avg=True) +diag.add_field('cloud_cover', 'high_cld_amt', time_avg=True) +diag.add_field('cloud_cover', 'mid_cld_amt', time_avg=True) +diag.add_field('cloud_cover', 'low_cld_amt', time_avg=True) +#diag.add_field('socrates', 'soc_tot_cloud_cover', time_avg=True) + +# Some intermediate outputs from marine strat clouds diag module +# diag.add_field('strat_cloud', 'eis', time_avg=True) +# diag.add_field('strat_cloud', 'ectei', time_avg=True) +# diag.add_field('strat_cloud', 'lts', time_avg=True) +# diag.add_field('strat_cloud', 'ELF', time_avg=True) +# diag.add_field('strat_cloud', 'zlcl', time_avg=True) +# diag.add_field('strat_cloud', 'z700', time_avg=True) +# diag.add_field('strat_cloud', 'gamma700', time_avg=True) +# diag.add_field('strat_cloud', 'gamma_DL', time_avg=True) +# diag.add_field('strat_cloud', 'theta', time_avg=True) +# diag.add_field('strat_cloud', 'dthdp', time_avg=True) +# diag.add_field('strat_cloud', 'beta1', time_avg=True) +# diag.add_field('strat_cloud', 'beta2', time_avg=True) +# diag.add_field('strat_cloud', 'zinv', time_avg=True) +# diag.add_field('strat_cloud', 'alpha', time_avg=True) +# diag.add_field('strat_cloud', 'DS', time_avg=True) +# diag.add_field('strat_cloud', 'IS', time_avg=True) + +exp.diag_table = diag + +# Empty the run directory ready to run +exp.clear_rundir() + +exp.inputfiles = [os.path.join(GFDL_BASE, 'input/rrtm_input_files/ozone_1990.nc'), + os.path.join(base_dir, 'input/era_land_t42_filtered.nc'), + os.path.join(base_dir, 'input/sst_clim_amip.nc'), + os.path.join(base_dir, 'input/siconc_clim_amip.nc')] + +# Define values for the 'core' namelist +exp.namelist = Namelist({ + 'main_nml':{ + 'days' : 30, + 'hours' : 0, + 'minutes' : 0, + 'seconds' : 0, + 'dt_atmos': 720, # 600 + 'current_date': [1,1,1,0,0,0], + 'calendar': 'thirty_day' + }, + + 'socrates_rad_nml': { + 'stellar_constant': 1370., + #'lw_spectral_filename': os.path.join(GFDL_BASE, 'src/atmos_param/socrates/src/trunk/data/spectra/ga7/sp_lw_ga7'), + #'sw_spectral_filename': os.path.join(GFDL_BASE, 'src/atmos_param/socrates/src/trunk/data/spectra/ga7/sp_sw_ga7'), + 'lw_spectral_filename': os.path.join(GFDL_BASE, 'src/atmos_param/socrates/src/trunk/data/spectra/ga3_1/sp_lw_ga3_1'), + 'sw_spectral_filename': os.path.join(GFDL_BASE, 'src/atmos_param/socrates/src/trunk/data/spectra/ga3_1/sp_sw_ga3_0'), + 'do_read_ozone': True, + 'ozone_file_name' : 'ozone_1990', + 'ozone_field_name': 'ozone_1990', + 'dt_rad': 4320, # 3600, + 'store_intermediate_rad': True, + 'chunk_size': 16, + 'use_pressure_interp_for_half_levels': False, + 'tidally_locked': False, + }, + + 'idealized_moist_phys_nml': { + 'do_damping': True, + 'turb': True, + 'mixed_layer_bc': True, + 'do_virtual': False, + 'do_simple': True, + 'roughness_mom' : 3.21e-05, + 'roughness_heat' : 3.21e-05, + 'roughness_moist': 3.21e-05, + 'two_stream_gray': False, # Use the grey radiation scheme + 'do_socrates_radiation': True, + 'convection_scheme': 'SIMPLE_BETTS_MILLER', # Use simple Betts miller convection + 'do_cloud_simple': True, # Turn on the cloud scheme switch + 'land_option': 'input', + 'land_file_name': 'INPUT/era_land_t42_filtered.nc', + 'land_roughness_prefactor': 10.0, + 'roughness_mom' : 2.e-04, # Ocean roughness lengths + 'roughness_heat' : 2.e-04, # Ocean roughness lengths + 'roughness_moist': 2.e-04, # Ocean roughness lengths + 'bucket': True, # Run with the bucket model + 'init_bucket_depth_land': 0.15, + }, + + # Using linear cloud scheme option + 'cloud_simple_nml': { + 'do_qcl_with_temp': True, + 'do_cloud_cover_diags': True, + 'do_add_stratocumulus': True, + 'reff_liq': 14, # Units: micron + 'reff_ice': 25, # Units: micron + 'qcl_val': 0.18, # Units: g/kg, not kg/kg + }, + + 'large_scale_cloud_nml': { + 'cf_diag_formula_name': 'linear', + 'do_adjust_cld_by_omega': False, + 'do_freezedry': True, + 'qv_polar_val': 0.006, # Units: kg/kg + 'freezedry_power': 2.5, + 'do_fitted_rhcrit': False, + 'linear_a_surf': 42, + 'linear_a_top': 13, + 'linear_power': 11, + }, + + 'marine_strat_cloud_nml': { + 'sc_diag_method': 'Park_ELF', + 'intermediate_outputs_diags': False, + 'dthdp_min_threshold': -0.08, + 'park_a': 1.3, + 'park_b': -0.1, + }, + + 'cloud_cover_diag_nml':{ + 'overlap_assumption': 'maximum-random', # or 'maximum', 'random' + 'mid_cld_bottom': 7.0e4, + 'high_cld_bottom': 4.0e4, + 'cf_min': 0, + }, + + 'vert_turb_driver_nml': { + 'do_mellor_yamada': False, # default: True + 'do_diffusivity': True, # default: False + 'do_simple': True, # default: False + 'constant_gust': 0.0, # default: 1.0 + 'use_tau': False + }, + + 'diffusivity_nml': { + 'do_entrain': True, #False, + 'do_simple': True, + }, + + 'surface_flux_nml': { + 'use_virtual_temp': False, + 'do_simple': True, + 'old_dtaudv': True, + 'land_humidity_prefactor': 1, + 'land_evap_prefactor': 0.6, + #'ocean_evap_prefactor': 1, + }, + + 'atmosphere_nml': { + 'idealized_moist_model': True + }, + + #Use a large mixed-layer depth, and the Albedo of the CTRL case in Jucker & Gerber, 2017 + 'mixed_layer_nml': { + 'tconst': 285., + 'prescribe_initial_dist': True, + 'evaporation': True, + 'depth': 20.0, # Depth of mixed layer used + 'land_option': 'input', # Tell mixed layer to get land mask from input file + 'land_h_capacity_prefactor': 0.1, # What factor to multiply mixed-layer depth by over land. + 'albedo_value': 0.12, # Ocean albedo value + 'land_albedo_prefactor': 1.3, # What factor to multiply ocean albedo by over land + 'do_qflux': False, # Don't use the prescribed analytical formula for q-fluxes + 'do_read_sst': True, # Read in sst values from input file + 'do_sc_sst': True, # Do specified ssts (need both to be true) + 'sst_file': 'sst_clim_amip', # Set name of sst input file + 'specify_sst_over_ocean_only': True, # Make sure sst only specified in regions of ocean. + # Copy from realistic_continents namelist + 'update_albedo_from_ice': True, # Use the simple ice model to update surface albedo + 'ice_albedo_value': 0.7, # What value of albedo to use in regions of ice + #'ice_concentration_threshold': 0.5, # ice concentration threshold above which to make albedo equal to ice_albedo_value + 'ice_albedo_method': 'ramp_function', + }, + + 'qe_moist_convection_nml': { + 'rhbm': 0.7, + 'Tmin': 160., + 'Tmax': 350., + }, + + 'lscale_cond_nml': { + 'do_simple': True, + 'do_evap': True, + }, + + 'sat_vapor_pres_nml': { + 'do_simple': True, + 'construct_table_wrt_liq_and_ice': True, + 'show_all_bad_values': True, + }, + + 'damping_driver_nml': { + 'do_rayleigh': True, + 'trayfric': -0.5, # neg. value: time in *days* + 'sponge_pbottom': 150., # Setting the lower pressure boundary for the model sponge layer in Pa. + 'do_conserve_energy': True, + }, + + # FMS Framework configuration + 'diag_manager_nml': { + 'mix_snapshot_average_fields': False # time avg fields are labelled with time in middle of window + }, + + 'fms_nml': { + 'domains_stack_size': 600000 # default: 0 + }, + + 'fms_io_nml': { + 'threading_write': 'single', # default: multi + 'fileset_write': 'single', # default: multi + }, + + 'spectral_dynamics_nml': { + 'damping_order': 4, + 'water_correction_limit': 200.e2, + 'reference_sea_level_press': 1.0e5, + 'num_levels': NUM_LEVELS, # How many model pressure levels to use + 'valid_range_t': [100., 800.], + 'initial_sphum': [2.e-6], + 'vert_coord_option': 'uneven_sigma', + 'surf_res': 0.03, # 0.2, # Parameter that sets the vertical distribution of sigma levels + 'scale_heights': 11.0, + 'exponent': 7.0, + 'robert_coeff': 0.03, + 'ocean_topog_smoothing': 0.8, + }, + + 'spectral_init_cond_nml':{ + 'topog_file_name': 'era_land_t42_filtered.nc', + 'topography_option': 'input', + }, +}) + + +if __name__=="__main__": + + cb.compile(debug=False) + + OVERWRITE = False + + # Set up the experiment object, with the first argument being the experiment name. + # This will be the name of the folder that the data will appear in. + exp.run(1, use_restart=False, num_cores=NCORES, overwrite_data=OVERWRITE) + for i in range(2, 25): + exp.run(i, num_cores=NCORES, overwrite_data=OVERWRITE) diff --git a/exp/test_cases/socrates_test/socrates_aquaplanet.py b/exp/test_cases/socrates_test/socrates_aquaplanet.py index cc7d68363..053c5d276 100644 --- a/exp/test_cases/socrates_test/socrates_aquaplanet.py +++ b/exp/test_cases/socrates_test/socrates_aquaplanet.py @@ -107,7 +107,6 @@ 'convection_scheme': 'SIMPLE_BETTS_MILLER', #Use simple Betts miller convection }, - 'vert_turb_driver_nml': { 'do_mellor_yamada': False, # default: True 'do_diffusivity': True, # default: False @@ -152,8 +151,8 @@ }, 'sat_vapor_pres_nml': { - 'do_simple':True, - }, + 'do_simple':True + }, 'damping_driver_nml': { 'do_rayleigh': True, @@ -199,8 +198,7 @@ #Set up the experiment object, with the first argument being the experiment name. #This will be the name of the folder that the data will appear in. - overwrite=False - - exp.run(1, use_restart=False, num_cores=NCORES, overwrite_data=overwrite)#, run_idb=True) + exp.run(1, use_restart=False, num_cores=NCORES, overwrite_data=False) + for i in range(2,121): exp.run(i, num_cores=NCORES, overwrite_data=overwrite) diff --git a/exp/test_cases/socrates_test/socrates_aquaplanet_amip_with_topo_clouds.py b/exp/test_cases/socrates_test/socrates_aquaplanet_amip_with_topo_clouds.py index d2de46e0f..9bda51c48 100644 --- a/exp/test_cases/socrates_test/socrates_aquaplanet_amip_with_topo_clouds.py +++ b/exp/test_cases/socrates_test/socrates_aquaplanet_amip_with_topo_clouds.py @@ -125,13 +125,13 @@ 'two_stream_gray': False, #Use the grey radiation scheme 'do_socrates_radiation': True, 'convection_scheme': 'SIMPLE_BETTS_MILLER', #Use simple Betts miller convection - 'do_cloud_simple': True, # this is where the clouds scheme is turned on + 'do_cloud_spookie': True, # this is where the clouds scheme is turned on 'land_option' : 'input', 'land_file_name' : 'INPUT/era-spectral7_T42_64x128.out.nc', 'land_roughness_prefactor' :10.0, }, - 'cloud_simple_nml': { #use all existing defaults as in code + 'cloud_spookie_nml': { #use all existing defaults as in code 'spookie_protocol':2 }, diff --git a/exp/test_cases/socrates_test/socrates_aquaplanet_cloud.py b/exp/test_cases/socrates_test/socrates_aquaplanet_cloud.py index ee30c5f60..b8e6f8beb 100644 --- a/exp/test_cases/socrates_test/socrates_aquaplanet_cloud.py +++ b/exp/test_cases/socrates_test/socrates_aquaplanet_cloud.py @@ -124,10 +124,10 @@ 'two_stream_gray': False, #Use the grey radiation scheme 'do_socrates_radiation': True, 'convection_scheme': 'SIMPLE_BETTS_MILLER', #Use simple Betts miller convection - 'do_cloud_simple': True # this is where the clouds scheme is turned on + 'do_cloud_spookie': True # this is where the clouds scheme is turned on }, - 'cloud_simple_nml': { #use all existing defaults as in code + 'cloud_spookie_nml': { #use all existing defaults as in code 'spookie_protocol':2 }, diff --git a/exp/test_cases/trip_test/trip_test_command_line b/exp/test_cases/trip_test/trip_test_command_line index fe7f19a87..8b93258ec 100755 --- a/exp/test_cases/trip_test/trip_test_command_line +++ b/exp/test_cases/trip_test/trip_test_command_line @@ -12,7 +12,7 @@ Default settings: """ from trip_test_functions import run_all_tests, list_all_test_cases_implemented_in_trip_test -import argparse +import argparse import sys import pdb diff --git a/exp/test_cases/trip_test/trip_test_functions.py b/exp/test_cases/trip_test/trip_test_functions.py index 5d452b7d8..0820c39f2 100644 --- a/exp/test_cases/trip_test/trip_test_functions.py +++ b/exp/test_cases/trip_test/trip_test_functions.py @@ -82,13 +82,19 @@ def get_nml_diag(test_case_name): nml_out = exp_temp.namelist codebase_to_use = IscaCodeBase - if 'socrates_aquaplanet' in test_case_name: - sys.path.insert(0, os.path.join(GFDL_BASE, 'exp/test_cases/socrates_test/')) + if 'soc_realistic_continents_fixed_sst_with_linear_cld_scheme' in test_case_name: + sys.path.insert(0, os.path.join(GFDL_BASE, 'exp/test_cases/simple_clouds/')) from socrates_aquaplanet import exp as exp_temp input_files = exp_temp.inputfiles nml_out = exp_temp.namelist codebase_to_use=SocratesCodeBase + if 'socrates_aquaplanet' in test_case_name: + sys.path.insert(0, os.path.join(GFDL_BASE, 'exp/test_cases/socrates_test/')) + from socrates_aquaplanet import exp as exp_temp + input_files = exp_temp.inputfiles + nml_out = exp_temp.namelist + if 'socrates_aquaplanet_cloud' in test_case_name: sys.path.insert(0, os.path.join(GFDL_BASE, 'exp/test_cases/socrates_test/')) from socrates_aquaplanet_cloud import exp as exp_temp @@ -152,8 +158,9 @@ def list_all_test_cases_implemented_in_trip_test(): 'MiMA', 'realistic_continents_fixed_sst', 'realistic_continents_variable_qflux', + #'simple_clouds', 'socrates_aquaplanet', - 'socrates_aquaplanet_cloud', + 'socrates_aquaplanet_cloud', 'top_down_test', 'variable_co2_grey', 'variable_co2_rrtm', diff --git a/src/atmos_column/column.F90 b/src/atmos_column/column.F90 new file mode 100644 index 000000000..c059f0fdf --- /dev/null +++ b/src/atmos_column/column.F90 @@ -0,0 +1,804 @@ +module column_mod + + +#ifdef INTERNAL_FILE_NML +use mpp_mod, only: input_nml_file +#else +use fms_mod, only: open_namelist_file +#endif + +use constants_mod, only: rdgas, rvgas, pi, grav +use column_init_cond_mod, only: column_init_cond +use column_grid_mod, only: column_grid_init, get_deg_lat, get_deg_lon, get_grid_boundaries, get_sin_lat, area_weighted_global_mean +use diag_manager_mod, only: diag_axis_init, register_diag_field, register_static_field, send_data, diag_manager_end +use field_manager_mod, only: MODEL_ATMOS +use fms_mod, only: mpp_pe, mpp_root_pe, error_mesg, NOTE, FATAL, write_version_number, stdlog, & + close_file, open_restart_file, file_exist, set_domain, & + read_data, write_data, check_nml_error, lowercase, uppercase, mpp_npes, & + field_size +use mpp_mod, only: NULL_PE, mpp_transmit, mpp_sync, mpp_send, & + mpp_broadcast, mpp_recv, mpp_max +use press_and_geopot_mod, only: press_and_geopot_init, pressure_variables, & + compute_pressures_and_heights,press_and_geopot_end +use tracer_manager_mod, only: get_number_tracers, query_method, get_tracer_index, NO_TRACER, get_tracer_names +use spec_mpp_mod, only: spec_mpp_init, get_grid_domain, grid_domain +use time_manager_mod, only: time_type, get_time, set_time, get_calendar_type, NO_CALENDAR, & + get_date, interval_alarm, operator( - ), operator( + ) +use tracer_type_mod, only: tracer_type, tracer_type_version, tracer_type_tagname + + +implicit none +private + +public :: column_init, column, column_end, column_diagnostics, get_num_levels, get_surf_geopotential, get_initial_fields, get_axis_id + +character(len=128), parameter :: version = '$Id: column.F90,v 0.1 2018/14/11 HH:MM:SS isca Exp $' +character(len=128), parameter :: tagname = '$Name: isca_201811 $' + +integer :: id_ps, id_u, id_v, id_t +integer :: id_pres_full, id_pres_half, id_zfull, id_zhalf +integer, allocatable, dimension(:) :: id_tr +character(len=8) :: mod_name = 'column' +integer, dimension(4) :: axis_id + +integer, parameter :: num_time_levels = 2 +logical :: module_is_initialized = .false. +logical :: dry_model + +type(time_type) :: Time_step, Alarm_time, Alarm_interval ! Used to determine when it is time to print global integrals. + +real, allocatable, dimension(:) :: sin_lat +real, allocatable, dimension(:,:,:,: ) :: ug, vg, tg ! last dimension is for time level +real, allocatable, dimension(:,:,:,:,:) :: grid_tracers ! 4'th dimension is for time level, last dimension is for tracer number +real, allocatable, dimension(:,: ) :: surf_geopotential +real, allocatable, dimension(:,:, : ) :: psg +real, allocatable, dimension(:) :: pk, bk + +! for lon boundaries NTL START HERE !!! +!real, allocatable, dimension(:) :: lat_boundaries_global, lon_boundaries_global + +real :: virtual_factor, dt_real +integer :: pe, npes, num_tracers, nhum, step_number +integer :: is, ie, js, je +integer :: previous, current, future + +!! NAMELIST VARIABLES + +logical :: use_virtual_temperature= .false., & + graceful_shutdown = .false. + +integer :: lon_max = 1, & ! Column + lat_max = 1, & + num_fourier = 0, & + num_spherical = 0, & + num_levels = 31, & + num_steps = 1 + +integer, dimension(2) :: print_interval=(/1,0/) + +logical :: q_decrease_only = .false. + +character(len=64) :: vert_coord_option = 'even_sigma', & + vert_difference_option = 'simmons_and_burridge', & + initial_state_option = 'default' + + +real :: scale_heights = 4., & + reference_sea_level_press = 101325., & + surf_res = .1, & + p_press = .1, & + p_sigma = .3, & + exponent = 2.5, & + initial_sphum = 0.0, & + robert_coeff = 0.0, & + raw_filter_coeff = 1.0 + +logical :: json_logging = .false. + +real, dimension(2) :: valid_range_t = (/100.,500./) + +namelist /column_nml/ use_virtual_temperature, valid_range_t, & + lon_max, lat_max, num_levels, & + print_interval, vert_coord_option, & + vert_difference_option, use_virtual_temperature, & + reference_sea_level_press, scale_heights, surf_res, & + p_press, p_sigma, exponent, & + initial_state_option, initial_sphum, graceful_shutdown, & + raw_filter_coeff, robert_coeff, json_logging, q_decrease_only + + +contains + +subroutine column_init(Time, Time_step_in, tracer_attributes, dry_model_out, nhum_out) + + type(time_type), intent(in) :: Time, Time_step_in + type(tracer_type), intent(inout), dimension(:) :: tracer_attributes + logical, intent(out) :: dry_model_out + integer, intent(out) :: nhum_out + + integer :: unit, ierr, io, ntr, nsphum, nmix_rat, seconds, days + !real :: del_lon, del_lat !!! NTL START HERE + !real :: longitude_origin_local = 0.0 + + integer :: i, j + + character(len=32) :: params + character(len=128) :: tname, longname, units + character(len=8) :: err_msg_1 + + if(module_is_initialized) return + +#ifdef INTERNAL_FILE_NML + read (input_nml_file, nml=column_nml, iostat=io) + ierr = check_nml_error(io, 'column_nml') +#else + unit = open_namelist_file() + ierr=1 + do while (ierr /= 0) + read(unit, nml=column_nml, iostat=io, end=20) + ierr = check_nml_error (io, 'column_nml') + enddo + 20 call close_file (unit) +#endif + + pe = mpp_pe() + npes = mpp_npes() + if (npes .gt. 1) then + write(err_msg_1,'(i8)') npes + call error_mesg('column_init','Can only run column model on one processor but npes = '//err_msg_1, FATAL) + endif + + call write_version_number(version, tagname) + if(mpp_pe() == mpp_root_pe()) write (stdlog(), nml=column_nml) + call write_version_number(tracer_type_version, tracer_type_tagname) + + Time_step = Time_step_in + Alarm_interval = set_time(print_interval(2), print_interval(1)) + Alarm_time = Time + Alarm_interval + + + call spec_mpp_init( num_fourier, num_spherical, lon_max, lat_max ) + + !!! MAYBE PUT ALL OF THIS IN A FILE LIKE: + call column_grid_init(lon_max, lat_max) ! and then get to it with other functions + call get_grid_domain(is, ie, js, je) + call get_number_tracers(MODEL_ATMOS, num_prog=num_tracers) + call allocate_fields + + do ntr=1,num_tracers + + call get_tracer_names(MODEL_ATMOS, ntr, tname, longname, units) + tracer_attributes(ntr)%name = lowercase(tname) + + enddo + nsphum = get_tracer_index(MODEL_ATMOS, 'sphum') + nmix_rat = get_tracer_index(MODEL_ATMOS, 'mix_rat') + + if(nsphum == NO_TRACER) then + if(nmix_rat == NO_TRACER) then + nhum = 0 + dry_model = .true. + else + nhum = nmix_rat + dry_model = .false. + endif + else + if(nmix_rat == NO_TRACER) then + nhum = nsphum + dry_model = .false. + else + call error_mesg('column_init','sphum and mix_rat cannot both be specified as tracers at the same time', FATAL) + endif + endif + dry_model_out = dry_model + nhum_out = nhum + + + call read_restart_or_do_coldstart(tracer_attributes) + + call press_and_geopot_init(pk, bk, use_virtual_temperature, vert_difference_option) + call column_diagnostics_init(Time) + + if(use_virtual_temperature) then + virtual_factor = (rvgas/rdgas) - 1.0 + end if + + allocate(sin_lat(js:je)) + call get_sin_lat(sin_lat) + + call set_domain(grid_domain) + call get_time(Time_step, seconds, days) + dt_real = 86400*days + seconds + + module_is_initialized = .true. + ! NTL: CHECK AGAINST spectral_dynamics_init TO SEE WHAT ELSE NEEDS TO BE INITIALISED + return +end subroutine column_init + +subroutine column(Time, psg_final, ug_final, vg_final, tg_final, tracer_attributes, grid_tracers_final, & + time_level_out, dt_psg, dt_ug, dt_vg, dt_tg, dt_tracers, wg_full, p_full, p_half, z_full) + +type(time_type), intent(in) :: Time +real, intent(out), dimension(is:, js: ) :: psg_final +real, intent(out), dimension(is:, js:, : ) :: ug_final, vg_final, tg_final +real, intent(out), dimension(is:, js:, :,:,:) :: grid_tracers_final +type(tracer_type),intent(inout), dimension(:) :: tracer_attributes +integer, intent(in) :: time_level_out + +real, intent(inout), dimension(is:, js: ) :: dt_psg +real, intent(inout), dimension(is:, js:, : ) :: dt_ug, dt_vg, dt_tg +real, intent(inout), dimension(is:, js:, :, :) :: dt_tracers +real, intent(out), dimension(is:, js:, : ) :: wg_full, p_full +real, intent(out), dimension(is:, js:, : ) :: p_half +real, intent(in), dimension(is:, js:, : ) :: z_full + +type(time_type) :: Time_diag + +real, dimension(is:ie, js:je, num_levels, num_tracers) :: dt_tracers_tmp +integer :: p, seconds, days +real :: delta_t +real :: extrtmp +integer :: ii,jj,kk,i1,j1,k1 +integer :: ntr + +logical :: pe_is_valid = .true. +logical :: r_pe_is_valid = .true. + +! THIS IS WHERE I NEED TO START FROM... +! TO DO: LOCAL VARIABLES, CHECK INPUTS, HOOK UP TO ATMOSPHERE.F90 AND GLOBAL VARIABLE DEFINTIONS +! DO something simple like next = current + dt_var * timestep + +if(.not.module_is_initialized) then + call error_mesg('column','column has not been initialized ', FATAL) +endif + +dt_tracers_tmp = dt_tracers + +step_loop: do step_number=1,num_steps + +if(previous == current) then + delta_t = dt_real/num_steps +else + delta_t = 2*dt_real/num_steps +endif +if(num_time_levels == 2) then + future = 3 - current +else + call error_mesg('column','Do not know how to set time pointers when num_time_levels does not equal 2',FATAL) +endif + + +call leapfrog_3d_real(tg, dt_tg, previous, current, future, delta_t, robert_coeff, raw_filter_coeff, .false.) + + + + +if(minval(tg(:,:,:,future)) < valid_range_t(1) .or. maxval(tg(:,:,:,future)) > valid_range_t(2)) then + pe_is_valid = .false. +!mj !s This doesn't affect the normal running of the code in any way. It simply allows identification of the point where temp violation has occured. + if(minval(tg(:,:,:,future)) < valid_range_t(1))then + extrtmp = minval(tg(:,:,:,future)) + else + extrtmp = maxval(tg(:,:,:,future)) + endif + do k1=1,size(tg,3) + do j1=1,size(tg,2) + do i1=1,size(tg,1) + if(tg(i1,j1,k1,future) .eq. extrtmp)then + ii=i1 + jj=j1 + kk=k1 + exit + endif + enddo + enddo + enddo + write(*,'(a,i3,a,3i3,2f10.3)')'PE, location, Textr(curr,future): ',mpp_pe()& + &,': ',ii,jj,kk& + &,tg(ii,jj,kk,current)& + &,tg(ii,jj,kk,future) + write(*,'(a,i3,a,3i3,2f10.3)')'PE, location, Uextr(curr,future): ',mpp_pe()& + &,': ',ii,jj,kk& + &,ug(ii,jj,kk,current)& + &,ug(ii,jj,kk,future) +!jm + if (.not.graceful_shutdown) then + call error_mesg('column','temperatures out of valid range', FATAL) + endif +endif + +! synchronisation between nodes. THIS WILL SLOW DOWN THE RUN but ensures +! all partially complete diagnostics are written to netcdf output. +if (graceful_shutdown) then + if (pe == mpp_root_pe()) then + do p = 0, npes-1 + ! wait for all nodes to report they are error free + if (p.ne.pe) then + call mpp_recv(r_pe_is_valid, p) + if (.not.r_pe_is_valid .or. .not.pe_is_valid) then + ! node reports error, tell all the others to shutdown + r_pe_is_valid = .false. + exit + end if + end if + end do + ! tell all the nodes to continue, or not + do p =0, npes-1 + if (p.ne.pe) call mpp_send(r_pe_is_valid, p) + end do + else + call mpp_send(pe_is_valid, mpp_root_pe()) + ! wait to hear back from root that all are ok to continue + call mpp_recv(r_pe_is_valid, mpp_root_pe()) + endif + if (.not.r_pe_is_valid) then + ! one of the nodes has broken the condition. gracefully shutdown diagnostics + ! and then raise a fatal error after all have hit the sync point. + call diag_manager_end(Time) + call mpp_sync() + call error_mesg('column','temperatures out of valid range', FATAL) + endif +endif + +! NTL: Need to write a different version of this which uses the leapfrog below... +do ntr = 1, num_tracers + call leapfrog_3d_real(grid_tracers(:,:,:,:,ntr),dt_tracers_tmp(:,:,:,ntr),previous,current,future,delta_t,tracer_attributes(ntr)%robert_coeff, raw_filter_coeff, q_decrease_only) +enddo + + +previous = current +current = future + +call get_time(Time, seconds, days) +seconds = seconds + step_number*int(dt_real/2) +Time_diag = set_time(seconds, days) + +enddo step_loop + +psg_final = psg(:,:, previous) +ug_final = ug(:,:,:,previous) +vg_final = vg(:,:,:,previous) +tg_final = tg(:,:,:,current) +grid_tracers_final(:,:,:,time_level_out,:) = grid_tracers(:,:,:,current,:) + +return +end subroutine column + +subroutine column_diagnostics_init(Time) + + type(time_type), intent(in) :: Time + real, dimension(lon_max ) :: lon + real, dimension(lon_max+1) :: lonb + real, dimension(lat_max ) :: lat + real, dimension(lat_max+1) :: latb + real, dimension(num_levels) :: p_full, ln_p_full + real, dimension(num_levels+1) :: p_half, ln_p_half + integer, dimension(3) :: axes_3d_half, axes_3d_full + integer :: id_lonb, id_latb, id_phalf, id_lon, id_lat, id_pfull + integer :: id_pk, id_bk, id_zsurf, ntr + real :: rad_to_deg + logical :: used + real,dimension(2) :: vrange + character(len=128) :: tname, longname, units + + ! NTL: NEED TO DO THIS + + vrange = (/ -400., 400. /) + + rad_to_deg = 180./pi + call get_grid_boundaries(lonb,latb,global=.true.) + call get_deg_lon(lon) + call get_deg_lat(lat) + + id_lonb=diag_axis_init('lonb', rad_to_deg*lonb, 'degrees_E', 'x', 'longitude edges', set_name=mod_name, Domain2=grid_domain) + id_latb=diag_axis_init('latb', rad_to_deg*latb, 'degrees_N', 'y', 'latitude edges', set_name=mod_name, Domain2=grid_domain) + id_lon =diag_axis_init('lon', lon, 'degrees_E', 'x', 'longitude', set_name=mod_name, Domain2=grid_domain, edges=id_lonb) + id_lat =diag_axis_init('lat', lat, 'degrees_N', 'y', 'latitude', set_name=mod_name, Domain2=grid_domain, edges=id_latb) + + call pressure_variables(p_half, ln_p_half, p_full, ln_p_full, reference_sea_level_press) + p_half = .01*p_half + p_full = .01*p_full + id_phalf = diag_axis_init('phalf',p_half,'hPa','z','approx half pressure level',direction=-1,set_name=mod_name) + id_pfull = diag_axis_init('pfull',p_full,'hPa','z','approx full pressure level',direction=-1,set_name=mod_name,edges=id_phalf) + + axes_3d_half = (/ id_lon, id_lat, id_phalf /) + axes_3d_full = (/ id_lon, id_lat, id_pfull /) + axis_id(1) = id_lon + axis_id(2) = id_lat + axis_id(3) = id_pfull + axis_id(4) = id_phalf + + id_pk = register_static_field(mod_name, 'pk', (/id_phalf/), 'vertical coordinate pressure values', 'pascals') + id_bk = register_static_field(mod_name, 'bk', (/id_phalf/), 'vertical coordinate sigma values', 'none') + id_zsurf = register_static_field(mod_name, 'zsurf', (/id_lon,id_lat/), 'geopotential height at the surface', 'm') + + if(id_pk > 0) used = send_data(id_pk, pk, Time) + if(id_bk > 0) used = send_data(id_bk, bk, Time) + if(id_zsurf > 0) used = send_data(id_zsurf, surf_geopotential/grav, Time) + + id_ps = register_diag_field(mod_name, & + 'ps', (/id_lon,id_lat/), Time, 'surface pressure', 'pascals') + + id_u = register_diag_field(mod_name, & + 'ucomp', axes_3d_full, Time, 'zonal wind component', 'm/sec', range=vrange) + + id_v = register_diag_field(mod_name, & + 'vcomp', axes_3d_full, Time, 'meridional wind component', 'm/sec', range=vrange) + + id_t = register_diag_field(mod_name, & + 'temp', axes_3d_full, Time, 'temperature', 'deg_k', range=valid_range_t) + + id_pres_full = register_diag_field(mod_name, & + 'pres_full', axes_3d_full, Time, 'pressure at full model levels', 'pascals') + + id_pres_half = register_diag_field(mod_name, & + 'pres_half', axes_3d_half, Time, 'pressure at half model levels', 'pascals') + + id_zfull = register_diag_field(mod_name, & + 'height', axes_3d_full, Time, 'geopotential height at full model levels','m') + + id_zhalf = register_diag_field(mod_name, & + 'height_half', axes_3d_half, Time, 'geopotential height at half model levels','m') + + allocate(id_tr(num_tracers)) + do ntr=1,num_tracers + call get_tracer_names(MODEL_ATMOS, ntr, tname, longname, units) + id_tr(ntr) = register_diag_field(mod_name, tname, axes_3d_full, Time, longname, units) + enddo + + return +end subroutine column_diagnostics_init + + + + +subroutine column_diagnostics(Time, p_surf, u_grid, v_grid, t_grid, wg_full, tr_grid, time_level) + + type(time_type), intent(in) :: Time + real, intent(in), dimension(is:, js:) :: p_surf + real, intent(in), dimension(is:, js:, :) :: u_grid, v_grid, t_grid, wg_full + real, intent(in), dimension(is:, js:, :, :, :) :: tr_grid + integer, intent(in) :: time_level + + real, dimension(is:ie, js:je, num_levels) :: ln_p_full, p_full, z_full + real, dimension(is:ie, js:je, num_levels+1) :: ln_p_half, p_half, z_half + logical :: used + integer :: ntr, i, j, k + character(len=8) :: err_msg_1, err_msg_2 + + if(id_ps > 0) used = send_data(id_ps, p_surf, Time) + if(id_u > 0) used = send_data(id_u, u_grid, Time) + if(id_v > 0) used = send_data(id_v, v_grid, Time) + if(id_t > 0) used = send_data(id_t, t_grid, Time) + + if(id_zfull > 0 .or. id_zhalf > 0) then + call compute_pressures_and_heights(t_grid, p_surf, surf_geopotential, z_full, z_half, p_full, p_half) + else if(id_pres_half > 0 .or. id_pres_full > 0) then + call pressure_variables(p_half, ln_p_half, p_full, ln_p_full, p_surf) + endif + + if(id_zfull > 0) used = send_data(id_zfull, z_full, Time) + if(id_zhalf > 0) used = send_data(id_zhalf, z_half, Time) + if(id_pres_full>0) used = send_data(id_pres_full, p_full, Time) + if(id_pres_half>0) used = send_data(id_pres_half, p_half, Time) + + if(size(tr_grid,5) /= num_tracers) then + write(err_msg_1,'(i8)') size(tr_grid,5) + write(err_msg_2,'(i8)') num_tracers + call error_mesg('column_diagnostics','size(tracers)='//err_msg_1//' Should be='//err_msg_2, FATAL) + endif + do ntr=1,num_tracers + if(id_tr(ntr) > 0) used = send_data(id_tr(ntr), tr_grid(:,:,:,time_level,ntr), Time) + enddo + + + if(interval_alarm(Time, Time_step, Alarm_time, Alarm_interval)) then + call global_integrals(Time, p_surf, u_grid, v_grid, t_grid, wg_full, tr_grid(:,:,:,time_level,:)) + endif + + return + end subroutine column_diagnostics + + subroutine column_end(tracer_attributes, Time) + + type(tracer_type), intent(in), dimension(:) :: tracer_attributes + type(time_type), intent(in), optional :: Time + integer :: ntr, nt + character(len=64) :: file, tr_name + + if(.not.module_is_initialized) return + + file='RESTART/column_model.res' + call write_data(trim(file), 'previous', previous, no_domain=.true.) + call write_data(trim(file), 'current', current, no_domain=.true.) + call write_data(trim(file), 'pk', pk, no_domain=.true.) + call write_data(trim(file), 'bk', bk, no_domain=.true.) + do nt=1,num_time_levels + call write_data(trim(file), 'ug', ug(:,:,:,nt), grid_domain) + call write_data(trim(file), 'vg', vg(:,:,:,nt), grid_domain) + call write_data(trim(file), 'tg', tg(:,:,:,nt), grid_domain) + call write_data(trim(file), 'psg', psg(:,:, nt), grid_domain) + do ntr = 1,num_tracers + tr_name = trim(tracer_attributes(ntr)%name) + call write_data(trim(file), trim(tr_name), grid_tracers(:,:,:,nt,ntr), grid_domain) + enddo + enddo + call write_data(trim(file), 'surf_geopotential', surf_geopotential, grid_domain) + + deallocate(ug, vg, tg, psg) + deallocate(sin_lat) + deallocate(pk, bk) + deallocate(surf_geopotential) + deallocate(grid_tracers) + + call column_diagnostics_end + call press_and_geopot_end + call set_domain(grid_domain) + module_is_initialized = .false. + + return + end subroutine column_end + + subroutine column_diagnostics_end + + if(.not.module_is_initialized) return + + deallocate(id_tr) + + return + end subroutine column_diagnostics_end + + subroutine global_integrals(Time, p_surf, u_grid, v_grid, t_grid, wg_full, tr_grid) + type(time_type), intent(in) :: Time + real, intent(in), dimension(is:ie, js:je) :: p_surf + real, intent(in), dimension(is:ie, js:je, num_levels) :: u_grid, v_grid, t_grid, wg_full + real, intent(in), dimension(is:ie, js:je, num_levels, num_tracers) :: tr_grid + integer :: year, month, days, hours, minutes, seconds + character(len=4), dimension(12) :: month_name + + real, dimension(is:ie, js:je, num_levels) :: speed + real :: max_speed, avgT + + month_name=(/' Jan',' Feb',' Mar',' Apr',' May',' Jun',' Jul',' Aug',' Sep',' Oct',' Nov',' Dec'/) + + speed = sqrt(u_grid*u_grid + v_grid*v_grid) + max_speed = maxval(speed) + call mpp_max(max_speed) + + avgT = area_weighted_global_mean(t_grid(:,:, num_levels)) + + if(mpp_pe() == mpp_root_pe()) then + if(get_calendar_type() == NO_CALENDAR) then + call get_time(Time, seconds, days) + if (json_logging) then + write(*, 300) days, seconds, max_speed, avgT + else + write(*,100) days, seconds + end if + else + call get_date(Time, year, month, days, hours, minutes, seconds) + if (json_logging) then + write(*,400) year, month, days, hours, minutes, seconds, max_speed, avgT + else + write(*,200) year, month_name(month), days, hours, minutes, seconds + end if + endif + endif + 100 format(' Integration completed through',i6,' days',i6,' seconds') + 200 format(' Integration completed through',i5,a4,i3,2x,i2,':',i2,':',i2) + 300 format(1x, '{"day":',i6,2x,',"second":', i6, & + 2x,',"max_speed":',e13.6,3x,',"avg_T":',e13.6, 3x '}') + 400 format(1x, '{"date": "',i0.4,'-',i0.2,'-',i0.2, & + '", "time": "', i0.2,':', i0.2,':', i0.2, '", "max_speed":',f6.1,3x,',"avg_T":',f6.1, 3x '}') + + end subroutine global_integrals + + + + +subroutine allocate_fields + + allocate (psg (is:ie, js:je, num_time_levels)) + allocate (ug (is:ie, js:je, num_levels, num_time_levels)) + allocate (vg (is:ie, js:je, num_levels, num_time_levels)) + allocate (tg (is:ie, js:je, num_levels, num_time_levels)) + + allocate (pk(num_levels+1), bk(num_levels+1)) + + allocate (surf_geopotential(is:ie, js:je)) + + allocate (grid_tracers(is:ie, js:je, num_levels, num_time_levels, num_tracers)) + + ! Filling allocatable arrays with zeros immediately after allocation facilitates code debugging + psg=0.; ug=0.; vg=0.; tg=0. + pk=0.; bk=0.; surf_geopotential=0.; grid_tracers=0. + + return +end subroutine allocate_fields + +subroutine get_num_levels(num_levels_out) + integer, intent(out) :: num_levels_out + + if(.not.module_is_initialized) then + call error_mesg('get_num_levels', 'column_init has not been called.', FATAL) + endif + + num_levels_out = num_levels + + return +end subroutine get_num_levels + +subroutine get_surf_geopotential(surf_geopotential_out) + real, intent(out), dimension(:,:) :: surf_geopotential_out + character(len=64) :: chtmp='shape(surf_geopotential)= should be ' + + if(.not.module_is_initialized) then + call error_mesg('get_surf_geopotential', 'column_init has not been called.', FATAL) + endif + + if(any(shape(surf_geopotential_out) /= shape(surf_geopotential))) then + write(chtmp(26:37),'(3i4)') shape(surf_geopotential_out) + write(chtmp(50:61),'(3i4)') shape(surf_geopotential) + call error_mesg('get_surf_geopotential', 'surf_geopotential has wrong shape. '//chtmp, FATAL) + endif + + surf_geopotential_out = surf_geopotential + + return +end subroutine get_surf_geopotential + + + +subroutine read_restart_or_do_coldstart(tracer_attributes) + + ! For backward compatibility, this routine has the capability + ! to read native data restart files written by inchon code. + + type(tracer_type), intent(inout), dimension(:) :: tracer_attributes + + integer :: m, n, k, nt, ntr + integer, dimension(4) :: siz + character(len=64) :: file, tr_name + character(len=4) :: ch1,ch2,ch3,ch4,ch5,ch6 + + file = 'INPUT/column_model.res.nc' + if(file_exist(trim(file))) then + call field_size(trim(file), 'ug', siz) + if(lon_max /= siz(1) .or. lat_max /= siz(2)) then + write(ch1,'(i4)') siz(1) + write(ch2,'(i4)') siz(2) + write(ch3,'(i4)') lon_max + write(ch4,'(i4)') lat_max + call error_mesg('column_init','Resolution of restart data does not match resolution specified on namelist.'// & + ' Restart data: lon_max='//ch1//', lat_max='//ch2//' Namelist: lon_max='//ch3//', lat_max='//ch4, FATAL) + endif + call read_data(trim(file), 'previous', previous, no_domain=.true.) + call read_data(trim(file), 'current', current, no_domain=.true.) + call read_data(trim(file), 'pk', pk, no_domain=.true.) + call read_data(trim(file), 'bk', bk, no_domain=.true.) + do nt=1,num_time_levels + call read_data(trim(file), 'ug', ug(:,:,:,nt), grid_domain, timelevel=nt) + call read_data(trim(file), 'vg', vg(:,:,:,nt), grid_domain, timelevel=nt) + call read_data(trim(file), 'tg', tg(:,:,:,nt), grid_domain, timelevel=nt) + call read_data(trim(file), 'psg', psg(:,:, nt), grid_domain, timelevel=nt) + do ntr = 1,num_tracers + tr_name = trim(tracer_attributes(ntr)%name) + call read_data(trim(file), trim(tr_name), grid_tracers(:,:,:,nt,ntr), grid_domain, timelevel=nt) + enddo ! loop over tracers + enddo ! loop over time levels + call read_data(trim(file), 'surf_geopotential', surf_geopotential, grid_domain) + + else + do ntr = 1,num_tracers + if(trim(tracer_attributes(ntr)%name) == 'sphum') then + grid_tracers(:,:,:,:,ntr) = initial_sphum + else if(trim(tracer_attributes(ntr)%name) == 'mix_rat') then + grid_tracers(:,:,:,:,ntr) = 0. + else + grid_tracers(:,:,:,:,ntr) = 0. + endif + enddo + + previous = 1 + current = 1 + call column_init_cond(initial_state_option, tracer_attributes, reference_sea_level_press, use_virtual_temperature,& + vert_coord_option, vert_difference_option, scale_heights, surf_res, p_press, p_sigma, & + exponent, pk, bk, ug(:,:,:,1), vg(:,:,:,1), tg(:,:,:,1), psg(:,:,1), & + grid_tracers(:,:,:,1,:), surf_geopotential) ! NTL REMOVED LAT AND LON BOUNDARIES + + ug (:,:,:,2) = ug (:,:,:,1) + vg (:,:,:,2) = vg (:,:,:,1) + tg (:,:,:,2) = tg (:,:,:,1) + psg (:,:, 2) = psg (:,:, 1) + grid_tracers(:,:,:,2,:) = grid_tracers(:,:,:,1,:) + + + endif + + return +end subroutine read_restart_or_do_coldstart + +subroutine get_initial_fields(ug_out, vg_out, tg_out, psg_out, grid_tracers_out) + real, intent(out), dimension(:,:,:) :: ug_out, vg_out, tg_out + real, intent(out), dimension(:,:) :: psg_out + real, intent(out), dimension(:,:,:,:) :: grid_tracers_out + + if(.not.module_is_initialized) then + call error_mesg('column, get_initial_fields','column has not been initialized',FATAL) + endif + + if(previous /= 1 .or. current /= 1) then + call error_mesg('column, get_initial_fields','This routine may be called only to get the& + & initial values after a cold_start',FATAL) + endif + + ug_out = ug(:,:,:,1) + vg_out = vg(:,:,:,1) + tg_out = tg(:,:,:,1) + psg_out = psg(:,:, 1) + grid_tracers_out = grid_tracers(:,:,:,1,:) + + end subroutine get_initial_fields + + function get_axis_id() + integer, dimension(4) :: get_axis_id + + if(.not.module_is_initialized) then + call error_mesg('get_axis_id','column_diagnostics_init has not been called.', FATAL) + endif + get_axis_id = axis_id + return + end function get_axis_id + + + + + subroutine leapfrog_3d_real(a, dt_a, previous, current, future, delta_t, robert_coeff, raw_filter_coeff, q_decrease_only) + + real, intent(inout), dimension(:,:,:,:) :: a + real, intent(in), dimension(:,:,: ) :: dt_a + integer, intent(in) :: previous, current, future + real, intent(in) :: delta_t, robert_coeff, raw_filter_coeff + logical, intent(in) :: q_decrease_only + + real, dimension(size(dt_a,1),size(dt_a,2),size(dt_a,3)) :: prev_curr_part_raw_filter + + integer :: i,j,k + + + prev_curr_part_raw_filter=a(:,:,:,previous) - 2.0*a(:,:,:,current) !st Defined at the start to get unmodified value of a(:,:,:,current). + + if(previous == current) then + a(:,:,:,future ) = a(:,:,:,previous) + delta_t*dt_a + a(:,:,:,current) = a(:,:,:,current ) + robert_coeff * (prev_curr_part_raw_filter + a(:,:,:,future ))*raw_filter_coeff + else + a(:,:,:,current) = a(:,:,:,current ) + robert_coeff * (prev_curr_part_raw_filter )*raw_filter_coeff + a(:,:,:,future ) = a(:,:,:,previous) + delta_t * dt_a + a(:,:,:,current) = a(:,:,:,current ) + robert_coeff * a(:,:,:,future)*raw_filter_coeff + endif + + a(:,:,:,future ) = a(:,:,:,future ) + robert_coeff * (prev_curr_part_raw_filter + a(:,:,:,future )) * (raw_filter_coeff-1.0) + + if (q_decrease_only) then + do i=1, size(dt_a,1) + do j=1, size(dt_a,2) + do k=size(dt_a,3)-1, 1, -1 + if (a(1,1,k,future) > a(1,1,k+1,future)) then + a(:,:,k,future) = a(:,:,k+1,future) + endif + end do + end do + end do + endif + + + + !st RAW filter (see e.g. Williams 2011 10.1175/2010MWR3601.1) conserves 3-time-level mean in leap-frog integrations, improving amplitude accuracy of leap-frog scheme from first to third order). + + return + end subroutine leapfrog_3d_real + + + + +end module column_mod \ No newline at end of file diff --git a/src/atmos_column/column_grid.F90 b/src/atmos_column/column_grid.F90 new file mode 100644 index 000000000..587ca9cd3 --- /dev/null +++ b/src/atmos_column/column_grid.F90 @@ -0,0 +1,461 @@ +module column_grid_mod + + +#ifdef INTERNAL_FILE_NML + use mpp_mod, only: input_nml_file +#else + use fms_mod, only: open_namelist_file +#endif + +use fms_mod, only: mpp_pe, mpp_root_pe, error_mesg, FATAL, write_version_number, check_nml_error, stdlog +use mpp_mod, only: mpp_error +use mpp_domains_mod, only: domain1D, mpp_get_compute_domains, mpp_get_domain_components, mpp_get_layout, mpp_global_field +use constants_mod, only: pi +use spec_mpp_mod, only: get_grid_domain, grid_domain, get_spec_domain + +implicit none +private + +character(len=128), parameter :: version = '$Id: column_grid.F90,v 0.1 2018/16/11 HH:MM:SS isca Exp $' +character(len=128), parameter :: tagname = '$Name: isca_201811 $' + +public :: column_grid_init +public :: get_sin_lat, area_weighted_global_mean !, got_cos_lat, getcosm_lat, get_cosm2_lat +public :: get_deg_lat, get_deg_lon, get_grid_boundaries +public :: get_lon_max, get_lat_max!, get_longitude_origin + +integer :: num_lon, num_lat, lat_max +real :: longitude_origin_local +logical :: module_is_initialized = .false. + +real, allocatable, dimension(:) :: deg_lon, deg_lat +real, allocatable, dimension(:) :: sin_lat +real, allocatable, dimension(:) :: cos_lat +real, allocatable, dimension(:) :: cosm_lat +real, allocatable, dimension(:) :: cosm2_lat +real, allocatable, dimension(:) :: wts_lat +real, allocatable, dimension(:) :: sin_hem +real, allocatable, dimension(:) :: wts_hem +real, allocatable, dimension(:) :: lon_boundaries_global +real, allocatable, dimension(:) :: lat_boundaries_global +real :: global_sum_of_wts +real :: sum_wts + +logical :: south_to_north_local + +integer :: is, ie, js, je + + +!! namelist parameters + +real :: lat_value = 0.0 +logical :: global_average = .false. + +namelist / column_grid_nml / lat_value, global_average + +contains + +subroutine column_grid_init(num_lon_in, num_lat_in, longitude_origin, south_to_north) + + integer, intent(in) :: num_lon_in, num_lat_in + real, intent(in), optional :: longitude_origin + logical, intent(in), optional :: south_to_north + + real, parameter :: total_degrees = 360. + real :: del_lat, del_lon + integer :: i, j + integer :: unit, ierr, io + + if(module_is_initialized) return + +#ifdef INTERNAL_FILE_NML + read (input_nml_file, nml=column_grid_nml, iostat=io) + ierr = check_nml_error(io, 'column_grid_nml') +#else + unit = open_namelist_file() + ierr=1 + do while (ierr /= 0) + read(unit, nml=column_grid_nml, iostat=io, end=20) + ierr = check_nml_error (io, 'column_grid_nml') + enddo +20 call close_file (unit) +#endif + + call write_version_number(version, tagname) + if(mpp_pe() == mpp_root_pe()) write (stdlog(), nml=column_grid_nml) + + + if(num_lon_in .eq. 0) then + call error_mesg('column_grid_init','num_lon_in cannot be zero', FATAL) + end if + num_lon = num_lon_in + + if(num_lat_in .eq. 0) then + call error_mesg('column_grid_init','num_lat_in cannot be zero', FATAL) + end if + num_lat = num_lat_in + lat_max = num_lat + + if(present(longitude_origin)) then + longitude_origin_local = longitude_origin + else + longitude_origin_local = 0.0 + end if + + call get_grid_domain(is, ie, js, je) + + allocate(deg_lon(num_lon)) + do i=1, num_lon + deg_lon(i) = 180*longitude_origin_local/pi + (i-1) * total_degrees / float(num_lon) + if(deg_lon(i) .ge. total_degrees) then + deg_lon(i) = deg_lon(i) - total_degrees + endif + if(deg_lon(i) .lt. 0.0) then + deg_lon(i) = deg_lon(i) + total_degrees + endif + end do + + allocate(deg_lat(num_lat)) + allocate (sin_lat(lat_max)) + allocate (cos_lat(lat_max)) + allocate (cosm_lat(lat_max)) + allocate (cosm2_lat(lat_max)) + allocate (wts_lat(lat_max)) + if(global_average) then + if ((num_lat .ne. 1) .or.(num_lon .ne. 1)) then + call error_mesg('column_grid_init', 'cannot set global_average = True with num_lat or num_lon .ne. 1', FATAL) + endif + deg_lat(num_lat) = 180*acos(pi / 4)/pi ! value that yields the fraction needed for insolation at this latitude to be equal to that of the global average (S/4) + sin_lat = sin(pi / 180 * deg_lat ) + cos_lat = cos(pi / 180 * deg_lat ) + wts_lat = 1. ! need to set wts lat such that it tricks interpolator_mod into doing the right thing.... + else + if(num_lat .eq. 1) then + deg_lat(num_lat) = lat_value + sin_lat = sin(pi / 180 * deg_lat ) + cos_lat = cos(pi / 180 * deg_lat ) + wts_lat = 1. + else + allocate (sin_hem(lat_max/2)) + allocate (wts_hem(lat_max/2)) + ! del_lat = 90. / (num_lat) + + ! deg_lat(1) = -90 + del_lat + ! do i = 2, num_lat + ! deg_lat(i) = deg_lat(i-1) + del_lat + ! enddo + if(present(south_to_north)) then + south_to_north_local = south_to_north + else + south_to_north_local = .true. + endif + ! if (.not. south_to_north_local) then + ! deg_lat(:) = - deg_lat(:) + ! endif + + call compute_gaussian(sin_hem, wts_hem, lat_max/2) + + if(south_to_north_local) then + sin_lat(1:lat_max/2) = - sin_hem + else + sin_lat(1:lat_max/2) = sin_hem + end if + + do j=1,lat_max/2 + sin_lat(lat_max+1-j) = - sin_lat(j) + wts_lat(j) = wts_hem(j) + wts_lat(lat_max+1-j) = wts_hem(j) + end do + + cos_lat = sqrt(1-sin_lat*sin_lat) + deg_lat = asin(sin_lat)*180.0/pi + endif + endif + cosm_lat = 1./cos_lat + cosm2_lat = 1./(cos_lat*cos_lat) + + ! this is done in transforms mod when spectral_dynamics is used + allocate( lon_boundaries_global(num_lon+1) ) + allocate( lat_boundaries_global(lat_max+1) ) + lat_boundaries_global(1) = 0.0 + if (num_lat .eq. 1) then + lat_boundaries_global(2) = .5*pi + else + sum_wts = 0. + do j=1,lat_max-1 + sum_wts = sum_wts + wts_lat(j) + lat_boundaries_global(j+1) = asin(sum_wts-1.) + end do + lat_boundaries_global(lat_max+1) = .5*pi + lat_boundaries_global(1) = -0.5*pi + if (.not. south_to_north_local) then + lat_boundaries_global(:) = -lat_boundaries_global(:) + end if + del_lon = 2*pi/num_lon + do i=1,num_lon+1 + lon_boundaries_global(i) = longitude_origin_local + (i-1.5)*del_lon + end do + endif + + global_sum_of_wts = sum(wts_lat) + + module_is_initialized = .true. + + return + +end subroutine column_grid_init + + +subroutine compute_gaussian(sin_hem_lcl, wts_hem_lcl, n_hem_lcl) + !---------------------------------------------------------------------- + ! + ! reference: + ! press, h. william, et. al., numerical recipes (fortran version), + ! cambridge, england: cambridge university press (1990) + ! + !------------------------------------------------------------------------ + + integer, intent (in) :: n_hem_lcl + real, intent (out), dimension(n_hem_lcl) :: sin_hem_lcl, wts_hem_lcl + + real :: converg + integer :: itermax + integer :: i, iter, j, n, nprec + real :: pp, p1, p2, p3, z, z1 + + + ! must use a more relaxed convergence criteria on the + ! workstations than that for the cray T90 + ! fez code is commented out + + !if(kind(converg).eq.8) then + ! converg = 1.0E-15 + !else if(kind(converg).eq.4) then + ! converg = 1.0E-7 + !else + ! call error_mesg('compute_gaussian','dont know what value to use for converg', FATAL) + !end if + + ! The 2 lines of code below will yeild a different result than the fez code + ! when kind(converg)=4. converg is 1.0E-6 instead of 1.0E-7 + ! This should be investigated further, but it's OK for now because it yeilds + ! the same result on the HPCS. -- pjp + nprec = precision(converg) + converg = .1**nprec + + + itermax = 10 + + n=2*n_hem_lcl + do i=1,n_hem_lcl + z = cos(pi*(i - 0.25)/(n + 0.5)) + do iter=1,itermax + p1 = 1.0 + p2 = 0.0 + + do j=1,n + p3 = p2 + p2 = p1 + p1 = ((2.0*j - 1.0)*z*p2 - (j - 1.0)*p3)/j + end do + + pp = n*(z*p1 - p2)/(z*z - 1.0E+00) + z1 = z + z = z1 - p1/pp + if(ABS(z - z1) .LT. converg) go to 10 + end do + call error_mesg('column_grid, compute_gaussian','abscissas failed to converge in itermax iterations', FATAL) + + 10 continue + + sin_hem_lcl (i) = z + wts_hem_lcl (i) = 2.0/((1.0 - z*z)*pp*pp) + + end do + +end subroutine compute_gaussian + + +subroutine get_deg_lon(deg_lon_out) + + real, intent (out), dimension(:) :: deg_lon_out + character(len=8) :: chtmp1, chtmp2 + + if(.not.module_is_initialized) then + call error_mesg('column_grid','module column_grid not initialized', FATAL) + end if + if(size(deg_lon_out,1).ne.num_lon) then + write(chtmp1,'(i8)') size(deg_lon_out,1) + write(chtmp2,'(i8)') num_lon + call error_mesg('column_grid', & + 'size of deg_lon does not equal num_lon. size(deg_lon)='//chtmp1//' num_lon='//chtmp2, FATAL) + end if + + deg_lon_out(:) = deg_lon(:) + + return +end subroutine get_deg_lon + +subroutine get_deg_lat(deg_lat_out) + !----------------------------------------------------------------------- + + real, intent (out), dimension(:) :: deg_lat_out + + if(.not. module_is_initialized) then + call error_mesg('column_grid','module column_grid is not initialized', FATAL) + end if + + if(size(deg_lat_out,1).eq.lat_max) then + deg_lat_out = deg_lat + else !assume grid compute domain + deg_lat_out = deg_lat(js:je) + end if + + return +end subroutine get_deg_lat + +subroutine get_grid_boundaries(lon_boundaries, lat_boundaries,global) + !------------------------------------------------------------------------- + + real, intent(out), dimension(:) :: lon_boundaries, lat_boundaries + logical,intent(in),optional :: global + + logical :: global_tmp + character(len=3) :: chtmp1, chtmp2 + + if(.not.module_is_initialized) then + call error_mesg('get_grid_boundaries','column_grid module is not initialized', FATAL) + end if + + if (present(global)) then + global_tmp = global + else + global_tmp = .false. + endif + + if (.not. global_tmp) then + if(size(lon_boundaries,1) /= ie-is+2) then + write(chtmp1,'(i3)') size(lon_boundaries,1) + write(chtmp2,'(i3)') ie-is+2 + call error_mesg('get_grid_boundaries','size(lon_boundaries) is incorrect. size(lon_boundaries)=' & + & //chtmp1//' Should be'//chtmp2, FATAL) + endif + + if(size(lat_boundaries,1) /= je-js+2) then + write(chtmp1,'(i3)') size(lat_boundaries,1) + write(chtmp2,'(i3)') je-js+2 + call error_mesg('get_grid_boundaries','size(lat_boundaries) is incorrect. size(lat_boundaries)=' & + & //chtmp1//' Should be'//chtmp2, FATAL) + endif + + else !global call + if(size(lon_boundaries,1) /= num_lon+1) then + write(chtmp1,'(i3)') size(lon_boundaries,1) + write(chtmp2,'(i3)') num_lon+1 + call error_mesg('get_grid_boundaries','size(lon_boundaries) is incorrect. size(lon_boundaries)=' & + & //chtmp1//' Should be'//chtmp2, FATAL) + endif + + if(size(lat_boundaries,1) /= lat_max+1) then + write(chtmp1,'(i3)') size(lat_boundaries,1) + write(chtmp2,'(i3)') lat_max+1 + call error_mesg('get_grid_boundaries','size(lat_boundaries) is incorrect. size(lat_boundaries)=' & + & //chtmp1//' Should be'//chtmp2, FATAL) + endif + endif + + if (global_tmp) then + lon_boundaries = lon_boundaries_global + lat_boundaries = lat_boundaries_global + else + lon_boundaries = lon_boundaries_global(is:ie+1) + lat_boundaries = lat_boundaries_global(js:je+1) + endif + return + end subroutine get_grid_boundaries + + subroutine get_sin_lat(sin_lat_out) + !----------------------------------------------------------------------- + + real, intent (out), dimension(:) :: sin_lat_out + + if(.not. module_is_initialized) then + call error_mesg('get_sin_lat','column_grid is not initialized', FATAL) + end if + + if(size(sin_lat_out,1).eq.lat_max) then + sin_lat_out = sin_lat + else !assume grid compute domain + sin_lat_out = sin_lat(js:je) + end if + + return + end subroutine get_sin_lat + + subroutine get_wts_lat(wts_lat_out) + !----------------------------------------------------------------------- + + real, intent (out), dimension(:) :: wts_lat_out + + if(.not. module_is_initialized) then + call error_mesg('get_wts_lat','column_grid is not initialized', FATAL) + end if + + if(size(wts_lat_out,1).eq.lat_max) then + wts_lat_out = wts_lat + else !assume grid compute domain + wts_lat_out = wts_lat(js:je) + end if + + return + end subroutine get_wts_lat + + function area_weighted_global_mean(field) + !------------------------------------------------------------------------- + real :: area_weighted_global_mean + real, intent(in), dimension(:,:) :: field + real, dimension(size(field,2)) :: wts_lat + real, dimension(size(field,1), size(field,2)) :: weighted_field_local + real, dimension(num_lon, lat_max) :: weighted_field_global + integer :: j + + call get_wts_lat(wts_lat) + do j=1,size(field,2) + weighted_field_local(:,j) = wts_lat(j)*field(:,j) + enddo + + call mpp_global_field(grid_domain, weighted_field_local, weighted_field_global) + area_weighted_global_mean = sum(weighted_field_global)/(global_sum_of_wts*num_lon) + + return + end function area_weighted_global_mean + + + subroutine get_lon_max(lon_max_out) + + integer, intent (out) :: lon_max_out + + if(.not.module_is_initialized) then + call error_mesg('get_lon_max','module column_grid not initialized', FATAL) + end if + + lon_max_out = num_lon + + return + end subroutine get_lon_max + + subroutine get_lat_max(lat_max_out) + !------------------------------------------------------------------------- + + integer, intent(out) :: lat_max_out + + if(.not.module_is_initialized) then + call error_mesg('get_lat_max','column_grid module is not initialized', FATAL) + end if + + lat_max_out = lat_max + + return + end subroutine get_lat_max + +end module column_grid_mod diff --git a/src/atmos_column/column_init_cond.F90 b/src/atmos_column/column_init_cond.F90 new file mode 100644 index 000000000..c9f0bc958 --- /dev/null +++ b/src/atmos_column/column_init_cond.F90 @@ -0,0 +1,119 @@ +module column_init_cond_mod + + +#ifdef INTERNAL_FILE_NML +use mpp_mod, only: input_nml_file +#else +use fms_mod, only: open_namelist_file +#endif + +use constants_mod, only: grav, pi +use column_initialize_fields_mod, only: column_initialize_fields +use fms_mod, only: mpp_pe, mpp_root_pe, error_mesg, FATAL, field_size, stdlog, file_exist, & + write_version_number, close_file, check_nml_error, read_data +use mpp_domains_mod, only: mpp_get_global_domain +use mpp_domains_mod, only: mpp_get_global_domain +use spec_mpp_mod, only: grid_domain, get_grid_domain +use vert_coordinate_mod, only: compute_vert_coord +use press_and_geopot_mod, only: press_and_geopot_init, pressure_variables +use tracer_type_mod, only: tracer_type + +implicit none +private + +public :: column_init_cond + +character(len=128), parameter :: version = '$Id: column_init_cond.F90,v 0.1 2018/14/11 HH:MM:SS isca Exp $' +character(len=128), parameter :: tagname = '$Name: isca_201811 $' + +real :: initial_temperature = 264. +real :: surf_geopotential = 0.0 +real :: surface_wind = 5. + +namelist / column_init_cond_nml / initial_temperature, surf_geopotential, surface_wind + +contains + +subroutine column_init_cond(initial_state_option, tracer_attributes, reference_sea_level_press, use_virtual_temperature, & + vert_coord_option, vert_difference_option, scale_heights, surf_res, & + p_press, p_sigma, exponent, pk, bk, ug, vg, tg, psg, & + grid_tracers, surf_geopotential_out)! NTL START HERE, lon_boundaries, lat_boundaries) + +character(len=*), intent(in) :: initial_state_option +type(tracer_type), intent(inout), dimension(:) :: tracer_attributes +real, intent(in) :: reference_sea_level_press +logical, intent(in) :: use_virtual_temperature +character(len=*), intent(in) :: vert_coord_option, vert_difference_option +real, intent(in) :: scale_heights, surf_res, p_press, p_sigma, exponent +!real, intent(in), dimension(:) :: lon_boundaries, lat_boundaries NTL START HERE +real, intent(out), dimension(:) :: pk, bk +real, intent(out), dimension(:,:,:) :: ug, vg, tg +real, intent(out), dimension(:,: ) :: psg +real, intent(out), dimension(:,:,:,:) :: grid_tracers +real, intent(out), dimension(:,: ) :: surf_geopotential_out + +integer :: unit, ierr, io + +!------------------------------------------------------------------------------------------------ + +#ifdef INTERNAL_FILE_NML + read (input_nml_file, nml=column_init_cond_nml, iostat=io) + ierr = check_nml_error(io, 'column_init_cond_nml') +#else + unit = open_namelist_file() + ierr=1 + do while (ierr /= 0) + read(unit, nml=column_init_cond_nml, iostat=io, end=20) + ierr = check_nml_error (io, 'column_init_cond_nml') + enddo +20 call close_file (unit) +#endif +call write_version_number(version, tagname) +if(mpp_pe() == mpp_root_pe()) write (stdlog(), nml=column_init_cond_nml) + + + +call compute_vert_coord(vert_coord_option, scale_heights, surf_res, exponent, p_press, p_sigma, reference_sea_level_press, pk,bk) +surf_geopotential_out = surf_geopotential ! only option to set topography to uniform surface geopotential +call press_and_geopot_init(pk, bk, use_virtual_temperature, vert_difference_option) + +if(initial_state_option == 'default') then + call column_initialize_fields(reference_sea_level_press, initial_temperature, surface_wind, & + surf_geopotential_out, psg, ug, vg, tg) +else +!!!!!!!! NTL: intial condition from file not yet configured !!!!!!!!!! +!else if(initial_state_option == 'input') then +!call ic_from_external_file(triang_trunc, tracer_attributes, vors, divs, ts, ln_ps, ug, & +!vg, tg, psg, vorg, divg, grid_tracers) + call error_mesg('column_init_cond','invalid initial state, can only choose "default"', FATAL) +endif + +call check_vert_coord(size(ug,3), psg) + +return +end subroutine column_init_cond + +subroutine check_vert_coord(num_levels, psg) + integer, intent(in) :: num_levels + real, intent(in), dimension(:,:) :: psg + real, dimension(size(psg,1), size(psg,2), num_levels ) :: p_full, ln_p_full + real, dimension(size(psg,1), size(psg,2), num_levels+1) :: p_half, ln_p_half + integer :: i,j,k + + call pressure_variables(p_half, ln_p_half, p_full, ln_p_full, psg) + do k=1,size(p_full,3) + do j=1,size(p_full,2) + do i=1,size(p_full,1) + if(p_half(i,j,k+1) < p_half(i,j,k)) then + call error_mesg('column_init_cond: check_vert_coord','Pressure levels intersect.',FATAL) + endif + enddo + enddo + enddo + + return + end subroutine check_vert_coord + + + +end module column_init_cond_mod \ No newline at end of file diff --git a/src/atmos_column/column_initialize_fields.F90 b/src/atmos_column/column_initialize_fields.F90 new file mode 100644 index 000000000..e9bb44eba --- /dev/null +++ b/src/atmos_column/column_initialize_fields.F90 @@ -0,0 +1,92 @@ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! !! +!! GNU General Public License !! +!! !! +!! This file is part of the Flexible Modeling System (FMS). !! +!! !! +!! FMS is free software; you can redistribute it and/or modify it !! +!! under the terms of the GNU General Public License as published by !! +!! the Free Software Foundation, either version 3 of the License, or !! +!! (at your option) any later version. !! +!! !! +!! FMS is distributed in the hope that it will be useful, !! +!! but WITHOUT ANY WARRANTY; without even the implied warranty of !! +!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !! +!! GNU General Public License for more details. !! +!! !! +!! You should have received a copy of the GNU General Public License !! +!! along with FMS. if not, see: http://www.gnu.org/licenses/gpl.txt !! +!! !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +module column_initialize_fields_mod + +use fms_mod, only: mpp_pe, mpp_root_pe, write_version_number + +use column_grid_mod, only: area_weighted_global_mean + +use constants_mod, only: rdgas + +use spec_mpp_mod, only: get_grid_domain + +implicit none +private + +public :: column_initialize_fields + +character(len=128), parameter :: version = '$Id: column_initialize_fields.F90,v 0.1 2018/14/11 HH:MM:SS isca Exp $' +character(len=128), parameter :: tagname = '$Name: isca_201811 $' + +contains + +!------------------------------------------------------------------------------------------------- +subroutine column_initialize_fields(reference_sea_level_press, initial_temperature, surface_wind, & + surf_geopotential, psg, ug, vg, tg) + +real, intent(in) :: reference_sea_level_press +real, intent(in) :: initial_temperature +real, intent(in) :: surface_wind + +real, intent(in), dimension(:,: ) :: surf_geopotential +real, intent(out), dimension(:,: ) :: psg +real, intent(out), dimension(:,:,: ) :: ug, vg, tg + +real, allocatable, dimension(:,:) :: ln_psg + +real :: initial_sea_level_press, global_mean_psg +real :: initial_perturbation = 1.e-7 + +integer :: is, ie, js, je, num_levels + +call write_version_number(version, tagname) + +num_levels = size(ug,3) +call get_grid_domain(is, ie, js, je) +allocate(ln_psg(is:ie, js:je)) + +initial_sea_level_press = reference_sea_level_press + +ug = 0. +vg = 0. +tg = 0. +psg = 0. + +ug(:,:,num_levels) = surface_wind / sqrt(2.) +vg(:,:,num_levels) = surface_wind / sqrt(2.) + +tg = initial_temperature +ln_psg = log(initial_sea_level_press) - surf_geopotential/(rdgas*initial_temperature) +psg = exp(ln_psg) + + +! compute and print mean surface pressure +global_mean_psg = area_weighted_global_mean(psg) +if(mpp_pe() == mpp_root_pe()) then + print '("mean surface pressure=",f9.4," mb")',.01*global_mean_psg +endif + +return +end subroutine column_initialize_fields +!================================================================================ + +end module column_initialize_fields_mod diff --git a/src/atmos_param/betts_miller/betts_miller.f90 b/src/atmos_param/betts_miller/betts_miller.f90 index 0e03b53cb..bc0caab06 100644 --- a/src/atmos_param/betts_miller/betts_miller.f90 +++ b/src/atmos_param/betts_miller/betts_miller.f90 @@ -19,7 +19,7 @@ module betts_miller_mod !--------------------------------------------------------------------- ! ---- public interfaces ---- - public betts_miller, betts_miller_init + public betts_miller, betts_miller_init, lcltabl !----------------------------------------------------------------------- ! ---- version number ---- @@ -101,7 +101,7 @@ module betts_miller_mod subroutine betts_miller (dt, tin, qin, pfull, phalf, coldT, & rain, snow, tdel, qdel, q_ref, bmflag, & klzbs, cape, cin, t_ref,invtau_bm_t,invtau_bm_q, & - capeflag, mask, conv) + capeflag, klcls, mask, conv) !----------------------------------------------------------------------- ! @@ -142,9 +142,9 @@ subroutine betts_miller (dt, tin, qin, pfull, phalf, coldT, & real , intent(in) , dimension(:,:,:) :: tin, qin, pfull, phalf real , intent(in) :: dt logical , intent(in) , dimension(:,:):: coldT - real , intent(out), dimension(:,:) :: rain,snow, klzbs, cape, & + real , intent(out), dimension(:,:) :: rain,snow, cape, & cin, invtau_bm_t, invtau_bm_q, capeflag - integer, intent(out), dimension(:,:) :: bmflag + integer, intent(out), dimension(:,:) :: bmflag, klzbs, klcls real , intent(out), dimension(:,:,:) :: tdel, qdel, q_ref, t_ref real , intent(in) , dimension(:,:,:), optional :: mask logical, intent(in) , dimension(:,:,:), optional :: conv @@ -162,8 +162,8 @@ subroutine betts_miller (dt, tin, qin, pfull, phalf, coldT, & real :: & cape1, cin1, tot, deltak, deltaq, qrefint, deltaqfrac, deltaqfrac2, & - ptopfrac, es, capeflag1, plzb, plcl, cape2, small -integer i, j, k, ix, jx, kx, klzb, ktop, klzb2 + ptopfrac, es, capeflag1, plzb, plcl, small + integer i, j, k, ix, jx, kx, klzb, ktop, klcl !----------------------------------------------------------------------- ! computation of precipitation by betts-miller scheme !----------------------------------------------------------------------- @@ -197,13 +197,14 @@ subroutine betts_miller (dt, tin, qin, pfull, phalf, coldT, & call capecalcnew( kx, pfull(i,j,:), phalf(i,j,:),& cp_air, rdgas, rvgas, hlv, kappa, tin(i,j,:), & rin(i,j,:), avgbl, cape1, cin1, tpc, & - rpc, klzb) + rpc, klzb, klcl) ! set values for storage capeflag(i,j) = capeflag1 cape(i,j) = cape1 cin(i,j) = cin1 klzbs(i,j) = klzb + klcls(i,j) = klcl if(cape1.gt.0.) then ! if((tot.gt.0.).and.(cape1.gt.0.)) then bmflag(i,j) = 1 @@ -443,7 +444,7 @@ end subroutine betts_miller !all new cape calculation. subroutine capecalcnew(kx,p,phalf,cp_air,rdgas,rvgas,hlv,kappa,tin,rin,& - avgbl,cape,cin,tp,rp,klzb) + avgbl,cape,cin,tp,rp,klzb,klcl) ! ! Input: @@ -471,6 +472,7 @@ subroutine capecalcnew(kx,p,phalf,cp_air,rdgas,rvgas,hlv,kappa,tin,rin,& ! where no adjustment, and set to the saturation humidity at ! the parcel temperature below the LCL) ! klzb Level of zero buoyancy +! klcl Lifting condensation level ! ! Algorithm: ! Start with surface parcel. @@ -485,11 +487,11 @@ subroutine capecalcnew(kx,p,phalf,cp_air,rdgas,rvgas,hlv,kappa,tin,rin,& logical, intent(in) :: avgbl real, intent(in), dimension(:) :: p, phalf, tin, rin real, intent(in) :: rdgas, rvgas, hlv, kappa, cp_air - integer, intent(out) :: klzb + integer, intent(out) :: klzb, klcl real, intent(out), dimension(:) :: tp, rp real, intent(out) :: cape, cin - integer :: k, klcl, klfc, klcl2 + integer :: k, klfc, klcl2 ! klcl logical :: nocape real, dimension(kx) :: theta real :: t0, r0, es, rs, theta0, pstar, value, tlcl, & diff --git a/src/atmos_param/cloud_simple/cloud_cover_diags.F90 b/src/atmos_param/cloud_simple/cloud_cover_diags.F90 new file mode 100644 index 000000000..aea5b337d --- /dev/null +++ b/src/atmos_param/cloud_simple/cloud_cover_diags.F90 @@ -0,0 +1,379 @@ +module cloud_cover_diags_mod + +#ifdef INTERNAL_FILE_NML + use mpp_mod, only: input_nml_file +#else + use fms_mod, only: open_namelist_file, close_file +#endif + + use fms_mod, only: stdlog, FATAL, WARNING, NOTE, error_mesg, & + uppercase, check_nml_error + use time_manager_mod, only: time_type + use diag_manager_mod, only: register_diag_field, send_data + + implicit none + + character(len=14), parameter :: mod_name = "cloud_cover" + + ! Overlap assumptions include 'maximum-random', 'maximum', and 'random', + ! and the default is 'maximum-random'. + character(len=32) :: overlap_assumption = 'maximum-random' + + real :: cf_min = 0.0 ! The clear-sky threshold + + real :: mid_cld_bottom = 7.0e4 ! Bottom (Top) pressure of middle (low) clouds + real :: high_cld_bottom = 4.0e4 ! Bottom (Top) pressure of high (middle) clouds + + ! ----- outputs for cloud amount diagnostics ----- ! + integer :: id_tot_cld_amt, id_high_cld_amt, id_mid_cld_amt, id_low_cld_amt + + namelist /cloud_cover_diag_nml/ & + overlap_assumption, cf_min, mid_cld_bottom, high_cld_bottom + + contains + + ! =================================================== + ! cloud cover diags init + ! =================================================== + subroutine cloud_cover_diags_init(axes, Time) + type(time_type), intent(in) :: Time + integer, intent(in), dimension(4) :: axes + integer :: io, ierr, nml_unit, stdlog_unit + +#ifdef INTERNAL_FILE_NML + read(input_nml_file, nml=cloud_cover_diag_nml, iostat=io) + ierr = check_nml_error(io, 'cloud_cover_diag_nml') +#else + if (file_exist('input.nml')) then + nml_unit = open_namelist_file() + ierr = 1 + do while (ierr /= 0) + read(nml_unit, nml=cloud_cover_diag_nml, iostat=io, end=10) + ierr = check_nml_error(io, 'cloud_cover_diag_nml') + enddo +10 call close_file(nml_unit) + endif +#endif + stdlog_unit = stdlog() + write(stdlog_unit, cloud_cover_diag_nml) + + call error_mesg(mod_name, 'The cloud overlap assumption is '// & + uppercase(trim(overlap_assumption)), NOTE) + + id_tot_cld_amt = register_diag_field (mod_name, 'tot_cld_amt', axes(1:2), Time, & + 'total cloud amount (%)', 'percent') + id_high_cld_amt = register_diag_field (mod_name, 'high_cld_amt', axes(1:2), Time, & + 'high cloud amount (%)', 'percent') + id_mid_cld_amt = register_diag_field (mod_name, 'mid_cld_amt', axes(1:2), Time, & + 'mid cloud amount (%)', 'percent') + id_low_cld_amt = register_diag_field (mod_name, 'low_cld_amt', axes(1:2), Time, & + 'low cloud amount (%)', 'percent') + + end subroutine cloud_cover_diags_init + + ! =================================================== + ! cloud cover diags init + ! =================================================== + subroutine cloud_cover_diags(cf, p_full, p_half, Time) + real, intent(in), dimension(:,:,:) :: cf, p_full, p_half + type(time_type), intent(in) :: Time + character(len=32) :: overlap_str = '' + + overlap_str = uppercase(trim(overlap_assumption)) + + if (overlap_str == 'MAXIMUM-RANDOM') then + call diag_cldamt_maxrnd_overlap(cf, p_full, p_half, Time) + + else if (overlap_str == 'MAXIMUM') then + call diag_cldamt_max_overlap(cf, p_full, Time) + + else if (overlap_str == 'RANDOM') then + call diag_cldamt_random_overlap(cf, p_full, Time) + + else + call error_mesg(mod_name, '"'//trim(overlap_assumption)//'"'// & + ' is not a valid cloud overlap assumption.', FATAL) + end if + + end subroutine cloud_cover_diags + + subroutine diag_cldamt_maxrnd_overlap(cf, pmid, pint, Time) + ! Original codes are from CESM, refer to: + ! https://github.com/E3SM-Project/E3SM/blob/master/components/cam/src/physics/cam/cloud_cover_diags.F90 + + !!! pmid is pfull, and pint is phalf + real, intent(in), dimension(:,:,:) :: cf, pmid, pint + type(time_type), intent(in) :: Time + + !---------------------------Local workspace----------------------------- + ! Total, low, middle and high random overlap cloud cover + real, dimension(size(cf,1), size(cf,2)) :: tot_ca, hgh_ca, mid_ca, low_ca + + integer :: i, j, k ! lat, lon, level indices + integer, dimension(size(cf,1), size(cf,2)) :: irgn ! Max-overlap region index + integer :: max_nmxrgn ! maximum value of nmxrgn over columns + integer :: ityp ! Type counter + real, dimension(size(cf,1), size(cf,2)) :: clrsky ! Max-random clear sky fraction + real, dimension(size(cf,1), size(cf,2)) :: clrskymax ! Maximum overlap clear sky fraction + integer, dimension(size(cf,1), size(cf,2)) :: nmxrgn + real, dimension(size(pint,1), size(pint,2), size(pint,3)) :: pmxrgn + + !------------------------------Cloud Range Paramters------------------------------- + real :: plowmax, plowmin ! Max/min prs for low cloud cover range + real :: pmedmax, pmedmin ! Max/min prs for mid cloud cover range + real :: phghmax, phghmin ! Max/min prs for hgh cloud cover range + + real, dimension(4) :: ptypmin + real, dimension(4) :: ptypmax + + plowmax = 1.2e5 + plowmin = mid_cld_bottom + + pmedmax = mid_cld_bottom + pmedmin = high_cld_bottom + + phghmax = high_cld_bottom + phghmin = 5.0e3 + + ptypmin = (/ phghmin, plowmin, pmedmin, phghmin /) + ptypmax = (/ plowmax, plowmax, pmedmax, phghmax /) + + ! call the overlap subroutine to obtain the nmxrgn and pmxrgn + call cldovrlap(pint, cf, nmxrgn, pmxrgn) + + ! Initialize region number + max_nmxrgn = -1 + do i = 1,size(cf,1) + do j = 1,size(cf,2) + max_nmxrgn = max(max_nmxrgn, nmxrgn(i,j)) + end do + end do + + do ityp = 1,4 + irgn = 1 + do k = 1,max_nmxrgn-1 + do i = 1,size(cf,1) + do j = 1,size(cf,2) + if (pmxrgn(i,j,irgn(i,j)) < ptypmin(ityp) .and. irgn(i,j) < nmxrgn(i,j)) then + irgn(i,j) = irgn(i,j) + 1 + end if + end do + end do + end do + ! + ! Compute cloud amount by estimating clear-sky amounts + ! + clrsky = 1.0 + clrskymax = 1.0 + + do i = 1,size(cf,1) + do j = 1,size(cf,2) + do k = 1,size(cf,3) + if (pmid(i,j,k) >= ptypmin(ityp) .and. pmid(i,j,k) <= ptypmax(ityp)) then + if (pmxrgn(i,j,irgn(i,j)) < pmid(i,j,k) .and. irgn(i,j) < nmxrgn(i,j)) then + irgn(i,j) = irgn(i,j) + 1 + clrsky(i,j) = clrsky(i,j) * clrskymax(i,j) + clrskymax(i,j) = 1.0 + endif + clrskymax(i,j) = min(clrskymax(i,j), 1.0-cf(i,j,k)) + endif + end do + end do + end do + + if (ityp == 1) tot_ca = 1.0 - (clrsky * clrskymax) + if (ityp == 2) low_ca = 1.0 - (clrsky * clrskymax) + if (ityp == 3) mid_ca = 1.0 - (clrsky * clrskymax) + if (ityp == 4) hgh_ca = 1.0 - (clrsky * clrskymax) + end do + + ! Diagnostics output + call output_cldamt(tot_ca, hgh_ca, mid_ca, low_ca, Time) + + end subroutine diag_cldamt_maxrnd_overlap + + subroutine cldovrlap(pint, cf, nmxrgn, pmxrgn) + ! The original codes are from CAM. + ! Please refer to: + ! https://github.com/E3SM-Project/E3SM/blob/master/components/cam/src/physics/cam/pkg_cldoptics.F90#L136 + + !----------------------------------------------------------------------- + ! Purpose: + ! Partitions each column into regions with clouds in neighboring layers. + ! This information is used to implement maximum overlap in these regions + ! with random overlap between them. + ! On output: + ! nmxrgn contains the number of regions in each column + ! pmxrgn contains the interface pressures for the lower boundaries of each region! + ! + ! Author: W. Collins + !----------------------------------------------------------------------- + + ! Input arguments + real, intent(in), dimension(:,:,:) :: pint ! Interface pressure + real, intent(in), dimension(:,:,:) :: cf ! Fractional cloud cover + + ! Output arguments + ! Number of maximally overlapped regions + integer, intent(out), dimension(size(cf,1), size(cf,2)) :: nmxrgn + real, intent(out), dimension(size(pint,1), size(pint,2), size(pint,3)) :: pmxrgn + + !---------------------------Local variables----------------------------- + integer :: i, j ! Lat/Longitude index + integer :: k ! Level index + integer :: n ! Max-overlap region counter + + real, dimension(size(pint,1), size(pint,2), size(pint,3)) :: pnm ! Interface pressure + logical :: cld_found ! Flag for detection of cloud + logical, dimension(size(cf,3)) :: cld_layer ! Flag for cloud in layer + integer :: pver, pverp + + pver = size(cf,3) + pverp = pver + 1 + + do i = 1,size(cf,1) + do j = 1,size(cf,2) + cld_found = .false. + ! True if cloud fraction greater than cf_min + cld_layer(:) = cf(i,j,:) > cf_min ! 0.0 + pmxrgn(i,j,:) = 0.0 + pnm(i,j,:) = pint(i,j,:) + n = 1 + do k = 1, pver + if (cld_layer(k) .and. .not. cld_found) then + cld_found = .true. + else if (.not. cld_layer(k) .and. cld_found) then + cld_found = .false. + if (count(cld_layer(k:pver)) == 0) then + exit + endif + pmxrgn(i,j,n) = pnm(i,j,k) + n = n + 1 + endif + end do + pmxrgn(i,j,n) = pnm(i,j,pverp) + nmxrgn(i,j) = n + end do + end do + end subroutine cldovrlap + + subroutine diag_cldamt_max_overlap(cf, p_full, Time) + real, intent(in), dimension(:,:,:) :: cf, p_full + type(time_type), intent(in) :: Time + real, dimension(size(cf,1), size(cf,2)) :: tot_ca, hgh_ca, mid_ca, low_ca + integer :: i, j, ks, ke + logical, dimension(size(cf,3)) :: ind_mid + + tot_ca = 1.0 + hgh_ca = 1.0 + mid_ca = 1.0 + low_ca = 1.0 + + ! total cf amount + tot_ca = maxval(cf, 3) + + do i = 1,size(cf,1) + do j = 1,size(cf,2) + ! low cloud amount + ks = minloc(p_full(i,j,:), 1, mask=p_full(i,j,:)>mid_cld_bottom) + ke = maxloc(p_full(i,j,:), 1, mask=p_full(i,j,:)>mid_cld_bottom) + low_ca(i,j) = maxval(cf(i,j,ks:ke), 1) + + ! middle cloud amount + ind_mid = high_cld_bottom<=p_full(i,j,:) .and. p_full(i,j,:)<=mid_cld_bottom + ks = minloc(p_full(i,j,:), 1, mask=ind_mid) + ke = maxloc(p_full(i,j,:), 1, mask=ind_mid) + mid_ca(i,j) = maxval(cf(i,j,ks:ke), 1) + + ! high cloud amount + ks = minloc(p_full(i,j,:), 1, mask=p_full(i,j,:)mid_cld_bottom) + ke = maxloc(p_full(i,j,:), 1, mask=p_full(i,j,:)>mid_cld_bottom) + call random_overlap_single_column(cf(i,j,ks:ke), low_ca(i,j)) + + ! middle cloud amount + ind_mid = high_cld_bottom<=p_full(i,j,:) .and. p_full(i,j,:)<=mid_cld_bottom + ks = minloc(p_full(i,j,:), 1, mask=ind_mid) + ke = maxloc(p_full(i,j,:), 1, mask=ind_mid) + call random_overlap_single_column(cf(i,j,ks:ke), mid_ca(i,j)) + + ! high cloud amount + ks = minloc(p_full(i,j,:), 1, mask=p_full(i,j,:) 0) then + used = send_data (id_tot_cld_amt, tot_ca*1.0e2, Time) + endif + if (id_high_cld_amt > 0) then + used = send_data (id_high_cld_amt, hgh_ca*1.0e2, Time) + endif + if (id_mid_cld_amt > 0) then + used = send_data (id_mid_cld_amt, mid_ca*1.0e2, Time) + endif + if (id_low_cld_amt > 0) then + used = send_data (id_low_cld_amt, low_ca*1.0e2, Time) + endif + end subroutine output_cldamt + + ! =================================================== + ! cloud cover diags end + ! =================================================== + subroutine cloud_cover_diags_end() + + end subroutine cloud_cover_diags_end + +end module cloud_cover_diags_mod diff --git a/src/atmos_param/cloud_simple/cloud_simple.F90 b/src/atmos_param/cloud_simple/cloud_simple.F90 index a720c52c4..2e65dfaa6 100644 --- a/src/atmos_param/cloud_simple/cloud_simple.F90 +++ b/src/atmos_param/cloud_simple/cloud_simple.F90 @@ -1,389 +1,212 @@ module cloud_simple_mod - use fms_mod, only: stdlog, FATAL, WARNING, error_mesg, & - open_namelist_file, close_file, open_file, & - check_nml_error, mpp_pe - use time_manager_mod, only: time_type - use sat_vapor_pres_mod, only: compute_qs - use constants_mod, only: KELVIN - - use diag_manager_mod, only: register_diag_field, send_data +#ifdef INTERNAL_FILE_NML + use mpp_mod, only: input_nml_file +#else + use fms_mod, only: open_namelist_file, close_file +#endif + + use fms_mod, only: stdlog, FATAL, WARNING, NOTE, error_mesg, & + uppercase, check_nml_error + use time_manager_mod, only: time_type + use sat_vapor_pres_mod, only: compute_qs, lookup_es + use diag_manager_mod, only: register_diag_field, send_data + use constants_mod, only: CP_AIR, GRAV, RDGAS, RVGAS, HLV, KAPPA, RADIUS, TFREEZE + use lcl_mod, only: lcl + use large_scale_cloud_mod, only: large_scale_cloud_init, large_scale_cloud_diag, & + large_scale_cloud_end + use marine_strat_cloud_mod, only: marine_strat_cloud_init, marine_strat_cloud_diag, & + marine_strat_cloud_end + use cloud_cover_diags_mod, only: cloud_cover_diags_init, cloud_cover_diags, & + cloud_cover_diags_end implicit none - character(len=128) :: version='$Id: cloud_simple.F90,v 1.0 2021/05/11$' - character(len=128) :: tag='Simple cloud scheme' - - logical :: do_init = .true. ! update to false after init has been run - - real :: cca_lower_limit = 0.0 ! simple convective cloud fraction min - ! the default is zero. Not being used but - ! could be adapted in future. - - ! There are two testing scenarios developed for SPOOKIE-2 project. Which - ! is why this code was created. The first was implemented and found not to - ! work very well in other models. It has been implemented her for curiousity - ! testing but not tested very much yet. The second protocol is what was used - ! for the SPOOKIE-2 runs and has been more widely tested. For this reason, - ! the default spookie_protocol is 2. The 1st protocol could be removed in - ! time (once the SPOOKIE-2 project is complete, but is left in the code for - ! now in case it is needed. - - integer :: spookie_protocol = 2 ! default is 2 - - ! Critical RH (fraction) values - SPOOKIE-2 protocol version 1 - real :: rhc_sfc = 1.0 - real :: rhc_base = 0.7 - real :: rhc_top = 0.2 ! In the protocol this was 20 % and in - ! implementation it was 30%. To check in - ! next round of validation. - - ! Critical RH (fraction) values - SPOOKIE-2 protocol version 2 - ! initial values for RH. Updated in calc_rh_min_max - real :: rh_min_sfc = 1.0 - real :: rh_min_base = 0.8 - real :: rh_min_top = 0.9 - - real :: rh_max_sfc = 1.0 - real :: rh_max_base = 1.0 - real :: rh_max_top = 1.0 - - ! Pressure (Pa) at cloud bottom and top (very approx) - real :: p_base = 70000. - real :: p_top = 20000. - - namelist /cloud_simple_nml/ cca_lower_limit, spookie_protocol, & - rhc_sfc, rhc_base, rhc_top, & - rh_min_top, rh_min_sfc, rh_min_base, & - rh_max_top, rh_max_sfc, rh_max_base - - integer :: id_cf, id_reff_rad, id_frac_liq, id_qcl_rad, id_rh_in_cf, & - id_simple_rhcrit, id_rh_min - - character(len=14), parameter :: mod_name_cld = "cloud_simple" + character(len=14), parameter :: mod_name_cld = "cloud_simple" - contains + logical :: do_init = .true. ! Check if init needs to be run + logical :: do_qcl_with_temp = .true. + logical :: do_cloud_cover_diags = .true. + logical :: do_add_stratocumulus = .false. - !----------------------------------------------- + ! Parameters to control the liquid cloud fraction + real :: T_max = -5 ! Units in Celcius + real :: T_min = -40 ! Units in Celcius + ! For effective cloud droplet radius + real :: reff_liq = 14.0 ! micron + real :: reff_ice = 25.0 - subroutine cloud_simple_init (axes, Time) + ! For in-cloud liquid water + real :: qcl_val = 0.2 ! g/kg - type(time_type), intent(in) :: Time - integer, intent(in), dimension(4) :: axes + ! ----- outputs for baisc cloud diagnostics ----- ! + integer :: id_cf, id_reff_rad, id_frac_liq, id_qcl_rad, id_rh_in_cf - integer :: io, ierr, unit + namelist /cloud_simple_nml/ & + T_min, T_max, reff_liq, reff_ice, & + qcl_val, do_qcl_with_temp, & + do_add_stratocumulus, do_cloud_cover_diags - unit = open_file (file='input.nml', action='read') - ierr=1 - do while (ierr /= 0) - read (unit, nml=cloud_simple_nml, iostat=io, end=10) - ierr = check_nml_error (io, 'cloud_simple_nml') - enddo - 10 call close_file (unit) + contains - unit = open_file (file='logfile.out', action='append') - if ( mpp_pe() == 0 ) then - write (unit,'(/,80("="),/(a))') trim(version), trim(tag) - write (unit,nml=cloud_simple_nml) + subroutine cloud_simple_init (axes, Time) + type(time_type), intent(in) :: Time + integer, intent(in), dimension(4) :: axes + integer :: io, ierr, nml_unit, stdlog_unit + +#ifdef INTERNAL_FILE_NML + read(input_nml_file, nml=cloud_simple_nml, iostat=io) + ierr = check_nml_error(io, 'cloud_simple_nml') +#else + if (file_exist('input.nml')) then + nml_unit = open_namelist_file() + ierr = 1 + do while (ierr /= 0) + read(nml_unit, nml=cloud_simple_nml, iostat=io, end=10) + ierr = check_nml_error(io, 'cloud_simple_nml') + enddo +10 call close_file(nml_unit) endif - call close_file(unit) - - !register diagnostics - id_cf = & - register_diag_field ( mod_name_cld, 'cf', axes(1:3), Time, & - 'Cloud fraction for the simple cloud scheme', 'unitless: values 0-1') - - id_frac_liq = & - register_diag_field ( mod_name_cld, 'frac_liq', axes(1:3), Time, & - 'Liquid cloud fraction (liquid, mixed-ice phase, ice)', & - 'unitless: values 0-1') - - id_reff_rad = & - register_diag_field ( mod_name_cld, 'reff_rad', axes(1:3), Time, & - 'Effective cloud particle radius', & - 'microns') - - id_qcl_rad = & - register_diag_field ( mod_name_cld, 'qcl_rad', axes(1:3), Time, & - 'Specific humidity of cloud liquid', & - 'kg/kg') - - ! rh_in_cf is an output diagnostic only for debugging - - id_rh_in_cf = & - register_diag_field ( mod_name_cld, 'rh_in_cf', axes(1:3), Time, & - 'RH as a percent', & - '%') - - id_simple_rhcrit = & - register_diag_field ( mod_name_cld, 'simple_rhcrit', axes(1:3), Time, & - 'RH as a percent for spookie protocol 1', & - '%') - - id_rh_min = & - register_diag_field ( mod_name_cld, 'rh_min', axes(1:3), Time, & - 'RH as a percent for spookie protocol 2', & - '%') - - - do_init = .false. !initialisation completed +#endif + stdlog_unit = stdlog() + write(stdlog_unit, cloud_simple_nml) - end subroutine cloud_simple_init + call error_mesg(mod_name_cld, 'Using SimCloud cloud scheme', NOTE) - !----------------------------------------------- + !register diagnostics + id_cf = register_diag_field (mod_name_cld, 'cf', axes(1:3), Time, & + 'Cloud fraction for the simple cloud scheme', 'unitless: values 0-1') + id_frac_liq = register_diag_field (mod_name_cld, 'frac_liq', axes(1:3), Time, & + 'Liquid cloud fraction (liquid, mixed-ice phase, ice)', 'unitless: values 0-1') + id_reff_rad = register_diag_field (mod_name_cld, 'reff_rad', axes(1:3), Time, & + 'Effective cloud particle radius', 'microns') + id_qcl_rad = register_diag_field (mod_name_cld, 'qcl_rad', axes(1:3), Time, & + 'Specific humidity of cloud liquid', 'kg/kg') + id_rh_in_cf = register_diag_field (mod_name_cld, 'rh_in_cf', axes(1:3), Time, & + 'RH as a percent', '%') - subroutine cloud_simple(p_half, p_full, Time, & - temp, q_hum, & - ! outs - cf, cca, reff_rad, qcl_rad) + call large_scale_cloud_init(axes, Time) - real , intent(in), dimension(:,:,:) :: temp, q_hum, p_full, p_half - type(time_type) , intent(in) :: Time + if (do_add_stratocumulus) call marine_strat_cloud_init(axes, Time) - real , intent(inout), dimension(:,:,:) :: cf, cca, reff_rad, qcl_rad + if (do_cloud_cover_diags) call cloud_cover_diags_init(axes, Time) - real, dimension(size(temp,1), size(temp, 2), size(temp, 3)) :: qs, frac_liq - real, dimension(size(temp,1), size(temp, 2), size(temp, 3)) :: rh_in_cf - real, dimension(size(temp,1), size(temp, 2), size(temp, 3)) :: simple_rhcrit - real, dimension(size(temp,1), size(temp, 2), size(temp, 3)) :: rh_min,rh_max + do_init = .false. !initialisation completed - integer :: i, j, k, k_surf + end subroutine cloud_simple_init - !check initiation has been done + ! ====================== Main Cloud Subroutine ====================== ! + subroutine cloud_simple(p_half, p_full, Time, temp, q_hum, z_full, & + wg_full, psg, temp_2m, q_2m, rh_2m, klcls, ocean, & + cf, reff_rad, qcl_rad) ! outs + real, intent(in), dimension(:,:,:) :: temp, q_hum, p_full, p_half, z_full, wg_full + real, intent(in), dimension(:,:) :: psg, temp_2m, q_2m, rh_2m + integer, intent(in), dimension(:,:) :: klcls + logical, intent(in), dimension(:,:) :: ocean + type(time_type), intent(in) :: Time + real, intent(out), dimension(:,:,:) :: cf, reff_rad, qcl_rad + real, dimension(size(temp,1), size(temp,2), size(temp,3)) :: qs, frac_liq, rh_in_cf + + !check initiation has been done - ie read in parameters if (do_init) call error_mesg ('cloud_simple', & 'cloud_simple_init has not been called.', FATAL) - ! Get the saturated specific humidity with respect to water and ice - ! this is set by the namelist variable sat_vapor_pres_nml - call compute_qs(temp, p_full, qs) - - k_surf = size(temp, 3) !set the location of the lowest model level - + ! Get the saturated specific humidity TOTAL (ie ice and vap) ***double check maths! + call compute_qs(temp, p_full, qs) + rh_in_cf = q_hum / qs - ! For future revisions, consider rewriting to remove the loops. - do k=1, size(temp, 3) - do j=1, size(temp, 2) - do i=1, size(temp, 1) - - ! calculate the liquid fraction - call calc_liq_frac(temp(i,j,k), frac_liq(i,j,k)) + call calc_liq_frac(temp, frac_liq) + + call calc_reff(frac_liq, reff_rad) - ! calculate the effective radius - call calc_reff(frac_liq(i,j,k), reff_rad(i,j,k)) + call large_scale_cloud_diag(p_full, psg, rh_in_cf, q_hum, qs, qcl_rad, wg_full, cf, Time) - if (spookie_protocol .eq. 1) then - ! calculate the critical RH - call calc_rhcrit(p_full(i,j,k), p_full(i,j,k_surf), & - simple_rhcrit(i,j,k)) - else - ! calculate the min and max RH - call calc_rh_min_max(p_full(i,j,k), p_full(i,j,k_surf), & - rh_min(i,j,k), rh_max(i,j,k)) - endif + if (do_add_stratocumulus) then + call marine_strat_cloud_diag(temp, p_full, p_half, z_full, rh_in_cf, q_hum, & + temp_2m, q_2m, rh_2m, psg, wg_full, klcls, cf, Time, ocean) + end if - ! calculate the cloud fraction - call calc_cf(q_hum(i,j,k), qs(i,j,k), cf(i,j,k), cca(i,j,k), & - rh_in_cf(i,j,k), simple_rhcrit = simple_rhcrit(i,j,k), & - rh_min = rh_min(i,j,k), rh_max = rh_max(i,j,k) ) + call calc_qcl_rad(p_full, temp, cf, qcl_rad) - ! calculate the specific humidity of cloud liquid - call calc_mixing_ratio(p_full(i,j,k), cf(i,j,k), temp(i,j,k), & - qcl_rad(i,j,k) ) - end do - end do - end do + if (do_cloud_cover_diags) call cloud_cover_diags(cf, p_full, p_half, Time) - !save some diagnotics - call output_cloud_diags(cf, reff_rad, frac_liq, qcl_rad, rh_in_cf, & - simple_rhcrit, rh_min, Time ) + call output_cloud_diags(cf, reff_rad, frac_liq, qcl_rad, rh_in_cf, Time) end subroutine cloud_simple subroutine calc_liq_frac(temp, frac_liq) + ! All liquid if above T_max and all ice below T_min, + ! linearly interpolate between T_min and T_max + real, intent(in), dimension(:,:,:) :: temp + real, intent(out), dimension(:,:,:) :: frac_liq - real, intent(in) :: temp - real, intent(out) :: frac_liq - - if (temp > KELVIN) then - ! All liquid if temp above zero + where (temp > TFREEZE + T_max) frac_liq = 1.0 - else if (temp < KELVIN-40.0) then - ! All ice if temp is below -40C + elsewhere (temp < TFREEZE + T_min) frac_liq = 0.0 - else - ! linearly interpolate between T=0 and -40C - frac_liq = 1.0 - (KELVIN - temp) / 40.0 - end if + elsewhere + frac_liq = (temp - TFREEZE - T_min) / (T_max - T_min) + end where end subroutine calc_liq_frac subroutine calc_reff(frac_liq, reff_rad) - ! the effective cloud radius is bounded between 10 and 20 microns - - real, intent(in) :: frac_liq - real, intent(out) :: reff_rad + real, intent(in), dimension(:,:,:) :: frac_liq + real, intent(out), dimension(:,:,:) :: reff_rad - reff_rad = 10.0 * frac_liq + 20.0 * (1.0 - frac_liq) - ! units in microns this will be updated before passing into soc + reff_rad = reff_liq * frac_liq + reff_ice * (1.0 - frac_liq) end subroutine calc_reff - subroutine calc_rhcrit(p_full, p_surf, simple_rhcrit) - ! Get the RH needed as a threshold for the cloud fraction calc. - ! This is only requires for spookie_protocol=1 - real, intent(in) :: p_full, p_surf - real, intent(out) :: simple_rhcrit - - ! Calculate RHcrit as function of pressure - if (p_full > p_base) then - - simple_rhcrit = rhc_sfc - (rhc_sfc - rhc_base) * & - (p_surf - p_full) / (p_surf - p_base) - - else if (p_full > p_top) then - - simple_rhcrit = rhc_base - (rhc_base - rhc_top) * & - (p_base - p_full) / (p_base - p_top) - - else - simple_rhcrit = rhc_top - endif - - end subroutine calc_rhcrit - - subroutine calc_rh_min_max(p_full, p_surf, rh_min, rh_max) - - real, intent(in) :: p_full, p_surf - real, intent(out) :: rh_min, rh_max - - real :: layer - - ! calculate RH min and max as a function of pressure - - if (p_full > p_base) then - ! For the layer between the surface and cloud base (default is 700 hpa) - - layer = (p_surf - p_full) / (p_surf - p_base) - - ! correction step to update initial values - rh_min = rh_min_sfc - (rh_min_sfc - rh_min_base) * layer - rh_max = rh_max_sfc - (rh_max_sfc - rh_max_base) * layer - - else if ( p_full > p_top ) then - ! For the layer where the cloud is (base up to top) - - layer = (p_base - p_full) / (p_base - p_top) - rh_min = rh_min_base - ( rh_min_base - rh_min_top ) * layer - rh_max = rh_max_base - ( rh_max_base - rh_max_top ) * layer - - else - ! Above the cloud top above top - rh_min = rh_min_top - rh_max = rh_max_top - endif - - end subroutine calc_rh_min_max - - subroutine calc_cf(q_hum, qsat, cf, cca, rh, simple_rhcrit, rh_min, rh_max) - ! Calculate large scale (stratiform) cloud fraction - ! as a simple linear function of RH - - real, intent(in) :: q_hum, qsat - real, intent(in), optional :: simple_rhcrit, rh_min, rh_max - - real, intent(out) :: cf, rh, cca - - ! The environment RH - rh = q_hum / qsat + subroutine calc_qcl_rad(p_full, temp, cf, qcl_rad) + ! calculate cloud water content + real, intent(in), dimension(:,:,:) :: p_full, cf, temp + real, intent(out), dimension(:,:,:) :: qcl_rad + real, dimension(size(temp,1), size(temp,2), size(temp,3)) :: in_cloud_qcl - if (spookie_protocol .eq. 1) then - cf = (rh - simple_rhcrit ) / (1.0 - simple_rhcrit) + if (do_qcl_with_temp) then + in_cloud_qcl = qcl_val * (temp-220.0) / (280.0-220.0) + in_cloud_qcl = MAX(3.0e-4, MIN(qcl_val, in_cloud_qcl)) / 1.0e3 ! convert to kg/kg else - cf = (rh - rh_min) / (rh_max - rh_min) - end if - - cf = MAX(0.0, MIN(1.0, cf)) + ! in_cloud_qcl as a function of height + in_cloud_qcl = 3.0e-4 + (1.0-3.0e-4) * (p_full-2.0e4) / 8.0e4 + in_cloud_qcl = MAX(0.0, in_cloud_qcl/1.0e3) ! convert to kg/kg + end if - ! include simple convective cloud fraction where present - ! This is currently not being used and array are zeros as - ! no convective cloud fraction is calculated - ! left in for future use + qcl_rad = cf * in_cloud_qcl - !if (cca > 0.0) then - ! cf = MAX( cca_lower_limit, cf ) - !end if - - end subroutine calc_cf - - subroutine calc_mixing_ratio(p_full, cf, temp, qcl_rad) - - ! calculate cloud water content - - real , intent(in) :: p_full, cf, temp - real , intent(out) :: qcl_rad ! mixing ratio of cloud liquid - - real :: in_cloud_qcl - - IF (spookie_protocol .eq. 1) THEN - ! pressure dependent in_cloud_qcl - ! bounded between: - ! 1 g/kg at 1000hpa - ! 3e-4 g/kg at 200 hpa - in_cloud_qcl = 3.0e-4 + (1.0 - 3.0e-4) * (p_full - p_top) / 80000.0 - in_cloud_qcl = MAX ( 0.0, in_cloud_qcl) ! in g/kg - ELSE - ! temperatue dependent in_cloud_qcl - ! bounded between: - ! 3e-4 g/kg at 220 K - ! 0.2 g/kg at 280K - in_cloud_qcl = MIN(0.2, 0.2 * ( temp - 220. ) / ( 280. - 220. )) - in_cloud_qcl = MAX(3.0e-4, in_cloud_qcl) ! in g/kg - ENDIF - - qcl_rad = cf * in_cloud_qcl / 1000. ! convert to kg/kg - - end subroutine calc_mixing_ratio - - subroutine output_cloud_diags(cf, reff_rad, frac_liq, qcl_rad, rh_in_cf, & - simple_rhcrit, rh_min, Time) - - real, intent(in), dimension(:,:,:) :: cf, reff_rad, frac_liq, qcl_rad, & - rh_in_cf - real, intent(in), dimension(:,:,:), optional :: simple_rhcrit, rh_min + end subroutine calc_qcl_rad + subroutine output_cloud_diags(cf, reff_rad, frac_liq, qcl_rad, rh_in_cf, Time) + real, intent(in), dimension(:,:,:) :: cf, reff_rad, frac_liq, qcl_rad, rh_in_cf type(time_type) , intent(in) :: Time - logical :: used - if ( id_cf > 0 ) then - used = send_data ( id_cf, cf, Time) + if (id_cf > 0) then + used = send_data (id_cf, cf, Time) endif - - if ( id_reff_rad > 0 ) then - used = send_data ( id_reff_rad, reff_rad, Time) + if (id_reff_rad > 0) then + used = send_data (id_reff_rad, reff_rad, Time) endif - - if ( id_frac_liq > 0 ) then - used = send_data ( id_frac_liq, frac_liq, Time) + if (id_frac_liq > 0) then + used = send_data (id_frac_liq, frac_liq, Time) endif - - if ( id_qcl_rad > 0 ) then - used = send_data ( id_qcl_rad, qcl_rad, Time) + if (id_qcl_rad > 0) then + used = send_data (id_qcl_rad, qcl_rad, Time) endif - - if ( id_rh_in_cf > 0 ) then - used = send_data ( id_rh_in_cf, rh_in_cf*100., Time) + if (id_rh_in_cf > 0) then + used = send_data (id_rh_in_cf, rh_in_cf*100., Time) endif - if ( id_simple_rhcrit > 0 ) then - used = send_data ( id_simple_rhcrit, simple_rhcrit*100.0, Time) - endif + end subroutine output_cloud_diags - if ( id_rh_min > 0 ) then - used = send_data ( id_rh_min, rh_min*100.0, Time) - endif + subroutine cloud_simple_end() - end subroutine output_cloud_diags + call large_scale_cloud_end() + if (do_add_stratocumulus) call marine_strat_cloud_end() + if (do_cloud_cover_diags) call cloud_cover_diags_end() + + end subroutine cloud_simple_end end module cloud_simple_mod diff --git a/src/atmos_param/cloud_simple/cloud_spookie.F90 b/src/atmos_param/cloud_simple/cloud_spookie.F90 new file mode 100644 index 000000000..7dcf50738 --- /dev/null +++ b/src/atmos_param/cloud_simple/cloud_spookie.F90 @@ -0,0 +1,391 @@ +module cloud_spookie_mod + + use fms_mod, only: stdlog, FATAL, WARNING, NOTE, error_mesg, & + open_namelist_file, close_file, open_file, & + check_nml_error, mpp_pe + use time_manager_mod, only: time_type + use sat_vapor_pres_mod, only: compute_qs + use constants_mod, only: KELVIN + + use diag_manager_mod, only: register_diag_field, send_data + + implicit none + + character(len=128) :: version='$Id: cloud_spookie.F90,v 1.0 2021/05/11$' + character(len=128) :: tag='Simple cloud scheme - SPOOKIE Protocol' + + logical :: do_init = .true. ! update to false after init has been run + + real :: cca_lower_limit = 0.0 ! simple convective cloud fraction min + ! the default is zero. Not being used but + ! could be adapted in future. + + ! There are two testing scenarios developed for SPOOKIE-2 project. Which + ! is why this code was created. The first was implemented and found not to + ! work very well in other models. It has been implemented her for curiousity + ! testing but not tested very much yet. The second protocol is what was used + ! for the SPOOKIE-2 runs and has been more widely tested. For this reason, + ! the default spookie_protocol is 2. The 1st protocol could be removed in + ! time (once the SPOOKIE-2 project is complete, but is left in the code for + ! now in case it is needed. + + integer :: spookie_protocol = 2 ! default is 2 + + ! Critical RH (fraction) values - SPOOKIE-2 protocol version 1 + real :: rhc_sfc = 1.0 + real :: rhc_base = 0.7 + real :: rhc_top = 0.2 ! In the protocol this was 20 % and in + ! implementation it was 30%. To check in + ! next round of validation. + + ! Critical RH (fraction) values - SPOOKIE-2 protocol version 2 + ! initial values for RH. Updated in calc_rh_min_max + real :: rh_min_sfc = 1.0 + real :: rh_min_base = 0.8 + real :: rh_min_top = 0.9 + + real :: rh_max_sfc = 1.0 + real :: rh_max_base = 1.0 + real :: rh_max_top = 1.0 + + ! Pressure (Pa) at cloud bottom and top (very approx) + real :: p_base = 70000. + real :: p_top = 20000. + + namelist /cloud_spookie_nml/ cca_lower_limit, spookie_protocol, & + rhc_sfc, rhc_base, rhc_top, & + rh_min_top, rh_min_sfc, rh_min_base, & + rh_max_top, rh_max_sfc, rh_max_base + + integer :: id_cf, id_reff_rad, id_frac_liq, id_qcl_rad, id_rh_in_cf, & + id_simple_rhcrit, id_rh_min + + character(len=14), parameter :: mod_name_cld = "cloud_simple" + + contains + + !----------------------------------------------- + + + subroutine cloud_spookie_init (axes, Time) + + type(time_type), intent(in) :: Time + integer, intent(in), dimension(4) :: axes + + integer :: io, ierr, unit + + unit = open_file (file='input.nml', action='read') + ierr=1 + do while (ierr /= 0) + read (unit, nml=cloud_spookie_nml, iostat=io, end=10) + ierr = check_nml_error (io, 'cloud_spookie_nml') + enddo + 10 call close_file (unit) + + unit = open_file (file='logfile.out', action='append') + if ( mpp_pe() == 0 ) then + write (unit,'(/,80("="),/(a))') trim(version), trim(tag) + write (unit,nml=cloud_spookie_nml) + endif + call close_file(unit) + + call error_mesg(mod_name_cld, 'Using SPOOKIE protocol cloud scheme', NOTE) + + !register diagnostics + id_cf = & + register_diag_field ( mod_name_cld, 'cf', axes(1:3), Time, & + 'Cloud fraction for the simple cloud scheme', 'unitless: values 0-1') + + id_frac_liq = & + register_diag_field ( mod_name_cld, 'frac_liq', axes(1:3), Time, & + 'Liquid cloud fraction (liquid, mixed-ice phase, ice)', & + 'unitless: values 0-1') + + id_reff_rad = & + register_diag_field ( mod_name_cld, 'reff_rad', axes(1:3), Time, & + 'Effective cloud particle radius', & + 'microns') + + id_qcl_rad = & + register_diag_field ( mod_name_cld, 'qcl_rad', axes(1:3), Time, & + 'Specific humidity of cloud liquid', & + 'kg/kg') + + ! rh_in_cf is an output diagnostic only for debugging + + id_rh_in_cf = & + register_diag_field ( mod_name_cld, 'rh_in_cf', axes(1:3), Time, & + 'RH as a percent', & + '%') + + id_simple_rhcrit = & + register_diag_field ( mod_name_cld, 'simple_rhcrit', axes(1:3), Time, & + 'RH as a percent for spookie protocol 1', & + '%') + + id_rh_min = & + register_diag_field ( mod_name_cld, 'rh_min', axes(1:3), Time, & + 'RH as a percent for spookie protocol 2', & + '%') + + + do_init = .false. !initialisation completed + + end subroutine cloud_spookie_init + + !----------------------------------------------- + + subroutine cloud_spookie(p_half, p_full, Time, & + temp, q_hum, & + ! outs + cf, cca, reff_rad, qcl_rad) + + real , intent(in), dimension(:,:,:) :: temp, q_hum, p_full, p_half + type(time_type) , intent(in) :: Time + + real , intent(inout), dimension(:,:,:) :: cf, cca, reff_rad, qcl_rad + + real, dimension(size(temp,1), size(temp, 2), size(temp, 3)) :: qs, frac_liq + real, dimension(size(temp,1), size(temp, 2), size(temp, 3)) :: rh_in_cf + real, dimension(size(temp,1), size(temp, 2), size(temp, 3)) :: simple_rhcrit + real, dimension(size(temp,1), size(temp, 2), size(temp, 3)) :: rh_min,rh_max + + integer :: i, j, k, k_surf + + !check initiation has been done + if (do_init) call error_mesg ('cloud_spookie', & + 'cloud_spookie_init has not been called.', FATAL) + + ! Get the saturated specific humidity with respect to water and ice + ! this is set by the namelist variable sat_vapor_pres_nml + call compute_qs(temp, p_full, qs) + + k_surf = size(temp, 3) !set the location of the lowest model level + + + ! For future revisions, consider rewriting to remove the loops. + do k=1, size(temp, 3) + do j=1, size(temp, 2) + do i=1, size(temp, 1) + + ! calculate the liquid fraction + call calc_liq_frac(temp(i,j,k), frac_liq(i,j,k)) + + ! calculate the effective radius + call calc_reff(frac_liq(i,j,k), reff_rad(i,j,k)) + + if (spookie_protocol .eq. 1) then + ! calculate the critical RH + call calc_rhcrit(p_full(i,j,k), p_full(i,j,k_surf), & + simple_rhcrit(i,j,k)) + else + ! calculate the min and max RH + call calc_rh_min_max(p_full(i,j,k), p_full(i,j,k_surf), & + rh_min(i,j,k), rh_max(i,j,k)) + endif + + ! calculate the cloud fraction + call calc_cf(q_hum(i,j,k), qs(i,j,k), cf(i,j,k), cca(i,j,k), & + rh_in_cf(i,j,k), simple_rhcrit = simple_rhcrit(i,j,k), & + rh_min = rh_min(i,j,k), rh_max = rh_max(i,j,k) ) + + ! calculate the specific humidity of cloud liquid + call calc_mixing_ratio(p_full(i,j,k), cf(i,j,k), temp(i,j,k), & + qcl_rad(i,j,k) ) + end do + end do + end do + + !save some diagnotics + call output_cloud_diags(cf, reff_rad, frac_liq, qcl_rad, rh_in_cf, & + simple_rhcrit, rh_min, Time ) + + end subroutine cloud_spookie + + subroutine calc_liq_frac(temp, frac_liq) + + real, intent(in) :: temp + real, intent(out) :: frac_liq + + if (temp > KELVIN) then + ! All liquid if temp above zero + frac_liq = 1.0 + else if (temp < KELVIN-40.0) then + ! All ice if temp is below -40C + frac_liq = 0.0 + else + ! linearly interpolate between T=0 and -40C + frac_liq = 1.0 - (KELVIN - temp) / 40.0 + end if + + end subroutine calc_liq_frac + + subroutine calc_reff(frac_liq, reff_rad) + ! the effective cloud radius is bounded between 10 and 20 microns + + real, intent(in) :: frac_liq + real, intent(out) :: reff_rad + + reff_rad = 10.0 * frac_liq + 20.0 * (1.0 - frac_liq) + ! units in microns this will be updated before passing into soc + + end subroutine calc_reff + + subroutine calc_rhcrit(p_full, p_surf, simple_rhcrit) + ! Get the RH needed as a threshold for the cloud fraction calc. + ! This is only requires for spookie_protocol=1 + real, intent(in) :: p_full, p_surf + real, intent(out) :: simple_rhcrit + + ! Calculate RHcrit as function of pressure + if (p_full > p_base) then + + simple_rhcrit = rhc_sfc - (rhc_sfc - rhc_base) * & + (p_surf - p_full) / (p_surf - p_base) + + else if (p_full > p_top) then + + simple_rhcrit = rhc_base - (rhc_base - rhc_top) * & + (p_base - p_full) / (p_base - p_top) + + else + simple_rhcrit = rhc_top + endif + + end subroutine calc_rhcrit + + subroutine calc_rh_min_max(p_full, p_surf, rh_min, rh_max) + + real, intent(in) :: p_full, p_surf + real, intent(out) :: rh_min, rh_max + + real :: layer + + ! calculate RH min and max as a function of pressure + + if (p_full > p_base) then + ! For the layer between the surface and cloud base (default is 700 hpa) + + layer = (p_surf - p_full) / (p_surf - p_base) + + ! correction step to update initial values + rh_min = rh_min_sfc - (rh_min_sfc - rh_min_base) * layer + rh_max = rh_max_sfc - (rh_max_sfc - rh_max_base) * layer + + else if ( p_full > p_top ) then + ! For the layer where the cloud is (base up to top) + + layer = (p_base - p_full) / (p_base - p_top) + rh_min = rh_min_base - ( rh_min_base - rh_min_top ) * layer + rh_max = rh_max_base - ( rh_max_base - rh_max_top ) * layer + + else + ! Above the cloud top above top + rh_min = rh_min_top + rh_max = rh_max_top + endif + + end subroutine calc_rh_min_max + + subroutine calc_cf(q_hum, qsat, cf, cca, rh, simple_rhcrit, rh_min, rh_max) + ! Calculate large scale (stratiform) cloud fraction + ! as a simple linear function of RH + + real, intent(in) :: q_hum, qsat + real, intent(in), optional :: simple_rhcrit, rh_min, rh_max + + real, intent(out) :: cf, rh, cca + + ! The environment RH + rh = q_hum / qsat + + if (spookie_protocol .eq. 1) then + cf = (rh - simple_rhcrit ) / (1.0 - simple_rhcrit) + else + cf = (rh - rh_min) / (rh_max - rh_min) + end if + + cf = MAX(0.0, MIN(1.0, cf)) + + ! include simple convective cloud fraction where present + ! This is currently not being used and array are zeros as + ! no convective cloud fraction is calculated + ! left in for future use + + !if (cca > 0.0) then + ! cf = MAX( cca_lower_limit, cf ) + !end if + + end subroutine calc_cf + + subroutine calc_mixing_ratio(p_full, cf, temp, qcl_rad) + + ! calculate cloud water content + + real , intent(in) :: p_full, cf, temp + real , intent(out) :: qcl_rad ! mixing ratio of cloud liquid + + real :: in_cloud_qcl + + IF (spookie_protocol .eq. 1) THEN + ! pressure dependent in_cloud_qcl + ! bounded between: + ! 1 g/kg at 1000hpa + ! 3e-4 g/kg at 200 hpa + in_cloud_qcl = 3.0e-4 + (1.0 - 3.0e-4) * (p_full - p_top) / 80000.0 + in_cloud_qcl = MAX ( 0.0, in_cloud_qcl) ! in g/kg + ELSE + ! temperatue dependent in_cloud_qcl + ! bounded between: + ! 3e-4 g/kg at 220 K + ! 0.2 g/kg at 280K + in_cloud_qcl = MIN(0.2, 0.2 * ( temp - 220. ) / ( 280. - 220. )) + in_cloud_qcl = MAX(3.0e-4, in_cloud_qcl) ! in g/kg + ENDIF + + qcl_rad = cf * in_cloud_qcl / 1000. ! convert to kg/kg + + end subroutine calc_mixing_ratio + + subroutine output_cloud_diags(cf, reff_rad, frac_liq, qcl_rad, rh_in_cf, & + simple_rhcrit, rh_min, Time) + + real, intent(in), dimension(:,:,:) :: cf, reff_rad, frac_liq, qcl_rad, & + rh_in_cf + real, intent(in), dimension(:,:,:), optional :: simple_rhcrit, rh_min + + type(time_type) , intent(in) :: Time + + logical :: used + + if ( id_cf > 0 ) then + used = send_data ( id_cf, cf, Time) + endif + + if ( id_reff_rad > 0 ) then + used = send_data ( id_reff_rad, reff_rad, Time) + endif + + if ( id_frac_liq > 0 ) then + used = send_data ( id_frac_liq, frac_liq, Time) + endif + + if ( id_qcl_rad > 0 ) then + used = send_data ( id_qcl_rad, qcl_rad, Time) + endif + + if ( id_rh_in_cf > 0 ) then + used = send_data ( id_rh_in_cf, rh_in_cf*100., Time) + endif + + if ( id_simple_rhcrit > 0 ) then + used = send_data ( id_simple_rhcrit, simple_rhcrit*100.0, Time) + endif + + if ( id_rh_min > 0 ) then + used = send_data ( id_rh_min, rh_min*100.0, Time) + endif + + end subroutine output_cloud_diags + +end module cloud_spookie_mod diff --git a/src/atmos_param/cloud_simple/large_scale_cloud.F90 b/src/atmos_param/cloud_simple/large_scale_cloud.F90 new file mode 100644 index 000000000..c26a78f4b --- /dev/null +++ b/src/atmos_param/cloud_simple/large_scale_cloud.F90 @@ -0,0 +1,334 @@ +module large_scale_cloud_mod + +#ifdef INTERNAL_FILE_NML + use mpp_mod, only: input_nml_file +#else + use fms_mod, only: open_namelist_file, close_file +#endif + + use fms_mod, only: stdlog, FATAL, WARNING, NOTE, error_mesg, & + uppercase, check_nml_error + use time_manager_mod, only: time_type + use sat_vapor_pres_mod, only: compute_qs, lookup_es + use diag_manager_mod, only: register_diag_field, send_data + use constants_mod, only: CP_AIR, GRAV, RDGAS, RVGAS, HLV, KAPPA, RADIUS, TFREEZE + + implicit none + + character(len=14), parameter :: mod_name = "ls_cloud" + + integer, parameter :: B_SPOOKIE=1, B_SUNDQVIST=2, B_LINEAR=3, & + B_SMITH=4, B_SLINGO=5, B_XR96=6 + integer, private :: cf_diag_formula = B_LINEAR + character(len=32) :: cf_diag_formula_name = 'linear' + + logical :: do_simple_rhcrit = .false. + logical :: do_fitted_rhcrit = .false. + logical :: do_adjust_cld_by_omega = .false. + logical :: do_poly_rhcrit = .false. + logical :: do_freezedry = .false. + + real :: rhcsfc = 0.95 + real :: rhc700 = 0.7 + real :: rhc200 = 0.3 + + ! Parameters to control the fitted critical RH profile + real :: rhc_surf = 0.8 + real :: rhc_top = 0.4 + real :: n_rhc = 3.1 + + ! Parameters for the freeze-dry problem in polar region + real :: qv_polar_val = 0.003 ! kg/kg + real :: freezedry_power = 2.5 + + ! Parameters to control linear coefficient profile + real :: linear_a_surf = 42 + real :: linear_a_top = 12 + real :: linear_power = 8.5 + + ! For slingo80 scheme + real :: slingo_rhc_low = 0.8 + real :: slingo_rhc_mid = 0.65 + real :: slingo_rhc_high = 0.8 + + ! For cloud adjustment by omega + real :: omega_adj_threshold = 0.1 !Pa/s + real :: adj_pres_threshold = 7.0e4 !Pa + + integer :: id_rhcrit + + namelist /large_scale_cloud_nml/ & + rhcsfc, rhc700, rhc200, & + do_fitted_rhcrit, do_poly_rhcrit, & + rhc_surf, rhc_top, n_rhc, & + cf_diag_formula_name, & + linear_a_surf, linear_a_top, linear_power, & + slingo_rhc_low, slingo_rhc_mid, slingo_rhc_high, & + do_adjust_cld_by_omega, omega_adj_threshold, adj_pres_threshold, & + do_freezedry, qv_polar_val, freezedry_power + + contains + + subroutine large_scale_cloud_init(axes, Time) + type(time_type), intent(in) :: Time + integer, intent(in), dimension(4) :: axes + integer :: io, ierr, nml_unit, stdlog_unit + character(len=32) :: method_str = '' + +#ifdef INTERNAL_FILE_NML + read(input_nml_file, nml=large_scale_cloud_nml, iostat=io) + ierr = check_nml_error(io, 'large_scale_cloud_nml') +#else + if (file_exist('input.nml')) then + nml_unit = open_namelist_file() + ierr = 1 + do while (ierr /= 0) + read(nml_unit, nml=large_scale_cloud_nml, iostat=io, end=10) + ierr = check_nml_error(io, 'large_scale_cloud_nml') + enddo +10 call close_file(nml_unit) + endif +#endif + stdlog_unit = stdlog() + write(stdlog_unit, large_scale_cloud_nml) + + ! Select cloud fraction diag formula + method_str = uppercase(trim(cf_diag_formula_name)) + + if(method_str == 'SPOOKIE') then + cf_diag_formula = B_SPOOKIE + call error_mesg(mod_name, 'Using default SPOOKIE cloud fraction diagnostic formula.', NOTE) + + else if(method_str == 'SUNDQVIST') then + cf_diag_formula = B_SUNDQVIST + call error_mesg(mod_name, 'Using Sundqvist (1989) cloud fraction diagnostic formula.', NOTE) + + else if(method_str == 'LINEAR') then + cf_diag_formula = B_LINEAR + call error_mesg(mod_name, 'Using linear cloud fraction diagnostic formula.', NOTE) + + else if(method_str == 'SMITH') then + cf_diag_formula = B_SMITH + call error_mesg(mod_name, 'Using Smith (1990) cloud fraction diagnostic formula.', NOTE) + + else if(method_str == 'SLINGO') then + cf_diag_formula = B_SLINGO + call error_mesg(mod_name, 'Using Slingo (1980) cloud fraction diagnostic formula.', NOTE) + + else if(method_str == 'XR96') then + cf_diag_formula = B_XR96 + call error_mesg(mod_name, 'Using Xu and Krueger (1996) cloud fraction diagnostic formula.', NOTE) + + else + call error_mesg(mod_name, '"'//trim(cf_diag_formula_name)//'"'// & + ' is not a valid cloud fraction diagnostic formula.', FATAL) + endif + + if (cf_diag_formula .eq. B_SPOOKIE .or. cf_diag_formula .eq. B_SUNDQVIST & + .or. cf_diag_formula .eq. B_SMITH) then + do_simple_rhcrit = .true. + else + do_simple_rhcrit = .false. + end if + + if(do_simple_rhcrit) then + id_rhcrit = register_diag_field (mod_name, 'rhcrit', axes(1:3), Time, & + 'critical relative humidity', '%') + end if + + end subroutine large_scale_cloud_init + + subroutine large_scale_cloud_diag(pfull, ps, rh, q_hum, qsat, qcl_rad, wg_full, cf, Time) + real, intent(in), dimension(:,:,:) :: pfull, rh, q_hum, qsat, qcl_rad, wg_full + real, intent(in), dimension(:,:) :: ps + real, intent(out), dimension(:,:,:) :: cf + type(time_type), intent(in) :: Time + real, dimension(size(rh,1), size(rh,2), size(rh,3)) :: rhcrit + logical :: used + + if (do_simple_rhcrit) then + call calc_rhcrit(pfull, rhcrit) + end if + + call calc_large_scale_cld_frac(pfull, ps, rh, q_hum, qsat, rhcrit, qcl_rad, cf) + + if(do_adjust_cld_by_omega) then + call adjust_cld_by_omega(pfull, wg_full, cf) + end if + + if(do_freezedry) then + call freezedry_adjustment(pfull, ps, cf, q_hum) + end if + + if (id_rhcrit > 0) then + used = send_data (id_rhcrit, rhcrit*100.0, Time) + endif + + end subroutine large_scale_cloud_diag + + subroutine calc_rhcrit(p_full, rhcrit) + !get the RH needed as a threshold for the cloud fraction calc. + real, intent(in), dimension(:,:,:) :: p_full + real, intent(out), dimension(:,:,:) :: rhcrit + real :: p_surf + real, dimension(size(p_full,1), size(p_full,2), size(p_full,3)) :: sigma + + real :: rhc1, rhc2, zrhc + p_surf = 1e5 + + if (do_fitted_rhcrit) then + rhcrit = rhc_top + (rhc_surf - rhc_top) * EXP(1.0 - (p_surf/p_full)**n_rhc) + else if (do_poly_rhcrit) then + rhc1 = 0.8 + rhc2 = 1.73 + zrhc = 0.95 !0.85 + sigma = p_full / p_surf + rhcrit = zrhc - rhc1*sigma * (1.0-sigma) * (1.0 + rhc2*(sigma-0.5)) + !rhcrit = poly_rhc_surf*sigma + poly_rhc_top*(1.0-sigma) + sigma * (1.0-sigma) * (1.0 + rhc2*(sigma-0.5)) + else + where (p_full > 7.0e4) + rhcrit = rhcsfc - (rhcsfc - rhc700) * (p_surf - p_full) / (p_surf - 7.0e4) + elsewhere (p_full > 2.0e4) + rhcrit = rhc700 - (rhc700 - rhc200) * (7.0e4 - p_full) / 5.0e4 + elsewhere + rhcrit = rhc200 + endwhere + end if + + end subroutine calc_rhcrit + + subroutine adjust_cld_by_omega(p_full, wg_full, cf) + real, intent(in), dimension(:,:,:) :: p_full, wg_full + real, intent(inout), dimension(:,:,:) :: cf + + where (p_full>adj_pres_threshold .and. omega_adj_threshold>wg_full .and. wg_full>0.0) + cf = min(1.0, (omega_adj_threshold-wg_full)/omega_adj_threshold) * cf + end where + + where (p_full>adj_pres_threshold .and. wg_full>=omega_adj_threshold) + cf = 0.0 + end where + + end subroutine adjust_cld_by_omega + + subroutine freezedry_adjustment(p_full, psg, cf, q_hum) + real, intent(in), dimension(:,:,:) :: p_full, q_hum + real, intent(in), dimension(:,:) :: psg + real, intent(inout), dimension(:,:,:) :: cf + integer :: k + real, dimension(size(cf,1), size(cf,2)) :: qv_k + + ! VAVRUS and WALISER, 2008, An Improved Parameterization for Simulating + ! Arctic Cloud Amount in the CCSM3 Climate Model, + ! Journal of Climate, DOI: 10.1175/2008JCLI2299.1 + ! + ! A difference from the paper is we adjust the clouds not only near the + ! surface but through all the levels of atmosphere + + do k=1,size(p_full,3) + qv_k = (p_full(:,:,k) / psg)**freezedry_power * qv_polar_val + cf(:,:,k) = cf(:,:,k) * MAX(0.15, MIN(1.0, q_hum(:,:,k) / qv_k)) + end do + + end subroutine freezedry_adjustment + + subroutine calc_large_scale_cld_frac(pfull, ps, rh, q_hum, qsat, rhcrit, qcl_rad, cf) + ! Calculate large scale (stratiform) cloud fraction + real, intent(in), dimension(:,:,:) :: pfull, rh, q_hum, qsat, rhcrit, qcl_rad + real, intent(in), dimension(:,:) :: ps + real, intent(out), dimension(:,:,:) :: cf + real, dimension(size(pfull,1), size(pfull,2), size(pfull,3)) :: rhc + real :: mid_top, mid_base, p_para, alpha_0, gamma ! For Xu and Krueger (1996) + integer :: i, j, k + + select case(cf_diag_formula) + case(B_SPOOKIE) + cf = (rh - rhcrit) / (1.0 - rhcrit) + + case(B_SUNDQVIST) + ! Refer to: Sundqvist et al., 1989, MWR, Condensation and Cloud Parameterization + ! Studies with a Mesoscale Numerical Weather Prediction Model + ! https://journals.ametsoc.org/doi/10.1175/1520-0493(1989)117%3C1641:CACPSW%3E2.0.CO%3B2 + ! + ! Eq (3.13) in the paper above + + cf = 1.0 - ((1.0 - MIN(rh,1.0)) / (1.0 - rhcrit))**0.5 + + case(B_SMITH) + ! Refer to: Smith (1990). A scheme for predicting layer clouds and their water + ! in a general circulation model. QJRMS, 116(492), 435-460. + + cf = 1.0 - (3.0 / sqrt(2.0) * (1.0 - MIN(rh,1.0))/(1.0 - rhcrit))**(2.0/3.0) + + case(B_SLINGO) + ! Refer to: Slingo (1980). A cloud parametrization scheme derived from + ! GATE data for use with a numerical model. QJRMS, 106(450), 747-770. + + mid_base = 8.0e4 + mid_top = 4.0e4 + rhc = 0.0 + + where (pfull > mid_base) + rhc = slingo_rhc_low + elsewhere (pfull < mid_top) + rhc = slingo_rhc_high + elsewhere + rhc = slingo_rhc_mid + end where + + where (rh= 273.15 K and with respect to ice if +! T < 273.15 K. +! * The value of rhl is interpreted to be the relative humidity with +! respect to liquid water +! * The value of rhs is interpreted to be the relative humidity with +! respect to ice +! - ldl is an optional logical flag. If true, the lifting deposition +! level (LDL) is returned instead of the LCL. +! - min_lcl_ldl is an optional logical flag. If true, the minimum of the +! LCL and LDL is returned. + +module lcl_mod + +contains + +function lcl(p,T,rh,rhl,rhs,return_ldl,return_min_lcl_ldl) + + implicit none + + ! In + double precision, intent(in) :: p, T + double precision, intent(in), optional :: rh, rhl, rhs + logical, intent(in), optional :: return_ldl, return_min_lcl_ldl + + ! Out + double precision :: lcl + + logical :: liquid2, solid2 + integer(kind=4) :: error + + double precision :: Ttrip, ptrip, E0v, E0s, ggr, rgasa, & + rgasv, cva, cvv, cvl, cvs, cpa, cpv, al, bl, cl, as, bs, cs, & + pv, qv, cpm, rgasm, rh2, rhl2, rhs2, ldl + integer :: rh_counter + logical :: return_ldl2, return_min_lcl_ldl2 + + ! Set defaults for options + return_ldl2 = .false. + return_min_lcl_ldl2 = .false. + + if (present(return_ldl)) return_ldl2 = return_ldl + if (present(return_min_lcl_ldl)) return_min_lcl_ldl2 = return_min_lcl_ldl + + ! Parameters + Ttrip = 273.16 ! K + ptrip = 611.65 ! Pa + E0v = 2.3740e6 ! J/kg + E0s = 0.3337e6 ! J/kg + ggr = 9.81 ! m/s^2 + rgasa = 287.04 ! J/kg/K + rgasv = 461. ! J/kg/K + cva = 719. ! J/kg/K + cvv = 1418. ! J/kg/K + cvl = 4119. ! J/kg/K + cvs = 1861. ! J/kg/K + cpa = cva + rgasa + cpv = cvv + rgasv + + ! Ensure that, at most, one of liquid and solid are true + if (return_ldl2 .and. return_min_lcl_ldl2) then + print *,'Error in lcl: At most, only one of return_ldl and return_min_lcl_ldl can be true' + stop + end if + + ! Calculate pv from rh, rhl, or rhs + rh_counter = 0 + if (present(rh )) rh_counter = rh_counter + 1 + if (present(rhl)) rh_counter = rh_counter + 1 + if (present(rhs)) rh_counter = rh_counter + 1 + if (rh_counter .ne. 1) then + print *,'Error in lcl: Exactly one of rh, rhl, and rhs must be specified' + stop + end if + + if (present(rh)) then + rh2 = rh + ! The variable rh is assumed to be + ! with respect to liquid if T > Ttrip and + ! with respect to solid if T < Ttrip + if (T > Ttrip) then + pv = rh2 * pvstarl(T) + else + pv = rh2 * pvstars(T) + end if + rhl2 = pv / pvstarl(T) + rhs2 = pv / pvstars(T) + else if (present(rhl)) then + rhl2 = rhl + pv = rhl2 * pvstarl(T) + rhs2 = pv / pvstars(T) + if (T > Ttrip) then + rh2 = rhl2 + else + rh2 = rhs2 + end if + else if (present(rhs)) then + rhs2 = rhs + pv = rhs2 * pvstars(T) + rhl2 = pv / pvstarl(T) + if (T > Ttrip) then + rh2 = rhl2 + else + rh2 = rhs2 + end if + end if + if (pv > p) then + print *,'Warning in lcl: pv exceeds p, returning -9999' + lcl = -9999. + return + end if + + ! Calculate lcl_liquid and lcl_solid + qv = rgasa*pv / (rgasv*p + (rgasa-rgasv)*pv) + rgasm = (1.-qv)*rgasa + qv*rgasv + cpm = (1.-qv)*cpa + qv*cpv + if (rh2==0) then + lcl = cpm*T/ggr + return + end if + al = -(cpv-cvl)/rgasv + cpm/rgasm + bl = -(E0v-(cvv-cvl)*Ttrip)/(rgasv*T) + !cl = pv/pvstarl(T)*exp(-(E0v-(cvv-cvl)*Ttrip)/(rgasv*T)) + cl = pv/pvstarl(T)*exp(bl) + + as = -(cpv-cvs)/rgasv + cpm/rgasm + bs = -(E0v+E0s-(cvv-cvs)*Ttrip)/(rgasv*T) + !cs = pv/pvstars(T)*exp(-(E0v+E0s-(cvv-cvs)*Ttrip)/(rgasv*T)) + cs = pv/pvstars(T)*exp(bs) + + lcl = cpm*T/ggr*( 1. - bl/(al*wapr(bl/al*cl**(1./al),-1,error,0)) ) + ldl = cpm*T/ggr*( 1. - bs/(as*wapr(bs/as*cs**(1./as),-1,error,0)) ) + + ! Return either the LCL or the LDL + if (return_ldl2 .and. return_min_lcl_ldl2) then + print *,'Error in lcl: return_ldl and return_min_lcl_ldl cannot both be true' + stop + else if (return_ldl2) then + lcl = ldl + else if (return_min_lcl_ldl2) then + lcl = min(lcl,ldl) + end if + + contains + + ! The saturation vapor pressure over liquid water + function pvstarl(T) + + implicit none + + double precision :: T ! In + double precision :: pvstarl ! Out + + pvstarl = ptrip * (T/Ttrip)**((cpv-cvl)/rgasv) * & + exp( (E0v - (cvv-cvl)*Ttrip) / rgasv * (1./Ttrip - 1./T) ) + + end function pvstarl + + ! The saturation vapor pressure over solid ice + function pvstars(T) + + implicit none + + double precision :: T ! In + double precision :: pvstars ! Out + + pvstars = ptrip * (T/Ttrip)**((cpv-cvs)/rgasv) * & + exp( (E0v + E0s - (cvv-cvs)*Ttrip) / rgasv * (1./Ttrip - 1./T) ) + + end function pvstars + +end function lcl + +function bisect ( xx, nb, ner, l ) + +!*****************************************************************************80 +! +!! BISECT approximates the W function using bisection. +! +! Discussion: +! +! The parameter TOL, which determines the accuracy of the bisection +! method, is calculated using NBITS (assuming the final bit is lost +! due to rounding error). +! +! N0 is the maximum number of iterations used in the bisection +! method. +! +! For XX close to 0 for Wp, the exponential approximation is used. +! The approximation is exact to O(XX^8) so, depending on the value +! of NBITS, the range of application of this formula varies. Outside +! this range, the usual bisection method is used. +! +! Licensing: +! +! This code is distributed under the GNU LGPL license. +! +! Modified: +! +! 15 June 2014 +! +! Author: +! +! Original FORTRAN77 version by Andrew Barry, S. J. Barry, +! Patricia Culligan-Hensley. +! This FORTRAN90 version by John Burkardt. +! +! Reference: +! +! Andrew Barry, S. J. Barry, Patricia Culligan-Hensley, +! Algorithm 743: WAPR - A Fortran routine for calculating real +! values of the W-function, +! ACM Transactions on Mathematical Software, +! Volume 21, Number 2, June 1995, pages 172-181. +! +! Parameters: +! +! Input, double precision :: XX, the argument. +! +! Input, integer ( kind = 4 ) NB, indicates the branch of the W function. +! 0, the upper branch; +! nonzero, the lower branch. +! +! Output, integer ( kind = 4 ) NER, the error flag. +! 0, success; +! 1, the routine did not converge. Perhaps reduce NBITS and try again. +! +! Input, integer ( kind = 4 ) L, the offset indicator. +! 1, XX represents the offset of the argument from -exp(-1). +! not 1, XX is the actual argument. +! +! Output, double precision :: BISECT, the value of W(X), as determined +! + implicit none + + double precision :: bisect +! double precision :: crude + double precision :: d + double precision :: f + double precision :: fd + integer ( kind = 4 ) i + integer ( kind = 4 ) l + integer ( kind = 4 ) n0 + parameter ( n0 = 500 ) + integer ( kind = 4 ) nb + integer ( kind = 4 ), save :: nbits = 0 + integer ( kind = 4 ) ner + double precision :: r + double precision :: test + double precision :: tol + double precision :: u + double precision :: x + double precision :: xx + + bisect = 0.0D+00 + ner = 0 + + if ( nbits == 0 ) then + call nbits_compute ( nbits ) + end if + + if ( l == 1 ) then + x = xx - exp ( -1.0D+00 ) + else + x = xx + end if + + if ( nb == 0 ) then + + test = 1.0D+00 / ( 2.0D+00 ** nbits ) ** ( 1.0D+00 / 7.0D+00 ) + + if ( abs ( x ) < test ) then + + bisect = x & + * exp ( - x & + * exp ( - x & + * exp ( - x & + * exp ( - x & + * exp ( - x & + * exp ( - x )))))) + + return + + else + + u = crude ( x, nb ) + 1.0D-03 + tol = abs ( u ) / 2.0D+00 ** nbits + d = max ( u - 2.0D-03, -1.0D+00 ) + + do i = 1, n0 + + r = 0.5D+00 * ( u - d ) + bisect = d + r +! +! Find root using w*exp(w)-x to avoid ln(0) error. +! + if ( x < exp ( 1.0D+00 ) ) then + + f = bisect * exp ( bisect ) - x + fd = d * exp ( d ) - x +! +! Find root using ln(w/x)+w to avoid overflow error. +! + else + + f = log ( bisect / x ) + bisect + fd = log ( d / x ) + d + + end if + + if ( f == 0.0D+00 ) then + return + end if + + if ( abs ( r ) <= tol ) then + return + end if + + if ( 0.0D+00 < fd * f ) then + d = bisect + else + u = bisect + end if + + end do + + end if + + else + + d = crude ( x, nb ) - 1.0D-03 + u = min ( d + 2.0D-03, -1.0D+00 ) + tol = abs ( u ) / 2.0D+00 ** nbits + + do i = 1, n0 + + r = 0.5D+00 * ( u - d ) + bisect = d + r + f = bisect * exp ( bisect ) - x + + if ( f == 0.0D+00 ) then + return + end if + + if ( abs ( r ) <= tol ) then + return + end if + + fd = d * exp ( d ) - x + + if ( 0.0D+00 < fd * f ) then + d = bisect + else + u = bisect + end if + + end do + + end if +! +! The iteration did not converge. +! + ner = 1 + + return +end function bisect + +function crude ( xx, nb ) + +!*****************************************************************************80 +! +!! CRUDE returns a crude approximation for the W function. +! +! Licensing: +! +! This code is distributed under the GNU LGPL license. +! +! Modified: +! +! 15 June 2014 +! +! Author: +! +! Original FORTRAN77 version by Andrew Barry, S. J. Barry, +! Patricia Culligan-Hensley. +! This FORTRAN90 version by John Burkardt. +! +! Reference: +! +! Andrew Barry, S. J. Barry, Patricia Culligan-Hensley, +! Algorithm 743: WAPR - A Fortran routine for calculating real +! values of the W-function, +! ACM Transactions on Mathematical Software, +! Volume 21, Number 2, June 1995, pages 172-181. +! +! Parameters: +! +! Input, double precision :: XX, the argument. +! +! Input, integer ( kind = 4 ) NB, indicates the desired branch. +! * 0, the upper branch; +! * nonzero, the lower branch. +! +! Output, double precision :: CRUDE, the crude approximation to W at XX. +! + implicit none + + double precision :: an2 + double precision :: c13 + double precision :: crude + double precision :: em + double precision :: em2 + double precision :: em9 + double precision :: eta + integer ( kind = 4 ) init + integer ( kind = 4 ) nb + double precision :: reta + double precision :: s2 + double precision :: s21 + double precision :: s22 + double precision :: s23 + double precision :: t + double precision :: ts + double precision :: xx + double precision :: zl + + save c13 + save em + save em2 + save em9 + save init + save s2 + save s21 + save s22 + save s23 + + data init / 0 / + + crude = 0.0D+00 +! +! Various mathematical constants. +! + if ( init == 0 ) then + init = 1 + em = - exp ( -1.0D+00 ) + em9 = - exp ( -9.0D+00 ) + c13 = 1.0D+00 / 3.0D+00 + em2 = 2.0D+00 / em + s2 = sqrt ( 2.0D+00 ) + s21 = 2.0D+00 * s2 - 3.0D+00 + s22 = 4.0D+00 - 3.0D+00 * s2 + s23 = s2 - 2.0D+00 + end if +! +! Crude Wp. +! + if ( nb == 0 ) then + + if ( xx <= 20.0D+00 ) then + reta = s2 * sqrt ( 1.0D+00 - xx / em ) + an2 = 4.612634277343749D+00 * sqrt ( sqrt ( reta + & + 1.09556884765625D+00 ) ) + crude = reta / ( 1.0D+00 + reta / ( 3.0D+00 & + + ( s21 * an2 + s22 ) * reta / ( s23 * ( an2 + reta )))) - 1.0D+00 + else + zl = log ( xx ) + crude = log ( xx / log ( xx & + / zl ** exp ( -1.124491989777808D+00 / & + ( 0.4225028202459761D+00 + zl )))) + end if + + else +! +! Crude Wm. +! + if ( xx <= em9 ) then + zl = log ( -xx ) + t = -1.0D+00 - zl + ts = sqrt ( t ) + crude = zl - ( 2.0D+00 * ts ) / ( s2 + ( c13 - t & + / ( 2.7D+02 + ts * 127.0471381349219D+00 ) ) * ts ) + else + zl = log ( -xx ) + eta = 2.0D+00 - em2 * xx + crude = log ( xx / log ( - xx / ( ( 1.0D+00 & + - 0.5043921323068457D+00 * ( zl + 1.0D+00 ) ) & + * ( sqrt ( eta ) + eta / 3.0D+00 ) + 1.0D+00 ) ) ) + end if + + end if + + return +end function crude + +subroutine nbits_compute ( nbits ) + +!*****************************************************************************80 +! +!! NBITS_COMPUTE computes the mantissa length minus one. +! +! Discussion: +! +! NBITS is the number of bits (less 1) in the mantissa of the +! floating point number number representation of your machine. +! It is used to determine the level of accuracy to which the W +! function should be calculated. +! +! Most machines use a 24-bit matissa for single precision and +! 53-56 bits for double precision ::. The IEEE standard is 53 +! bits. The Fujitsu VP2200 uses 56 bits. Long word length +! machines vary, e.g., the Cray X/MP has a 48-bit mantissa for +! single precision. +! +! Licensing: +! +! This code is distributed under the GNU LGPL license. +! +! Modified: +! +! 15 June 2014 +! +! Author: +! +! Original FORTRAN77 version by Andrew Barry, S. J. Barry, +! Patricia Culligan-Hensley. +! This FORTRAN90 version by John Burkardt. +! +! Reference: +! +! Andrew Barry, S. J. Barry, Patricia Culligan-Hensley, +! Algorithm 743: WAPR - A Fortran routine for calculating real +! values of the W-function, +! ACM Transactions on Mathematical Software, +! Volume 21, Number 2, June 1995, pages 172-181. +! +! Parameters: +! +! Output, integer ( kind = 4 ) NBITS, the mantissa length, in bits, +! minus one. +! + implicit none + + double precision :: b + integer ( kind = 4 ) i + integer ( kind = 4 ) nbits + double precision :: v + + nbits = 0 + + b = 1.0D+00 + + do + + b = b / 2.0D+00 + v = b + 1.0D+00 + + if ( v == 1.0D+00 ) then + return + end if + + nbits = nbits + 1 + + end do + + return +end subroutine nbits_compute + +subroutine timestamp ( ) + +!*****************************************************************************80 +! +!! TIMESTAMP prints the current YMDHMS date as a time stamp. +! +! Example: +! +! 31 May 2001 9:45:54.872 AM +! +! Licensing: +! +! This code is distributed under the GNU LGPL license. +! +! Modified: +! +! 18 May 2013 +! +! Author: +! +! John Burkardt +! +! Parameters: +! +! None +! + implicit none + + character ( len = 8 ) ampm + integer ( kind = 4 ) d + integer ( kind = 4 ) h + integer ( kind = 4 ) m + integer ( kind = 4 ) mm + character ( len = 9 ), parameter, dimension(12) :: month = (/ & + 'January ', 'February ', 'March ', 'April ', & + 'May ', 'June ', 'July ', 'August ', & + 'September', 'October ', 'November ', 'December ' /) + integer ( kind = 4 ) n + integer ( kind = 4 ) s + integer ( kind = 4 ) values(8) + integer ( kind = 4 ) y + + call date_and_time ( values = values ) + + y = values(1) + m = values(2) + d = values(3) + h = values(5) + n = values(6) + s = values(7) + mm = values(8) + + if ( h < 12 ) then + ampm = 'AM' + else if ( h == 12 ) then + if ( n == 0 .and. s == 0 ) then + ampm = 'Noon' + else + ampm = 'PM' + end if + else + h = h - 12 + if ( h < 12 ) then + ampm = 'PM' + else if ( h == 12 ) then + if ( n == 0 .and. s == 0 ) then + ampm = 'Midnight' + else + ampm = 'AM' + end if + end if + end if + + write ( *, '(i2.2,1x,a,1x,i4,2x,i2,a1,i2.2,a1,i2.2,a1,i3.3,1x,a)' ) & + d, trim ( month(m) ), y, h, ':', n, ':', s, '.', mm, trim ( ampm ) + + return +end subroutine timestamp + +function wapr ( x, nb, nerror, l ) + +!*****************************************************************************80 +! +!! WAPR approximates the W function. +! +! Discussion: +! +! The call will fail if the input value X is out of range. +! The range requirement for the upper branch is: +! -exp(-1) <= X. +! The range requirement for the lower branch is: +! -exp(-1) < X < 0. +! +! Licensing: +! +! This code is distributed under the GNU LGPL license. +! +! Modified: +! +! 15 June 2014 +! +! Author: +! +! Original FORTRAN77 version by Andrew Barry, S. J. Barry, +! Patricia Culligan-Hensley. +! This FORTRAN90 version by John Burkardt. +! +! Reference: +! +! Andrew Barry, S. J. Barry, Patricia Culligan-Hensley, +! Algorithm 743: WAPR - A Fortran routine for calculating real +! values of the W-function, +! ACM Transactions on Mathematical Software, +! Volume 21, Number 2, June 1995, pages 172-181. +! +! Parameters: +! +! Input, double precision :: X, the argument. +! +! Input, integer ( kind = 4 ) NB, indicates the desired branch. +! * 0, the upper branch; +! * nonzero, the lower branch. +! +! Output, integer ( kind = 4 ) NERROR, the error flag. +! * 0, successful call. +! * 1, failure, the input X is out of range. +! +! Input, integer ( kind = 4 ) L, indicates the interpretation of X. +! * 1, X is actually the offset from -(exp-1), so compute W(X-exp(-1)). +! * not 1, X is the argument; compute W(X); +! +! Output, double precision :: WAPR, the approximate value of W(X). +! + implicit none + + double precision :: an2 + double precision :: an3 + double precision :: an4 + double precision :: an5 + double precision :: an6 + double precision :: c13 + double precision :: c23 + double precision :: d12 + double precision :: delx + double precision :: em + double precision :: em2 + double precision :: em9 + double precision :: eta + integer ( kind = 4 ) i + integer ( kind = 4 ) init + integer ( kind = 4 ) l + integer ( kind = 4 ) m + integer ( kind = 4 ) nb + integer ( kind = 4 ) nbits + integer ( kind = 4 ) nerror + integer ( kind = 4 ) niter + double precision :: reta + double precision :: s2 + double precision :: s21 + double precision :: s22 + double precision :: s23 + double precision :: t + double precision :: tb + double precision :: tb2 + double precision :: temp + double precision :: temp2 + double precision :: ts + double precision :: wapr + double precision :: x + double precision :: x0 + double precision :: x1 + double precision :: xx + double precision :: zl + double precision :: zn + + save an3 + save an4 + save an5 + save an6 + save c13 + save c23 + save d12 + save em + save em2 + save em9 + save init + save nbits + save niter + save s2 + save s21 + save s22 + save s23 + save tb + save tb2 + save x0 + save x1 + + data init / 0 / + data niter / 1 / + + wapr = 0.0D+00 + nerror = 0 + + if ( init == 0 ) then + + init = 1 + + call nbits_compute ( nbits ) + + if ( 56 <= nbits ) then + niter = 2 + end if +! +! Various mathematical constants. +! + em = -exp ( -1.0D+00 ) + em9 = -exp ( -9.0D+00 ) + c13 = 1.0D+00 / 3.0D+00 + c23 = 2.0D+00 * c13 + em2 = 2.0D+00 / em + d12 = -em2 + tb = 0.5D+00 ** nbits + tb2 = sqrt ( tb ) + x0 = tb ** ( 1.0D+00 / 6.0D+00 ) * 0.5D+00 + x1 = ( 1.0D+00 - 17.0D+00 * tb ** ( 2.0D+00 / 7.0D+00 ) ) * em + an3 = 8.0D+00 / 3.0D+00 + an4 = 135.0D+00 / 83.0D+00 + an5 = 166.0D+00 / 39.0D+00 + an6 = 3167.0D+00 / 3549.0D+00 + s2 = sqrt ( 2.0D+00 ) + s21 = 2.0D+00 * s2 - 3.0D+00 + s22 = 4.0D+00 - 3.0D+00 * s2 + s23 = s2 - 2.0D+00 + + end if + + if ( l == 1 ) then + + delx = x + + if ( delx < 0.0D+00 ) then + nerror = 1 + write ( *, '(a)' ) '' + write ( *, '(a)' ) 'WAPR - Fatal error!' + write ( *, '(a)' ) ' The offset X is negative.' + write ( *, '(a)' ) ' It must be nonnegative.' + stop 1 + end if + + xx = x + em + + else + + if ( x < em ) then + nerror = 1 + return + else if ( x == em ) then + wapr = -1.0D+00 + return + end if + + xx = x + delx = xx - em + + end if + + if ( nb == 0 ) then +! +! Calculations for Wp. +! + if ( abs ( xx ) <= x0 ) then + wapr = xx / ( 1.0D+00 + xx / ( 1.0D+00 + xx & + / ( 2.0D+00 + xx / ( 0.6D+00 + 0.34D+00 * xx )))) + return + else if ( xx <= x1 ) then + reta = sqrt ( d12 * delx ) + wapr = reta / ( 1.0D+00 + reta / ( 3.0D+00 + reta / ( reta & + / ( an4 + reta / ( reta * an6 + an5 ) ) + an3 ) ) ) & + - 1.0D+00 + return + else if ( xx <= 20.0D+00 ) then + reta = s2 * sqrt ( 1.0D+00 - xx / em ) + an2 = 4.612634277343749D+00 * sqrt ( sqrt ( reta + & + 1.09556884765625D+00 )) + wapr = reta / ( 1.0D+00 + reta / ( 3.0D+00 + ( s21 * an2 & + + s22 ) * reta / ( s23 * ( an2 + reta )))) - 1.0D+00 + else + zl = log ( xx ) + wapr = log ( xx / log ( xx & + / zl ** exp ( -1.124491989777808D+00 / & + ( 0.4225028202459761D+00 + zl )))) + end if +! +! Calculations for Wm. +! + else + + if ( 0.0D+00 <= xx ) then + nerror = 1 + return + else if ( xx <= x1 ) then + reta = sqrt ( d12 * delx ) + wapr = reta / ( reta / ( 3.0D+00 + reta / ( reta / ( an4 & + + reta / ( reta * an6 - an5 ) ) - an3 ) ) - 1.0D+00 ) - 1.0D+00 + return + else if ( xx <= em9 ) then + zl = log ( -xx ) + t = -1.0D+00 - zl + ts = sqrt ( t ) + wapr = zl - ( 2.0D+00 * ts ) / ( s2 + ( c13 - t & + / ( 270.0D+00 + ts * 127.0471381349219D+00 )) * ts ) + else + zl = log ( -xx ) + eta = 2.0D+00 - em2 * xx + wapr = log ( xx / log ( -xx / ( ( 1.0D+00 & + - 0.5043921323068457D+00 * ( zl + 1.0D+00 ) ) & + * ( sqrt ( eta ) + eta / 3.0D+00 ) + 1.0D+00 ))) + end if + + end if + + do i = 1, niter + zn = log ( xx / wapr ) - wapr + temp = 1.0D+00 + wapr + temp2 = temp + c23 * zn + temp2 = 2.0D+00 * temp * temp2 + wapr = wapr * ( 1.0D+00 + ( zn / temp ) * ( temp2 - zn ) & + / ( temp2 - 2.0D+00 * zn ) ) + end do + + return +end function wapr + +end module lcl_mod diff --git a/src/atmos_param/cloud_simple/marine_strat_cloud.F90 b/src/atmos_param/cloud_simple/marine_strat_cloud.F90 new file mode 100644 index 000000000..007af2e5f --- /dev/null +++ b/src/atmos_param/cloud_simple/marine_strat_cloud.F90 @@ -0,0 +1,593 @@ +module marine_strat_cloud_mod + +#ifdef INTERNAL_FILE_NML + use mpp_mod, only: input_nml_file +#else + use fms_mod, only: open_namelist_file, close_file +#endif + + use fms_mod, only: stdlog, FATAL, WARNING, NOTE, error_mesg, & + uppercase, check_nml_error + use time_manager_mod, only: time_type + use sat_vapor_pres_mod, only: compute_qs, lookup_es + use diag_manager_mod, only: register_diag_field, send_data + use constants_mod, only: CP_AIR, GRAV, RDGAS, RVGAS, HLV, KAPPA, RADIUS, TFREEZE + use lcl_mod, only: lcl + + implicit none + + character(len=14), parameter :: mod_name = "strat_cloud" + + character(len=32) :: sc_diag_method = 'Park_ELF' + logical :: intermediate_outputs_diags = .false. + real :: dthdp_min_threshold = -0.05 ! K/hPa, which is -0.125 in CESM1.2.1 + + ! ----- outputs for EIS, ECTEI and ELF diagnostics ----- ! + integer :: id_theta, id_dthdp, id_lts, id_eis, id_ectei, id_zlcl, & + id_gamma_850, id_gamma_DL, id_gamma_700, id_z700, & + id_zinv, id_ELF, id_beta1, id_beta2, id_IS, id_DS, id_alpha, & + id_low_cld_amt_park, id_marine_strat + + ! Define constants for Earth mass and Newtonian gravational constant + ! Refer to: https://github.com/Unidata/MetPy/ --> src/metpy/constants.py + real :: EARTH_MASS = 5.9722e24 ! kg + ! Refer to: https://physics.nist.gov/cgi-bin/cuu/Value?bg + real :: GRAV_CONST = 6.674e-11 ! m^3 / kg / s^2 + + ! Linear coefficient for Park_ELF scheme + real :: park_a = 1.272 + real :: park_b = -0.366 + + namelist /marine_strat_cloud_nml/ & + sc_diag_method, intermediate_outputs_diags, dthdp_min_threshold, & + park_a, park_b + + contains + + subroutine marine_strat_cloud_init(axes, Time) + type(time_type), intent(in) :: Time + integer, intent(in), dimension(4) :: axes + integer :: io, ierr, nml_unit, stdlog_unit + character(len=32) :: method_str = '' + +#ifdef INTERNAL_FILE_NML + read(input_nml_file, nml=marine_strat_cloud_nml, iostat=io) + ierr = check_nml_error(io, 'marine_strat_cloud_nml') +#else + if (file_exist('input.nml')) then + nml_unit = open_namelist_file() + ierr = 1 + do while (ierr /= 0) + read(nml_unit, nml=marine_strat_cloud_nml, iostat=io, end=10) + ierr = check_nml_error(io, 'marine_strat_cloud_nml') + enddo +10 call close_file(nml_unit) + endif +#endif + stdlog_unit = stdlog() + write(stdlog_unit, marine_strat_cloud_nml) + + call error_mesg(mod_name, 'The stratomulus diagnosis method is '// & + uppercase(trim(sc_diag_method)), NOTE) + + method_str = uppercase(trim(sc_diag_method)) + + if (method_str(1:3)=='EIS' .or. method_str(1:5)=='ECTEI' & + .or. method_str(1:4)=='PARK') then + id_eis = register_diag_field (mod_name, 'eis', axes(1:2), Time, & + 'estimated inversion strength', 'K') + end if + + if (method_str(1:5)=='ECTEI' .or. method_str(1:4)=='PARK') then + id_ectei = register_diag_field (mod_name, 'ectei', axes(1:2), Time, & + 'estimated cloud top entrainment index', 'K') + end if + + if (method_str(1:4)=='PARK') then + id_ELF = register_diag_field (mod_name, 'ELF', axes(1:2), Time, & + 'estimated low cloud fraction', '') + end if + + id_marine_strat = register_diag_field ( mod_name, 'marine_strat', axes(1:3), Time, & + 'marine low stratus cloud amount', '0-1' ) + + id_zlcl = register_diag_field (mod_name, 'zlcl', axes(1:2), Time, & + 'height of lcl', 'meter') + id_theta = register_diag_field (mod_name, 'theta', axes(1:3), Time, & + 'potential temperature', 'K') + id_lts = register_diag_field (mod_name, 'lts', axes(1:2), Time, & + 'low-tropospheric stability', 'K') + + if(intermediate_outputs_diags) then + id_dthdp = register_diag_field (mod_name, 'dthdp', axes(1:3), Time, & + 'dtheta/dp', 'K/hPa' ) + id_z700 = register_diag_field ( mod_name, 'z700', axes(1:2), Time, & + 'height of 700mb', 'meter') + + if (method_str(1:3)=='EIS') then + id_gamma_850 = register_diag_field (mod_name, 'gamma850', axes(1:2), Time, & + 'moist lapse rate at 850hPa', 'K/m') + end if + + if (method_str(1:4)=='PARK') then + id_beta1 = register_diag_field (mod_name, 'beta1', axes(1:2), Time, & + 'first low-level cloud suppression parameter', '') + id_beta2 = register_diag_field (mod_name, 'beta2', axes(1:2), Time, & + 'second low-level cloud suppression parameter', '') + id_zinv = register_diag_field (mod_name, 'zinv', axes(1:2), Time, & + 'height of invesion layer', 'meter') + id_DS = register_diag_field (mod_name, 'DS', axes(1:2), Time, & + 'decoupling strength', 'K') + id_IS = register_diag_field (mod_name, 'IS', axes(1:2), Time, & + 'inversion strength', 'K') + id_alpha = register_diag_field (mod_name, 'alpha', axes(1:2), Time, & + 'decoupling parameter', '') + id_low_cld_amt_park = register_diag_field ( mod_name, 'low_cld_amt_park', axes(1:2), Time, & + 'low cloud amount estimated from Park method', 'percent' ) + id_gamma_DL = register_diag_field (mod_name, 'gamma_DL', axes(1:2), Time, & + 'moist lapse rate at decoupling layer', 'K/m') + id_gamma_700 = register_diag_field (mod_name, 'gamma700', axes(1:2), Time, & + 'moist lapse rate at 700hPa', 'K/m') + end if + end if + + end subroutine marine_strat_cloud_init + + subroutine marine_strat_cloud_diag(temp, p_full, p_half, z_full, rh, q_hum, temp_2m, & + q_2m, rh_2m, psg, wg_full, klcls, cf, Time, ocean) + implicit none + real, intent(in), dimension(:,:,:) :: temp, q_hum, p_full, p_half, z_full, rh, wg_full + type(time_type), intent(in) :: Time + real, intent(in), dimension(:,:) :: temp_2m, q_2m, rh_2m, psg + integer, intent(in), dimension(:,:) :: klcls + logical, intent(in), dimension(:,:) :: ocean + real, intent(out), dimension(:,:,:) :: cf + + ! local variables + real, dimension(size(temp,1), size(temp,2), size(temp,3)) :: theta, dthdp, marine_strat + integer, dimension(size(temp,1), size(temp,2)) :: kdthdp, kinvs + real, dimension(size(temp,1), size(temp,2)) :: eis, ectei, ELF, low_ca_park + real :: strat, omega_pos_threshold + logical :: used + character(len=32) :: method_str = '' + integer :: i, j, k, k700, kb, k_surf, kk, nlev + + eis = 0.0 + ectei = 0.0 + ELF = 0.0 + dthdp = 0.0 + + call calc_theta_dthdp(temp, temp_2m, p_full, p_half, psg, theta, dthdp, kdthdp) + + method_str = uppercase(trim(sc_diag_method)) + if (method_str(1:3)=='EIS' .or. method_str(1:5)=='ECTEI') then + call calc_eis(p_full, z_full, temp, temp_2m, psg, klcls, eis, Time) + end if + if (method_str(1:5)=='ECTEI') then + call calc_ectei(p_full, q_hum, q_2m, eis, ectei, Time) + end if + if (method_str(1:4)=='PARK') then + call calc_Park_proxies(p_full, psg, z_full, temp, temp_2m, q_hum, & + q_2m, rh_2m, klcls, ELF, kinvs, Time) + end if + + k_surf = size(temp, 3) + omega_pos_threshold = 0. !1.4*100/3600 + marine_strat = 0.0 + + do i=1, size(temp, 1) + do j=1, size(temp, 2) + if (ocean(i,j)) then + ! =========== Add off-coast marine stratiform clouds =========== ! + kk = kdthdp(i,j) + + if (kk .ne. 0) then + kb = min(kk+1, k_surf) + do k = kk, kb + if (wg_full(i,j,k)>omega_pos_threshold .and. & + dthdp(i,j,k)8.0e4) then + call estimate_stratiform_cld(method_str, i, j, k, kb, p_full, & + cf, rh, theta, eis, dthdp, ectei, ELF) + marine_strat(i,j,k) = min(1.0, max(0.0, cf(i,j,k))) + end if + end do + endif + end if + end do + end do + + if (id_theta > 0) then + used = send_data(id_theta, theta, Time) + end if + if (id_marine_strat > 0) then + used = send_data(id_marine_strat, marine_strat, Time) + end if + + if(intermediate_outputs_diags) then + if (id_dthdp > 0) then + used = send_data(id_dthdp, dthdp, Time) + end if + if (id_low_cld_amt_park > 0) then + used = send_data(id_low_cld_amt_park, low_ca_park, Time) + end if + end if + end subroutine marine_strat_cloud_diag + + subroutine estimate_stratiform_cld(method_str, i, j, k, kb, pfull, & + cf, rh, theta, eis, dthdp, ectei, ELF) + implicit none + integer, intent(in) :: i, j, k + integer, intent(in) :: kb + character(len=32), intent(in) :: method_str + real, intent(in), dimension(:,:,:) :: rh, theta, pfull, dthdp + real, intent(in), dimension(:,:) :: eis, ectei, ELF + real, intent(out), dimension(:,:,:) :: cf + real :: strat, rhb_frac + integer :: k700, k_surf + + k_surf = size(pfull, 3) + k700 = minloc(abs(pfull(i,j,:) - 7.0e4), 1) + + if(method_str == 'LTS') then + strat = min(1.0, max(0.0, (theta(i,j,k700) - theta(i,j,k_surf)) * 0.057 - 0.5573)) + cf(i,j,k) = max(strat, cf(i,j,k)) + + else if(method_str == 'SLINGO') then + strat = min(1.0, max(0.0, -6.67*dthdp(i,j,k) - 0.667)) + rhb_frac = min(1.0, max(0.0, (rh(i,j,kb) - 0.6) / 0.2)) + cf(i,j,k) = min(1.0, max(cf(i,j,k), strat*rhb_frac)) + + else if(method_str == 'EIS_WOOD') then + !strat = min(1.0, max(0.0, 0.0221*eis(i,j) + 0.1128)) + strat = min(1.0, max(0.0, 0.06*eis(i,j) + 0.14)) ! Wood and Betherton, 2006 + cf(i,j,k) = min(1.0, max(cf(i,j,k), strat)) + + else if(method_str == 'ECTEI') then + ! Kawai, Koshiro and Webb, 2017 + strat = min(1.0, max(0.0, 0.031*ectei(i,j) + 0.39)) + cf(i,j,k) = min(1.0, max(cf(i,j,k), strat)) + + else if(method_str == 'PARK_ELF') then + ! Park and Shin, 2019, ACP + ! strat = min(1.0, max(0.0, 1.272*ELF(i,j)-0.366)) + strat = min(1.0, max(0.0, park_a * ELF(i,j) + park_b)) + cf(i,j,k) = min(1.0, max(cf(i,j,k), strat)) + + else + call error_mesg('cloud_simple', method_str//' is not supported yet!', FATAL) + + end if + end subroutine estimate_stratiform_cld + + subroutine calc_theta_dthdp(temp, temp_2m, pfull, phalf, ps, theta, dthdp, kdthdp) + real, intent(in), dimension(:,:,:) :: temp, pfull, phalf + real, intent(in), dimension(:,:) :: temp_2m, ps + real, intent(out), dimension(:,:,:) :: theta, dthdp + integer, intent(out), dimension(:,:) :: kdthdp + real, dimension(size(temp,1), size(temp,2)) :: theta_0 + real :: premib, pstar + integer :: i, j, k, kb + + kdthdp = 0 + premib = 8.0e4 + dthdp = 0.0 + pstar = 1.0e5 + + kb = size(temp, 3) !bottom level + do k=1,kb + theta(:,:,k) = temp(:,:,k) * (pstar / pfull(:,:,k))**(RDGAS / CP_AIR) + end do + + do k=1,kb-1 + dthdp(:,:,k) = (theta(:,:,k) - theta(:,:,k+1)) / (phalf(:,:,k) - phalf(:,:,k+1)) * 1.0e2 + end do + + theta_0 = temp_2m * (pstar / ps)**(RDGAS / CP_AIR) + dthdp(:,:,kb) = (theta(:,:,kb) - theta_0) / (phalf(:,:,kb) - ps) * 1.0e2 + + kdthdp = minloc(dthdp, dim=3, mask=(pfull>premib).and.(dthdp src/metpy/calc/basic.py + + implicit none + real, intent(in), dimension(:,:,:) :: geopot + real, dimension(size(geopot,1),size(geopot,2),size(geopot,3)):: height, scaled + + scaled = geopot * RADIUS + height = scaled * RADIUS / (GRAV_CONST * EARTH_MASS - scaled) + end function geopotential_to_height + + subroutine calc_lcls(klcls, pfull, temp, zfull, ts, ps, rh_surf, plcls, tlcls, zlcls) + ! Example to call: + ! call calc_lcls(klcls, pfull=p_full, plcls=plcl2d) + ! rh_surf in range [0,1] + implicit none + integer, intent(in), dimension(:,:) :: klcls + real, intent(in), dimension(:,:,:), optional :: temp, pfull, zfull + real, intent(in), dimension(:,:), optional :: rh_surf, ts, ps + real, intent(out), dimension(:,:), optional :: plcls, tlcls, zlcls + integer :: i, j + + do i=1, size(klcls,1) + do j=1, size(klcls,2) + + if(present(pfull) .and. present(plcls)) then + plcls(i,j) = pfull(i,j,klcls(i,j)) + end if + + if(present(temp) .and. present(tlcls)) then + tlcls(i,j) = temp(i,j,klcls(i,j)) + end if + + if (present(zfull) .and. present(zlcls)) then + zlcls(i,j) = zfull(i,j,klcls(i,j)) + end if + + if (present(rh_surf) .and. present(ts) .and. present(ps) .and. present(zlcls)) then + ! Use the exact LCL formula from D. M. Romps [2017, JAS 74(12)] + zlcls(i,j) = lcl(ps(i,j), ts(i,j), rh=rh_surf(i,j)) + end if + + if(.not.((present(pfull) .and. present(plcls)) .or. & + (present(temp) .and. present(tlcls)) .or. & + (present(zfull) .and. present(zlcls)) .or. & + (present(rh_surf) .and. present(ts) .and. present(ps) .and. present(zlcls)))) then + call error_mesg('calc_lcls in cloud_simple', 'At least one group of '// & + 'pfull(plcls), temp(tlcls) and zfull/rh_surf(zlcls) should exist.', FATAL) + end if + + end do + end do + + end subroutine calc_lcls + + subroutine calc_eis(pfull, zfull, temp, ts, ps, klcls, eis, Time) + ! Estimated inversion stability (EIS) + ! Refer to: Wood and Bretherton, 2006, Journal of Climate + implicit none + real, intent(in), dimension(:,:,:) :: pfull, zfull, temp + real, intent(in), dimension(:,:) :: ts, ps + integer, intent(in), dimension(:,:) :: klcls + type(time_type), intent(in) :: Time + real, intent(out), dimension(:,:) :: eis + real, dimension(size(temp,1), size(temp,2)) :: zlcl, z700, Gamma850, LTS + real, dimension(size(temp,1), size(temp,2), size(temp,3)) :: zfull_height + real :: pstar, T850 + logical :: used + integer :: k700, i, j + + zfull_height = geopotential_to_height(zfull*GRAV) + pstar = 1.e5 ! Pa + + do i=1, size(temp,1) + do j=1, size(temp,2) + k700 = minloc(abs(pfull(i,j,:) - 7.0e4), 1) + LTS(i,j) = temp(i,j,k700)*((pstar/pfull(i,j,k700))**(RDGAS/CP_AIR)) - & + ts(i,j)*(pstar/ps(i,j))**(RDGAS/CP_AIR) + T850 = (temp(i,j,k700) + ts(i,j)) / 2.0 + call calc_moist_lapse_rate(T850, 8.5e4, Gamma850(i,j)) + z700(i,j) = zfull_height(i,j,k700) + end do + end do + + call calc_lcls(klcls, zfull=zfull_height, zlcls=zlcl) + eis = LTS - Gamma850 * (z700 - zlcl) + + ! ----- output diagnositics ------ ! + if(id_eis > 0) then + used = send_data (id_eis, eis, Time) + end if + if(id_lts > 0) then + used = send_data (id_lts, LTS, Time) + end if + if(id_zlcl > 0) then + used = send_data (id_zlcl, zlcl, Time) + end if + + if(intermediate_outputs_diags) then + if(id_z700 > 0) then + used = send_data (id_z700, z700, Time) + end if + if(id_gamma_850 > 0) then + used = send_data (id_gamma_850, Gamma850, Time) + end if + end if + end subroutine calc_eis + + subroutine calc_ectei(pfull, q_hum, q_surf, eis, ectei, Time) + ! Estimated Cloud Top Entrainment Index (ECTEI) + ! Refer to: Eq(3) in Kawai, Koshiro and Webb, 2017, Journal of Climate + implicit none + real, intent(in), dimension(:,:,:) :: pfull, q_hum + real, intent(in), dimension(:,:) :: q_surf, eis + type(time_type), intent(in) :: Time + real, intent(out), dimension(:,:) :: ectei + real, dimension(size(pfull,1),size(pfull,2)) :: q_700 + integer :: k700, i, j + real :: k_en, C_qgap, beta + logical :: used + + k_en = 0.7 + C_qgap = 0.76 + beta = (1.0 - k_en) * C_qgap + + do i=1, size(pfull,1) + do j=1, size(pfull,2) + k700 = minloc(abs(pfull(i,j,:) - 7.0e4), 1) + q_700(i,j) = q_hum(i,j,k700) + end do + end do + + ectei = eis - beta * HLV / CP_AIR * (q_surf - q_700) + + if(id_ectei > 0) then + used = send_data (id_ectei, ectei, Time) + end if + end subroutine calc_ectei + + subroutine calc_Park_proxies(pfull, ps, zfull, temp, ts, q_hum, q_surf, & + rh_surf, klcls, ELF, kinvs, Time) + ! Refer to: Park and Shin, 2019, Atmospheric Chemistry and Physics + ! Heuristic estimation of low-level cloud fraction over the globe + ! based on a decoupling parameterization + ! https://www.atmos-chem-phys.net/19/5635/2019/ + + implicit none + real, intent(in), dimension(:,:,:) :: pfull, zfull, temp, q_hum + real, intent(in), dimension(:,:) :: ts, q_surf, ps, rh_surf + integer, intent(in), dimension(:,:) :: klcls + type(time_type), intent(in) :: Time + real, intent(out), dimension(:,:) :: ELF + integer, intent(out), dimension(:,:) :: kinvs + real, dimension(size(temp,1), size(temp,2)) :: plcl, tlcl, zlcl, z700, Gamma_DL, & + Gamma700, LTS, z_ML, zinv, qv_ML, beta2 + ! other paramters + real, dimension(size(temp,1), size(temp,2)) :: beta1, IS, DS, eis, ectei, alpha, f_para + real, dimension(size(temp,1), size(temp,2), size(temp,3)) :: zfull_height + real :: pstar, delta_zs, theta_ML + logical :: used + integer :: k700, i, j + + delta_zs = 2750.0 ! meter, constant + pstar = 1.0e5 ! Pa + kappa = RDGAS / CP_AIR + + zfull_height = geopotential_to_height(zfull*GRAV) + + call calc_lcls(klcls, pfull=pfull, temp=temp, ts=ts, ps=ps, & + rh_surf=rh_surf, plcls=plcl, tlcls=tlcl, zlcls=zlcl) + + where(zlcl < 0) + zlcl = 0.0 + end where + + do i=1, size(pfull,1) + do j=1, size(pfull,2) + k700 = minloc(abs(pfull(i,j,:) - 7.0e4), 1) + z700(i,j) = zfull_height(i,j,k700) + + ! Mixed Layer is the LCL + call calc_moist_lapse_rate(tlcl(i,j), plcl(i,j), Gamma_DL(i,j)) + call calc_moist_lapse_rate(temp(i,j,k700), pfull(i,j,k700), Gamma700(i,j)) + + theta_ML = ts(i,j) * (pstar / ps(i,j))**kappa + LTS(i,j) = temp(i,j,k700) * (pstar / pfull(i,j,k700))**kappa - theta_ML + qv_ML(i,j) = q_hum(i,j,klcls(i,j)) + end do + end do + + z_ML = zlcl + zinv = -LTS/Gamma700 + z700 + delta_zs*(Gamma_DL/Gamma700) + + ! Rest zinv + where(zinv < z_ML) + zinv = z_ML + end where + where(zinv > z_ML+delta_zs) + zinv = z_ML + delta_zs + end where + + do i=1, size(pfull,1) + do j=1, size(pfull,2) + kinvs(i,j) = minloc(abs(zinv(i,j)-zfull_height(i,j,:)), 1) + end do + end do + + ! low-level cloud suppression parameters (LCS) + beta2 = sqrt(zinv*zlcl) / delta_zs + ! freeze-dry factor (Vavrus and Waliser, 2008) + f_para = max(0.15, min(1.0, qv_ML/0.003)) + ! Estimated low-cloud fraction (ELF) + ELF = f_para * (1.0 - beta2) + + ! ----- output diagnostics ----- ! + if(id_ELF>0) then + used = send_data(id_ELF, ELF, Time) + end if + if(id_lts>0) then + used = send_data(id_lts, LTS, Time) + end if + if(id_zlcl>0) then + used = send_data(id_zlcl, zlcl, Time) + end if + + if(intermediate_outputs_diags) then + !============= Other prameters =============! + beta1 = (zinv + zlcl) / delta_zs + alpha = (zinv - z_ML) / delta_zs + IS = (1.0 - alpha) * Gamma_DL * delta_zs + DS = alpha * Gamma_DL * delta_zs + eis = LTS + Gamma_DL*z_ML - Gamma700*z700 + call calc_ectei(pfull, q_hum, q_surf, eis, ectei, Time) + + !Add some diagnostic ouputs + call output_extra_diags_for_Park_ELF(Time, beta1, beta2, & + alpha, eis, IS, DS, z700, zinv, Gamma700, Gamma_DL) + end if + end subroutine calc_Park_proxies + + subroutine calc_moist_lapse_rate(T, p, Gamma) + real, intent(in) :: T, p + real, intent(out) :: Gamma + real :: es, qs + + ! Eq(5) in the following paper: + ! Wood & Bretherton (2006). On the relationship between stratiform low cloud + ! cover and lower-tropospheric stability. Journal of climate, 19(24), 6425-6432. + + call lookup_es(T, es) + qs = 0.622 * es / (p - es) + Gamma = (GRAV/CP_AIR) * (1.0 - (1.0 + HLV*qs/RDGAS/T) / (1.0 + HLV**2 * qs/CP_AIR/RVGAS/T**2)) + end subroutine calc_moist_lapse_rate + + subroutine output_extra_diags_for_Park_ELF(Time, beta1, beta2, & + alpha, eis, IS, DS, z700, zinv, Gamma700, Gamma_DL) + + real, intent(in), dimension(:,:) :: beta1, beta2, alpha, eis, & + IS, DS, z700, zinv, Gamma700, Gamma_DL + type(time_type) , intent(in) :: Time + logical :: used + + if (id_eis>0) then + ! Notice the eis here is a little different from that in calc_eis + used = send_data (id_eis, eis, Time) + endif + if (id_beta1 > 0) then + used = send_data (id_beta1, beta1, Time) + endif + if (id_beta2 > 0) then + used = send_data (id_beta2, beta2, Time) + endif + if (id_alpha > 0) then + used = send_data (id_alpha, alpha, Time) + endif + if (id_DS > 0) then + used = send_data(id_DS, DS, Time) + endif + if (id_IS > 0) then + used = send_data (id_IS, IS, Time) + endif + if (id_zinv > 0) then + used = send_data (id_zinv, zinv, Time) + endif + if (id_z700 > 0) then + used = send_data (id_z700, z700, Time) + endif + if (id_gamma_700 > 0) then + used = send_data (id_gamma_700, Gamma700, Time) + endif + if (id_gamma_DL > 0) then + used = send_data (id_gamma_DL, Gamma_DL, Time) + endif + end subroutine output_extra_diags_for_Park_ELF + + subroutine marine_strat_cloud_end() + + end subroutine marine_strat_cloud_end + +end module marine_strat_cloud_mod diff --git a/src/atmos_param/diffusivity/diffusivity.F90 b/src/atmos_param/diffusivity/diffusivity.F90 index c9a44410e..921e5bb73 100644 --- a/src/atmos_param/diffusivity/diffusivity.F90 +++ b/src/atmos_param/diffusivity/diffusivity.F90 @@ -261,7 +261,7 @@ end subroutine diffusivity_end !======================================================================= subroutine diffusivity(t, q, u, v, p_full, p_half, z_full, z_half, & - u_star, b_star, h, k_m, k_t, kbot) + u_star, b_star, h, k_m, k_t, ind_lcl, kbot) real, intent(in), dimension(:,:,:) :: t, q, u, v real, intent(in), dimension(:,:,:) :: p_full, p_half @@ -269,6 +269,7 @@ subroutine diffusivity(t, q, u, v, p_full, p_half, z_full, z_half, & real, intent(in), dimension(:,:) :: u_star, b_star real, intent(inout), dimension(:,:,:) :: k_m, k_t real, intent(out), dimension(:,:) :: h +integer, intent(in), optional, dimension(:,:) :: ind_lcl integer, intent(in), optional, dimension(:,:) :: kbot real, dimension(size(t,1),size(t,2),size(t,3)) :: svcp,z_full_ag, & @@ -311,9 +312,16 @@ subroutine diffusivity(t, q, u, v, p_full, p_half, z_full, z_half, & end do z_half_ag(:,:,nlev+1) = z_half(:,:,nlev+1) - z_surf(:,:) - if(fixed_depth) then h = depth_0 +else if (present(ind_lcl)) then + nlat = size(t,2) + nlon = size(t,1) + do j=1,nlat + do i=1,nlon + h(i,j)=z_full_ag(i,j,ind_lcl(i,j)) + end do + end do else call pbl_depth(svcp,u,v,z_full_ag,u_star,b_star,h,kbot=kbot) end if diff --git a/src/atmos_param/dry_convection/dry_convection.f90 b/src/atmos_param/dry_convection/dry_convection.f90 index 36d8fee19..b113fa998 100644 --- a/src/atmos_param/dry_convection/dry_convection.f90 +++ b/src/atmos_param/dry_convection/dry_convection.f90 @@ -117,7 +117,7 @@ end subroutine dry_convection_init !! @param[out] dt_tg Calculated temperature tendency !! @param[out] cape Convective Available Potential Energy !! @param[out] cin Convective Inhibition - subroutine dry_convection(Time, tg, p_full, p_half, dt_tg, cape, cin) + subroutine dry_convection(Time, tg, p_full, p_half, dt_tg, cape, cin, lzb, lcl) type(time_type), intent(in) :: Time @@ -131,6 +131,10 @@ subroutine dry_convection(Time, tg, p_full, p_half, dt_tg, cape, cin) real, intent(out), dimension(size(tg,1),size(tg,2)) :: & cape, & !< convectively available potential energy cin !< convective inhibition + integer, intent(out), dimension(:,:) :: & + lcl, & !< lifting condensation level (index) + lzb !< level of zero buoyancy + ! --- local variables --- real, dimension(size(tg,1),size(tg,2)) :: & @@ -138,8 +142,6 @@ subroutine dry_convection(Time, tg, p_full, p_half, dt_tg, cape, cin) ener_int !< energy integral from ground to LZB integer, dimension(size(tg,1),size(tg,2)) :: & - lcl, & !< lifting condensation level (index) - lzb, & !< level of zero buoyancy btm !< bottom of convecting region real, dimension(size(tg,1),size(tg,2), size(tg,3)) :: & @@ -174,7 +176,7 @@ subroutine dry_convection(Time, tg, p_full, p_half, dt_tg, cape, cin) do i=1, size(tg,1) do j=1, size(tg,2) - + do k=1, num_levels if(k>=lzb(i,j).and. k<=btm(i,j)) then ! in convecting region between ground and LZB diff --git a/src/atmos_param/hs_forcing/hs_forcing.F90 b/src/atmos_param/hs_forcing/hs_forcing.F90 index 4f5f6f53e..70fc3d23c 100644 --- a/src/atmos_param/hs_forcing/hs_forcing.F90 +++ b/src/atmos_param/hs_forcing/hs_forcing.F90 @@ -49,7 +49,11 @@ module hs_forcing_mod CONSTANT, INTERP_WEIGHTED_P use astronomy_mod, only: diurnal_exoplanet, astronomy_init, obliq, ecc +#ifdef COLUMN_MODEL +use spec_mpp_mod, only: grid_domain, get_grid_domain +#else use transforms_mod, only: grid_domain, get_grid_domain +#endif implicit none diff --git a/src/atmos_param/qe_moist_convection/qe_moist_convection.F90 b/src/atmos_param/qe_moist_convection/qe_moist_convection.F90 index af299fcfa..2f57b9ecf 100644 --- a/src/atmos_param/qe_moist_convection/qe_moist_convection.F90 +++ b/src/atmos_param/qe_moist_convection/qe_moist_convection.F90 @@ -189,7 +189,7 @@ end subroutine generate_lcl_table subroutine qe_moist_convection (dt, Tin, qin, p_full, p_half, coldT, & rain, snow, deltaT, deltaq, qref, convflag, & kLZBs, CAPE, CIN, invtau_q_relaxation, & - invtau_t_relaxation, Tref) + invtau_t_relaxation, Tref, kLCLs) !----------------------------------------------------------------------- ! @@ -231,9 +231,9 @@ subroutine qe_moist_convection (dt, Tin, qin, p_full, p_half, coldT, & real , intent(in) :: dt logical, intent(in) , dimension(:,:) :: coldT - real , intent(out), dimension(:,:) :: rain, snow, kLZBs, CAPE, CIN + real , intent(out), dimension(:,:) :: rain, snow, CAPE, CIN real , intent(out), dimension(:,:) :: invtau_q_relaxation, invtau_t_relaxation - integer, intent(out), dimension(:,:) :: convflag + integer, intent(out), dimension(:,:) :: convflag, kLZBs, kLCLs real , intent(out), dimension(:,:,:) :: deltaT, deltaq, qref, Tref !----------------------------------------------------------------------- @@ -248,7 +248,7 @@ subroutine qe_moist_convection (dt, Tin, qin, p_full, p_half, coldT, & call SBM_convection_scheme(dt, Tin, qin, p_full, p_half, rain, snow, & deltaT, deltaq, kLZBs, CAPE, CIN,invtau_q_relaxation, & invtau_t_relaxation, Tref, qref, & - val_min, val_max, val_inc, lcl_temp_table, convflag) + val_min, val_max, val_inc, lcl_temp_table, convflag, kLCLs) end subroutine qe_moist_convection @@ -256,7 +256,8 @@ end subroutine qe_moist_convection subroutine SBM_convection_scheme(dt, Tin, qin, p_full, p_half, rain, snow, & deltaT, deltaq, kLZBs, CAPE, CIN, invtau_q_relaxation, invtau_t_relaxation,& - Tref, qref, val_min, val_max, val_inc, lcl_temp_table, convflag) + Tref, qref, val_min, val_max, val_inc, lcl_temp_table, convflag, kLCLs) + !----------------------------------------------------------------------- ! @@ -275,11 +276,10 @@ subroutine SBM_convection_scheme(dt, Tin, qin, p_full, p_half, rain, snow, & real, intent(in), dimension(:) :: lcl_temp_table real, intent(out), dimension(:,:) :: rain, snow, CAPE, CIN real, intent(out), dimension(:,:) :: invtau_q_relaxation, invtau_t_relaxation - real, intent(out), dimension(:,:) :: kLZBs real, intent(out), dimension(:,:,:) :: deltaT, deltaq, Tref, qref - integer, intent(out), dimension(:,:) :: convflag + integer, intent(out), dimension(:,:) :: kLZBs, convflag, kLCLs - integer :: k_surface, i, j, kLZB + integer :: k_surface, i, j, kLZB, kLCL real, dimension(size(Tin, 3)) :: & deltaq_parcel, deltaT_parcel, T_parcel, r_parcel, qref_parcel, Tref_parcel real, dimension(size(Tin, 1), size(Tin, 2)) :: Pq @@ -287,9 +287,6 @@ subroutine SBM_convection_scheme(dt, Tin, qin, p_full, p_half, rain, snow, & real :: cape_parcel, cin_parcel, Pq_parcel, Pt_parcel real :: invtau_q_relaxation_parcel, invtau_t_relaxation_parcel - - - ! Initialization of parameters and variables k_surface = size(Tin, 3) deltaq = 0. @@ -318,12 +315,14 @@ subroutine SBM_convection_scheme(dt, Tin, qin, p_full, p_half, rain, snow, & ! parcel lifted from lowest model level call CAPE_calculation(k_surface, p_full(i,j,:), p_half(i,j,:), & Tin(i,j,:), rin(i,j,:), kLZB, T_parcel, r_parcel, & - cape_parcel, cin_parcel, val_min, val_max, lcl_temp_table) + cape_parcel, cin_parcel, val_min, val_max, lcl_temp_table,& + kLCL) ! Store values CAPE(i,j) = cape_parcel CIN(i,j) = cin_parcel kLZBs(i,j) = kLZB + kLCLs(i,j) = kLCL ! If CAPE>0, set reference temperature and humidity above and below ! the LZB (Level of Zero Buoyancy) @@ -394,7 +393,8 @@ end subroutine sbm_convection_scheme !####################################################################### subroutine CAPE_calculation(k_surface, p_full, p_half, Tin, rin, kLZB, & - Tp, rp, CAPE, CIN, val_min, val_max, lcl_temp_table) + Tp, rp, CAPE, CIN, val_min, val_max, lcl_temp_table, kLCL) + ! Calculates CAPE, CIN, level of zero buoyancy, and parcel properties ! (second order accurate in delta(ln p) and exact LCL calculation) @@ -405,13 +405,13 @@ subroutine CAPE_calculation(k_surface, p_full, p_half, Tin, rin, kLZB, & real, intent(in), dimension(:) :: Tin, rin real, intent(in) :: val_min , val_max real, intent(in), dimension(:) :: lcl_temp_table - integer, intent(out) :: kLZB + integer, intent(out) :: kLZB, kLCL real, intent(out), dimension(:) :: Tp, rp real, intent(out) :: CAPE, CIN logical :: nocape, saturated, skip real :: pLZB, T0, r0, es, rs, pLCL - integer :: kLFC, k, kLCL + integer :: kLFC, k real, dimension(size(Tin)) :: Tin_virtual nocape = .true. @@ -423,6 +423,7 @@ subroutine CAPE_calculation(k_surface, p_full, p_half, Tin, rin, kLZB, & Tp = Tin rp = rin saturated = .false. + kLCL = 0 ! Calculation of values to check whether the lowest level is saturated ! Calculate the virtual temperature @@ -452,6 +453,7 @@ subroutine CAPE_calculation(k_surface, p_full, p_half, Tin, rin, kLZB, & ! Calculation above the LCL call CAPE_above_LCL(kLCL, kLZB, kLFC, Tp, rp, rin, p_full, nocape, skip,& CIN, CAPE, Tin, Tin_virtual, p_half, pLZB) + end subroutine CAPE_CALCULATION diff --git a/src/atmos_param/ras/ras.f90 b/src/atmos_param/ras/ras.f90 index 6fb228041..a4bc63a2d 100644 --- a/src/atmos_param/ras/ras.f90 +++ b/src/atmos_param/ras/ras.f90 @@ -492,6 +492,7 @@ SUBROUTINE RAS( is, js, Time, temp0, qvap0, & uwnd0, vwnd0, pres0, pres0_int, zhalf0, coldT0, & dtime, dtemp0, dqvap0, duwnd0, dvwnd0, & rain0, snow0, do_strat, & + klzbs, klcls, & !OPTIONAL IN mask, kbot, & !OPTIONAL OUT @@ -554,6 +555,7 @@ SUBROUTINE RAS( is, js, Time, temp0, qvap0, & ! Da0 - OPTIONAL; cloud fraction change ! DR0 - OPTIONAL; increment to prognostic tracers !--------------------------------------------------------------------- + integer, intent(out), dimension(:,:) :: klzbs, klcls real, intent(out), dimension(:,:,:) :: dtemp0, dqvap0, duwnd0, dvwnd0 real, intent(out), dimension(:,:) :: rain0, snow0 @@ -569,7 +571,7 @@ SUBROUTINE RAS( is, js, Time, temp0, qvap0, & logical :: coldT, exist real :: precip, Hl, psfc, dpcu, dtinv - integer :: ksfc, klcl + integer :: ksfc, klcl, klzb integer, dimension(SIZE(temp0,3)) :: ic @@ -750,6 +752,12 @@ SUBROUTINE RAS( is, js, Time, temp0, qvap0, & end do end if + do j = 1,jmax + do i = 1,imax + klcls(i,j) = kcbase(i,j) + end do + end do + !--------------------------------------------------------------------- ! LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL @@ -853,6 +861,7 @@ SUBROUTINE RAS( is, js, Time, temp0, qvap0, & Hl, exist ) if ( .not. exist ) CYCLE + klzbs(i,j) = klcl !--------------------------------------------------------------------- ! Cloud top loop starts !--------------------------------------------------------------------- @@ -862,6 +871,8 @@ SUBROUTINE RAS( is, js, Time, temp0, qvap0, & ib = ic(nc) if( ib >= klcl) CYCLE + klzbs(i,j) = min(klzbs(i,j), ib) + if ( setras ) then ! --- Compute some stuff alpha(:) = qvap_sat(:) - dqvap_sat(:) * temp(:) diff --git a/src/atmos_param/rrtm_radiation/rrtm_radiation.f90 b/src/atmos_param/rrtm_radiation/rrtm_radiation.F90 similarity index 96% rename from src/atmos_param/rrtm_radiation/rrtm_radiation.f90 rename to src/atmos_param/rrtm_radiation/rrtm_radiation.F90 index 808d5239d..6b80f7789 100644 --- a/src/atmos_param/rrtm_radiation/rrtm_radiation.f90 +++ b/src/atmos_param/rrtm_radiation/rrtm_radiation.F90 @@ -131,6 +131,9 @@ module rrtm_vars character(len=256) :: co2_file='co2' ! file name of co2 file to read character(len=256) :: co2_variable_name='co2' ! field name of co2 file to read + logical :: do_scm_ozone=.false. ! read single column ozone from namelist? note: ONLY when using SCM. + real(kind=rb), dimension(100) :: scm_ozone = -1 ! input array for single column ozone. max number of levels = 100 + ! secondary gases (CH4,N2O,O2,CFC11,CFC12,CFC22,CCL4) logical :: include_secondary_gases=.false. ! non-zero values for above listed secondary gases? real(kind=rb) :: ch4_val = 0. ! if .true., value for CH4 vmr @@ -210,7 +213,7 @@ module rrtm_vars &lonstep, do_zm_tracers, do_zm_rad, & &do_precip_albedo, precip_albedo_mode, precip_albedo, precip_lat,& &do_read_co2, co2_file, co2_variable_name, use_dyofyr, solrad, & - &solday, equinox_day,solr_cnst + &solday, equinox_day,solr_cnst, do_scm_ozone, scm_ozone end module rrtm_vars !***************************************************************************************** @@ -240,7 +243,11 @@ subroutine rrtm_radiation_init(axes,Time,ncols,nlay,lonb,latb, Time_step) &write_version_number, stdlog, & &error_mesg, NOTE, WARNING, FATAL use time_manager_mod, only: time_type, length_of_day, get_time - use transforms_mod, only: get_grid_domain +#ifdef COLUMN_MODEL + use spec_mpp_mod, only: get_grid_domain +#else + use transforms_mod, only: get_grid_domain +#endif ! Local variables implicit none @@ -445,7 +452,7 @@ subroutine rrtm_radiation_init(axes,Time,ncols,nlay,lonb,latb, Time_step) if(do_read_ozone)then call interpolator_init (o3_interp, trim(ozone_file)//'.nc', lonb, latb, data_out_of_bounds=(/ZERO/)) - endif + endif if(do_read_h2o)then call interpolator_init (h2o_interp, trim(h2o_file)//'.nc', lonb, latb, data_out_of_bounds=(/ZERO/)) @@ -455,6 +462,12 @@ subroutine rrtm_radiation_init(axes,Time,ncols,nlay,lonb,latb, Time_step) call interpolator_init (co2_interp, trim(co2_file)//'.nc', lonb, latb, data_out_of_bounds=(/ZERO/)) endif + if(do_scm_ozone)then + call error_mesg('run_rrtm', & + 'Input o3 will be read in exactly as specified in input (i.e. no plevel interpolation will be performed). Ensure it is specified correctly in namelist. ONLY FOR USE IN SINGLE COLUMN MODEL.', & + WARNING) + endif + if(store_intermediate_rad .or. id_flux_sw > 0) & allocate(sw_flux(size(lonb,1)-1,size(latb,2)-1)) if(store_intermediate_rad .or. id_flux_lw > 0) & @@ -549,7 +562,11 @@ subroutine run_rrtmg(is,js,Time,lat,lon,p_full,p_half,albedo,q,t,t_surf_rad,tdt, use diag_manager_mod, only: register_diag_field, send_data use time_manager_mod,only: time_type +#ifdef COLUMN_MODEL + use column_grid_mod, only: area_weighted_global_mean +#else use transforms_mod,only: area_weighted_global_mean +#endif !--------------------------------------------------------------------------------------------------------------- ! In/Out variables implicit none @@ -725,11 +742,30 @@ subroutine run_rrtmg(is,js,Time,lat,lon,p_full,p_half,albedo,q,t,t_surf_rad,tdt, !get ozone if(do_read_ozone)then call interpolator( o3_interp, Time_loc, p_half, o3f, trim(ozone_file)) + endif + if(do_scm_ozone)then ! Allows for option to specify ozone vertical profile in namelist for SCM. + if(do_read_ozone)then + call error_mesg('run_rrtm', 'Cannot set do_scm_ozone and do_read_ozone = .true.', FATAL) + endif + if((size(q,1)>1).or.(size(q,2)>1))then + call error_mesg('run_rrtm', 'Cannot set do_scm_ozone if simulating more than one column, use do_read_ozone instead', FATAL) + endif + if(scm_ozone(size(q,3)).eq.-1)then + call error_mesg('run_rrtm', 'Input o3 must be specified on model pressure levels but not enough levels specified', FATAL) + endif + if(scm_ozone(size(q,3)+1).ne.-1)then + call error_mesg('run_rrtm', 'Input o3 must be specified on model pressure levels but too many levels specified', FATAL) + endif + o3f(1,1,:) = scm_ozone(1:size(q,3)) + !PUT THIS WARNING SOMEWHERE ELSE + endif + if (do_read_ozone .or. do_scm_ozone) then if (input_o3_file_is_mmr) then o3f = o3f * (1000. * gas_constant / rdgas ) / wtmozone !RRTM expects all abundances to be volume mixing ratio. So if input file is mass mixing ratio, it must be converted to volume mixing ratio using the molar masses of dry air and ozone. ! Molar mass of dry air calculated from gas_constant / rdgas, and converted into g/mol from kg/mol by multiplying by 1000. This conversion is necessary because wtmozone is in g/mol. endif endif + !get co2 if(do_read_co2)then @@ -800,8 +836,8 @@ subroutine run_rrtmg(is,js,Time,lat,lon,p_full,p_half,albedo,q,t,t_surf_rad,tdt, &phalf(:,sk+1) = pfull(:,sk)*0.5 tfull = reshape(t (1:si:lonstep,:,sk :1:-1),(/ si*sj/lonstep,sk /)) thalf = reshape(t_half(1:si:lonstep,:,sk+1:1:-1),(/ si*sj/lonstep,sk+1 /)) - h2o = reshape(h2o_vmr (1:si:lonstep,:,sk :1:-1),(/ si*sj/lonstep,sk /)) - if(do_read_ozone)o3 = reshape(o3f(1:si:lonstep,:,sk :1:-1),(/ si*sj/lonstep,sk /)) + h2o = reshape(h2o_vmr(1:si:lonstep,:,sk :1:-1),(/ si*sj/lonstep,sk /)) + if((do_read_ozone).or.(do_scm_ozone))o3 = reshape(o3f(1:si:lonstep,:,sk :1:-1),(/ si*sj/lonstep,sk /)) if(do_read_co2)co2 = reshape(co2f(1:si:lonstep,:,sk :1:-1),(/ si*sj/lonstep,sk /)) diff --git a/src/atmos_param/socrates/interface/read_control.F90 b/src/atmos_param/socrates/interface/read_control.F90 index 92c8cec9d..c877f9fbe 100644 --- a/src/atmos_param/socrates/interface/read_control.F90 +++ b/src/atmos_param/socrates/interface/read_control.F90 @@ -9,8 +9,7 @@ MODULE read_control_mod ! Subroutine to set input algorithmic options for the core radiation code !------------------------------------------------------------------------------ -SUBROUTINE read_control(control, spectrum, do_cloud_simple) - +SUBROUTINE read_control(control, spectrum, do_clouds) USE rad_pcf USE def_control, ONLY: StrCtrl, allocate_control @@ -28,7 +27,8 @@ SUBROUTINE read_control(control, spectrum, do_cloud_simple) ! Spectral data: TYPE (StrSpecData), INTENT(IN) :: spectrum -LOGICAL, INTENT(IN), OPTIONAL :: do_cloud_simple +LOGICAL, INTENT(IN), OPTIONAL :: do_clouds + ! Local variables. INTEGER :: i @@ -97,7 +97,7 @@ SUBROUTINE read_control(control, spectrum, do_cloud_simple) control%i_gas_overlap = ip_overlap_k_eqv_scl ! Properties of clouds -if (do_cloud_simple) then +if (do_clouds) then control%i_cloud_representation = ip_cloud_ice_water else control%i_cloud_representation = ip_cloud_off diff --git a/src/atmos_param/socrates/interface/set_dimen.F90 b/src/atmos_param/socrates/interface/set_dimen.F90 index da18d8473..3301bbbbd 100644 --- a/src/atmos_param/socrates/interface/set_dimen.F90 +++ b/src/atmos_param/socrates/interface/set_dimen.F90 @@ -63,9 +63,14 @@ SUBROUTINE set_dimen(control, dimen, spectrum, n_profile, n_layer, & dimen%id_cloud_top = dimen%nd_layer + 1 - n_cloud_layer !ie TOA -! this gives the allocate the full column for radiation -! rather than the layers over which cloud is present -dimen%nd_layer_clr = dimen%nd_layer +IF (control%l_cloud) THEN + ! this gives the allocate the full column for radiation + ! rather than the layers over which cloud is present + dimen%nd_layer_clr = dimen%nd_layer + +ELSE + dimen%nd_layer_clr = dimen%nd_layer +END IF ! Aerosol dimen%nd_aerosol_mode = MAX(1,n_aer_mode) diff --git a/src/atmos_param/socrates/interface/socrates_calc.F90 b/src/atmos_param/socrates/interface/socrates_calc.F90 index 4bed571f1..bc40be70f 100644 --- a/src/atmos_param/socrates/interface/socrates_calc.F90 +++ b/src/atmos_param/socrates/interface/socrates_calc.F90 @@ -19,9 +19,6 @@ module socrates_calc_mod ! ============================================================================== - - - ! Set up the call to the Socrates radiation scheme ! ----------------------------------------------------------------------------- !DIAG Added Time @@ -33,10 +30,10 @@ subroutine socrates_calc(Time_diag,control, spectrum, & t_rad_surf, cos_zenith_angle, solar_irrad, orog_corr, & l_planet_grey_surface, planet_albedo, planet_emissivity, & layer_heat_capacity, & - cld_frac, cld_conv_frac, reff_rad, mmr_cl_rad, do_cloud_simple, & + cld_frac, reff_rad, mmr_cl_rad, & flux_direct, flux_down, flux_up, & - flux_down_clear, flux_up_clear, & - heating_rate, spectral_olr) + flux_direct_clear, flux_down_clear, flux_up_clear, & + heating_rate, spectral_olr, tot_cloud_cover) use rad_pcf use def_control, only: StrCtrl @@ -52,8 +49,7 @@ subroutine socrates_calc(Time_diag,control, spectrum, & use set_dimen_mod, only: set_dimen use set_atm_mod, only: set_atm use set_bound_mod, only: set_bound -use socrates_set_cld_mod, only: set_simple_cld -use set_cld_mod, only: set_cld +use socrates_set_cld, only: set_cld use set_aer_mod, only: set_aer use soc_constants_mod, only: i_def, r_def @@ -119,10 +115,7 @@ subroutine socrates_calc(Time_diag,control, spectrum, & ! Heat capacity of layer real(r_def), intent(in) :: cld_frac(n_profile, n_layer) -! Cloud fraction at layer centres for stratocumulus cloud - -real(r_def), intent(in) :: cld_conv_frac(n_profile, n_layer) -! Cloud fraction at layer centres for convective cloud +! Cloud fraction at layer centres real(r_def), intent(in) :: reff_rad(n_profile, n_layer) ! Cloud liquid particle radius from simple cloud scheme @@ -130,22 +123,26 @@ subroutine socrates_calc(Time_diag,control, spectrum, & real(r_def), intent(in) :: mmr_cl_rad(n_profile, n_layer) ! Cloud liquid mmr at layer centres -logical, INTENT(in) :: do_cloud_simple -! Logical for if cloud scheme is on or not - real(r_def), intent(out) :: flux_direct(n_profile, 0:n_layer) ! Direct (unscattered) downwards flux (Wm-2) -real(r_def), intent(out) :: flux_down(n_profile, 0:n_layer), & - flux_down_clear(n_profile, 0:n_layer) +real(r_def), intent(out) :: flux_down(n_profile, 0:n_layer) ! Downwards flux (Wm-2) -real(r_def), intent(out) :: flux_up(n_profile, 0:n_layer), & - flux_up_clear(n_profile, 0:n_layer) +real(r_def), intent(out) :: flux_up(n_profile, 0:n_layer) ! Upwards flux (Wm-2) +real(r_def), intent(out) :: flux_direct_clear(n_profile, 0:n_layer) +! Direct (unscattered) downwards flux under clear-sky condition (Wm-2) +real(r_def), intent(out) :: flux_down_clear(n_profile, 0:n_layer) +! Downwards flux under clear-sky condition (Wm-2) +real(r_def), intent(out) :: flux_up_clear(n_profile, 0:n_layer) +! Upwards flux under clear-sky condition (Wm-2) real(r_def), intent(out) :: heating_rate(n_profile, n_layer) ! Heating rate (Ks-1) REAL(r_def), INTENT(inout), optional :: spectral_olr(:,:) ! Spectral OLR +real(r_def), intent(out), optional :: tot_cloud_cover(n_profile) +! Total cloud cover + ! Dimensions: TYPE (StrDim) :: dimen @@ -186,27 +183,23 @@ subroutine socrates_calc(Time_diag,control, spectrum, & t_rad_surf, cos_zenith_angle, solar_irrad, orog_corr, & l_planet_grey_surface, planet_albedo, planet_emissivity) - if (do_cloud_simple) then - zeros_cld = 0. - ten_microns_cld = 1. - call set_simple_cld(cld, control, dimen, spectrum, n_profile, n_layer, & - conv_frac = cld_conv_frac,& - liq_frac = cld_frac, & - ice_frac = zeros_cld, & - liq_mmr = mmr_cl_rad, & - ice_mmr = zeros_cld, & - liq_dim = reff_rad, & - ice_dim = zeros_cld ) - else - call set_cld(control, dimen, spectrum, cld, n_profile) - endif +! call set_cld(control, dimen, spectrum, cld, n_profile) + +zeros_cld = 0. +ten_microns_cld = 1. +call set_cld(cld, control, dimen, spectrum, n_profile, n_layer, & + liq_frac = cld_frac, & + ice_frac = zeros_cld, & + liq_mmr = mmr_cl_rad, & + ice_mmr = zeros_cld, & + liq_dim = reff_rad, & + ice_dim = zeros_cld ) call set_aer(control, dimen, spectrum, aer, n_profile) ! DEPENDS ON: radiance_calc call radiance_calc(control, dimen, spectrum, atm, cld, aer, bound, radout) - ! set heating rates and diagnostics do l=1, n_profile do i=1, n_layer @@ -218,15 +211,20 @@ subroutine socrates_calc(Time_diag,control, spectrum, & do l=1, n_profile do i=0, n_layer - flux_direct(l, i) = radout%flux_direct(l, i, 1) - flux_down(l, i) = radout%flux_down(l, i, 1) + flux_direct(l, i) = radout%flux_direct(l, i, 1) + flux_down(l, i) = radout%flux_down(l, i, 1) + flux_up(l, i) = radout%flux_up(l, i, 1) + + flux_direct_clear(l, i) = radout%flux_direct_clear(l, i, 1) flux_down_clear(l, i) = radout%flux_down_clear(l, i, 1) - flux_up(l, i) = radout%flux_up(l, i, 1) flux_up_clear(l, i) = radout%flux_up_clear(l, i, 1) end do if (present(spectral_olr)) then spectral_olr(l,:) = radout%flux_up_clear_band(l,0,:) endif + if (present(tot_cloud_cover)) then + tot_cloud_cover(l) = radout%tot_cloud_cover(l) + endif end do call deallocate_out(radout) @@ -237,6 +235,5 @@ subroutine socrates_calc(Time_diag,control, spectrum, & call deallocate_bound(bound) call deallocate_atm(atm) - end subroutine socrates_calc end module socrates_calc_mod diff --git a/src/atmos_param/socrates/interface/socrates_config_mod.f90 b/src/atmos_param/socrates/interface/socrates_config_mod.f90 index 8f9e9881b..58ff3f64f 100644 --- a/src/atmos_param/socrates/interface/socrates_config_mod.f90 +++ b/src/atmos_param/socrates/interface/socrates_config_mod.f90 @@ -40,6 +40,9 @@ module socrates_config_mod real :: co2_ppmv = 300. !Default CO2 concentration in PPMV logical :: input_co2_mmr=.false. !Socrates wants input concentrations as mmr not vmr, so need to make sure input data supplied is converted if necessary + logical :: do_scm_ozone=.false. ! read single column ozone from namelist? note: ONLY when using SCM + real(r_def), dimension(100) :: scm_ozone = -1 ! input array for single column ozone. max number of levels = 100 + logical :: use_pressure_interp_for_half_levels = .False. !By default (.False.) does linear interpolation in height for half-level temperatures. True does linear interp using pressure. ! Incoming radiation options for namelist @@ -126,6 +129,7 @@ module socrates_config_mod hfc134a_mix_ratio, & inc_h2o, inc_co2, inc_co, inc_o3, inc_n2o, inc_ch4, inc_o2, & inc_so2, inc_cfc11, inc_cfc12, inc_cfc113, inc_hcfc22, inc_hfc134a, & - use_pressure_interp_for_half_levels, & - frierson_solar_rad, del_sol, del_sw + use_pressure_interp_for_half_levels, & + frierson_solar_rad, del_sol, del_sw, do_scm_ozone, scm_ozone + end module socrates_config_mod diff --git a/src/atmos_param/socrates/interface/socrates_interface.F90 b/src/atmos_param/socrates/interface/socrates_interface.F90 index ab91d9c2b..f970ba98c 100644 --- a/src/atmos_param/socrates/interface/socrates_interface.F90 +++ b/src/atmos_param/socrates/interface/socrates_interface.F90 @@ -34,8 +34,8 @@ MODULE socrates_interface_mod USE def_spectrum USE constants_mod, only: grav, rdgas, rvgas, cp_air USE fms_mod, only: stdlog, FATAL, WARNING, error_mesg - USE interpolator_mod, only: interpolate_type - USE soc_constants_mod + USE interpolator_mod, only: interpolate_type + USE soc_constants_mod IMPLICIT NONE @@ -51,21 +51,23 @@ MODULE socrates_interface_mod TYPE(StrCtrl) :: control_lw, control_lw_hires ! Diagnostic IDs, name, and missing value - INTEGER :: id_soc_spectral_olr + INTEGER :: id_soc_spectral_olr ! INTEGER :: id_soc_surf_spectrum_sw !not implemented yet INTEGER :: id_soc_tdt_sw, id_soc_tdt_lw, id_soc_tdt_rad - INTEGER :: id_soc_surf_flux_lw, id_soc_surf_flux_sw - - INTEGER :: id_soc_surf_flux_lw_down, id_soc_surf_flux_sw_down - INTEGER :: id_soc_surf_flux_lw_clear, id_soc_surf_flux_sw_clear - INTEGER :: id_soc_surf_flux_lw_down_clear, id_soc_surf_flux_sw_down_clear + INTEGER :: id_soc_surf_flux_lw, id_soc_surf_flux_sw + INTEGER :: id_soc_surf_flux_lw_down, id_soc_surf_flux_sw_down INTEGER :: id_soc_flux_lw, id_soc_flux_sw - INTEGER :: id_soc_olr, id_soc_toa_sw, id_soc_olr_clear, id_soc_toa_sw_clear - INTEGER :: id_soc_toa_sw_down, id_soc_toa_sw_down_clear + INTEGER :: id_soc_flux_lw_clr, id_soc_flux_sw_clr + INTEGER :: id_soc_olr, id_soc_toa_sw + INTEGER :: id_soc_toa_sw_up, id_soc_toa_sw_down + INTEGER :: id_soc_olr_clr, id_soc_toa_sw_clr, id_soc_toa_sw_up_clr ! clear-sky case + INTEGER :: id_soc_surf_flux_sw_clr, id_soc_surf_flux_sw_down_clr, & + id_soc_surf_flux_lw_clr, id_soc_surf_flux_lw_down_clr INTEGER :: id_soc_ozone, id_soc_co2, id_soc_coszen INTEGER :: n_soc_bands_lw, n_soc_bands_sw INTEGER :: n_soc_bands_lw_hires, n_soc_bands_sw_hires INTEGER :: id_soc_bins_lw, id_soc_bins_sw + INTEGER :: id_soc_tot_cloud_cover CHARACTER(len=10), PARAMETER :: soc_mod_name = 'socrates' REAL :: missing_value = -999 @@ -73,24 +75,27 @@ MODULE socrates_interface_mod REAL :: dt_last !Time of last radiation calculation - used to tell whether it is time to recompute radiation or not REAL(r_def), allocatable, dimension(:,:,:) :: tdt_soc_sw_store, tdt_soc_lw_store - REAL(r_def), allocatable, dimension(:,:,:) :: thd_sw_flux_net_store, thd_lw_flux_net_store - REAL(r_def), allocatable, dimension(:,:,:) :: thd_co2_store, thd_ozone_store + REAL(r_def), allocatable, dimension(:,:,:) :: thd_sw_flux_net_store, thd_lw_flux_net_store, & + thd_sw_flux_clr_net_store, thd_lw_flux_clr_net_store + REAL(r_def), allocatable, dimension(:,:,:) :: thd_co2_store, thd_ozone_store REAL(r_def), allocatable, dimension(:,:) :: net_surf_sw_down_store, surf_lw_down_store, surf_lw_net_store, & surf_sw_down_store, toa_sw_down_store, & - toa_sw_store, olr_store, coszen_store - REAL(r_def), allocatable, dimension(:,:) :: net_surf_sw_down_clear_store, surf_sw_down_clear_store, & - surf_lw_down_clear_store, surf_lw_net_clear_store, & - toa_sw_clear_store, olr_clear_store, toa_sw_down_clear_store - REAL(r_def), allocatable, dimension(:,:,:) :: outputted_soc_spectral_olr, spectral_olr_store + toa_sw_store, olr_store, coszen_store, & + toa_sw_clr_store, olr_clr_store, toa_sw_up_store, toa_sw_up_clr_store, & + net_surf_sw_down_clr_store, surf_lw_down_clr_store, & + surf_lw_net_clr_store, surf_sw_down_clr_store + + REAL(r_def), allocatable, dimension(:,:,:) :: outputted_soc_spectral_olr, spectral_olr_store, outputted_soc_spectral_olr_clr REAL(r_def), allocatable, dimension(:) :: soc_bins_lw, soc_bins_sw + LOGICAL :: do_clouds = .false. CONTAINS - SUBROUTINE socrates_init(is, ie, js, je, num_levels, axes, Time, lat, lonb, latb, delta_t_atmos, do_cloud_simple) +SUBROUTINE socrates_init(is, ie, js, je, num_levels, axes, Time, lat, lonb, latb, delta_t_atmos, do_cloud_simple, do_cloud_spookie) !! Initialises Socrates spectra, arrays, and constants USE astronomy_mod, only: astronomy_init - USE interpolator_mod, only: interpolate_type, interpolator_init, ZERO + USE interpolator_mod, only: interpolate_type, interpolator_init, ZERO USE socrates_config_mod ! Arguments @@ -100,8 +105,8 @@ SUBROUTINE socrates_init(is, ie, js, je, num_levels, axes, Time, lat, lonb, latb INTEGER, INTENT(in) :: is, ie, js, je, num_levels REAL, INTENT(in) , DIMENSION(:,:) :: lat REAL, INTENT(in) , DIMENSION(:,:) :: lonb, latb - LOGICAL, INTENT(IN) :: do_cloud_simple - + LOGICAL, INTENT(IN) :: do_cloud_simple, do_cloud_spookie + integer :: io, stdlog_unit integer :: res, time_step_seconds real :: day_in_s_check @@ -118,77 +123,78 @@ SUBROUTINE socrates_init(is, ie, js, je, num_levels, axes, Time, lat, lonb, latb call close_file(nml_unit) endif #endif -stdlog_unit = stdlog() -write(stdlog_unit, socrates_rad_nml) + stdlog_unit = stdlog() + write(stdlog_unit, socrates_rad_nml) !Initialise astronomy call astronomy_init !Initialise variables related to radiation timestep - call get_time(delta_t_atmos,time_step_seconds) + call get_time(delta_t_atmos, time_step_seconds) - if (dt_rad .le. 0.) then - dt_rad = time_step_seconds !Make sure that dt_rad is set if it is not specified in the namelist - endif + if (dt_rad .le. 0.) then + dt_rad = time_step_seconds !Make sure that dt_rad is set if it is not specified in the namelist + endif - dt_last = -real(dt_rad) !make sure we are computing radiation at the first time step + dt_last = -real(dt_rad) !make sure we are computing radiation at the first time step - if (dt_rad .gt. time_step_seconds) then - res=mod(dt_rad, time_step_seconds) + if (dt_rad .gt. time_step_seconds) then + res=mod(dt_rad, time_step_seconds) - if (res.ne.0) then - call error_mesg( 'socrates_init', & - 'dt_rad must be an integer multiple of dt_atmos',FATAL) - endif + if (res.ne.0) then + call error_mesg( 'socrates_init', & + 'dt_rad must be an integer multiple of dt_atmos', FATAL) + endif - day_in_s_check=length_of_day() - res=mod(int(day_in_s_check), dt_rad) + day_in_s_check=length_of_day() + res=mod(int(day_in_s_check), dt_rad) - if (res.ne.0) then - call error_mesg( 'socrates_init', & - 'dt_rad does not fit into one day an integer number of times', WARNING) - endif + if (res.ne.0) then + call error_mesg( 'socrates_init', & + 'dt_rad does not fit into one day an integer number of times', WARNING) + endif + endif + if(dt_rad_avg .le. 0) dt_rad_avg = dt_rad - endif + if ((tidally_locked .eqv. .true.) .and. (frierson_solar_rad .eqv. .true.)) then + call error_mesg( 'socrates_init', & + 'tidally_locked and frierson_solar_rad cannot both be true', FATAL) + endif - if(dt_rad_avg .le. 0) dt_rad_avg = dt_rad - if ((tidally_locked.eqv..true.) .and. (frierson_solar_rad .eqv. .true.)) then + if (js == 1) then + if (lw_spectral_filename .eq. 'unset') then call error_mesg( 'socrates_init', & - 'tidally_locked and frierson_solar_rad cannot both be true',FATAL) + 'lw_spectral_filename is unset, and must point to a valid spectral file', FATAL) endif - IF (js == 1) THEN - - if (lw_spectral_filename .eq. 'unset') then - call error_mesg( 'socrates_init', & - 'lw_spectral_filename is unset, and must point to a valid spectral file',FATAL) - endif - - if (sw_spectral_filename .eq. 'unset') then - call error_mesg( 'socrates_init', & - 'sw_spectral_filename is unset, and must point to a valid spectral file',FATAL) - endif - ENDIF + if (sw_spectral_filename .eq. 'unset') then + call error_mesg( 'socrates_init', & + 'sw_spectral_filename is unset, and must point to a valid spectral file', FATAL) + endif + endif if (lw_hires_spectral_filename .eq. 'unset') then - IF (js == 1) THEN - call error_mesg( 'socrates_init', & - 'lw_hires_spectral_filename is unset, making equal to lw_spectral_filename',WARNING) - endif + if (js == 1) then + call error_mesg( 'socrates_init', & + 'lw_hires_spectral_filename is unset, making equal to lw_spectral_filename', WARNING) + endif lw_hires_spectral_filename = lw_spectral_filename endif if (sw_hires_spectral_filename .eq. 'unset') then - IF (js == 1) THEN - call error_mesg( 'socrates_init', & - 'sw_hires_spectral_filename is unset, making equal to sw_spectral_filename',WARNING) - endif + if (js == 1) then + call error_mesg( 'socrates_init', & + 'sw_hires_spectral_filename is unset, making equal to sw_spectral_filename', WARNING) + endif sw_hires_spectral_filename = sw_spectral_filename endif - + + if ((do_cloud_simple) .or. (do_cloud_spookie)) then + do_clouds = .true. + endif ! Socrates spectral files -- should be set by namelist control_lw%spectral_file = lw_spectral_filename @@ -202,12 +208,12 @@ SUBROUTINE socrates_init(is, ie, js, je, num_levels, axes, Time, lat, lonb, latb CALL read_spectrum(control_lw_hires%spectral_file,spectrum_lw_hires) CALL read_spectrum(control_sw%spectral_file,spectrum_sw) CALL read_spectrum(control_sw_hires%spectral_file,spectrum_sw_hires) - + ! Set Socrates configuration - CALL read_control(control_lw,spectrum_lw, do_cloud_simple) - CALL read_control(control_lw_hires,spectrum_lw_hires, do_cloud_simple) - CALL read_control(control_sw,spectrum_sw, do_cloud_simple) - CALL read_control(control_sw_hires,spectrum_sw_hires, do_cloud_simple) + CALL read_control(control_lw,spectrum_lw, do_clouds) + CALL read_control(control_lw_hires,spectrum_lw_hires, do_clouds) + CALL read_control(control_sw,spectrum_sw, do_clouds) + CALL read_control(control_sw_hires,spectrum_sw_hires, do_clouds) ! Specify LW and SW setups control_sw%isolir=1 @@ -217,18 +223,18 @@ SUBROUTINE socrates_init(is, ie, js, je, num_levels, axes, Time, lat, lonb, latb if(socrates_hires_mode) then allocate(soc_bins_lw(spectrum_lw_hires%dim%nd_band)) - allocate(soc_bins_sw(spectrum_sw_hires%dim%nd_band)) - soc_bins_lw = spectrum_lw_hires%Basic%wavelength_long - soc_bins_sw = spectrum_sw_hires%Basic%wavelength_short + allocate(soc_bins_sw(spectrum_sw_hires%dim%nd_band)) + soc_bins_lw = spectrum_lw_hires%Basic%wavelength_long + soc_bins_sw = spectrum_sw_hires%Basic%wavelength_short else allocate(soc_bins_lw(spectrum_lw%dim%nd_band)) - allocate(soc_bins_sw(spectrum_sw%dim%nd_band)) - soc_bins_lw = spectrum_lw%Basic%wavelength_long - soc_bins_sw = spectrum_sw%Basic%wavelength_short - endif - - !Need to actually give bins arrays values - + allocate(soc_bins_sw(spectrum_sw%dim%nd_band)) + soc_bins_lw = spectrum_lw%Basic%wavelength_long + soc_bins_sw = spectrum_sw%Basic%wavelength_short + endif + + !Need to actually give bins arrays values + id_soc_bins_lw = diag_axis_init('soc_bins_lw', soc_bins_lw, 'cm^-1', 'n', 'socrates lw spectral bin centers', set_name='socrates_lw_bins') id_soc_bins_sw = diag_axis_init('soc_bins_sw', soc_bins_sw, 'cm^-1', 'n', 'socrates sw spectral bin centers', set_name='socrates_sw_bins') @@ -237,138 +243,161 @@ SUBROUTINE socrates_init(is, ie, js, je, num_levels, axes, Time, lat, lonb, latb id_soc_spectral_olr = & register_diag_field ( soc_mod_name, 'soc_spectral_olr',(/ axes(1:2), id_soc_bins_lw/) , Time, & 'socrates substellar LW OLR spectrum', & - 'watts/m2', missing_value=missing_value ) + 'watts/m2', missing_value=missing_value ) !Not implemented yet ! id_soc_surf_spectrum_sw = & ! register_diag_field ( soc_mod_name, 'soc_surf_spectrum_sw',(/ axes(1:2), id_soc_bins_sw/) , Time, & ! 'socrates substellar SW surface spectrum', & -! 'watts/m2', missing_value=missing_value ) +! 'watts/m2', missing_value=missing_value ) id_soc_tdt_lw = & register_diag_field ( soc_mod_name, 'soc_tdt_lw', axes(1:3), Time, & 'socrates Temperature tendency due to LW radiation', & - 'K/s', missing_value=missing_value ) + 'K/s', missing_value=missing_value ) id_soc_tdt_sw = & register_diag_field ( soc_mod_name, 'soc_tdt_sw', axes(1:3), Time, & 'socrates Temperature tendency due to SW radiation', & - 'K/s', missing_value=missing_value ) + 'K/s', missing_value=missing_value ) id_soc_tdt_rad = & register_diag_field ( soc_mod_name, 'soc_tdt_rad', axes(1:3), Time, & 'socrates Temperature tendency due to radiation', & - 'K/s', missing_value=missing_value ) + 'K/s', missing_value=missing_value ) id_soc_surf_flux_lw = & register_diag_field ( soc_mod_name, 'soc_surf_flux_lw', axes(1:2), Time, & 'socrates Net LW surface flux (up)', & - 'watts/m2', missing_value=missing_value ) - - id_soc_surf_flux_lw_clear = & - register_diag_field ( soc_mod_name, 'soc_surf_flux_lw_clear', axes(1:2), Time, & - 'socrates Net LW surface flux (up) clear sky', & - 'watts/m2', missing_value=missing_value ) + 'watts/m2', missing_value=missing_value ) - id_soc_surf_flux_lw_down = & + id_soc_surf_flux_lw_down = & register_diag_field ( soc_mod_name, 'soc_surf_flux_lw_down', axes(1:2), Time, & 'socrates LW surface flux down', & - 'watts/m2', missing_value=missing_value ) - - id_soc_surf_flux_lw_down_clear = & - register_diag_field ( soc_mod_name, 'soc_surf_flux_lw_down_clear', axes(1:2), Time, & - 'socrates LW surface flux down clear sky', & - 'watts/m2', missing_value=missing_value ) + 'watts/m2', missing_value=missing_value ) id_soc_surf_flux_sw = & register_diag_field ( soc_mod_name, 'soc_surf_flux_sw', axes(1:2), Time, & - 'socrates Net SW surface flux (down)', & - 'watts/m2', missing_value=missing_value ) - - id_soc_surf_flux_sw_clear = & - register_diag_field ( soc_mod_name, 'soc_surf_flux_sw_clear', axes(1:2), Time, & - 'socrates Net SW surface flux (down) clear sky', & - 'watts/m2', missing_value=missing_value ) + 'socrates Net SW surface flux (down)', & + 'watts/m2', missing_value=missing_value ) id_soc_surf_flux_sw_down = & register_diag_field ( soc_mod_name, 'soc_surf_flux_sw_down', axes(1:2), Time, & - 'socrates SW surface flux down', & - 'watts/m2', missing_value=missing_value ) - - id_soc_surf_flux_sw_down_clear = & - register_diag_field ( soc_mod_name, 'soc_surf_flux_sw_down_clear', axes(1:2), Time, & - 'socrates SW surface flux down clear sky', & - 'watts/m2', missing_value=missing_value ) + 'socrates SW surface flux down', & + 'watts/m2', missing_value=missing_value ) id_soc_olr = & register_diag_field ( soc_mod_name, 'soc_olr', axes(1:2), Time, & 'socrates TOA LW flux (up)', & - 'watts/m2', missing_value=missing_value ) - - id_soc_olr_clear = & - register_diag_field ( soc_mod_name, 'soc_olr_clear', axes(1:2), Time, & - 'socrates TOA LW flux (up) clear-sky', & - 'watts/m2', missing_value=missing_value ) + 'watts/m2', missing_value=missing_value ) id_soc_toa_sw = & register_diag_field ( soc_mod_name, 'soc_toa_sw', axes(1:2), Time, & - 'socrates Net TOA SW flux (down)', & - 'watts/m2', missing_value=missing_value ) + 'socrates Net TOA SW flux (down)', & + 'watts/m2', missing_value=missing_value ) - id_soc_toa_sw_clear = & - register_diag_field ( soc_mod_name, 'soc_toa_sw_clear', axes(1:2), Time, & - 'socrates Net TOA SW flux (down) clear', & - 'watts/m2', missing_value=missing_value ) + id_soc_toa_sw_up = & + register_diag_field ( soc_mod_name, 'soc_toa_sw_up', axes(1:2), Time, & + 'socrates upward TOA SW flux', & + 'watts/m2', missing_value=missing_value ) id_soc_toa_sw_down = & register_diag_field ( soc_mod_name, 'soc_toa_sw_down', axes(1:2), Time, & - 'socrates TOA SW flux down', & - 'watts/m2', missing_value=missing_value ) - - id_soc_toa_sw_down_clear = & - register_diag_field ( soc_mod_name, 'soc_toa_sw_down_clear', axes(1:2), Time, & - 'socrates TOA SW flux down clear sky', & - 'watts/m2', missing_value=missing_value ) + 'socrates TOA SW flux down', & + 'watts/m2', missing_value=missing_value ) + + id_soc_olr_clr = & + register_diag_field ( soc_mod_name, 'soc_olr_clr', axes(1:2), Time, & + 'clear-sky socrates TOA LW flux (up)', & + 'watts/m2', missing_value=missing_value ) + + id_soc_toa_sw_clr = & + register_diag_field ( soc_mod_name, 'soc_toa_sw_clr', axes(1:2), Time, & + 'clear-sky socrates Net TOA SW flux (down)', & + 'watts/m2', missing_value=missing_value ) + + id_soc_toa_sw_up_clr = & + register_diag_field ( soc_mod_name, 'soc_toa_sw_up_clr', axes(1:2), Time, & + 'clear-sky socrates upward TOA SW flux', & + 'watts/m2', missing_value=missing_value ) + + id_soc_flux_lw_clr = & + register_diag_field ( soc_mod_name, 'soc_flux_lw_clr', (/axes(1),axes(2),axes(4)/), Time, & + 'clear-sky socrates Net LW flux (up)', & + 'watts/m2', missing_value=missing_value ) + + id_soc_flux_sw_clr = & + register_diag_field ( soc_mod_name, 'soc_flux_sw_clr', (/axes(1),axes(2),axes(4)/), Time, & + 'clear-sky socrates Net SW flux (up)', & + 'watts/m2', missing_value=missing_value ) + + id_soc_surf_flux_lw_clr = & + register_diag_field ( soc_mod_name, 'soc_surf_flux_lw_clr', axes(1:2), Time, & + 'clear-sky socrates Net LW surface flux (up)', & + 'watts/m2', missing_value=missing_value ) + + id_soc_surf_flux_lw_down_clr = & + register_diag_field ( soc_mod_name, 'soc_surf_flux_lw_down_clr', axes(1:2), Time, & + 'clear-sky socrates LW surface flux down', & + 'watts/m2', missing_value=missing_value ) + + id_soc_surf_flux_sw_clr = & + register_diag_field ( soc_mod_name, 'soc_surf_flux_sw_clr', axes(1:2), Time, & + 'clear-sky socrates Net SW surface flux (down)', & + 'watts/m2', missing_value=missing_value ) + + id_soc_surf_flux_sw_down_clr = & + register_diag_field ( soc_mod_name, 'soc_surf_flux_sw_down_clr', axes(1:2), Time, & + 'clear-sky socrates SW surface flux down', & + 'watts/m2', missing_value=missing_value ) id_soc_flux_lw = & register_diag_field ( soc_mod_name, 'soc_flux_lw', (/axes(1),axes(2),axes(4)/), Time, & 'socrates Net LW flux (up)', & - 'watts/m2', missing_value=missing_value ) + 'watts/m2', missing_value=missing_value ) id_soc_flux_sw = & register_diag_field ( soc_mod_name, 'soc_flux_sw', (/axes(1),axes(2),axes(4)/), Time, & - 'socrates Net SW flux (up)', & - 'watts/m2', missing_value=missing_value ) + 'socrates Net SW flux (up)', & + 'watts/m2', missing_value=missing_value ) id_soc_coszen = & register_diag_field ( soc_mod_name, 'soc_coszen', axes(1:2), Time, & 'socrates Cosine(zenith_angle)', & - 'none', missing_value=missing_value ) + 'none', missing_value=missing_value ) id_soc_ozone = & register_diag_field ( soc_mod_name, 'soc_ozone', axes(1:3), Time, & 'socrates Ozone', & - 'mmr', missing_value=missing_value ) + 'mmr', missing_value=missing_value ) id_soc_co2 = & register_diag_field ( soc_mod_name, 'soc_co2', axes(1:3), Time, & 'socrates Co2', & - 'mmr', missing_value=missing_value ) + 'mmr', missing_value=missing_value ) + id_soc_tot_cloud_cover = & + register_diag_field ( soc_mod_name, 'soc_tot_cloud_cover', axes(1:2), Time, & + 'socrates Total cloud cover', & + '%', missing_value=missing_value ) - if(do_read_ozone)then - call interpolator_init (o3_interp, trim(ozone_file_name)//'.nc', lonb, latb, data_out_of_bounds=(/ZERO/)) + if(do_read_ozone)then + call interpolator_init (o3_interp, trim(ozone_file_name)//'.nc', lonb, latb, data_out_of_bounds=(/ZERO/)) + endif + + if(do_read_co2)then + call interpolator_init (co2_interp, trim(co2_file_name)//'.nc', lonb, latb, data_out_of_bounds=(/ZERO/)) + endif + + if(do_scm_ozone)then + call error_mesg('socrates_interface', & + 'Input o3 will be read in exactly as specified in input (i.e. no plevel interpolation will be performed). Ensure it is specified correctly in namelist. ONLY FOR USE WITH SINGLE COLUMN MODEL.', & + WARNING) endif - - if(do_read_co2)then - call interpolator_init (co2_interp, trim(co2_file_name)//'.nc', lonb, latb, data_out_of_bounds=(/ZERO/)) - endif if (mod((size(lonb,1)-1)*(size(latb,1)-1), chunk_size) .ne. 0) then - call error_mesg( 'socrates_init', & - 'chunk_size must equally divide number of points per processor, which it currently does not.',FATAL) - + 'chunk_size must equally divide number of points per processor, which it currently does not.', FATAL) endif ! Number of bands @@ -377,6 +406,7 @@ SUBROUTINE socrates_init(is, ie, js, je, num_levels, axes, Time, lat, lonb, latb n_soc_bands_sw = spectrum_sw%dim%nd_band n_soc_bands_sw_hires = spectrum_sw_hires%dim%nd_band + if (socrates_hires_mode .eqv. .True.) then allocate(outputted_soc_spectral_olr(size(lonb,1)-1, size(latb,2)-1, n_soc_bands_lw_hires)) else @@ -385,83 +415,101 @@ SUBROUTINE socrates_init(is, ie, js, je, num_levels, axes, Time, lat, lonb, latb if(store_intermediate_rad) then - ! required for computation + ! required for computation allocate(tdt_soc_sw_store(size(lonb,1)-1, size(latb,2)-1, num_levels)) allocate(tdt_soc_lw_store(size(lonb,1)-1, size(latb,2)-1, num_levels)) allocate(net_surf_sw_down_store(size(lonb,1)-1, size(latb,2)-1)) allocate(surf_lw_down_store(size(lonb,1)-1, size(latb,2)-1)) - ! only required for output - if (id_soc_flux_lw > 0) then + ! only required for output + if (id_soc_surf_flux_lw > 0) then + allocate(surf_lw_net_store(size(lonb,1)-1, size(latb,2)-1)) + endif + + if (id_soc_flux_lw > 0) then allocate(thd_lw_flux_net_store(size(lonb,1)-1, size(latb,2)-1, num_levels+1)) - endif + endif - if (id_soc_flux_sw > 0) then + if (id_soc_flux_sw > 0) then allocate(thd_sw_flux_net_store(size(lonb,1)-1, size(latb,2)-1, num_levels+1)) - endif + endif - if (id_soc_surf_flux_sw_clear > 0) then - allocate(net_surf_sw_down_clear_store(size(lonb,1)-1, size(latb,2)-1)) + if (id_soc_surf_flux_sw_down > 0) then + allocate(surf_sw_down_store(size(lonb,1)-1, size(latb,2)-1)) endif - if (id_soc_surf_flux_lw_down_clear > 0) then - allocate(surf_lw_down_clear_store(size(lonb,1)-1, size(latb,2)-1)) + + if (id_soc_olr > 0) then + allocate(olr_store(size(lonb,1)-1, size(latb,2)-1)) endif - !surface - if (id_soc_surf_flux_lw > 0) then - allocate(surf_lw_net_store(size(lonb,1)-1, size(latb,2)-1)) + if (id_soc_toa_sw > 0) then + allocate(toa_sw_store(size(lonb,1)-1, size(latb,2)-1)) endif - if (id_soc_surf_flux_lw_clear > 0) then - allocate(surf_lw_net_clear_store(size(lonb,1)-1, size(latb,2)-1)) + + if (id_soc_toa_sw_down > 0) then + allocate(toa_sw_down_store(size(lonb,1)-1, size(latb,2)-1)) endif - if (id_soc_surf_flux_sw_down > 0) then - allocate(surf_sw_down_store(size(lonb,1)-1, size(latb,2)-1)) - endif - if (id_soc_surf_flux_sw_down_clear > 0) then - allocate(surf_sw_down_clear_store(size(lonb,1)-1, size(latb,2)-1)) - endif - if (id_soc_olr > 0) then - allocate(olr_store(size(lonb,1)-1, size(latb,2)-1)) - endif + if (id_soc_toa_sw_up > 0) then + allocate(toa_sw_up_store(size(lonb,1)-1, size(latb,2)-1)) + endif - if (id_soc_olr_clear > 0) then - allocate(olr_clear_store(size(lonb,1)-1, size(latb,2)-1)) - endif - if (id_soc_toa_sw > 0) then - allocate(toa_sw_store(size(lonb,1)-1, size(latb,2)-1)) + if (id_soc_flux_lw_clr > 0) then + allocate(thd_lw_flux_clr_net_store(size(lonb,1)-1, size(latb,2)-1, num_levels+1)) endif - if (id_soc_toa_sw_clear > 0) then - allocate(toa_sw_clear_store(size(lonb,1)-1, size(latb,2)-1)) + + if (id_soc_flux_sw_clr > 0) then + allocate(thd_sw_flux_clr_net_store(size(lonb,1)-1, size(latb,2)-1, num_levels+1)) endif - if (id_soc_toa_sw_down > 0) then - allocate(toa_sw_down_store(size(lonb,1)-1, size(latb,2)-1)) + + if (id_soc_olr_clr > 0) then + allocate(olr_clr_store(size(lonb,1)-1, size(latb,2)-1)) endif - if (id_soc_toa_sw_down_clear > 0) then - allocate(toa_sw_down_clear_store(size(lonb,1)-1, size(latb,2)-1)) + + if (id_soc_toa_sw_clr > 0) then + allocate(toa_sw_clr_store(size(lonb,1)-1, size(latb,2)-1)) endif + if (id_soc_toa_sw_up_clr > 0) then + allocate(toa_sw_up_clr_store(size(lonb,1)-1, size(latb,2)-1)) + endif - if (id_soc_coszen > 0) then + if (id_soc_surf_flux_sw_clr > 0) then + allocate(net_surf_sw_down_clr_store(size(lonb,1)-1, size(latb,2)-1)) + endif + + if (id_soc_surf_flux_sw_down_clr > 0) then + allocate(surf_sw_down_clr_store(size(lonb,1)-1, size(latb,2)-1)) + endif + + if (id_soc_surf_flux_lw_clr > 0) then + allocate(surf_lw_net_clr_store(size(lonb,1)-1, size(latb,2)-1)) + endif + + if (id_soc_surf_flux_lw_down_clr > 0) then + allocate(surf_lw_down_clr_store(size(lonb,1)-1, size(latb,2)-1)) + endif + + if (id_soc_coszen > 0) then allocate(coszen_store(size(lonb,1)-1, size(latb,2)-1)) endif - if (id_soc_ozone > 0) then + if (id_soc_ozone > 0) then allocate(thd_ozone_store(size(lonb,1)-1, size(latb,2)-1, num_levels)) - endif + endif - if (id_soc_co2 > 0 ) then + if (id_soc_co2 > 0 ) then allocate(thd_co2_store(size(lonb,1)-1, size(latb,2)-1, num_levels)) endif - ! spectral output currently not available as required axis not present in diag file - if (id_soc_spectral_olr > 0) then + ! spectral output currently not available as required axis not present in diag file + if (id_soc_spectral_olr > 0) then if (socrates_hires_mode .eqv. .True.) then allocate(spectral_olr_store(size(lonb,1)-1, size(latb,2)-1, n_soc_bands_lw_hires)) else allocate(spectral_olr_store(size(lonb,1)-1, size(latb,2)-1, n_soc_bands_lw )) endif - endif + endif endif @@ -487,7 +535,7 @@ SUBROUTINE socrates_init(is, ie, js, je, num_levels, axes, Time, lat, lonb, latb PRINT*, ' ' PRINT*, '-----------------------------------' PRINT*, ' ' - end if + END IF return end subroutine socrates_init @@ -500,13 +548,13 @@ subroutine socrates_interface(Time_diag, rlat, rlon, soc_lw_mode, & fms_temp, fms_spec_hum, fms_ozone, fms_co2, fms_t_surf, & fms_p_full, fms_p_half, fms_z_full, fms_z_half, fms_albedo, & fms_coszen, fms_rrsun, n_profile, n_layer, & - fms_cld_frac, fms_cld_conv_frac, fms_reff_rad, fms_mmr_cl_rad,& + fms_cld_frac, fms_reff_rad, fms_mmr_cl_rad, & output_heating_rate, output_flux_down, output_flux_up, & - output_flux_down_clear, output_flux_up_clear, & - do_cloud_simple, & + output_flux_down_clr, output_flux_up_clr, & + do_cloud_simple, do_cloud_spookie, & !optionals output_soc_spectral_olr, output_flux_direct, & - t_half_level_out ) + output_flux_direct_clr, t_half_level_out, tot_cloud_cover ) use realtype_rd use read_control_mod @@ -543,21 +591,24 @@ subroutine socrates_interface(Time_diag, rlat, rlon, soc_lw_mode, & real(r_def), intent(in) :: rlon(:,:) real(r_def), intent(in) :: rlat(:,:) real(r_def), intent(in) :: fms_z_full(:,:,:), fms_z_half(:,:,:) - real(r_def), intent(in) :: fms_rrsun + real(r_def), intent(in) :: fms_rrsun real(r_def), intent(in) :: fms_cld_frac(:,:,:), fms_reff_rad(:,:,:), fms_mmr_cl_rad(:,:,:) - real(r_def), intent(in) :: fms_cld_conv_frac(:,:,:) - logical, intent(in) :: do_cloud_simple + logical, intent(in) :: do_cloud_simple, do_cloud_spookie ! Output arrays real(r_def), intent(out) :: output_heating_rate(:,:,:) - real(r_def), intent(out) :: output_flux_up(:,:,:), output_flux_up_clear(:,:,:) - real(r_def), intent(out) :: output_flux_down(:,:,:), output_flux_down_clear(:,:,:) + real(r_def), intent(out) :: output_flux_up(:,:,:) + real(r_def), intent(out) :: output_flux_down(:,:,:) + real(r_def), intent(out) :: output_flux_up_clr(:,:,:) + real(r_def), intent(out) :: output_flux_down_clr(:,:,:) - real(r_def), intent(out), optional :: output_flux_direct(:,:,:) + real(r_def), intent(out), optional :: output_flux_direct(:,:,:) + real(r_def), intent(out), optional :: output_flux_direct_clr(:,:,:) real(r_def), intent(out), optional :: output_soc_spectral_olr(:,:,:) real(r_def), intent(out), optional :: t_half_level_out(size(fms_temp,1),size(fms_temp,2),size(fms_temp,3)+1) + real(r_def), intent(out), optional :: tot_cloud_cover(:,:) ! Hi-res output INTEGER, PARAMETER :: out_unit=20 @@ -568,15 +619,13 @@ subroutine socrates_interface(Time_diag, rlat, rlon, soc_lw_mode, & real(r_def), dimension(n_profile, n_layer) :: input_p, input_t, input_mixing_ratio, & input_d_mass, input_density, input_layer_heat_capacity, & soc_heating_rate, input_o3_mixing_ratio, & - input_co2_mixing_ratio,z_full_reshaped, input_cld_frac, input_reff_rad, input_mmr_cl_rad, & - input_cld_conv_frac + input_co2_mixing_ratio,z_full_reshaped, input_cld_frac, input_reff_rad, input_mmr_cl_rad real(r_def), dimension(n_profile, 0:n_layer) :: input_p_level, input_t_level, soc_flux_direct, & - soc_flux_down, soc_flux_up, z_half_reshaped, & - soc_flux_down_clear, soc_flux_up_clear + soc_flux_down, soc_flux_up, soc_flux_direct_clr, soc_flux_down_clr, soc_flux_up_clr, z_half_reshaped real(r_def), dimension(n_profile) :: input_t_surf, input_cos_zenith_angle, input_solar_irrad, & - input_orog_corr, input_planet_albedo + input_orog_corr, input_planet_albedo, soc_tot_cloud_cover ! Socrates options @@ -610,211 +659,222 @@ subroutine socrates_interface(Time_diag, rlat, rlon, soc_lw_mode, & sj = size(fms_temp,2) sk = size(fms_temp,3) - !Set input T, p, p_level, and mixing ratio profiles - input_t = reshape(fms_temp(:,:,:),(/si*sj,sk /)) - input_p = reshape(fms_p_full(:,:,:),(/si*sj,sk /)) - input_p_level = reshape(fms_p_half(:,:,:),(/si*sj,sk+1 /)) - - input_cld_frac = reshape(fms_cld_frac(:,:,:),(/si*sj,sk /)) - input_cld_conv_frac = reshape(fms_cld_conv_frac(:,:,:),(/si*sj,sk /)) - - input_reff_rad = reshape(fms_reff_rad(:,:,:),(/si*sj,sk /)) - input_mmr_cl_rad = reshape(fms_mmr_cl_rad(:,:,:),(/si*sj,sk/)) - - if (account_for_effect_of_water .eqv. .true.) then - input_mixing_ratio = reshape(fms_spec_hum(:,:,:) / (1. - fms_spec_hum(:,:,:)),(/si*sj,sk /)) !Mass mixing ratio = q / (1-q) - else - input_mixing_ratio = 0.0 - endif - - if (account_for_effect_of_ozone .eqv. .true.) then - input_o3_mixing_ratio = reshape(fms_ozone(:,:,:),(/si*sj,sk /)) - else - input_o3_mixing_ratio = 0.0 - endif - - input_co2_mixing_ratio = reshape(fms_co2(:,:,:),(/si*sj,sk /)) - - !------------- - - !Default parameters - input_cos_zenith_angle = reshape((fms_coszen(:,:)),(/si*sj /)) - input_orog_corr = 0.0 - input_planet_albedo = reshape(fms_albedo(:,:),(/n_profile /)) - - !Set tide-locked flux - should be set by namelist eventually! - input_solar_irrad = stellar_constant * fms_rrsun ! * fms_rrsun includes effect of eccentricity if using diurnal_solar, rrsun = 1 if tidally locked - input_t_surf = reshape(fms_t_surf(:,:),(/si*sj /)) - z_full_reshaped = reshape(fms_z_full(:,:,:), (/si*sj, sk/)) - z_half_reshaped = reshape(fms_z_half(:,:,:), (/si*sj, sk+1/)) - - !-------------- - !Set input t_level by scaling t - NEEDS TO CHANGE! - if (use_pressure_interp_for_half_levels) then - DO i = nlat, nlat - DO k = 0,n_layer - input_t_level(:,k) = input_t(:,k) + (input_t(:,k+1)-input_t(:,k)) * ((input_p_level(:,k)-input_p(:,k))/(input_p(:,k+1)-input_p(:,k))) - END DO + + !Set input T, p, p_level, and mixing ratio profiles + input_t = reshape(fms_temp(:,:,:),(/si*sj,sk /)) + input_p = reshape(fms_p_full(:,:,:),(/si*sj,sk /)) + input_p_level = reshape(fms_p_half(:,:,:),(/si*sj,sk+1 /)) + + input_cld_frac = reshape(fms_cld_frac(:,:,:),(/si*sj,sk /)) + input_reff_rad = reshape(fms_reff_rad(:,:,:),(/si*sj,sk /)) + input_mmr_cl_rad = reshape(fms_mmr_cl_rad(:,:,:),(/si*sj,sk/)) + + if (account_for_effect_of_water .eqv. .true.) then + input_mixing_ratio = reshape(fms_spec_hum(:,:,:) / (1. - fms_spec_hum(:,:,:)),(/si*sj,sk /)) !Mass mixing ratio = q / (1-q) + else + input_mixing_ratio = 0.0 + endif + + if (account_for_effect_of_ozone .eqv. .true.) then + input_o3_mixing_ratio = reshape(fms_ozone(:,:,:),(/si*sj,sk /)) + else + input_o3_mixing_ratio = 0.0 + endif + + input_co2_mixing_ratio = reshape(fms_co2(:,:,:),(/si*sj,sk /)) + + !------------- + + !Default parameters + input_cos_zenith_angle = reshape((fms_coszen(:,:)),(/si*sj /)) + input_orog_corr = 0.0 + input_planet_albedo = reshape(fms_albedo(:,:),(/n_profile /)) + + !Set tide-locked flux - should be set by namelist eventually! + input_solar_irrad = stellar_constant * fms_rrsun ! * fms_rrsun includes effect of eccentricity if using diurnal_solar, rrsun = 1 if tidally locked + input_t_surf = reshape(fms_t_surf(:,:),(/si*sj /)) + z_full_reshaped = reshape(fms_z_full(:,:,:), (/si*sj, sk/)) + z_half_reshaped = reshape(fms_z_half(:,:,:), (/si*sj, sk+1/)) + + !-------------- + !Set input t_level by scaling t - NEEDS TO CHANGE! + if (use_pressure_interp_for_half_levels) then + DO i = nlat, nlat + DO k = 0,n_layer + input_t_level(:,k) = input_t(:,k) + (input_t(:,k+1)-input_t(:,k)) * ((input_p_level(:,k)-input_p(:,k))/(input_p(:,k+1)-input_p(:,k))) + END DO ! input_t_level(:,n_layer) = input_t(:,n_layer) + input_t(:,n_layer) - input_t_level(:,n_layer-1) - input_t_level(:,n_layer) = input_t(:,n_layer) + (input_t(:,n_layer)-input_t(:,n_layer-1)) * ((input_p_level(:,n_layer)-input_p(:,n_layer))/(input_p(:,n_layer)-input_p(:,n_layer-1))) - + input_t_level(:,n_layer) = input_t(:,n_layer) + (input_t(:,n_layer)-input_t(:,n_layer-1)) * ((input_p_level(:,n_layer)-input_p(:,n_layer))/(input_p(:,n_layer)-input_p(:,n_layer-1))) + ! input_t_level(:,0) = input_t(:,1) - (input_t_level(:,1) - input_t(:,1)) - input_t_level(:,0) = input_t(:,1) + (input_t(:,2)-input_t(:,1)) * ((input_p_level(:,0)-input_p(:,1))/(input_p(:,2)-input_p(:,1))) - - END DO - else - - call interp_temp(z_full_reshaped,z_half_reshaped,input_t, input_t_level) - - endif - - if (present(t_half_level_out)) then - t_half_level_out(:,:,:) = reshape(input_t_level,(/si,sj,sk+1 /)) - endif - - !Set input dry mass, density, and heat capacity profiles - DO i=n_layer, 1, -1 - input_d_mass(:,i) = (input_p_level(:,i)-input_p_level(:,i-1))/grav - input_density(:,i) = input_p(:,i)/(rdgas*input_t(:,i)) - input_layer_heat_capacity(:,i) = input_d_mass(:,i)*cp_air - END DO - - - ! Zero heating rate - soc_heating_rate = 0.0 - - ! Test if LW or SW mode - if (soc_lw_mode .eqv. .TRUE.) then - control_lw%isolir = 2 - CALL read_control(control_lw, spectrum_lw, do_cloud_simple) - if (socrates_hires_mode .eqv. .FALSE.) then - control_calc = control_lw - spectrum_calc = spectrum_lw - else - control_calc = control_lw_hires - spectrum_calc = spectrum_lw_hires - end if - - else - control_sw%isolir = 1 - CALL read_control(control_sw, spectrum_sw, do_cloud_simple) - if(socrates_hires_mode .eqv. .FALSE.) then - control_calc = control_sw - spectrum_calc = spectrum_sw - else - control_calc = control_sw_hires - spectrum_calc = spectrum_sw_hires - end if - - end if - - - ! Do calculation - CALL read_control(control_calc, spectrum_calc, do_cloud_simple) + + input_t_level(:,0) = input_t(:,1) + (input_t(:,2)-input_t(:,1)) * ((input_p_level(:,0)-input_p(:,1))/(input_p(:,2)-input_p(:,1))) + + END DO + else + + call interp_temp(z_full_reshaped,z_half_reshaped,input_t, input_t_level) + + endif + + if (present(t_half_level_out)) then + t_half_level_out(:,:,:) = reshape(input_t_level,(/si,sj,sk+1 /)) + endif + + !Set input dry mass, density, and heat capacity profiles + DO i=n_layer, 1, -1 + input_d_mass(:,i) = (input_p_level(:,i)-input_p_level(:,i-1))/grav + input_density(:,i) = input_p(:,i)/(rdgas*input_t(:,i)) + input_layer_heat_capacity(:,i) = input_d_mass(:,i)*cp_air + END DO + + ! Zero heating rate + soc_heating_rate = 0.0 + + if (do_cloud_simple .or. do_cloud_spookie) then + do_clouds = .true. + endif + + ! Test if LW or SW mode + if (soc_lw_mode .eqv. .TRUE.) then + control_lw%isolir = 2 + CALL read_control(control_lw, spectrum_lw, do_clouds) + if (socrates_hires_mode .eqv. .FALSE.) then + control_calc = control_lw + spectrum_calc = spectrum_lw + else + control_calc = control_lw_hires + spectrum_calc = spectrum_lw_hires + end if + + else + control_sw%isolir = 1 + CALL read_control(control_sw, spectrum_sw, do_clouds) + if(socrates_hires_mode .eqv. .FALSE.) then + control_calc = control_sw + spectrum_calc = spectrum_sw + else + control_calc = control_sw_hires + spectrum_calc = spectrum_sw_hires + end if + + end if + + ! Do calculation + CALL read_control(control_calc, spectrum_calc, do_clouds) + n_chunk_loop = (si*sj)/chunk_size n_profile_chunk = n_profile / n_chunk_loop - DO i_chunk=1,n_chunk_loop - - idx_chunk_start = (i_chunk-1)*chunk_size + 1 - idx_chunk_end = (i_chunk)*chunk_size - - if (soc_lw_mode.eqv..TRUE.) then - - CALL socrates_calc(Time_diag, control_calc, spectrum_calc, & - n_profile_chunk, n_layer, input_n_cloud_layer, input_n_aer_mode, & - input_cld_subcol_gen, input_cld_subcol_req, & - input_p(idx_chunk_start:idx_chunk_end,:), & - input_t(idx_chunk_start:idx_chunk_end,:), & - input_t_level(idx_chunk_start:idx_chunk_end,:), & - input_d_mass(idx_chunk_start:idx_chunk_end,:), & - input_density(idx_chunk_start:idx_chunk_end,:), & - input_mixing_ratio(idx_chunk_start:idx_chunk_end,:), & - input_o3_mixing_ratio(idx_chunk_start:idx_chunk_end,:), & - input_co2_mixing_ratio(idx_chunk_start:idx_chunk_end,:), & - input_t_surf(idx_chunk_start:idx_chunk_end), & - input_cos_zenith_angle(idx_chunk_start:idx_chunk_end), & - input_solar_irrad(idx_chunk_start:idx_chunk_end), & - input_orog_corr(idx_chunk_start:idx_chunk_end), & - l_planet_grey_surface, & - input_planet_albedo(idx_chunk_start:idx_chunk_end), & - input_planet_emissivity, & - input_layer_heat_capacity(idx_chunk_start:idx_chunk_end,:), & - input_cld_frac(idx_chunk_start:idx_chunk_end,:), & - input_cld_conv_frac(idx_chunk_start:idx_chunk_end,:), & - input_reff_rad(idx_chunk_start:idx_chunk_end,:), & - input_mmr_cl_rad(idx_chunk_start:idx_chunk_end,:), & - do_cloud_simple, & - soc_flux_direct(idx_chunk_start:idx_chunk_end,:), & - soc_flux_down(idx_chunk_start:idx_chunk_end,:), & - soc_flux_up(idx_chunk_start:idx_chunk_end,:), & - soc_flux_down_clear(idx_chunk_start:idx_chunk_end,:), & - soc_flux_up_clear(idx_chunk_start:idx_chunk_end,:), & - soc_heating_rate(idx_chunk_start:idx_chunk_end,:), & - soc_spectral_olr(idx_chunk_start:idx_chunk_end,:)) - - else - CALL socrates_calc(Time_diag, control_calc, spectrum_calc, & - n_profile_chunk, n_layer, input_n_cloud_layer, input_n_aer_mode, & - input_cld_subcol_gen, input_cld_subcol_req, & - input_p(idx_chunk_start:idx_chunk_end,:), & - input_t(idx_chunk_start:idx_chunk_end,:), & - input_t_level(idx_chunk_start:idx_chunk_end,:), & - input_d_mass(idx_chunk_start:idx_chunk_end,:), & - input_density(idx_chunk_start:idx_chunk_end,:), & - input_mixing_ratio(idx_chunk_start:idx_chunk_end,:), & - input_o3_mixing_ratio(idx_chunk_start:idx_chunk_end,:), & - input_co2_mixing_ratio(idx_chunk_start:idx_chunk_end,:), & - input_t_surf(idx_chunk_start:idx_chunk_end), & - input_cos_zenith_angle(idx_chunk_start:idx_chunk_end), & - input_solar_irrad(idx_chunk_start:idx_chunk_end), & - input_orog_corr(idx_chunk_start:idx_chunk_end), & - l_planet_grey_surface, & - input_planet_albedo(idx_chunk_start:idx_chunk_end), & - input_planet_emissivity, & - input_layer_heat_capacity(idx_chunk_start:idx_chunk_end,:), & - input_cld_frac(idx_chunk_start:idx_chunk_end,:), & - input_cld_conv_frac(idx_chunk_start:idx_chunk_end,:), & - input_reff_rad(idx_chunk_start:idx_chunk_end,:), & - input_mmr_cl_rad(idx_chunk_start:idx_chunk_end,:), & - do_cloud_simple, & - soc_flux_direct(idx_chunk_start:idx_chunk_end,:), & - soc_flux_down(idx_chunk_start:idx_chunk_end,:), & - soc_flux_up(idx_chunk_start:idx_chunk_end,:), & - soc_flux_down_clear(idx_chunk_start:idx_chunk_end,:), & - soc_flux_up_clear(idx_chunk_start:idx_chunk_end,:), & - soc_heating_rate(idx_chunk_start:idx_chunk_end,:)) - endif - - ENDDO - - ! Set output arrays - output_flux_up(:,:,:) = reshape(soc_flux_up(:,:),(/si,sj,sk+1 /)) - output_flux_down(:,:,:) = reshape(soc_flux_down(:,:),(/si,sj,sk+1 /)) - - output_flux_up_clear(:,:,:) = reshape(soc_flux_up_clear(:,:),(/si,sj,sk+1 /)) - output_flux_down_clear(:,:,:) = reshape(soc_flux_down_clear(:,:),(/si,sj,sk+1 /)) - - if(present(output_flux_direct)) then - output_flux_direct(:,:,:) = reshape(soc_flux_direct(:,:),(/si,sj,sk+1 /)) - endif - - output_heating_rate(:,:,:) = reshape(soc_heating_rate(:,:),(/si,sj,sk /)) - - if (soc_lw_mode .eqv. .TRUE.) then - output_soc_spectral_olr(:,:,:) = reshape(soc_spectral_olr(:,:),(/si,sj,int(n_soc_bands_lw,i_def) /)) - endif + + DO i_chunk=1,n_chunk_loop + + idx_chunk_start = (i_chunk-1)*chunk_size + 1 + idx_chunk_end = (i_chunk)*chunk_size + + if (soc_lw_mode .eqv. .TRUE.) then + CALL socrates_calc(Time_diag, control_calc, spectrum_calc, & + n_profile_chunk, n_layer, input_n_cloud_layer, input_n_aer_mode, & + input_cld_subcol_gen, input_cld_subcol_req, & + input_p(idx_chunk_start:idx_chunk_end,:), & + input_t(idx_chunk_start:idx_chunk_end,:), & + input_t_level(idx_chunk_start:idx_chunk_end,:), & + input_d_mass(idx_chunk_start:idx_chunk_end,:), & + input_density(idx_chunk_start:idx_chunk_end,:), & + input_mixing_ratio(idx_chunk_start:idx_chunk_end,:), & + input_o3_mixing_ratio(idx_chunk_start:idx_chunk_end,:), & + input_co2_mixing_ratio(idx_chunk_start:idx_chunk_end,:), & + input_t_surf(idx_chunk_start:idx_chunk_end), & + input_cos_zenith_angle(idx_chunk_start:idx_chunk_end), & + input_solar_irrad(idx_chunk_start:idx_chunk_end), & + input_orog_corr(idx_chunk_start:idx_chunk_end), & + l_planet_grey_surface, & + input_planet_albedo(idx_chunk_start:idx_chunk_end), & + input_planet_emissivity, & + input_layer_heat_capacity(idx_chunk_start:idx_chunk_end,:), & + input_cld_frac(idx_chunk_start:idx_chunk_end,:), & + input_reff_rad(idx_chunk_start:idx_chunk_end,:), & + input_mmr_cl_rad(idx_chunk_start:idx_chunk_end,:), & + soc_flux_direct(idx_chunk_start:idx_chunk_end,:), & + soc_flux_down(idx_chunk_start:idx_chunk_end,:), & + soc_flux_up(idx_chunk_start:idx_chunk_end,:), & + soc_flux_direct_clr(idx_chunk_start:idx_chunk_end,:), & + soc_flux_down_clr(idx_chunk_start:idx_chunk_end,:), & + soc_flux_up_clr(idx_chunk_start:idx_chunk_end,:), & + soc_heating_rate(idx_chunk_start:idx_chunk_end,:), & + soc_spectral_olr(idx_chunk_start:idx_chunk_end,:), & + soc_tot_cloud_cover(idx_chunk_start:idx_chunk_end)) + + else + CALL socrates_calc(Time_diag, control_calc, spectrum_calc, & + n_profile_chunk, n_layer, input_n_cloud_layer, input_n_aer_mode, & + input_cld_subcol_gen, input_cld_subcol_req, & + input_p(idx_chunk_start:idx_chunk_end,:), & + input_t(idx_chunk_start:idx_chunk_end,:), & + input_t_level(idx_chunk_start:idx_chunk_end,:), & + input_d_mass(idx_chunk_start:idx_chunk_end,:), & + input_density(idx_chunk_start:idx_chunk_end,:), & + input_mixing_ratio(idx_chunk_start:idx_chunk_end,:), & + input_o3_mixing_ratio(idx_chunk_start:idx_chunk_end,:), & + input_co2_mixing_ratio(idx_chunk_start:idx_chunk_end,:), & + input_t_surf(idx_chunk_start:idx_chunk_end), & + input_cos_zenith_angle(idx_chunk_start:idx_chunk_end), & + input_solar_irrad(idx_chunk_start:idx_chunk_end), & + input_orog_corr(idx_chunk_start:idx_chunk_end), & + l_planet_grey_surface, & + input_planet_albedo(idx_chunk_start:idx_chunk_end), & + input_planet_emissivity, & + input_layer_heat_capacity(idx_chunk_start:idx_chunk_end,:), & + input_cld_frac(idx_chunk_start:idx_chunk_end,:), & + input_reff_rad(idx_chunk_start:idx_chunk_end,:), & + input_mmr_cl_rad(idx_chunk_start:idx_chunk_end,:), & + soc_flux_direct(idx_chunk_start:idx_chunk_end,:), & + soc_flux_down(idx_chunk_start:idx_chunk_end,:), & + soc_flux_up(idx_chunk_start:idx_chunk_end,:), & + soc_flux_direct_clr(idx_chunk_start:idx_chunk_end,:), & + soc_flux_down_clr(idx_chunk_start:idx_chunk_end,:), & + soc_flux_up_clr(idx_chunk_start:idx_chunk_end,:), & + soc_heating_rate(idx_chunk_start:idx_chunk_end,:)) + endif + + ENDDO + + ! Set output arrays + output_flux_up(:,:,:) = reshape(soc_flux_up(:,:),(/si,sj,sk+1 /)) + output_flux_down(:,:,:) = reshape(soc_flux_down(:,:),(/si,sj,sk+1 /)) + + output_flux_up_clr(:,:,:) = reshape(soc_flux_up_clr(:,:),(/si,sj,sk+1 /)) + output_flux_down_clr(:,:,:) = reshape(soc_flux_down_clr(:,:),(/si,sj,sk+1 /)) + + if(present(output_flux_direct)) then + output_flux_direct(:,:,:) = reshape(soc_flux_direct(:,:),(/si,sj,sk+1 /)) + endif + + if(present(output_flux_direct_clr)) then + output_flux_direct_clr(:,:,:) = reshape(soc_flux_direct_clr(:,:),(/si,sj,sk+1 /)) + endif + + output_heating_rate(:,:,:) = reshape(soc_heating_rate(:,:),(/si,sj,sk /)) + + if(present(tot_cloud_cover)) then + tot_cloud_cover(:,:) = reshape(soc_tot_cloud_cover(:), (/si,sj/)) + endif + + if (soc_lw_mode .eqv. .TRUE.) then + output_soc_spectral_olr(:,:,:) = reshape(soc_spectral_olr(:,:),(/si,sj,int(n_soc_bands_lw,i_def) /)) + endif + end subroutine socrates_interface subroutine run_socrates(Time, Time_diag, rad_lat, rad_lon, temp_in, q_in, t_surf_in, p_full_in, p_half_in, z_full_in, z_half_in, albedo_in, & - temp_tend, net_surf_sw_down, surf_lw_down, delta_t, do_cloud_simple, cf_rad, cca_rad, reff_rad, qcl_rad) + temp_tend, net_surf_sw_down, surf_lw_down, delta_t, do_cloud_simple, do_cloud_spookie, cf_rad, reff_rad, qcl_rad) use astronomy_mod, only: diurnal_solar use constants_mod, only: pi, wtmco2, wtmozone, rdgas, gas_constant use interpolator_mod,only: interpolator - USE socrates_config_mod + USE socrates_config_mod ! Input time type(time_type), intent(in) :: Time, Time_diag @@ -824,501 +884,169 @@ subroutine run_socrates(Time, Time_diag, rad_lat, rad_lon, temp_in, q_in, t_surf real, intent(inout), dimension(:,:,:) :: temp_tend real, intent(out), dimension(:,:) :: net_surf_sw_down, surf_lw_down real, intent(in) :: delta_t - logical, intent(in) :: do_cloud_simple - real, intent(in), dimension(:,:,:) :: cf_rad, cca_rad, reff_rad, qcl_rad + logical, intent(in) :: do_cloud_simple, do_cloud_spookie + real, intent(in), dimension(:,:,:) :: cf_rad, reff_rad, qcl_rad integer(i_def) :: n_profile, n_layer real(r_def), dimension(size(temp_in,1), size(temp_in,2)) :: t_surf_for_soc, rad_lat_soc, rad_lon_soc, albedo_soc - real(r_def), dimension(size(temp_in,1), size(temp_in,2), size(temp_in,3)) :: tg_tmp_soc, q_soc, ozone_soc, co2_soc, p_full_soc - real(r_def), dimension(size(temp_in,1), size(temp_in,2), size(temp_in,3)) :: output_heating_rate_sw, output_heating_rate_lw - real(r_def), dimension(size(temp_in,1), size(temp_in,2), size(temp_in,3)) :: output_heating_rate_total, z_full_soc - real(r_def), dimension(size(temp_in,1), size(temp_in,2), size(temp_in,3)) :: cld_frac_soc, cld_conv_frac_soc - real(r_def), dimension(size(temp_in,1), size(temp_in,2), size(temp_in,3)) :: reff_rad_soc, mmr_cl_rad_soc, qcl_rad_soc - - real(r_def), dimension(size(temp_in,1), size(temp_in,2), size(temp_in,3)+1) :: p_half_soc, t_half_out, z_half_soc - real(r_def), dimension(size(temp_in,1), size(temp_in,2), size(temp_in,3)+1) :: output_soc_flux_sw_down, output_soc_flux_sw_up - real(r_def), dimension(size(temp_in,1), size(temp_in,2), size(temp_in,3)+1) :: output_soc_flux_lw_down, output_soc_flux_lw_up - real(r_def), dimension(size(temp_in,1), size(temp_in,2), size(temp_in,3)+1) :: output_soc_flux_lw_down_clear, output_soc_flux_lw_up_clear - real(r_def), dimension(size(temp_in,1), size(temp_in,2), size(temp_in,3)+1) :: output_soc_flux_sw_down_clear, output_soc_flux_sw_up_clear - + real(r_def), dimension(size(temp_in,1), & + size(temp_in,2), size(temp_in,3)) :: tg_tmp_soc, q_soc, ozone_soc, co2_soc, p_full_soc, & + output_heating_rate_sw, output_heating_rate_lw, output_heating_rate_total, & + output_heating_rate_sw_clr, output_heating_rate_lw_clr, & + z_full_soc, cld_frac_soc, reff_rad_soc, mmr_cl_rad_soc, qcl_rad_soc, & + cld_frac_soc_clr, reff_rad_soc_clr, mmr_cl_rad_soc_clr + real(r_def), dimension(size(temp_in,1), & + size(temp_in,2), size(temp_in,3)+1) :: p_half_soc, t_half_out, z_half_soc, output_soc_flux_sw_down, & + output_soc_flux_sw_up, output_soc_flux_lw_down, output_soc_flux_lw_up, & + output_soc_flux_sw_down_clr, output_soc_flux_sw_up_clr, & + output_soc_flux_lw_down_clr, output_soc_flux_lw_up_clr, & + t_half_out_clr + real(r_def), dimension(size(temp_in,1), size(temp_in,2)) :: tot_cloud_cover logical :: soc_lw_mode, used integer :: seconds, days, year_in_s - real :: r_seconds, r_days, r_total_seconds, frac_of_day, frac_of_year, gmt, time_since_ae, rrsun, dt_rad_radians, day_in_s, r_solday, r_dt_rad_avg - real, dimension(size(temp_in,1), size(temp_in,2)) :: coszen, fracsun, surf_lw_net, olr, toa_sw, p2, toa_sw_down, surf_sw_down - - real, dimension(size(temp_in,1), size(temp_in,2)) :: olr_clear, toa_sw_clear, toa_sw_down_clear - real, dimension(size(temp_in,1), size(temp_in,2)) :: surf_lw_down_clear, surf_lw_net_clear, & - surf_sw_down_clear, net_surf_sw_down_clear - + real :: r_seconds, r_days, r_total_seconds, frac_of_day, frac_of_year, gmt, time_since_ae, rrsun, & + dt_rad_radians, day_in_s, r_solday, r_dt_rad_avg + real, dimension(size(temp_in,1), size(temp_in,2)) :: coszen, fracsun, surf_lw_net, olr, toa_sw, & + p2, toa_sw_down, surf_sw_down, & + olr_clr, toa_sw_clr, toa_sw_up, toa_sw_up_clr, & + net_surf_sw_down_clr, surf_sw_down_clr, surf_lw_net_clr, surf_lw_down_clr real, dimension(size(temp_in,1), size(temp_in,2), size(temp_in,3)) :: ozone_in, co2_in - real, dimension(size(temp_in,1), size(temp_in,2), size(temp_in,3)+1) :: thd_sw_flux_net, thd_lw_flux_net + real, dimension(size(temp_in,1), size(temp_in,2), size(temp_in,3)+1) :: thd_sw_flux_net, thd_lw_flux_net, thd_sw_flux_clr_net, thd_lw_flux_clr_net + type(time_type) :: Time_loc - + !check if we really want to recompute radiation + ! alarm + call get_time(Time,seconds,days) + r_days = real(days) + r_seconds = real(seconds) + r_total_seconds=r_seconds+(r_days*86400.) - !check if we really want to recompute radiation - ! alarm - call get_time(Time,seconds,days) - r_days = real(days) - r_seconds = real(seconds) - r_total_seconds=r_seconds+(r_days*86400.) - if(r_total_seconds - dt_last .ge. dt_rad) then - dt_last = r_total_seconds - else - if(store_intermediate_rad) then - !required for computation - output_heating_rate_sw = tdt_soc_sw_store - output_heating_rate_lw = tdt_soc_lw_store - net_surf_sw_down = real(net_surf_sw_down_store) - surf_lw_down = real(surf_lw_down_store) - - !only required for output - if (id_soc_surf_flux_sw_clear > 0) then - net_surf_sw_down_clear = net_surf_sw_down_clear_store - endif - - if (id_soc_surf_flux_lw_down_clear > 0) then - surf_lw_down_clear = surf_lw_down_clear_store - endif - - if (id_soc_surf_flux_lw > 0) then - surf_lw_net = surf_lw_net_store - endif - - if (id_soc_surf_flux_lw_clear > 0) then - surf_lw_net_clear = surf_lw_net_clear_store - endif - - if (id_soc_flux_lw > 0) then - thd_lw_flux_net = thd_lw_flux_net_store - endif - if (id_soc_flux_sw > 0) then - thd_sw_flux_net = thd_sw_flux_net_store - endif - - if (id_soc_surf_flux_sw_down > 0) then - surf_sw_down = surf_sw_down_store - endif - if (id_soc_surf_flux_sw_down_clear > 0) then - surf_sw_down_clear = surf_sw_down_clear_store - endif - - if (id_soc_surf_flux_sw_down_clear > 0) then - surf_sw_down_clear = surf_sw_down_clear_store - endif - - if (id_soc_olr > 0) then - olr = olr_store - endif - - if (id_soc_olr_clear > 0) then - olr_clear = olr_clear_store - endif - - if (id_soc_toa_sw > 0) then - toa_sw = toa_sw_store - endif - if (id_soc_toa_sw_clear > 0) then - toa_sw_clear = toa_sw_clear_store - endif - - if (id_soc_toa_sw_down > 0) then - toa_sw_down = toa_sw_down_store - endif - - if (id_soc_toa_sw_down_clear > 0) then - toa_sw_down_clear = toa_sw_down_clear_store - endif - - if (id_soc_toa_sw_down > 0) then - toa_sw_down = toa_sw_down_store - endif - - if (id_soc_toa_sw_down_clear > 0) then - toa_sw_down_clear = toa_sw_down_clear_store - endif - - if (id_soc_coszen > 0) then - coszen = coszen_store - endif - - if (id_soc_ozone > 0) then - ozone_in = thd_ozone_store - endif - - if (id_soc_co2 > 0) then - co2_in = thd_co2_store - endif - - if (id_soc_spectral_olr > 0) then - outputted_soc_spectral_olr = spectral_olr_store - endif - else - !all sky heating rates. - output_heating_rate_sw = 0. - output_heating_rate_lw = 0. - - !all sky and clear sky fluxes. - thd_sw_flux_net = 0. - thd_lw_flux_net = 0. - - net_surf_sw_down = 0. - net_surf_sw_down_clear = 0. - - surf_sw_down = 0. - surf_sw_down_clear = 0. - - surf_lw_down = 0. - surf_lw_down_clear = 0. - - surf_lw_net = 0. - surf_lw_net_clear = 0. - - toa_sw = 0. - toa_sw_clear = 0. - - toa_sw_down = 0. - toa_sw_down_clear = 0. - - olr = 0. - olr_clear = 0. - - !Others - coszen = 0. - ozone_in = 0. - co2_in = 0. - outputted_soc_spectral_olr = 0. - endif - - temp_tend(:,:,:) = temp_tend(:,:,:) + real(output_heating_rate_sw)+real(output_heating_rate_lw) - output_heating_rate_total = output_heating_rate_sw +output_heating_rate_lw - - ! Send diagnostics - if(id_soc_tdt_lw > 0) then !heating rate in (Ks-1) - used = send_data ( id_soc_tdt_lw, output_heating_rate_lw, Time_diag) - endif - if(id_soc_tdt_sw > 0) then - used = send_data ( id_soc_tdt_sw, output_heating_rate_sw, Time_diag) - endif - if(id_soc_tdt_rad > 0) then - used = send_data ( id_soc_tdt_rad, output_heating_rate_total, Time_diag) - endif - if(id_soc_surf_flux_lw > 0) then - used = send_data ( id_soc_surf_flux_lw, surf_lw_net, Time_diag) - endif - if(id_soc_surf_flux_lw_clear > 0) then - used = send_data ( id_soc_surf_flux_lw_clear, surf_lw_net_clear, Time_diag) - endif - if(id_soc_surf_flux_lw_down > 0) then - used = send_data ( id_soc_surf_flux_lw_down, surf_lw_down, Time_diag) - endif - if(id_soc_surf_flux_lw_down_clear > 0) then - used = send_data ( id_soc_surf_flux_lw_down_clear, surf_lw_down_clear, Time_diag) - endif - if(id_soc_surf_flux_sw > 0) then - used = send_data ( id_soc_surf_flux_sw, net_surf_sw_down, Time_diag) - endif - if(id_soc_surf_flux_sw_clear > 0) then - used = send_data ( id_soc_surf_flux_sw_clear, net_surf_sw_down_clear, Time_diag) - endif - if(id_soc_surf_flux_sw_down > 0) then - used = send_data ( id_soc_surf_flux_sw_down, surf_sw_down, Time_diag) - endif - if(id_soc_surf_flux_sw_down_clear > 0) then - used = send_data ( id_soc_surf_flux_sw_down_clear, surf_sw_down_clear, Time_diag) - endif - if(id_soc_olr > 0) then - used = send_data ( id_soc_olr, olr, Time_diag) - endif - if(id_soc_olr_clear > 0) then - used = send_data ( id_soc_olr_clear, olr_clear, Time_diag) + if(r_total_seconds - dt_last .ge. dt_rad) then + dt_last = r_total_seconds + else + if(store_intermediate_rad) then + !required for computation + output_heating_rate_sw = tdt_soc_sw_store + output_heating_rate_lw = tdt_soc_lw_store + net_surf_sw_down = real(net_surf_sw_down_store) + surf_lw_down = real(surf_lw_down_store) + + !only required for output + if (id_soc_surf_flux_lw > 0) then + surf_lw_net = real(surf_lw_net_store) endif - if(id_soc_toa_sw > 0) then - used = send_data ( id_soc_toa_sw, toa_sw, Time_diag) + if (id_soc_flux_lw > 0) then + thd_lw_flux_net = thd_lw_flux_net_store endif - if(id_soc_toa_sw_clear > 0) then - used = send_data ( id_soc_toa_sw_clear, toa_sw_clear, Time_diag) + + if (id_soc_flux_sw > 0) then + thd_sw_flux_net = thd_sw_flux_net_store endif - if(id_soc_toa_sw_down > 0) then - used = send_data ( id_soc_toa_sw_down, toa_sw_down, Time_diag) + + if (id_soc_surf_flux_sw_down > 0) then + surf_sw_down = surf_sw_down_store endif - if(id_soc_toa_sw_down_clear > 0) then - used = send_data ( id_soc_toa_sw_down_clear, toa_sw_down_clear, Time_diag) + + if (id_soc_olr > 0) then + olr = olr_store endif - if(id_soc_flux_lw > 0) then - used = send_data ( id_soc_flux_lw, thd_lw_flux_net, Time_diag) + + if (id_soc_toa_sw > 0) then + toa_sw = toa_sw_store endif - if(id_soc_flux_sw > 0) then - used = send_data ( id_soc_flux_sw, thd_sw_flux_net, Time_diag) + + if (id_soc_toa_sw_up > 0) then + toa_sw_up = toa_sw_up_store endif - if(id_soc_coszen > 0) then - used = send_data ( id_soc_coszen, coszen, Time_diag) + if (id_soc_flux_lw_clr > 0) then + thd_lw_flux_clr_net = thd_lw_flux_clr_net_store endif - if(id_soc_co2 > 0) then - used = send_data ( id_soc_co2, co2_in, Time_diag) - endif - if(id_soc_ozone > 0) then - used = send_data ( id_soc_ozone, ozone_in, Time_diag) + + if (id_soc_flux_sw_clr > 0) then + thd_sw_flux_clr_net = thd_sw_flux_clr_net_store endif - if(id_soc_spectral_olr > 0) then - used = send_data ( id_soc_spectral_olr, outputted_soc_spectral_olr, Time_diag) - endif - ! Diagnostics sent - - return !not time yet - - endif - - - !make sure we run perpetual when solday > 0) - if(solday > 0)then - Time_loc = set_time(seconds,solday) - else - Time_loc = Time - endif - - !Set tide-locked flux if tidally-locked = .true. Else use diurnal-solar - !to calculate insolation from orbit! - if (tidally_locked) then - coszen = COS(rad_lat(:,:))*COS(rad_lon(:,:)) - WHERE (coszen < 0.0) coszen = 0.0 - rrsun = 1 - ! needs to be set to 1 so that stellar_radiation is unchanged in socrates_interface - - elseif (frierson_solar_rad) then - p2 = (1. - 3.*sin(rad_lat(:,:))**2)/4. - coszen = 0.25 * (1.0 + del_sol * p2 + del_sw * sin(rad_lat(:,:))) - rrsun = 1 ! needs to be set to 1 so that stellar_radiation is unchanged in socrates_interface - - else - - ! compute zenith angle - call get_time(Time_loc, seconds, days) - call get_time(length_of_year(), year_in_s) - day_in_s = length_of_day() - - r_seconds=real(seconds) - r_days=real(days) - r_total_seconds=r_seconds+(r_days*86400.) - - frac_of_day = r_total_seconds / day_in_s - - if(solday > 0) then - r_solday=real(solday) - frac_of_year=(r_solday*day_in_s)/year_in_s - else - frac_of_year = r_total_seconds / year_in_s - endif - gmt = abs(mod(frac_of_day, 1.0)) * 2.0 * pi - time_since_ae = modulo(frac_of_year-equinox_day, 1.0) * 2.0 * pi - - if(do_rad_time_avg) then - r_dt_rad_avg=real(dt_rad_avg) - dt_rad_radians = (r_dt_rad_avg/day_in_s)*2.0*pi - call diurnal_solar(rad_lat, rad_lon, gmt, time_since_ae, coszen, fracsun, rrsun, dt_rad_radians) - else - ! Seasonal Cycle: Use astronomical parameters to calculate insolation - call diurnal_solar(rad_lat, rad_lon, gmt, time_since_ae, coszen, fracsun, rrsun) - end if - - endif - - ozone_in = 0.0 - - !get ozone - if(do_read_ozone)then - call interpolator( o3_interp, Time_diag, p_half_in, ozone_in, trim(ozone_field_name)) - if (input_o3_file_is_mmr.eqv..false.) then - ozone_in = ozone_in * wtmozone / (1000. * gas_constant / rdgas ) !Socrates expects all abundances to be mass mixing ratio. So if input file is volume mixing ratio, it must be converted to mass mixing ratio using the molar masses of dry air and ozone - ! Molar mass of dry air calculated from gas_constant / rdgas, and converted into g/mol from kg/mol by multiplying by 1000. This conversion is necessary because wtmozone is in g/mol. - - endif - endif - - if (input_co2_mmr.eqv..false.) then - co2_in = co2_ppmv * 1.e-6 * wtmco2 / (1000. * gas_constant / rdgas )!Convert co2_ppmv to a mass mixing ratio, as required by socrates - ! Molar mass of dry air calculated from gas_constant / rdgas, and converted into g/mol from kg/mol by multiplying by 1000. This conversion is necessary because wtmco2 is in g/mol. - else - co2_in = co2_ppmv * 1.e-6 !No need to convert if it is already a mmr - endif - - !get co2 - if(do_read_co2)then - call interpolator( co2_interp, Time_diag, p_half_in, co2_in, trim(co2_field_name)) - if (input_co2_mmr.eqv..false.) then - co2_in = co2_in * 1.e-6 * wtmco2 / (1000. * gas_constant / rdgas ) - ! Molar mass of dry air calculated from gas_constant / rdgas, and converted into g/mol from kg/mol by multiplying by 1000. This conversion is necessary because wtmco2 is in g/mol. - - endif - endif - - - if(do_cloud_simple) then - cld_frac_soc = REAL(cf_rad, kind(r_def)) - cld_conv_frac_soc = REAL(cca_rad, kind(r_def)) - - reff_rad_soc = REAL(reff_rad, kind(r_def)) - - qcl_rad_soc = REAL(qcl_rad, kind(r_def)) - mmr_cl_rad_soc = qcl_rad_soc / (1.0 - qcl_rad_soc) !check if qcl is indeed specific humidity and not mmr - - else - cld_frac_soc = 0. - cld_conv_frac_soc = 0. - reff_rad_soc = 0. - mmr_cl_rad_soc = 0. - - endif - n_profile = INT(size(temp_in,2)*size(temp_in,1), kind(i_def)) - n_layer = INT(size(temp_in,3), kind(i_def)) - t_surf_for_soc = REAL(t_surf_in(:,:), kind(r_def)) - ! LW calculation - ! Retrieve output_heating_rate, and downward surface SW and LW fluxes - soc_lw_mode = .TRUE. - - rad_lat_soc = REAL(rad_lat, kind(r_def)) - rad_lon_soc = REAL(rad_lon, kind(r_def)) - tg_tmp_soc = REAL(temp_in, kind(r_def)) - q_soc = REAL(q_in, kind(r_def)) - ozone_soc = REAL(ozone_in, kind(r_def)) - co2_soc = REAL(co2_in, kind(r_def)) - p_full_soc = REAL(p_full_in, kind(r_def)) - p_half_soc = REAL(p_half_in, kind(r_def)) - albedo_soc = REAL(albedo_in, kind(r_def)) - z_full_soc = REAL(z_full_in, kind(r_def)) - z_half_soc = REAL(z_half_in, kind(r_def)) - - CALL socrates_interface(Time, rad_lat_soc, rad_lon_soc, soc_lw_mode, & - tg_tmp_soc, q_soc, ozone_soc, co2_soc, t_surf_for_soc, p_full_soc, & - p_half_soc, z_full_soc, z_half_soc, albedo_soc, coszen, rrsun, & - n_profile, n_layer, cld_frac_soc, cld_conv_frac_soc, reff_rad_soc, mmr_cl_rad_soc,& - output_heating_rate_lw, output_soc_flux_lw_down, output_soc_flux_lw_up, & - output_soc_flux_lw_down_clear, output_soc_flux_lw_up_clear, & - do_cloud_simple, & - !optional outs - output_soc_spectral_olr = outputted_soc_spectral_olr, & - t_half_level_out = t_half_out) - - - tg_tmp_soc = tg_tmp_soc + output_heating_rate_lw*delta_t !Output heating rate in K/s, so is a temperature tendency - surf_lw_down(:,:) = REAL(output_soc_flux_lw_down(:,:, n_layer+1)) - surf_lw_down_clear(:,:) = REAL(output_soc_flux_lw_down_clear(:,:, n_layer+1)) - - surf_lw_net(:,:) = REAL(output_soc_flux_lw_up(:,:,n_layer+1) - & - output_soc_flux_lw_down(:,:, n_layer+1)) - surf_lw_net_clear(:,:) = REAL(output_soc_flux_lw_up_clear(:,:,n_layer+1) - & - output_soc_flux_lw_down_clear(:,:, n_layer+1)) - olr(:,:) = REAL(output_soc_flux_lw_up(:,:,1)) - olr_clear(:,:) = REAL(output_soc_flux_lw_up_clear(:,:,1)) - - thd_lw_flux_net = REAL(output_soc_flux_lw_up - output_soc_flux_lw_down) - - temp_tend(:,:,:) = temp_tend(:,:,:) + real(output_heating_rate_lw) - - - ! SW calculation - ! Retrieve output_heating_rate, and downward surface SW and LW fluxes - soc_lw_mode = .FALSE. - CALL socrates_interface(Time, rad_lat_soc, rad_lon_soc, soc_lw_mode, & - tg_tmp_soc, q_soc, ozone_soc, co2_soc, t_surf_for_soc, p_full_soc, & - p_half_soc, z_full_soc, z_half_soc, albedo_soc, coszen, rrsun, & - n_profile, n_layer, cld_frac_soc, cld_conv_frac_soc, reff_rad_soc, mmr_cl_rad_soc, & - output_heating_rate_sw, output_soc_flux_sw_down, output_soc_flux_sw_up, & - output_soc_flux_sw_down_clear, output_soc_flux_sw_up_clear, & - do_cloud_simple) - - - tg_tmp_soc = tg_tmp_soc + output_heating_rate_sw*delta_t !Output heating rate in K/s, so is a temperature tendency - net_surf_sw_down(:,:) = REAL(output_soc_flux_sw_down(:,:, n_layer+1) - & - output_soc_flux_sw_up(:,:,n_layer+1) ) - net_surf_sw_down_clear(:,:) = REAL(output_soc_flux_sw_down_clear(:,:, n_layer+1) - & - output_soc_flux_sw_up_clear(:,:,n_layer+1) ) - - toa_sw(:,:) = REAL(output_soc_flux_sw_down(:,:,1) - & - output_soc_flux_sw_up(:,:,1)) - toa_sw_clear(:,:) = REAL(output_soc_flux_sw_down_clear(:,:,1) - & - output_soc_flux_sw_up_clear(:,:,1)) - - thd_sw_flux_net = REAL(output_soc_flux_sw_up - output_soc_flux_sw_down) !net sw all levels - - toa_sw_down(:,:) = REAL(output_soc_flux_sw_down(:,:,1)) - toa_sw_down_clear(:,:) = REAL(output_soc_flux_sw_down_clear(:,:,1)) - - surf_sw_down(:,:) = REAL(output_soc_flux_sw_down(:,:, n_layer+1)) - surf_sw_down_clear(:,:) = REAL(output_soc_flux_sw_down_clear(:,:, n_layer+1)) - - temp_tend(:,:,:) = temp_tend(:,:,:) + real(output_heating_rate_sw) - - output_heating_rate_total = output_heating_rate_lw + output_heating_rate_sw - - if(store_intermediate_rad)then - ! required for calculation - tdt_soc_lw_store = output_heating_rate_lw - tdt_soc_sw_store = output_heating_rate_sw - net_surf_sw_down_store = real(net_surf_sw_down, kind(r_def)) - surf_lw_down_store = real(surf_lw_down, kind(r_def)) - - ! required for output - if (id_soc_flux_lw > 0) then - thd_lw_flux_net_store = thd_lw_flux_net - endif - - if (id_soc_flux_sw > 0) then - thd_sw_flux_net_store = thd_sw_flux_net + + if (id_soc_olr_clr > 0) then + olr_clr = olr_clr_store endif - - if (id_soc_surf_flux_sw_down > 0) then - surf_sw_down_store = surf_sw_down - endif - if (id_soc_toa_sw_down > 0) then - toa_sw_down_store = toa_sw_down - endif + if (id_soc_toa_sw_clr > 0) then + toa_sw_clr = toa_sw_clr_store + endif - if (id_soc_surf_flux_lw > 0) then - surf_lw_net_store = surf_lw_net - endif + if (id_soc_toa_sw_up_clr > 0) then + toa_sw_up_clr = toa_sw_up_clr_store + endif - if (id_soc_surf_flux_sw_down > 0) then - surf_sw_down_store = surf_sw_down - endif + if (id_soc_surf_flux_sw_clr > 0) then + net_surf_sw_down_clr = net_surf_sw_down_clr_store + endif - if (id_soc_toa_sw_down > 0) then - toa_sw_down_store = toa_sw_down - endif + if (id_soc_surf_flux_sw_down_clr > 0) then + surf_sw_down_clr = surf_sw_down_clr_store + endif - if (id_soc_olr > 0) then - olr_store = olr - endif + if (id_soc_surf_flux_lw_clr > 0) then + surf_lw_net_clr = surf_lw_net_clr_store + endif - if (id_soc_olr_clear > 0) then - olr_clear_store = olr_clear - endif + if (id_soc_surf_flux_lw_down_clr > 0) then + surf_lw_down_clr = surf_lw_down_clr_store + endif - if (id_soc_toa_sw > 0) then - toa_sw_store = toa_sw - endif + if (id_soc_toa_sw_down > 0) then + toa_sw_down = toa_sw_down_store + endif - if (id_soc_coszen > 0) then - coszen_store = coszen - endif + if (id_soc_coszen > 0) then + coszen = coszen_store + endif - if (id_soc_ozone > 0) then - thd_ozone_store = ozone_in - endif + if (id_soc_ozone > 0) then + ozone_in = thd_ozone_store + endif - if (id_soc_co2 > 0) then - thd_co2_store = co2_in + if (id_soc_co2 > 0) then + co2_in = thd_co2_store endif - + if (id_soc_spectral_olr > 0) then - spectral_olr_store = outputted_soc_spectral_olr - endif - - endif + outputted_soc_spectral_olr = spectral_olr_store + endif + else + output_heating_rate_sw = 0. + output_heating_rate_lw = 0. + thd_sw_flux_net = 0. + thd_lw_flux_net = 0. + net_surf_sw_down = 0. + surf_lw_down = 0. + surf_lw_net = 0. + toa_sw = 0. + olr = 0. + toa_sw_up = 0. + + olr_clr = 0. + toa_sw_clr = 0. + toa_sw_up_clr = 0. + thd_sw_flux_clr_net = 0. + thd_lw_flux_clr_net = 0. + net_surf_sw_down_clr = 0. + surf_sw_down_clr = 0. + surf_lw_net_clr = 0. + surf_lw_down_clr = 0. + + coszen = 0. + ozone_in = 0. + co2_in = 0. + outputted_soc_spectral_olr = 0. + endif + + temp_tend(:,:,:) = temp_tend(:,:,:) + real(output_heating_rate_sw)+real(output_heating_rate_lw) + output_heating_rate_total = output_heating_rate_sw +output_heating_rate_lw ! Send diagnostics if(id_soc_tdt_lw > 0) then @@ -1329,151 +1057,501 @@ subroutine run_socrates(Time, Time_diag, rad_lat, rad_lon, temp_in, q_in, t_surf endif if(id_soc_tdt_rad > 0) then used = send_data ( id_soc_tdt_rad, output_heating_rate_total, Time_diag) - endif + endif if(id_soc_surf_flux_lw > 0) then used = send_data ( id_soc_surf_flux_lw, surf_lw_net, Time_diag) endif - if(id_soc_surf_flux_lw_clear > 0) then - used = send_data ( id_soc_surf_flux_lw_clear, surf_lw_net_clear, Time_diag) - endif if(id_soc_surf_flux_lw_down > 0) then used = send_data ( id_soc_surf_flux_lw_down, surf_lw_down, Time_diag) endif - if(id_soc_surf_flux_lw_down_clear > 0) then - used = send_data ( id_soc_surf_flux_lw_down_clear, surf_lw_down_clear, Time_diag) - endif if(id_soc_surf_flux_sw > 0) then used = send_data ( id_soc_surf_flux_sw, net_surf_sw_down, Time_diag) endif - if(id_soc_surf_flux_sw_clear > 0) then - used = send_data ( id_soc_surf_flux_sw_clear, net_surf_sw_down_clear, Time_diag) - endif if(id_soc_surf_flux_sw_down > 0) then used = send_data ( id_soc_surf_flux_sw_down, surf_sw_down, Time_diag) endif - if(id_soc_surf_flux_sw_down_clear > 0) then - used = send_data ( id_soc_surf_flux_sw_down_clear, surf_sw_down_clear, Time_diag) - endif if(id_soc_olr > 0) then used = send_data ( id_soc_olr, olr, Time_diag) endif - if(id_soc_olr_clear > 0) then - used = send_data ( id_soc_olr_clear, olr_clear, Time_diag) - endif if(id_soc_toa_sw > 0) then used = send_data ( id_soc_toa_sw, toa_sw, Time_diag) endif - if(id_soc_toa_sw_clear > 0) then - used = send_data ( id_soc_toa_sw_clear, toa_sw_clear, Time_diag) - endif if(id_soc_toa_sw_down > 0) then used = send_data ( id_soc_toa_sw_down, toa_sw_down, Time_diag) endif - if(id_soc_toa_sw_down_clear > 0) then - used = send_data ( id_soc_toa_sw_down_clear, toa_sw_down_clear, Time_diag) + if(id_soc_toa_sw_up > 0) then + used = send_data ( id_soc_toa_sw_up, toa_sw_up, Time_diag) endif - if(id_soc_flux_lw > 0) then - used = send_data ( id_soc_flux_lw, thd_lw_flux_net, Time_diag) + + if(id_soc_olr_clr > 0) then + used = send_data ( id_soc_olr_clr, olr_clr, Time_diag) endif - if(id_soc_surf_flux_lw_down > 0) then - used = send_data ( id_soc_surf_flux_lw_down, surf_lw_down, Time_diag) + if(id_soc_toa_sw_clr > 0) then + used = send_data ( id_soc_toa_sw_clr, toa_sw_clr, Time_diag) + endif + if(id_soc_toa_sw_up_clr > 0) then + used = send_data ( id_soc_toa_sw_up_clr, toa_sw_up_clr, Time_diag) + endif + if(id_soc_flux_lw_clr > 0) then + used = send_data ( id_soc_flux_lw_clr, thd_lw_flux_clr_net, Time_diag) endif - if(id_soc_surf_flux_lw_down_clear > 0) then - used = send_data ( id_soc_surf_flux_lw_down_clear, surf_lw_down_clear, Time_diag) + if(id_soc_flux_sw_clr > 0) then + used = send_data ( id_soc_flux_sw_clr, thd_sw_flux_clr_net, Time_diag) + endif + if (id_soc_surf_flux_sw_clr > 0) then + used = send_data ( id_soc_surf_flux_sw_clr, net_surf_sw_down_clr, Time_diag) + endif + if (id_soc_surf_flux_sw_down_clr > 0) then + used = send_data ( id_soc_surf_flux_sw_down_clr, surf_sw_down_clr, Time_diag) + endif + if (id_soc_surf_flux_lw_clr > 0) then + used = send_data ( id_soc_surf_flux_lw_clr, surf_lw_net_clr, Time_diag) + endif + if (id_soc_surf_flux_lw_down_clr > 0) then + used = send_data ( id_soc_surf_flux_lw_down_clr, surf_lw_down_clr, Time_diag) + endif + + if(id_soc_flux_lw > 0) then + used = send_data ( id_soc_flux_lw, thd_lw_flux_net, Time_diag) endif if(id_soc_flux_sw > 0) then used = send_data ( id_soc_flux_sw, thd_sw_flux_net, Time_diag) endif + if(id_soc_coszen > 0) then used = send_data ( id_soc_coszen, coszen, Time_diag) endif - if(id_soc_co2 > 0) then + if(id_soc_co2 > 0) then used = send_data ( id_soc_co2, co2_in, Time_diag) - endif - if(id_soc_ozone > 0) then + endif + if(id_soc_ozone > 0) then used = send_data ( id_soc_ozone, ozone_in, Time_diag) - endif - if(id_soc_spectral_olr > 0) then + endif + if(id_soc_spectral_olr > 0) then used = send_data ( id_soc_spectral_olr, outputted_soc_spectral_olr, Time_diag) - endif - ! Diagnostics sent + endif + ! Diagnostics sent + + return !not time yet + + endif -end subroutine run_socrates + !make sure we run perpetual when solday > 0) + if(solday > 0)then + Time_loc = set_time(seconds,solday) + else + Time_loc = Time + endif + + !Set tide-locked flux if tidally-locked = .true. Else use diurnal-solar + !to calculate insolation from orbit! + if (tidally_locked.eqv..true.) then + coszen = COS(rad_lat(:,:))*COS(rad_lon(:,:)) + WHERE (coszen < 0.0) coszen = 0.0 + rrsun = 1 ! needs to be set, set to 1 so that stellar_radiation is unchanged in socrates_interface + + elseif (frierson_solar_rad .eqv. .true.) then + p2 = (1. - 3.*sin(rad_lat(:,:))**2)/4. + coszen = 0.25 * (1.0 + del_sol * p2 + del_sw * sin(rad_lat(:,:))) + rrsun = 1 ! needs to be set, set to 1 so that stellar_radiation is unchanged in socrates_interface + + else + ! compute zenith angle + call get_time(Time_loc, seconds, days) + call get_time(length_of_year(), year_in_s) + day_in_s = length_of_day() + + r_seconds=real(seconds) + r_days=real(days) + r_total_seconds=r_seconds+(r_days*86400.) + + frac_of_day = r_total_seconds / day_in_s + + if(solday > 0) then + r_solday=real(solday) + frac_of_year=(r_solday*day_in_s)/year_in_s + else + frac_of_year = r_total_seconds / year_in_s + endif + gmt = abs(mod(frac_of_day, 1.0)) * 2.0 * pi + time_since_ae = modulo(frac_of_year-equinox_day, 1.0) * 2.0 * pi + + if(do_rad_time_avg) then + r_dt_rad_avg=real(dt_rad_avg) + dt_rad_radians = (r_dt_rad_avg/day_in_s)*2.0*pi + call diurnal_solar(rad_lat, rad_lon, gmt, time_since_ae, coszen, fracsun, rrsun, dt_rad_radians) + else + ! Seasonal Cycle: Use astronomical parameters to calculate insolation + call diurnal_solar(rad_lat, rad_lon, gmt, time_since_ae, coszen, fracsun, rrsun) + end if + + endif + + ozone_in = 0.0 + + !get ozone + if(do_read_ozone)then + call interpolator( o3_interp, Time_diag, p_half_in, ozone_in, trim(ozone_field_name)) + endif + if(do_scm_ozone)then ! Allows for option to specify ozone vertical profile in namelist for SCM. + if(do_read_ozone)then + call error_mesg('socrates_interface', 'Cannot set do_scm_ozone and do_read_ozone = .true.', FATAL) + endif + if((size(temp_in,1)>1).or.(size(temp_in,2)>1))then + call error_mesg('socrates_interface', 'Cannot set do_scm_ozone if simulating more than one column, use do_read_ozone instead', FATAL) + endif + if(scm_ozone(size(temp_in,3)).eq.-1)then + call error_mesg('socrates_interface', 'Input o3 must be specified on model pressure levels but not enough levels specified', FATAL) + endif + if(scm_ozone(size(temp_in,3)+1).ne.-1)then + call error_mesg('socrates_interface', 'Input o3 must be specified on model pressure levels but too many levels specified', FATAL) + endif + ozone_in(1,1,:) = scm_ozone(1:size(temp_in,3)) + !PUT THIS WARNING SOMEWHERE ELSE + endif + if (do_read_ozone .or. do_scm_ozone) then + if (input_o3_file_is_mmr.eqv..false.) then + + ozone_in = ozone_in * wtmozone / (1000. * gas_constant / rdgas ) !Socrates expects all abundances to be mass mixing ratio. So if input file is volume mixing ratio, it must be converted to mass mixing ratio using the molar masses of dry air and ozone + ! Molar mass of dry air calculated from gas_constant / rdgas, and converted into g/mol from kg/mol by multiplying by 1000. This conversion is necessary because wtmozone is in g/mol. + + endif + endif + + if (input_co2_mmr .eqv. .false.) then + co2_in = co2_ppmv * 1.e-6 * wtmco2 / (1000. * gas_constant / rdgas ) + ! Convert co2_ppmv to a mass mixing ratio, as required by socrates + ! Molar mass of dry air calculated from gas_constant / rdgas, and converted into g/mol + ! from kg/mol by multiplying by 1000. This conversion is necessary because wtmco2 is in g/mol. + else + co2_in = co2_ppmv * 1.e-6 !No need to convert if it is already a mmr + endif + + !get co2 + if(do_read_co2)then + call interpolator( co2_interp, Time_diag, p_half_in, co2_in, trim(co2_field_name)) + if (input_co2_mmr .eqv. .false.) then + co2_in = co2_in * 1.e-6 * wtmco2 / (1000. * gas_constant / rdgas ) + ! Molar mass of dry air calculated from gas_constant / rdgas, and converted into g/mol + ! from kg/mol by multiplying by 1000. This conversion is necessary because wtmco2 is in g/mol. + endif + endif + + if(do_cloud_simple .or. do_cloud_spookie) then + cld_frac_soc = REAL(cf_rad, kind(r_def)) + reff_rad_soc = REAL(reff_rad, kind(r_def)) + + qcl_rad_soc = REAL(qcl_rad, kind(r_def)) + mmr_cl_rad_soc = qcl_rad_soc / (1.0 - qcl_rad_soc) !check if qcl is indeed specific humidity and not mmr + else + cld_frac_soc = 0. + reff_rad_soc = 0. + mmr_cl_rad_soc = 0. + endif + + cld_frac_soc_clr = 0. + reff_rad_soc_clr = 0. + mmr_cl_rad_soc_clr = 0. + + n_profile = INT(size(temp_in,2)*size(temp_in,1), kind(i_def)) + n_layer = INT(size(temp_in,3), kind(i_def)) + t_surf_for_soc = REAL(t_surf_in(:,:), kind(r_def)) + ! LW calculation + ! Retrieve output_heating_rate, and downward surface SW and LW fluxes + soc_lw_mode = .TRUE. + + rad_lat_soc = REAL(rad_lat, kind(r_def)) + rad_lon_soc = REAL(rad_lon, kind(r_def)) + tg_tmp_soc = REAL(temp_in, kind(r_def)) + q_soc = REAL(q_in, kind(r_def)) + ozone_soc = REAL(ozone_in, kind(r_def)) + co2_soc = REAL(co2_in, kind(r_def)) + p_full_soc = REAL(p_full_in, kind(r_def)) + p_half_soc = REAL(p_half_in, kind(r_def)) + albedo_soc = REAL(albedo_in, kind(r_def)) + z_full_soc = REAL(z_full_in, kind(r_def)) + z_half_soc = REAL(z_half_in, kind(r_def)) + + CALL socrates_interface(Time, rad_lat_soc, rad_lon_soc, soc_lw_mode, & + tg_tmp_soc, q_soc, ozone_soc, co2_soc, t_surf_for_soc, p_full_soc, & + p_half_soc, z_full_soc, z_half_soc, albedo_soc, coszen, rrsun, & + n_profile, n_layer, cld_frac_soc, reff_rad_soc, mmr_cl_rad_soc, & + output_heating_rate_lw, output_soc_flux_lw_down, output_soc_flux_lw_up, & + output_soc_flux_lw_down_clr, output_soc_flux_lw_up_clr, & + do_cloud_simple, do_cloud_spookie, & + !optional outs + output_soc_spectral_olr = outputted_soc_spectral_olr, & + t_half_level_out = t_half_out, & + tot_cloud_cover = tot_cloud_cover ) + + tg_tmp_soc = tg_tmp_soc + output_heating_rate_lw*delta_t !Output heating rate in K/s, so is a temperature tendency + surf_lw_down(:,:) = REAL(output_soc_flux_lw_down(:,:, n_layer+1)) + surf_lw_net(:,:) = REAL(output_soc_flux_lw_up(:,:,n_layer+1) - output_soc_flux_lw_down(:,:, n_layer+1)) + olr(:,:) = REAL(output_soc_flux_lw_up(:,:,1)) + thd_lw_flux_net = REAL(output_soc_flux_lw_up - output_soc_flux_lw_down) + + olr_clr(:,:) = REAL(output_soc_flux_lw_up_clr(:,:,1)) + thd_lw_flux_clr_net = REAL(output_soc_flux_lw_up_clr - output_soc_flux_lw_down_clr) + surf_lw_down_clr(:,:) = REAL(output_soc_flux_lw_down_clr(:,:, n_layer+1)) + surf_lw_net_clr(:,:) = REAL(output_soc_flux_lw_up_clr(:,:,n_layer+1) - output_soc_flux_lw_down_clr(:,:, n_layer+1)) + + temp_tend(:,:,:) = temp_tend(:,:,:) + real(output_heating_rate_lw) + + ! SW calculation + ! Retrieve output_heating_rate, and downward surface SW and LW fluxes + soc_lw_mode = .FALSE. + CALL socrates_interface(Time, rad_lat_soc, rad_lon_soc, soc_lw_mode, & + tg_tmp_soc, q_soc, ozone_soc, co2_soc, t_surf_for_soc, p_full_soc, & + p_half_soc, z_full_soc, z_half_soc, albedo_soc, coszen, rrsun, & + n_profile, n_layer, cld_frac_soc, reff_rad_soc, mmr_cl_rad_soc, & + output_heating_rate_sw, output_soc_flux_sw_down, output_soc_flux_sw_up, & + output_soc_flux_sw_down_clr, output_soc_flux_sw_up_clr, & + do_cloud_simple, do_cloud_spookie) + + tg_tmp_soc = tg_tmp_soc + output_heating_rate_sw*delta_t !Output heating rate in K/s, so is a temperature tendency + net_surf_sw_down(:,:) = REAL(output_soc_flux_sw_down(:,:, n_layer+1)-output_soc_flux_sw_up(:,:,n_layer+1) ) + surf_sw_down(:,:) = REAL(output_soc_flux_sw_down(:,:, n_layer+1)) + toa_sw(:,:) = REAL(output_soc_flux_sw_down(:,:,1)-output_soc_flux_sw_up(:,:,1)) + toa_sw_down(:,:) = REAL(output_soc_flux_sw_down(:,:,1)) + thd_sw_flux_net = REAL(output_soc_flux_sw_up - output_soc_flux_sw_down) + toa_sw_up(:,:) = REAL(output_soc_flux_sw_up(:,:,1)) + + toa_sw_clr(:,:) = REAL(output_soc_flux_sw_down_clr(:,:,1)-output_soc_flux_sw_up_clr(:,:,1)) + thd_sw_flux_clr_net = REAL(output_soc_flux_sw_up_clr - output_soc_flux_sw_down_clr) + toa_sw_up_clr(:,:) = REAL(output_soc_flux_sw_up_clr(:,:,1)) + net_surf_sw_down_clr(:,:) = REAL(output_soc_flux_sw_down_clr(:,:, n_layer+1)-output_soc_flux_sw_up_clr(:,:,n_layer+1) ) + surf_sw_down_clr(:,:) = REAL(output_soc_flux_sw_down_clr(:,:, n_layer+1)) + + temp_tend(:,:,:) = temp_tend(:,:,:) + real(output_heating_rate_sw) + output_heating_rate_total = output_heating_rate_lw + output_heating_rate_sw + + if(store_intermediate_rad)then + ! required for calculation + tdt_soc_lw_store = output_heating_rate_lw + tdt_soc_sw_store = output_heating_rate_sw + net_surf_sw_down_store = real(net_surf_sw_down, kind(r_def)) + surf_lw_down_store = real(surf_lw_down, kind(r_def)) + + ! required for output + if (id_soc_surf_flux_lw > 0) then + surf_lw_net_store = real(surf_lw_net, kind(r_def)) + endif + + if (id_soc_flux_lw > 0) then + thd_lw_flux_net_store = thd_lw_flux_net + endif + + if (id_soc_flux_sw > 0) then + thd_sw_flux_net_store = thd_sw_flux_net + endif + + if (id_soc_surf_flux_sw_down > 0) then + surf_sw_down_store = surf_sw_down + endif + + if (id_soc_toa_sw_down > 0) then + toa_sw_down_store = toa_sw_down + endif + + if (id_soc_olr > 0) then + olr_store = olr + endif + + if (id_soc_toa_sw > 0) then + toa_sw_store = toa_sw + endif + + if (id_soc_toa_sw_up > 0) then + toa_sw_up_store = toa_sw_up + endif + + if (id_soc_flux_lw_clr > 0) then + thd_lw_flux_clr_net_store = thd_lw_flux_clr_net + endif + + if (id_soc_flux_sw_clr > 0) then + thd_sw_flux_clr_net_store = thd_sw_flux_clr_net + endif + + if (id_soc_olr_clr > 0) then + olr_clr_store = olr_clr + endif + + if (id_soc_toa_sw_clr > 0) then + toa_sw_clr_store = toa_sw_clr + endif + + if (id_soc_toa_sw_up_clr > 0) then + toa_sw_up_clr_store = toa_sw_up_clr + endif + + if (id_soc_surf_flux_sw_clr > 0) then + net_surf_sw_down_clr_store = net_surf_sw_down_clr + endif + + if (id_soc_surf_flux_sw_down_clr > 0) then + surf_sw_down_clr_store = surf_sw_down_clr + endif + + if (id_soc_surf_flux_lw_clr > 0) then + surf_lw_net_clr_store = surf_lw_net_clr + endif + + if (id_soc_surf_flux_lw_down_clr > 0) then + surf_lw_down_clr_store = surf_lw_down_clr + endif + + if (id_soc_coszen > 0) then + coszen_store = coszen + endif + + if (id_soc_ozone > 0) then + thd_ozone_store = ozone_in + endif + + if (id_soc_co2 > 0) then + thd_co2_store = co2_in + endif + + if (id_soc_spectral_olr > 0) then + spectral_olr_store = outputted_soc_spectral_olr + endif + + endif + + ! Send diagnostics + if(id_soc_tdt_lw > 0) then + used = send_data ( id_soc_tdt_lw, output_heating_rate_lw, Time_diag) + endif + if(id_soc_tdt_sw > 0) then + used = send_data ( id_soc_tdt_sw, output_heating_rate_sw, Time_diag) + endif + if(id_soc_tdt_rad > 0) then + used = send_data ( id_soc_tdt_rad, output_heating_rate_total, Time_diag) + endif + if(id_soc_surf_flux_lw > 0) then + used = send_data ( id_soc_surf_flux_lw, surf_lw_net, Time_diag) + endif + if(id_soc_surf_flux_sw > 0) then + used = send_data ( id_soc_surf_flux_sw, net_surf_sw_down, Time_diag) + endif + if(id_soc_surf_flux_sw_down > 0) then + used = send_data ( id_soc_surf_flux_sw_down, surf_sw_down, Time_diag) + endif + if(id_soc_olr > 0) then + used = send_data ( id_soc_olr, olr, Time_diag) + endif + if(id_soc_toa_sw > 0) then + used = send_data ( id_soc_toa_sw, toa_sw, Time_diag) + endif + if(id_soc_toa_sw_down > 0) then + used = send_data ( id_soc_toa_sw_down, toa_sw_down, Time_diag) + endif + if(id_soc_toa_sw_up > 0) then + used = send_data ( id_soc_toa_sw_up, toa_sw_up, Time_diag) + endif + + if(id_soc_olr_clr > 0) then + used = send_data ( id_soc_olr_clr, olr_clr, Time_diag) + endif + if(id_soc_toa_sw_clr > 0) then + used = send_data ( id_soc_toa_sw_clr, toa_sw_clr, Time_diag) + endif + if(id_soc_toa_sw_up_clr > 0) then + used = send_data ( id_soc_toa_sw_up_clr, toa_sw_up_clr, Time_diag) + endif + if(id_soc_flux_lw_clr > 0) then + used = send_data ( id_soc_flux_lw_clr, thd_lw_flux_clr_net, Time_diag) + endif + if(id_soc_flux_sw_clr > 0) then + used = send_data ( id_soc_flux_sw_clr, thd_sw_flux_clr_net, Time_diag) + endif + if (id_soc_surf_flux_sw_clr > 0) then + used = send_data ( id_soc_surf_flux_sw_clr, net_surf_sw_down_clr, Time_diag) + endif + if (id_soc_surf_flux_sw_down_clr > 0) then + used = send_data ( id_soc_surf_flux_sw_down_clr, surf_sw_down_clr, Time_diag) + endif + if (id_soc_surf_flux_lw_clr > 0) then + used = send_data ( id_soc_surf_flux_lw_clr, surf_lw_net_clr, Time_diag) + endif + if (id_soc_surf_flux_lw_down_clr > 0) then + used = send_data ( id_soc_surf_flux_lw_down_clr, surf_lw_down_clr, Time_diag) + endif + if(id_soc_flux_lw > 0) then + used = send_data ( id_soc_flux_lw, thd_lw_flux_net, Time_diag) + endif + if(id_soc_surf_flux_lw_down > 0) then + used = send_data ( id_soc_surf_flux_lw_down, surf_lw_down, Time_diag) + endif + if(id_soc_flux_sw > 0) then + used = send_data ( id_soc_flux_sw, thd_sw_flux_net, Time_diag) + endif + if(id_soc_coszen > 0) then + used = send_data ( id_soc_coszen, coszen, Time_diag) + endif + if(id_soc_co2 > 0) then + used = send_data ( id_soc_co2, co2_in, Time_diag) + endif + if(id_soc_ozone > 0) then + used = send_data ( id_soc_ozone, ozone_in, Time_diag) + endif + if(id_soc_spectral_olr > 0) then + used = send_data ( id_soc_spectral_olr, outputted_soc_spectral_olr, Time_diag) + endif + if(id_soc_tot_cloud_cover > 0) then + used = send_data ( id_soc_tot_cloud_cover, tot_cloud_cover*1e2, Time_diag) + endif + ! Diagnostics sent + +end subroutine run_socrates subroutine run_socrates_end - use interpolator_mod, only: interpolator_end - USE socrates_config_mod + use interpolator_mod, only: interpolator_end + USE socrates_config_mod if(do_read_ozone) call interpolator_end(o3_interp) if(do_read_co2) call interpolator_end(co2_interp) - DEALLOCATE(soc_bins_lw) - DEALLOCATE(soc_bins_sw) - DEALLOCATE(outputted_soc_spectral_olr) - DEALLOCATE(tdt_soc_sw_store) - DEALLOCATE(tdt_soc_lw_store) - DEALLOCATE(net_surf_sw_down_store) - DEALLOCATE(surf_lw_down_store) - - if (id_soc_flux_lw > 0) DEALLOCATE(thd_lw_flux_net_store) - if (id_soc_flux_sw > 0) DEALLOCATE(thd_sw_flux_net_store) - if (id_soc_surf_flux_sw_clear > 0) DEALLOCATE(net_surf_sw_down_clear_store) - if (id_soc_surf_flux_lw_down_clear > 0) DEALLOCATE(surf_lw_down_clear_store) - if (id_soc_surf_flux_lw > 0) DEALLOCATE(surf_lw_net_store) - if (id_soc_surf_flux_lw_clear > 0) DEALLOCATE(surf_lw_net_clear_store) - if (id_soc_surf_flux_sw_down > 0) DEALLOCATE(surf_sw_down_store) - if (id_soc_surf_flux_sw_down_clear > 0) DEALLOCATE(surf_sw_down_clear_store) - if (id_soc_olr > 0) DEALLOCATE(olr_store) - if (id_soc_olr_clear > 0) DEALLOCATE(olr_clear_store) - if (id_soc_toa_sw > 0) DEALLOCATE(toa_sw_store) - if (id_soc_toa_sw_clear > 0) DEALLOCATE(toa_sw_clear_store) - if (id_soc_toa_sw_down > 0) DEALLOCATE(toa_sw_down_store) - if (id_soc_toa_sw_down_clear > 0) DEALLOCATE(toa_sw_down_clear_store) - if (id_soc_coszen > 0) DEALLOCATE(coszen_store) - if (id_soc_ozone > 0) DEALLOCATE(thd_ozone_store) - if (id_soc_co2 > 0 ) DEALLOCATE(thd_co2_store) - if (id_soc_spectral_olr > 0) DEALLOCATE(spectral_olr_store) - end subroutine run_socrates_end !***************************************************************************************** - subroutine interp_temp(z_full,z_half,temp_in, t_half) - implicit none - - real(r_def),dimension(:,:),intent(in) :: z_full,z_half,temp_in - real(r_def),dimension(size(z_half,1), size(z_half,2)),intent(out) :: t_half - - integer i,k,kend - real dzk,dzk1,dzk2 - -! note: z_full(kend) = z_half(kend), so there's something fishy -! also, for some reason, z_half(k=1)=0. so we need to deal with k=1 separately - kend=size(z_full,2) - do k=2,kend - do i=1,size(temp_in,1) - dzk2 = 1./( z_full(i,k-1) - z_full(i,k) ) - dzk = ( z_half(i,k ) - z_full(i,k) )*dzk2 - dzk1 = ( z_full(i,k-1) - z_half(i,k) )*dzk2 - t_half(i,k) = temp_in(i,k)*dzk1 + temp_in(i,k-1)*dzk - enddo - enddo -! top of the atmosphere: need to extrapolate. z_half(1)=0, so need to use values -! on full grid - do i=1,size(temp_in,1) - !standard linear extrapolation - !top: use full points, and distance is 1.5 from k=2 - t_half(i,1) = 0.5*(3*temp_in(i,1)-temp_in(i,2)) - !bottom: z=0 => distance is - !-z_full(kend-1)/(z_full(kend)-z_full(kend-1)) - t_half(i,kend+1) = temp_in(i,kend-1) & - + (z_half(i,kend+1) - z_full(i,kend-1))& - * (temp_in(i,kend ) - temp_in(i,kend-1))& - / (z_full(i,kend ) - z_full(i,kend-1)) - enddo - - - end subroutine interp_temp +subroutine interp_temp(z_full,z_half,temp_in, t_half) + implicit none + + real(r_def),dimension(:,:),intent(in) :: z_full,z_half,temp_in + real(r_def),dimension(size(z_half,1), size(z_half,2)),intent(out) :: t_half + + integer i,k,kend + real dzk,dzk1,dzk2 + + ! note: z_full(kend) = z_half(kend), so there's something fishy + ! also, for some reason, z_half(k=1)=0. so we need to deal with k=1 separately + kend=size(z_full,2) + do k=2,kend + do i=1,size(temp_in,1) + dzk2 = 1./( z_full(i,k-1) - z_full(i,k) ) + dzk = ( z_half(i,k ) - z_full(i,k) )*dzk2 + dzk1 = ( z_full(i,k-1) - z_half(i,k) )*dzk2 + t_half(i,k) = temp_in(i,k)*dzk1 + temp_in(i,k-1)*dzk + enddo + enddo + ! top of the atmosphere: need to extrapolate. z_half(1)=0, so need to use values + ! on full grid + do i=1,size(temp_in,1) + !standard linear extrapolation + !top: use full points, and distance is 1.5 from k=2 + t_half(i,1) = 0.5*(3*temp_in(i,1)-temp_in(i,2)) + !bottom: z=0 => distance is + !-z_full(kend-1)/(z_full(kend)-z_full(kend-1)) + t_half(i,kend+1) = temp_in(i,kend-1) & + + (z_half(i,kend+1) - z_full(i,kend-1)) & + * (temp_in(i,kend ) - temp_in(i,kend-1)) & + / (z_full(i,kend ) - z_full(i,kend-1)) + enddo + +end subroutine interp_temp !***************************************************************************************** - + end module socrates_interface_mod diff --git a/src/atmos_param/socrates/interface/socrates_set_cld.F90 b/src/atmos_param/socrates/interface/socrates_set_cld.F90 index f544c26f4..3af8423b8 100644 --- a/src/atmos_param/socrates/interface/socrates_set_cld.F90 +++ b/src/atmos_param/socrates/interface/socrates_set_cld.F90 @@ -7,12 +7,12 @@ ! Set the variables in the Socrates cloud type ! !------------------------------------------------------------------------------ -module socrates_set_cld_mod +module socrates_set_cld implicit none -character(len=*), parameter, private :: ModuleName = 'SOCRATES_SET_CLD_MOD' +character(len=*), parameter, private :: ModuleName = 'SOCRATES_SET_CLD' contains -subroutine set_simple_cld(cld, control, dimen, spectrum, n_profile, n_layer, & +subroutine set_cld(cld, control, dimen, spectrum, n_profile, n_layer, & cloud_frac, conv_frac, & liq_frac, ice_frac, liq_conv_frac, ice_conv_frac, & liq_mmr, ice_mmr, liq_conv_mmr, ice_conv_mmr, & @@ -81,7 +81,7 @@ subroutine set_simple_cld(cld, control, dimen, spectrum, n_profile, n_layer, & real(r_def) :: min_cloud_fraction = 0.0001 integer :: ierr = i_normal -character (len=*), parameter :: RoutineName = 'SET_SIMPLE_CLD' +character (len=*), parameter :: RoutineName = 'SET_CLD' character (len=128) :: cmessage ! Functions called @@ -499,5 +499,5 @@ subroutine set_simple_cld(cld, control, dimen, spectrum, n_profile, n_layer, & end do end do -end subroutine set_simple_cld -end module socrates_set_cld_mod +end subroutine set_cld +end module socrates_set_cld diff --git a/src/atmos_param/vert_turb_driver/vert_turb_driver.F90 b/src/atmos_param/vert_turb_driver/vert_turb_driver.F90 index 5bdac40ee..01784c0f3 100644 --- a/src/atmos_param/vert_turb_driver/vert_turb_driver.F90 +++ b/src/atmos_param/vert_turb_driver/vert_turb_driver.F90 @@ -144,8 +144,8 @@ subroutine vert_turb_driver (is, js, Time, Time_next, dt, tdtlw, & p_half, p_full, z_half, z_full, u_star, & b_star, q_star, rough, lat, convect, & u, v, t, q, r, um, vm, tm, qm, rm, & - udt, vdt, tdt, qdt, rdt, diff_t, diff_m, & - gust, z_pbl, mask, kbot ) + udt, vdt, tdt, qdt, rdt, ind_lcl, do_lcl_diffusivity_depth, diff_t, diff_m, & + gust, z_pbl, mask, kbot ) !----------------------------------------------------------------------- integer, intent(in) :: is, js @@ -159,6 +159,8 @@ subroutine vert_turb_driver (is, js, Time, Time_next, dt, tdtlw, & u, v, t, q, um, vm, tm, qm, & udt, vdt, tdt, qdt real, intent(in) , dimension(:,:,:,:) :: r, rm, rdt + integer, intent(in), dimension(:,:) :: ind_lcl + logical, intent(in) :: do_lcl_diffusivity_depth real, intent(out), dimension(:,:,:) :: diff_t, diff_m real, intent(out), dimension(:,:) :: gust, z_pbl real, intent(in),optional, dimension(:,:,:) :: mask @@ -306,11 +308,15 @@ subroutine vert_turb_driver (is, js, Time, Time_next, dt, tdtlw, & !--------------------------- !------------------- non-local K scheme -------------- - - call diffusivity ( tt, qq, uu, vv, p_full, p_half, z_full, z_half, & - u_star, b_star, z_pbl, diff_m, diff_t, & - kbot = kbot) - + if (do_lcl_diffusivity_depth) then + call diffusivity ( tt, qq, uu, vv, p_full, p_half, z_full, z_half, & + u_star, b_star, z_pbl, diff_m, diff_t, & + ind_lcl = ind_lcl, kbot = kbot) + else + call diffusivity ( tt, qq, uu, vv, p_full, p_half, z_full, z_half, & + u_star, b_star, z_pbl, diff_m, diff_t, & + kbot = kbot) + endif !--------------------------- else if (do_edt) then !---------------------------- diff --git a/src/atmos_spectral/driver/solo/atmosphere.F90 b/src/atmos_spectral/driver/solo/atmosphere.F90 index 25da9465e..3091e1fe0 100644 --- a/src/atmos_spectral/driver/solo/atmosphere.F90 +++ b/src/atmos_spectral/driver/solo/atmosphere.F90 @@ -32,17 +32,25 @@ module atmosphere_mod use constants_mod, only: grav, pi -use transforms_mod, only: trans_grid_to_spherical, trans_spherical_to_grid, & - get_deg_lon, get_deg_lat, get_grid_boundaries, grid_domain, & - spectral_domain, get_grid_domain, get_lon_max, get_lat_max, atmosphere_domain - use time_manager_mod, only: time_type, get_time, operator( + ) use press_and_geopot_mod, only: compute_pressures_and_heights -use spectral_dynamics_mod, only: spectral_dynamics_init, spectral_dynamics, spectral_dynamics_end, & - get_num_levels, get_axis_id, spectral_diagnostics, get_initial_fields, & - complete_robert_filter, get_surf_geopotential +#ifdef COLUMN_MODEL + use spec_mpp_mod, only: grid_domain, get_grid_domain, atmosphere_domain + use column_mod, only: column_init, column, column_end, & + get_axis_id, column_diagnostics, get_num_levels, & + get_surf_geopotential, get_initial_fields + use column_grid_mod, only: get_deg_lon, get_deg_lat, get_grid_boundaries, & + get_lon_max, get_lat_max +#else + use spectral_dynamics_mod, only: spectral_dynamics_init, spectral_dynamics, spectral_dynamics_end, & + get_num_levels, get_axis_id, spectral_diagnostics, get_initial_fields, & + complete_robert_filter, get_surf_geopotential + use transforms_mod, only: trans_grid_to_spherical, trans_spherical_to_grid, & + get_deg_lon, get_deg_lat, get_grid_boundaries, grid_domain, & + spectral_domain, get_grid_domain, get_lon_max, get_lat_max, atmosphere_domain +#endif use tracer_type_mod, only: tracer_type @@ -78,7 +86,7 @@ module atmosphere_mod integer, parameter :: num_time_levels = 2 integer :: is, ie, js, je, num_levels, num_tracers, nhum -logical :: dry_model +logical :: dry_model, column_model real, allocatable, dimension(:,:,:,:) :: p_half, p_full real, allocatable, dimension(:,:,:,:) :: z_half, z_full @@ -142,7 +150,13 @@ subroutine atmosphere_init(Time_init, Time, Time_step_in) call get_number_tracers(MODEL_ATMOS, num_prog=num_tracers) allocate (tracer_attributes(num_tracers)) -call spectral_dynamics_init(Time, Time_step, tracer_attributes, dry_model, nhum) +#ifdef COLUMN_MODEL + call column_init(Time, Time_step, tracer_attributes, dry_model, nhum) + column_model = .true. +#else + call spectral_dynamics_init(Time, Time_step, tracer_attributes, dry_model, nhum) + column_model = .false. +#endif call get_grid_domain(is, ie, js, je) call get_num_levels(num_levels) @@ -284,7 +298,7 @@ subroutine atmosphere(Time) Time_next = Time + Time_step if(idealized_moist_model) then - call idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, tg, grid_tracers, & + call idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, psg, wg_full, tg, grid_tracers, & previous, current, dt_ug, dt_vg, dt_tg, dt_tracers) else call hs_forcing(1, ie-is+1, 1, je-js+1, delta_t, Time_next, rad_lon_2d, rad_lat_2d, & @@ -302,11 +316,17 @@ subroutine atmosphere(Time) else future = previous endif - -call spectral_dynamics(Time, psg(:,:,future), ug(:,:,:,future), vg(:,:,:,future), & +#ifdef COLUMN_MODEL +call column(Time, psg(:,:,future), ug(:,:,:,future), vg(:,:,:,future), & tg(:,:,:,future), tracer_attributes, grid_tracers(:,:,:,:,:), future, & dt_psg, dt_ug, dt_vg, dt_tg, dt_tracers, wg_full, & p_full(:,:,:,current), p_half(:,:,:,current), z_full(:,:,:,current)) +#else + call spectral_dynamics(Time, psg(:,:,future), ug(:,:,:,future), vg(:,:,:,future), & + tg(:,:,:,future), tracer_attributes, grid_tracers(:,:,:,:,:), future, & + dt_psg, dt_ug, dt_vg, dt_tg, dt_tracers, wg_full, & + p_full(:,:,:,current), p_half(:,:,:,current), z_full(:,:,:,current)) +#endif if(dry_model) then call compute_pressures_and_heights(tg(:,:,:,future), psg(:,:,future), surf_geopotential, & @@ -317,8 +337,13 @@ subroutine atmosphere(Time) grid_tracers(:,:,:,future,nhum)) endif +#ifdef COLUMN_MODEL +call column_diagnostics(Time_next, psg(:,:,future), ug(:,:,:,future), vg(:,:,:,future), & +tg(:,:,:,future), wg_full, grid_tracers(:,:,:,:,:), future) +#else call spectral_diagnostics(Time_next, psg(:,:,future), ug(:,:,:,future), vg(:,:,:,future), & tg(:,:,:,future), wg_full, grid_tracers(:,:,:,:,:), future) +#endif previous = current current = future @@ -359,7 +384,11 @@ subroutine atmosphere_end else call hs_forcing_end endif +#ifdef COLUMN_MODEL +call column_end(tracer_attributes) +#else call spectral_dynamics_end(tracer_attributes) +#endif deallocate(tracer_attributes) module_is_initialized = .false. diff --git a/src/atmos_spectral/driver/solo/idealized_moist_phys.F90 b/src/atmos_spectral/driver/solo/idealized_moist_phys.F90 index 1b86aff46..81963dbc6 100644 --- a/src/atmos_spectral/driver/solo/idealized_moist_phys.F90 +++ b/src/atmos_spectral/driver/solo/idealized_moist_phys.F90 @@ -6,7 +6,8 @@ module idealized_moist_phys_mod use fms_mod, only: open_namelist_file, close_file #endif -use fms_mod, only: write_version_number, file_exist, close_file, stdlog, error_mesg, NOTE, FATAL, read_data, field_size, uppercase, mpp_pe, check_nml_error +use fms_mod, only: write_version_number, file_exist, close_file, stdlog, error_mesg, NOTE, & + FATAL, WARNING, read_data, field_size, uppercase, mpp_pe, check_nml_error ! cp_air needed for rrtmg and pstd_mks needed for pref calculation use constants_mod, only: grav, rdgas, rvgas, cp_air, PSTD_MKS, dens_h2o @@ -19,7 +20,9 @@ module idealized_moist_phys_mod use two_stream_gray_rad_mod, only: two_stream_gray_rad_init, two_stream_gray_rad_down, two_stream_gray_rad_up, two_stream_gray_rad_end -use cloud_simple_mod, only: cloud_simple_init, cloud_simple +use cloud_simple_mod, only: cloud_simple_init, cloud_simple_end, cloud_simple + +use cloud_spookie_mod, only: cloud_spookie_init, cloud_spookie use mixed_layer_mod, only: mixed_layer_init, mixed_layer, mixed_layer_end, albedo_calc @@ -35,9 +38,13 @@ module idealized_moist_phys_mod use diag_manager_mod, only: register_diag_field, send_data -use transforms_mod, only: get_grid_domain - +#ifdef COLUMN_MODEL +use column_mod, only: get_num_levels, get_surf_geopotential, get_axis_id +use spec_mpp_mod, only: get_grid_domain, grid_domain +#else +use transforms_mod, only: get_grid_domain, grid_domain use spectral_dynamics_mod, only: get_axis_id, get_num_levels, get_surf_geopotential +#endif use surface_flux_mod, only: surface_flux, gp_surface_flux @@ -49,8 +56,6 @@ module idealized_moist_phys_mod use mpp_domains_mod, only: mpp_get_global_domain ! needed for reading in land -use transforms_mod, only: grid_domain - use tracer_manager_mod, only: get_number_tracers, query_method use field_manager_mod, only: MODEL_ATMOS @@ -93,9 +98,10 @@ module idealized_moist_phys_mod logical :: module_is_initialized =.false. logical :: turb = .false. +logical :: do_lcl_diffusivity_depth = .false. logical :: do_virtual = .false. ! whether virtual temp used in gcm_vert_diff -!s Convection scheme options +! Convection scheme options character(len=256) :: convection_scheme = 'unset' !< Use a specific convection scheme. Valid options integer, parameter :: UNSET = -1, & !! are NONE, SIMPLE_BETTS_MILLER, FULL_BETTS_MILLER, DRY NO_CONV = 0, & @@ -103,7 +109,7 @@ module idealized_moist_phys_mod FULL_BETTS_MILLER_CONV = 2,& DRY_CONV = 3, & RAS_CONV = 4 - + integer :: r_conv_scheme = UNSET ! the selected convection scheme logical :: lwet_convection = .false. @@ -111,58 +117,59 @@ module idealized_moist_phys_mod logical :: do_ras = .false. ! Cloud options -logical :: do_cloud_simple = .false. ! by default the cloud scheme is off. +logical :: do_cloud_simple = .false. ! SimCloud cloud scheme +logical :: do_cloud_spookie = .false. ! SPOOKIE protocol cloud scheme -!s Radiation options +! Radiation options logical :: two_stream_gray = .true. logical :: do_rrtm_radiation = .false. logical :: do_socrates_radiation = .false. -!s MiMA uses damping +! MiMA uses damping logical :: do_damping = .false. logical :: mixed_layer_bc = .false. -logical :: gp_surface = .false. !s Use Schneider & Liu 2009's prescription of lower-boundary heat flux +logical :: gp_surface = .false. ! Use Schneider & Liu 2009's prescription of lower-boundary heat flux -logical :: do_simple = .false. !s Have added this to enable relative humidity to be calculated correctly below. +logical :: do_simple = .false. ! Have added this to enable relative humidity to be calculated correctly below. real :: roughness_heat = 0.05 real :: roughness_moist = 0.05 real :: roughness_mom = 0.05 real :: land_roughness_prefactor = 1.0 -!s options for adding idealised land +! options for adding idealised land character(len=256) :: land_option = 'none' character(len=256) :: land_file_name = 'INPUT/land.nc' character(len=256) :: land_field_name = 'land_mask' -! RG Add bucket -logical :: bucket = .false. +! Add bucket +logical :: bucket = .false. integer :: future real :: init_bucket_depth = 1000. ! default large value -real :: init_bucket_depth_land = 20. +real :: init_bucket_depth_land = 20. real :: max_bucket_depth_land = 0.15 ! default from Manabe 1969 real :: robert_bucket = 0.04 ! default robert coefficient for bucket depth LJJ real :: raw_bucket = 0.53 ! default raw coefficient for bucket depth LJJ -! end RG Add bucket +! end Add bucket namelist / idealized_moist_phys_nml / turb, lwet_convection, do_bm, do_ras, roughness_heat, & - do_cloud_simple, & + do_cloud_simple, do_cloud_spookie, & two_stream_gray, do_rrtm_radiation, do_damping,& mixed_layer_bc, do_simple, & roughness_moist, roughness_mom, do_virtual, & - land_option, land_file_name, land_field_name, & !s options for idealised land - land_roughness_prefactor, & - gp_surface, convection_scheme, & - bucket, init_bucket_depth, init_bucket_depth_land, & !RG Add bucket + land_option, land_file_name, land_field_name, & ! options for idealised land + land_roughness_prefactor, & + gp_surface, convection_scheme, & + bucket, init_bucket_depth, init_bucket_depth_land, & max_bucket_depth_land, robert_bucket, raw_bucket, & - do_socrates_radiation + do_socrates_radiation, do_lcl_diffusivity_depth -integer, parameter :: num_time_levels = 2 !RG Add bucket - number of time levels added to allow timestepping in this module -real, allocatable, dimension(:,:,:) :: bucket_depth ! RG Add bucket -real, allocatable, dimension(:,: ) :: dt_bucket, filt ! RG Add bucket +integer, parameter :: num_time_levels = 2 ! Add bucket - number of time levels added to allow timestepping in this module +real, allocatable, dimension(:,:,:) :: bucket_depth +real, allocatable, dimension(:,: ) :: dt_bucket, filt real, allocatable, dimension(:,:) :: & z_surf, & ! surface height @@ -239,15 +246,20 @@ module idealized_moist_phys_mod real, allocatable, dimension(:,:) :: & land_ones ! land points (all zeros) -real, allocatable, dimension(:,:) :: & +integer, allocatable, dimension(:,:) :: & klzbs, & ! stored level of zero buoyancy values + klcls ! stored lifting condensation level values + +real, allocatable, dimension(:,:) :: & cape, & ! convectively available potential energy cin, & ! convective inhibition (this and the above are before the adjustment) invtau_q_relaxation, & ! temperature relaxation time scale invtau_t_relaxation, & ! humidity relaxation time scale rain, & ! Can be resolved or parameterised snow, & ! - precip ! cumulus rain + resolved rain + resolved snow + precip, & ! cumulus rain + resolved rain + resolved snow + convective_rain ! save the result for convective rain + real, allocatable, dimension(:,:,:) :: & t_ref, & ! relaxation temperature for bettsmiller scheme @@ -288,12 +300,12 @@ module idealized_moist_phys_mod integer, allocatable, dimension(:,:) :: convflag ! indicates which qe convection subroutines are used real, allocatable, dimension(:,:) :: rad_lat, rad_lon -real, allocatable, dimension(:) :: pref, p_half_1d, ln_p_half_1d, p_full_1d,ln_p_full_1d !s pref is a reference pressure profile, which in 2006 MiMA is just the initial full pressure levels, and an extra level with the reference surface pressure. Others are only necessary to calculate pref. -real, allocatable, dimension(:,:) :: capeflag !s Added for Betts Miller scheme (rather than the simplified Betts Miller scheme). +real, allocatable, dimension(:) :: pref, p_half_1d, ln_p_half_1d, p_full_1d,ln_p_full_1d ! pref is a reference pressure profile, which in 2006 MiMA is just the initial full pressure levels, and an extra level with the reference surface pressure. Others are only necessary to calculate pref. +real, allocatable, dimension(:,:) :: capeflag ! Added for Betts Miller scheme (rather than the simplified Betts Miller scheme). type(surf_diff_type) :: Tri_surf ! used by gcm_vert_diff -!s initialise constants ready to be used in rh_calc +! initialise constants ready to be used in rh_calc real :: d622 = 0. real :: d378 = 0. @@ -312,14 +324,14 @@ subroutine idealized_moist_phys_init(Time, Time_step_in, nhum, rad_lon_2d, rad_l integer, intent(in) :: nhum real, intent(in), dimension(:,:) :: rad_lon_2d, rad_lat_2d, rad_lonb_2d, rad_latb_2d, t_surf_init -integer :: io, nml_unit, stdlog_unit, seconds, days, id, jd, kd +integer :: io, ierr, nml_unit, stdlog_unit, seconds, days, id, jd, kd real, dimension (size(rad_lonb_2d,1)-1, size(rad_latb_2d,2)-1) :: sgsmtn ! needed for damping_driver -!s added for land reading +! added for land reading integer, dimension(4) :: siz -integer :: global_num_lon, global_num_lat, ierr +integer :: global_num_lon, global_num_lat character(len=12) :: ctmp1=' by ', ctmp2=' by ' -!s end added for land reading +! end added for land reading ! Added for RAS integer :: num_tracers=0,num_ras_tracers=0,n=0 @@ -336,36 +348,46 @@ subroutine idealized_moist_phys_init(Time, Time_step_in, nhum, rad_lon_2d, rad_l #ifdef INTERNAL_FILE_NML read (input_nml_file, nml=idealized_moist_phys_nml, iostat=io) - ierr = check_nml_error (io,'idealized_moist_phys_nml') + ierr = check_nml_error(io, 'idealized_moist_phys_nml') #else if ( file_exist('input.nml') ) then nml_unit = open_namelist_file() - read (nml_unit, idealized_moist_phys_nml, iostat=io) - ierr = check_nml_error (io,'idealized_moist_phys_nml') - call close_file(nml_unit) + ierr = 1 + do while (ierr /= 0) + read(nml_unit, idealized_moist_phys_nml, iostat=io, end=10) + ierr = check_nml_error(io, 'idealized_moist_phys_nml') + enddo +10 call close_file(nml_unit) endif #endif stdlog_unit = stdlog() write(stdlog_unit, idealized_moist_phys_nml) -!s initialise variables for rh_calc +! initialise variables for rh_calc d622 = rdgas/rvgas d378 = 1.-d622 +if(do_cloud_simple .and. do_cloud_spookie) & + call error_mesg('cloud_simple','do_cloud_simple and do_cloud_spookie cannot both be .true.',FATAL) + if(do_cloud_simple) then call cloud_simple_init(get_axis_id(), Time) end if +if(do_cloud_spookie) then + call cloud_spookie_init(get_axis_id(), Time) +end if -!s need to make sure that gray radiation and rrtm radiation are not both called. +! need to make sure that gray radiation and rrtm radiation are not both called. if(two_stream_gray .and. do_rrtm_radiation) & call error_mesg('physics_driver_init','do_grey_radiation and do_rrtm_radiation cannot both be .true.',FATAL) -if(two_stream_gray .and. do_cloud_simple) & +if(two_stream_gray .and. (do_cloud_simple .or. do_cloud_spookie)) & call error_mesg('idealized_moist_phys','Gray radiation is not configured to run with the cloud scheme at present.',FATAL) -if(do_rrtm_radiation .and. do_cloud_simple) & +if(do_rrtm_radiation .and. (do_cloud_simple .or. do_cloud_spookie)) & call error_mesg('idealized_moist_phys','RRTM is not configured to run with the cloud scheme at present.',FATAL) + if(uppercase(trim(convection_scheme)) == 'NONE') then r_conv_scheme = NO_CONV lwet_convection = .false. @@ -379,14 +401,14 @@ subroutine idealized_moist_phys_init(Time, Time_step_in, nhum, rad_lon_2d, rad_l lwet_convection = .true. do_bm = .false. do_ras = .false. - + else if(uppercase(trim(convection_scheme)) == 'FULL_BETTS_MILLER') then r_conv_scheme = FULL_BETTS_MILLER_CONV call error_mesg('idealized_moist_phys','Using Betts-Miller convection scheme.', NOTE) do_bm = .true. lwet_convection = .false. do_ras = .false. - + else if(uppercase(trim(convection_scheme)) == 'RAS') then r_conv_scheme = RAS_CONV call error_mesg('idealized_moist_phys','Using relaxed Arakawa Schubert convection scheme.', NOTE) @@ -399,7 +421,7 @@ subroutine idealized_moist_phys_init(Time, Time_step_in, nhum, rad_lon_2d, rad_l call error_mesg('idealized_moist_phys','Using dry convection scheme.', NOTE) lwet_convection = .false. do_bm = .false. - do_ras = .false. + do_ras = .false. else if(uppercase(trim(convection_scheme)) == 'UNSET') then call error_mesg('idealized_moist_phys','determining convection scheme from flags', NOTE) @@ -414,7 +436,7 @@ subroutine idealized_moist_phys_init(Time, Time_step_in, nhum, rad_lon_2d, rad_l if (do_ras) then r_conv_scheme = RAS_CONV call error_mesg('idealized_moist_phys','Using relaxed Arakawa Schubert convection scheme.', NOTE) - end if + end if else call error_mesg('idealized_moist_phys','"'//trim(convection_scheme)//'"'//' is not a valid convection scheme.'// & ' Choices are NONE, SIMPLE_BETTS, FULL_BETTS_MILLER, RAS, DRY', FATAL) @@ -422,12 +444,17 @@ subroutine idealized_moist_phys_init(Time, Time_step_in, nhum, rad_lon_2d, rad_l if(lwet_convection .and. do_bm) & call error_mesg('idealized_moist_phys','lwet_convection and do_bm cannot both be .true.',FATAL) - + if(lwet_convection .and. do_ras) & - call error_mesg('idealized_moist_phys','lwet_convection and do_ras cannot both be .true.',FATAL) + call error_mesg('idealized_moist_phys','lwet_convection and do_ras cannot both be .true.',FATAL) if(do_bm .and. do_ras) & - call error_mesg('idealized_moist_phys','do_bm and do_ras cannot both be .true.',FATAL) + call error_mesg('idealized_moist_phys','do_bm and do_ras cannot both be .true.',FATAL) + +if(do_lcl_diffusivity_depth .and. (.not. (lwet_convection .or. do_ras .or. do_bm))) & + call error_mesg('idealized_moist_phys','do_lcl_diffusivity_depth cannot be .true. if moist convection is not enabled',FATAL) + + nsphum = nhum Time_step = Time_step_in @@ -492,7 +519,7 @@ subroutine idealized_moist_phys_init(Time, Time_step_in, nhum, rad_lon_2d, rad_l allocate(diff_t (is:ie, js:je, num_levels)) allocate(diff_m (is:ie, js:je, num_levels)) allocate(diss_heat (is:ie, js:je, num_levels)) -allocate(diss_heat_ray (is:ie, js:je, num_levels)) !s added for rayleigh_bottom_drag, used when gp_surface=.True. +allocate(diss_heat_ray (is:ie, js:je, num_levels)) ! added for rayleigh_bottom_drag, used when gp_surface=.True. allocate(tdtlw (is:ie, js:je, num_levels)); tdtlw = 0.0 allocate(non_diff_dt_ug (is:ie, js:je, num_levels)) @@ -508,7 +535,8 @@ subroutine idealized_moist_phys_init(Time, Time_step_in, nhum, rad_lon_2d, rad_l allocate(cond_dt_qg (is:ie, js:je, num_levels)) allocate(coldT (is:ie, js:je)); coldT = .false. -allocate(klzbs (is:ie, js:je)) +allocate(klzbs (is:ie, js:je)); klzbs = 0 +allocate(klcls (is:ie, js:je)); klcls = 0 allocate(cape (is:ie, js:je)) allocate(cin (is:ie, js:je)) allocate(invtau_q_relaxation (is:ie, js:je)) @@ -516,17 +544,20 @@ subroutine idealized_moist_phys_init(Time, Time_step_in, nhum, rad_lon_2d, rad_l allocate(rain (is:ie, js:je)); rain = 0.0 allocate(snow (is:ie, js:je)); snow = 0.0 allocate(precip (is:ie, js:je)); precip = 0.0 +allocate(convective_rain (is:ie, js:je)); convective_rain = 0.0 allocate(convflag (is:ie, js:je)) allocate(convect (is:ie, js:je)); convect = .false. + + allocate(t_ref (is:ie, js:je, num_levels)); t_ref = 0.0 allocate(q_ref (is:ie, js:je, num_levels)); q_ref = 0.0 -allocate (albedo (is:ie, js:je)) !s allocate for albedo, to be set in mixed_layer_init. -allocate(coszen (is:ie, js:je)) !s allocate coszen to be set in run_rrtmg -allocate(pbltop (is:ie, js:je)) !s allocate coszen to be set in run_rrtmg +allocate (albedo (is:ie, js:je)) ! allocate for albedo, to be set in mixed_layer_init. +allocate(coszen (is:ie, js:je)) ! allocate coszen to be set in run_rrtmg +allocate(pbltop (is:ie, js:je)) ! allocate coszen to be set in run_rrtmg -allocate(pref(num_levels+1)) !s reference pressure profile, as in spectral_physics.f90 in FMS 2006 and original MiMA. +allocate(pref(num_levels+1)) ! reference pressure profile, as in spectral_physics.f90 in FMS 2006 and original MiMA. allocate(p_half_1d(num_levels+1), ln_p_half_1d(num_levels+1)) allocate(p_full_1d(num_levels ), ln_p_full_1d(num_levels )) allocate(capeflag (is:ie, js:je)) @@ -534,17 +565,17 @@ subroutine idealized_moist_phys_init(Time, Time_step_in, nhum, rad_lon_2d, rad_l call get_surf_geopotential(z_surf) z_surf = z_surf/grav -!s initialise the land area +! initialise the land area if(trim(land_option) .eq. 'input')then -!s read in land nc file -!s adapted from spectral_init_cond.F90 +! read in land nc file +! adapted from spectral_init_cond.F90 if(file_exist(trim(land_file_name))) then call mpp_get_global_domain(grid_domain, xsize=global_num_lon, ysize=global_num_lat) call field_size(trim(land_file_name), trim(land_field_name), siz) if ( siz(1) == global_num_lon .or. siz(2) == global_num_lat ) then call read_data(trim(land_file_name), trim(land_field_name), land_ones, grid_domain) - !s write something to screen to let the user know what's happening. + ! write something to screen to let the user know what's happening. else write(ctmp1(1: 4),'(i4)') siz(1) write(ctmp1(9:12),'(i4)') siz(2) @@ -558,11 +589,11 @@ subroutine idealized_moist_phys_init(Time, Time_step_in, nhum, rad_lon_2d, rad_l ' but '//trim(land_file_name)//' does not exist', FATAL) endif - !s convert data in land nc file to land logical array + ! convert data in land nc file to land logical array where(land_ones > 0.) land = .true. elseif(trim(land_option) .eq. 'zsurf')then - !s wherever zsurf is greater than some threshold height then make land = .true. + ! wherever zsurf is greater than some threshold height then make land = .true. where ( z_surf > 10. ) land = .true. endif @@ -611,8 +642,8 @@ subroutine idealized_moist_phys_init(Time, Time_step_in, nhum, rad_lon_2d, rad_l ! to quickly enter the atmosphere avoiding problems with the convection scheme t_surf = t_surf_init + 1.0 - call mixed_layer_init(is, ie, js, je, num_levels, t_surf, bucket_depth, get_axis_id(), Time, albedo, rad_lonb_2d(:,:), rad_latb_2d(:,:), land, bucket) ! t_surf is intent(inout) !s albedo distribution set here. - + call mixed_layer_init(is, ie, js, je, num_levels, t_surf, bucket_depth, get_axis_id(), Time, albedo, rad_lonb_2d(:,:), rad_latb_2d(:,:), land, bucket) ! t_surf is intent(inout) ! albedo distribution set here. + elseif(gp_surface) then albedo=0.0 call error_mesg('idealized_moist_phys','Because gp_surface=.True., setting albedo=0.0', NOTE) @@ -625,7 +656,7 @@ subroutine idealized_moist_phys_init(Time, Time_step_in, nhum, rad_lon_2d, rad_l ! need to call vert_diff_init even if using gcm_vert_diff (rather than ! gcm_vert_diff_down) because the variable sphum is not initialized ! otherwise in the vert_diff module - call vert_diff_init (Tri_surf, ie-is+1, je-js+1, num_levels, .true., do_virtual) !s do_conserve_energy is hard-coded in. + call vert_diff_init (Tri_surf, ie-is+1, je-js+1, num_levels, .true., do_virtual) ! do_conserve_energy is hard-coded in. end if call lscale_cond_init() @@ -688,7 +719,7 @@ subroutine idealized_moist_phys_init(Time, Time_step_in, nhum, rad_lon_2d, rad_l !run without startiform cloud scheme !--------------------------------------------------------------------- - ! retrieve the number of registered tracers in order to determine + ! retrieve the number of registered tracers in order to determine ! which tracers are to be convectively transported. !--------------------------------------------------------------------- @@ -700,7 +731,7 @@ subroutine idealized_moist_phys_init(Time, Time_step_in, nhum, rad_lon_2d, rad_l do_strat = .false. !Commented code not used such that tracers are not advected by RAS. Could implement in future. - + ! do n=1, num_tracers ! if (query_method ('convection', MODEL_ATMOS, n, scheme)) then ! num_ras_tracers = num_ras_tracers + 1 @@ -716,13 +747,13 @@ subroutine idealized_moist_phys_init(Time, Time_step_in, nhum, rad_lon_2d, rad_l !---------------------------------------------------------------------- ! for each tracer, determine if it is to be transported by convect- - ! ion, and the convection schemes that are to transport it. set a + ! ion, and the convection schemes that are to transport it. set a ! logical flag to .true. for each tracer that is to be transported by ! each scheme and increment the count of tracers to be transported ! by that scheme. !---------------------------------------------------------------------- - call ras_init (do_strat, axes,Time,tracers_in_ras) + call ras_init (do_strat, axes,Time,tracers_in_ras) end select @@ -736,7 +767,6 @@ subroutine idealized_moist_phys_init(Time, Time_step_in, nhum, rad_lon_2d, rad_l axes(1:2), Time, 'Rain from convection','kg/m/m/s') !endif - if(two_stream_gray) call two_stream_gray_rad_init(is, ie, js, je, num_levels, get_axis_id(), Time, rad_lonb_2d, rad_latb_2d, dt_real) #ifdef RRTM_NO_COMPILE @@ -745,7 +775,7 @@ subroutine idealized_moist_phys_init(Time, Time_step_in, nhum, rad_lon_2d, rad_l endif #else if(do_rrtm_radiation) then - id=ie-is+1 !s Taking dimensions from equivalend calls in vert_turb_driver_init + id=ie-is+1 ! Taking dimensions from equivalend calls in vert_turb_driver_init jd=je-js+1 kd=num_levels call rrtmg_lw_ini(cp_air) @@ -762,7 +792,7 @@ subroutine idealized_moist_phys_init(Time, Time_step_in, nhum, rad_lon_2d, rad_l endif #else if (do_socrates_radiation) then - call socrates_init(is, ie, js, je, num_levels, axes, Time, rad_lat, rad_lonb_2d, rad_latb_2d, Time_step_in, do_cloud_simple) + call socrates_init(is, ie, js, je, num_levels, axes, Time, rad_lat, rad_lonb_2d, rad_latb_2d, Time_step_in, do_cloud_simple, do_cloud_spookie) endif #endif @@ -786,11 +816,12 @@ subroutine idealized_moist_phys_init(Time, Time_step_in, nhum, rad_lon_2d, rad_l end subroutine idealized_moist_phys_init !================================================================================================================================= -subroutine idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, tg, grid_tracers, & +subroutine idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, psg, wg_full, tg, grid_tracers, & previous, current, dt_ug, dt_vg, dt_tg, dt_tracers, mask, kbot) type(time_type), intent(in) :: Time real, dimension(:,:,:,:), intent(in) :: p_half, p_full, z_half, z_full, ug, vg, tg +real, dimension(:,:,:), intent(in) :: psg, wg_full real, dimension(:,:,:,:,:), intent(in) :: grid_tracers integer, intent(in) :: previous, current real, dimension(:,:,:), intent(inout) :: dt_ug, dt_vg, dt_tg @@ -800,7 +831,7 @@ subroutine idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, tg real, dimension(size(ug,1), size(ug,2), size(ug,3)) :: tg_tmp, qg_tmp, RH,tg_interp, mc, dt_ug_conv, dt_vg_conv ! Simple cloud scheme variabilies to pass to radiation -real, dimension(size(ug,1), size(ug,2), size(ug,3)) :: cf_rad, reff_rad, qcl_rad, cca_rad +real, dimension(size(ug,1), size(ug,2), size(ug,3)) :: cf_rad, reff_rad, qcl_rad, cca_rad real, intent(in) , dimension(:,:,:), optional :: mask integer, intent(in) , dimension(:,:), optional :: kbot @@ -815,11 +846,14 @@ subroutine idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, tg endif if (bucket) then - dt_bucket = 0.0 ! RG Add bucket - filt = 0.0 ! RG Add bucket + dt_bucket = 0.0 + filt = 0.0 endif -rain = 0.0; snow = 0.0; precip = 0.0 + +rain = 0.0; snow = 0.0; precip = 0.0; klcls = 0 +convective_rain = 0.0 + select case(r_conv_scheme) @@ -833,7 +867,8 @@ subroutine idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, tg q_ref, convflag, & klzbs, cape, & cin, invtau_q_relaxation, & - invtau_t_relaxation, t_ref) + invtau_t_relaxation, t_ref, & + klcls) tg_tmp = conv_dt_tg + tg(:,:,:,previous) qg_tmp = conv_dt_qg + grid_tracers(:,:,:,previous,nsphum) @@ -841,7 +876,7 @@ subroutine idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, tg conv_dt_tg = conv_dt_tg/delta_t conv_dt_qg = conv_dt_qg/delta_t - depth_change_conv = rain/dens_h2o ! RG Add bucket + depth_change_conv = rain/dens_h2o rain = rain/delta_t precip = rain @@ -862,7 +897,7 @@ subroutine idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, tg klzbs, cape, & cin, t_ref, & invtau_t_relaxation, invtau_q_relaxation, & - capeflag) + capeflag, klcls) tg_tmp = conv_dt_tg + tg(:,:,:,previous) qg_tmp = conv_dt_qg + grid_tracers(:,:,:,previous,nsphum) @@ -870,7 +905,7 @@ subroutine idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, tg conv_dt_tg = conv_dt_tg/delta_t conv_dt_qg = conv_dt_qg/delta_t - depth_change_conv = rain/dens_h2o ! RG Add bucket + depth_change_conv = rain/dens_h2o rain = rain/delta_t precip = rain @@ -883,7 +918,7 @@ subroutine idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, tg case(DRY_CONV) call dry_convection(Time, tg(:, :, :, previous), & p_full(:,:,:,previous), p_half(:,:,:,previous), & - conv_dt_tg, cape, cin) + conv_dt_tg, cape, cin, klzbs, klcls) tg_tmp = conv_dt_tg*delta_t + tg(:,:,:,previous) qg_tmp = grid_tracers(:,:,:,previous,nsphum) @@ -894,19 +929,20 @@ subroutine idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, tg case(RAS_CONV) - call ras (is, js, Time, & + call ras (is, js, Time, & tg(:,:,:,previous), grid_tracers(:,:,:,previous,nsphum), & ug(:,:,:,previous), vg(:,:,:,previous), p_full(:,:,:,previous), & p_half(:,:,:,previous), z_half(:,:,:,previous), coldT, delta_t, & conv_dt_tg, conv_dt_qg, dt_ug_conv, dt_vg_conv, & - rain, snow, do_strat, & - !OPTIONAL + rain, snow, do_strat, & + klzbs, klcls, & + !OPTIONAL mask, kbot, & !OPTIONAL OUT mc, tracer(:,:,:), tracer(:,:,:), & tracer(:,:,:), tracertnd(:,:,:), & tracertnd(:,:,:), tracertnd(:,:,:)) - + !update tendencies - dT and dq are done after cases tg_tmp = tg(:,:,:,previous) + conv_dt_tg @@ -922,6 +958,7 @@ subroutine idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, tg case(NO_CONV) + conv_dt_tg = 0.0 tg_tmp = tg(:,:,:,previous) qg_tmp = grid_tracers(:,:,:,previous,nsphum) @@ -930,11 +967,11 @@ subroutine idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, tg end select - ! Add the T and q tendencies due to convection to the timestep dt_tg = dt_tg + conv_dt_tg dt_tracers(:,:,:,nsphum) = dt_tracers(:,:,:,nsphum) + conv_dt_qg +convective_rain = precip ! Perform large scale convection if (r_conv_scheme .ne. DRY_CONV) then @@ -949,7 +986,7 @@ subroutine idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, tg cond_dt_tg = cond_dt_tg/delta_t cond_dt_qg = cond_dt_qg/delta_t - depth_change_cond = rain/dens_h2o ! RG Add bucket + depth_change_cond = rain/dens_h2o rain = rain/delta_t snow = snow/delta_t precip = precip + rain + snow @@ -970,22 +1007,44 @@ subroutine idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, tg ! initialise outs to zero -cf_rad(:,:,:) = 0. -reff_rad(:,:,:) = 0. -qcl_rad(:,:,:) = 0. -cca_rad(:,:,:) = 0. + !Set to zero regardless of if clouds are used in radiation code + cf_rad = 0. + reff_rad = 0. + qcl_rad = 1e-8 + cca_rad = 0. if(do_cloud_simple) then - - call cloud_simple(p_half(:,:,:,current), p_full(:,:,:,current), & + call cloud_simple(p_half(:,:,:,current), & + p_full(:,:,:,current), & Time, & tg(:,:,:,previous), & grid_tracers(:,:,:,previous,nsphum), & - ! inouts - - cf_rad(:,:,:), cca_rad(:,:,:), & - reff_rad(:,:,:), qcl_rad(:,:,:) & - ) - + z_full(:,:,:,current), & + wg_full(:,:,:), & + psg(:,:,current), & + temp_2m(:,:), & + q_2m(:,:), & + rh_2m(:,:), & + klcls(:,:), & + .not. land(:,:), & ! ocean mask, True is for ocean + ! ----- outs ----- + cf_rad(:,:,:), & + reff_rad(:,:,:), & + qcl_rad(:,:,:) ) +elseif(do_cloud_spookie) then + cf_rad(:,:,:) = 0. + reff_rad(:,:,:) = 0. + qcl_rad(:,:,:) = 0. + cca_rad(:,:,:) = 0. + + call cloud_spookie(p_half(:,:,:,current), & + p_full(:,:,:,current), & + Time, & + tg(:,:,:,previous), & + grid_tracers(:,:,:,previous,nsphum), & + ! inouts - + cf_rad(:,:,:), cca_rad(:,:,:), & + reff_rad(:,:,:), qcl_rad(:,:,:) ) endif ! Begin the radiation calculation by computing downward fluxes. @@ -1082,6 +1141,15 @@ subroutine idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, tg endif +! 10m winds and 2m temperature add mo_profile() + +if(id_temp_2m > 0) used = send_data(id_temp_2m, temp_2m, Time) ! 2m temp +if(id_u_10m > 0) used = send_data(id_u_10m, u_10m, Time) ! 10m wind (u) +if(id_v_10m > 0) used = send_data(id_v_10m, v_10m, Time) ! 10m wind (v) + +if(id_q_2m > 0) used = send_data(id_q_2m, q_2m, Time) ! Add 2m humidity +if(id_rh_2m > 0) used = send_data(id_rh_2m, rh_2m*1e2, Time) ! Add 2m humidity + ! Now complete the radiation calculation by computing the upward and net fluxes. if(two_stream_gray) then @@ -1104,7 +1172,8 @@ subroutine idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, tg call interp_temp(z_full(:,:,:,current),z_half(:,:,:,current),tg_interp, Time) call run_rrtmg(is,js,Time,rad_lat(:,:),rad_lon(:,:),p_full(:,:,:,current),p_half(:,:,:,current), & albedo,grid_tracers(:,:,:,previous,nsphum),tg_interp,t_surf(:,:),dt_tg(:,:,:), & - coszen,net_surf_sw_down(:,:),surf_lw_down(:,:)) + coszen,net_surf_sw_down(:,:),surf_lw_down(:,:))!, cf_rad(:,:,:), reff_rad(:,:,:), & + !do_cloud_simple ) endif #endif @@ -1114,9 +1183,8 @@ subroutine idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, tg endif #else if (do_socrates_radiation) then - ! Socrates interface - - if(do_cloud_simple) then + ! Socrates interface + if((do_cloud_simple) .or. (do_cloud_spookie)) then ! Simple cloud scheme outputs radii in microns, but Socrates expects ! it in metres so convert it. reff_rad = 1.e-6 * reff_rad @@ -1128,9 +1196,8 @@ subroutine idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, tg p_half(:,:,:,current), z_full(:,:,:,current), & z_half(:,:,:,current), albedo, dt_tg(:,:,:), & net_surf_sw_down(:,:), surf_lw_down(:,:), delta_t, & - do_cloud_simple, cf_rad(:,:,:), cca_rad(:,:,:), & - reff_rad(:,:,:), qcl_rad(:,:,:) ) - + do_cloud_simple, do_cloud_spookie, cf_rad(:,:,:), & + reff_rad(:,:,:), qcl_rad(:,:,:) ) endif #endif @@ -1151,8 +1218,6 @@ subroutine idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, tg endif - - !---------------------------------------------------------------------- ! Copied from MiMA physics_driver.f90 ! call damping_driver to calculate the various model dampings that @@ -1168,12 +1233,10 @@ subroutine idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, tg grid_tracers(:,:,:,previous,:), & dt_ug(:,:,:), dt_vg(:,:,:), dt_tg(:,:,:), & dt_tracers(:,:,:,nsphum), dt_tracers(:,:,:,:), & - z_pbl) !s have taken the names of arrays etc from vert_turb_driver below. Watch ntp from 2006 call to this routine? + z_pbl) ! have taken the names of arrays etc from vert_turb_driver below. Watch ntp from 2006 call to this routine? endif - - if(turb) then call vert_turb_driver( 1, 1, & @@ -1192,11 +1255,12 @@ subroutine idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, tg grid_tracers(:,:,:,previous,nsphum), grid_tracers(:,:,:,previous,:), & dt_ug(:,:,:), dt_vg(:,:,:), & dt_tg(:,:,:), dt_tracers(:,:,:,nsphum), & - dt_tracers(:,:,:,:), diff_t(:,:,:), & - diff_m(:,:,:), gust(:,:), & - z_pbl(:,:) ) + dt_tracers(:,:,:,:), klcls(:,:), & + do_lcl_diffusivity_depth, diff_t(:,:,:), & + diff_m(:,:,:), gust(:,:), & + z_pbl(:,:) ) - pbltop(is:ie,js:je) = z_pbl(:,:) !s added so that z_pbl can be used subsequently by damping_driver. + pbltop(is:ie,js:je) = z_pbl(:,:) ! added so that z_pbl can be used subsequently by damping_driver. ! !! Don't zero these derivatives as the surface flux depends implicitly @@ -1213,7 +1277,6 @@ subroutine idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, tg call error_mesg('atmosphere','no diffusion implentation for non-mixed layer b.c.',FATAL) endif - ! We must use gcm_vert_diff_down and _up rather than gcm_vert_diff as the surface flux ! depends implicitly on the surface values @@ -1273,14 +1336,13 @@ subroutine idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, tg endif ! if(turb) then -!s Adding relative humidity calculation so as to allow comparison with Frierson's thesis. +! Adding relative humidity calculation so as to allow comparison with Frierson's thesis. call rh_calc (p_full(:,:,:,previous),tg_tmp,qg_tmp,RH) if(id_rh >0) used = send_data(id_rh, RH*100., Time) - -! RG Add bucket -! Timestepping for bucket. -! NB In tapios github, all physics is still in atmosphere.F90 and this leapfrogging is done there. +! Add bucket +! Timestepping for bucket. +! NB In tapios github, all physics is still in atmosphere.F90 and this leapfrogging is done there. !This part has been included here to avoid editing atmosphere.F90 ! Therefore define a future variable locally, but do not feedback any changes to timestepping variables upstream, so as to avoid messing with the model's overall timestepping. ! Bucket diffusion has been cut for this version - could be incorporated later. @@ -1295,7 +1357,7 @@ subroutine idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, tg ! bucket time tendency dt_bucket = depth_change_cond + depth_change_conv - depth_change_lh - !change in bucket depth in one leapfrog timestep [m] + !change in bucket depth in one leapfrog timestep [m] ! use the raw filter in leapfrog time stepping @@ -1307,13 +1369,13 @@ subroutine idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, tg *(bucket_depth(:,:,previous) - 2.0*bucket_depth(:,:,current) + bucket_depth(:,:,future)) * raw_bucket else bucket_depth(:,:,current) = bucket_depth(:,:,current ) + robert_bucket & - *(bucket_depth(:,:,previous) - 2.0*bucket_depth(:,:,current)) * raw_bucket + *(bucket_depth(:,:,previous) - 2.0*bucket_depth(:,:,current)) * raw_bucket bucket_depth(:,:,future ) = bucket_depth(:,:,previous) + dt_bucket bucket_depth(:,:,current) = bucket_depth(:,:,current) + robert_bucket * bucket_depth(:,:,future) * raw_bucket endif bucket_depth(:,:,future) = bucket_depth(:,:,future) + robert_bucket * (filt(:,:) + bucket_depth(:,:, future)) & - * (raw_bucket - 1.0) + * (raw_bucket - 1.0) where (bucket_depth <= 0.) bucket_depth = 0. @@ -1330,9 +1392,6 @@ subroutine idealized_moist_phys(Time, p_half, p_full, z_half, z_full, ug, vg, tg endif ! end Add bucket section - - - end subroutine idealized_moist_phys !================================================================================================================================= subroutine idealized_moist_phys_end @@ -1359,11 +1418,10 @@ subroutine idealized_moist_phys_end end subroutine idealized_moist_phys_end !================================================================================================================================= -subroutine rh_calc(pfull,T,qv,RH) !s subroutine copied from 2006 FMS MoistModel file moist_processes.f90 (v14 2012/06/22 14:50:00). +subroutine rh_calc(pfull,T,qv,RH) ! subroutine copied from 2006 FMS MoistModel file moist_processes.f90 (v14 2012/06/22 14:50:00). IMPLICIT NONE - REAL, INTENT (IN), DIMENSION(:,:,:) :: pfull,T,qv REAL, INTENT (OUT), DIMENSION(:,:,:) :: RH diff --git a/src/atmos_spectral/driver/solo/mixed_layer.F90 b/src/atmos_spectral/driver/solo/mixed_layer.F90 index 4eee4ff1d..051d985fe 100644 --- a/src/atmos_spectral/driver/solo/mixed_layer.F90 +++ b/src/atmos_spectral/driver/solo/mixed_layer.F90 @@ -26,7 +26,7 @@ module mixed_layer_mod ! use fms_mod, only: set_domain, write_version_number, & - mpp_pe, mpp_root_pe, error_mesg, FATAL, WARNING + mpp_pe, mpp_root_pe, error_mesg, NOTE, FATAL, WARNING use fms_mod, only: stdlog, check_nml_error, close_file,& open_namelist_file, stdout, file_exist, & @@ -43,14 +43,21 @@ module mixed_layer_mod use time_manager_mod, only: time_type +#ifdef COLUMN_MODEL +use column_grid_mod, only: get_deg_lon, get_deg_lat +use column_mod, only: get_surf_geopotential +use spec_mpp_mod, only: grid_domain +#else use transforms_mod, only: get_deg_lat, get_deg_lon, grid_domain +! mj know about surface topography +use spectral_dynamics_mod,only: get_surf_geopotential +#endif use vert_diff_mod, only: surf_diff_type use mpp_domains_mod, only: mpp_get_global_domain !s added to enable qflux reading -! mj know about surface topography -use spectral_dynamics_mod,only: get_surf_geopotential + ! mj read SSTs use interpolator_mod, only: interpolate_type,interpolator_init& &,CONSTANT,interpolator @@ -123,6 +130,7 @@ module mixed_layer_mod real :: ice_albedo_value = 0.7 real :: ice_concentration_threshold = 0.5 logical :: update_albedo_from_ice = .false. +character(len=256) :: ice_albedo_method = 'step_function' logical :: add_latent_heat_flux_anom = .false. character(len=256) :: flux_lhe_anom_file_name = 'INPUT/flux_lhe_anom.nc' @@ -143,7 +151,7 @@ module mixed_layer_mod load_qflux,qflux_file_name,time_varying_qflux, & update_albedo_from_ice, ice_file_name, & ice_albedo_value, specify_sst_over_ocean_only, & - ice_concentration_threshold, & + ice_concentration_threshold, ice_albedo_method,& add_latent_heat_flux_anom,flux_lhe_anom_file_name,& flux_lhe_anom_field_name, do_ape_sst, qflux_field_name @@ -344,6 +352,10 @@ subroutine mixed_layer_init(is, ie, js, je, num_levels, t_surf, bucket_depth, ax endif +if(trim(ice_albedo_method) == 'ramp_function') then + call error_mesg('mixed_layer','Alternative method ramp_function used for ice albedo output.', NOTE) +endif + id_t_surf = register_diag_field(mod_name, 't_surf', & axes(1:2), Time, 'surface temperature','K') id_flux_t = register_diag_field(mod_name, 'flux_t', & @@ -595,13 +607,13 @@ subroutine mixed_layer ( & endif if(update_albedo_from_ice) then - call read_ice_conc(Time_next) - land_ice_mask=.false. - where(land_mask.or.(ice_concentration.gt.ice_concentration_threshold)) - land_ice_mask=.true. - end where + call read_ice_conc(Time_next) + land_ice_mask=.false. + where(land_mask.or.(ice_concentration.gt.ice_concentration_threshold)) + land_ice_mask=.true. + end where else - land_ice_mask=land_mask + land_ice_mask=land_mask endif call albedo_calc(albedo_out,Time_next) @@ -757,9 +769,16 @@ subroutine albedo_calc(albedo_inout,Time) if(update_albedo_from_ice) then - where(ice_concentration.gt.ice_concentration_threshold) - albedo_inout=ice_albedo_value + if(trim(ice_albedo_method) == 'step_function') then + where(ice_concentration.gt.ice_concentration_threshold) + albedo_inout=ice_albedo_value end where + else if(trim(ice_albedo_method) == 'ramp_function') then + albedo_inout = albedo_inout*(1.0-ice_concentration) + ice_albedo_value*ice_concentration + else + call error_mesg('mixed_layer','"'//trim(ice_albedo_method)//'"'//' is not a valid method for determining'// & + 'albedo when ice is present. Choices are: step_function or ramp_function.', FATAL) + endif if ( id_ice_conc > 0 ) used = send_data ( id_ice_conc, ice_concentration, Time ) if ( id_albedo > 0 ) used = send_data ( id_albedo, albedo_inout, Time ) diff --git a/src/coupler/surface_flux.F90 b/src/coupler/surface_flux.F90 index 74a9eb861..d38850528 100644 --- a/src/coupler/surface_flux.F90 +++ b/src/coupler/surface_flux.F90 @@ -261,11 +261,11 @@ module surface_flux_mod logical :: raoult_sat_vap = .false. logical :: do_simple = .false. -real :: land_humidity_prefactor = 1.0 !s Default is that land makes no difference to evaporative fluxes -real :: land_evap_prefactor = 1.0 !s Default is that land makes no difference to evaporative fluxes +real :: land_humidity_prefactor = 1.0 ! Default is that land makes no difference to evaporative fluxes +real :: land_evap_prefactor = 1.0 ! Default is that land makes no difference to evaporative fluxes -real :: flux_heat_gp = 5.7 !s Default value for Jupiter of 5.7 Wm^-2 -real :: diabatic_acce = 1.0 !s Diabatic acceleration?? +real :: flux_heat_gp = 5.7 ! Default value for Jupiter of 5.7 Wm^-2 +real :: diabatic_acce = 1.0 ! Diabatic acceleration?? namelist /surface_flux_nml/ no_neg_q, & @@ -279,10 +279,10 @@ module surface_flux_mod ncar_ocean_flux_orig, & raoult_sat_vap, & do_simple, & - land_humidity_prefactor, & !s Added to make land 'dry', i.e. to decrease the evaporative heat flux in areas of land. - land_evap_prefactor, & !s Added to make land 'dry', i.e. to decrease the evaporative heat flux in areas of land. - flux_heat_gp, & !s prescribed lower boundary heat flux on a giant planet - diabatic_acce + land_humidity_prefactor, & ! Added to make land 'dry', i.e. to decrease the evaporative heat flux in areas of land. + land_evap_prefactor, & ! Added to make land 'dry', i.e. to decrease the evaporative heat flux in areas of land. + flux_heat_gp, & ! prescribed lower boundary heat flux on a giant planet + diabatic_acce @@ -338,8 +338,8 @@ module surface_flux_mod subroutine surface_flux_1d ( & t_atm, q_atm_in, u_atm, v_atm, p_atm, z_atm, & p_surf, t_surf, t_ca, q_surf, & - bucket, bucket_depth, max_bucket_depth_land, & !RG Add bucket - depth_change_lh_1d, depth_change_conv_1d, depth_change_cond_1d, & !RG Add bucket + bucket, bucket_depth, max_bucket_depth_land, & + depth_change_lh_1d, depth_change_conv_1d, depth_change_cond_1d, & u_surf, v_surf, & rough_mom, rough_heat, rough_moist, rough_scale, gust, & flux_t, flux_q, flux_r, flux_u, flux_v, & @@ -347,16 +347,16 @@ subroutine surface_flux_1d ( & w_atm, u_star, b_star, q_star, & dhdt_surf, dedt_surf, dedq_surf, drdt_surf, & dhdt_atm, dedq_atm, dtaudu_atm, dtaudv_atm, & - ex_del_m, ex_del_h, ex_del_q, & !mp586 for 10m winds and 2m temp - temp_2m, u_10m, v_10m, & !mp586 for 10m winds and 2m temp - q_2m, rh_2m, & !Add 2m q and RH + ex_del_m, ex_del_h, ex_del_q, & + temp_2m, u_10m, v_10m, & + q_2m, rh_2m, & dt, land, seawater, avail ) ! ! slm Mar 28 2002 -- remove agument drag_q since it is just cd_q*wind ! ============================================================================ ! ---- arguments ----------------------------------------------------------- logical, intent(in), dimension(:) :: land, seawater, avail - logical, intent(in) :: bucket !RG Add bucket + logical, intent(in) :: bucket ! Add bucket model real, intent(in), dimension(:) :: & t_atm, q_atm_in, u_atm, v_atm, & p_atm, z_atm, t_ca, & @@ -368,22 +368,22 @@ subroutine surface_flux_1d ( & dhdt_atm, dedq_atm, dtaudu_atm,dtaudv_atm, & w_atm, u_star, b_star, q_star, & cd_m, cd_t, cd_q, & - ex_del_m, ex_del_h, ex_del_q, & !mp586 for 10m winds and 2m temp - temp_2m, u_10m, v_10m, & !mp586 for 10m winds and 2m temp - q_2m, rh_2m ! Add 2m q and RH + ex_del_m, ex_del_h, ex_del_q, & + temp_2m, u_10m, v_10m, & + q_2m, rh_2m real, intent(inout), dimension(:) :: q_surf - real, intent(inout), dimension(:) :: bucket_depth !RG Add bucket - real, intent(inout), dimension(:) :: depth_change_lh_1d !RG Add bucket - real, intent(in), dimension(:) :: depth_change_conv_1d, depth_change_cond_1d !RG Add bucket + real, intent(inout), dimension(:) :: bucket_depth + real, intent(inout), dimension(:) :: depth_change_lh_1d + real, intent(in), dimension(:) :: depth_change_conv_1d, depth_change_cond_1d real, intent(in) :: max_bucket_depth_land real, intent(in) :: dt ! ---- local constants ----------------------------------------------------- ! temperature increment and its reciprocal value for comp. of derivatives real, parameter:: del_temp=0.1, del_temp_inv=1.0/del_temp - real:: zrefm, zrefh !mp586 for 10m winds and 2m temp + real:: zrefm, zrefh ! ---- local vars ---------------------------------------------------------- @@ -432,7 +432,7 @@ subroutine surface_flux_1d ( & ! initilaize surface air humidity according to surface type where (land) ! q_surf0 = q_surf ! land calculates it - q_surf0 = q_sat !s our simplified land evaporation model does not calculate q_surf, so we specify it as q_sat. + q_surf0 = q_sat ! our simplified land evaporation model does not calculate q_surf, so we specify it as q_sat. elsewhere q_surf0 = q_sat ! everything else assumes saturated sfc humidity endwhere @@ -505,9 +505,7 @@ subroutine surface_flux_1d ( & rough_mom, rough_heat, rough_moist, w_atm, & cd_m, cd_t, cd_q, u_star, b_star, avail ) -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!!!!!! added by mp586 for 10m winds and 2m temperature add mo_profile()!!!!!!!! - +! added for 10m winds and 2m temperature add mo_profile() zrefm = 10. !want winds at 10m zrefh = 2. !want temp and q at 2m @@ -517,10 +515,8 @@ subroutine surface_flux_1d ( & u_star, b_star, q_star, & ex_del_m, ex_del_h, ex_del_q, avail ) - ! adapted from https://github.com/mom-ocean/MOM5/blob/3702ad86f9653f4e315b98613eb824a47d89cf00/src/coupler/flux_exchange.F90#L1932 - ! ------- reference temp ----------- where (avail) & temp_2m = t_surf + (t_atm - t_surf) * ex_del_h !t_ca = canopy temperature, assuming that there is no canopy (no difference between land and ocean), t_ca = t_surf @@ -533,8 +529,8 @@ subroutine surface_flux_1d ( & where (avail) & v_10m = v_atm * ex_del_m ! setting v at surface to 0. -!!!!!!!!!!!! end of mp586 additions !!!!!!!!!!!!!!!!!!!!!!! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! end of low level wind additions + ! Add 2m q and RH @@ -584,29 +580,29 @@ subroutine surface_flux_1d ( & ! evaporation rho_drag = drag_q * rho - end where + end where -!RG Add bucket - if bucket is on evaluate fluxes based on moisture availability. -!RG Note changes to avail statements to allow bucket to be switched on or off +! Add bucket - if bucket is on evaluate fluxes based on moisture availability. +! Note changes to avail statements to allow bucket to be switched on or off if (bucket) then where (avail) ! begin LJJ addition where(land) where (bucket_depth >= max_bucket_depth_land*0.75) flux_q = rho_drag * (q_surf0 - q_atm) - elsewhere + elsewhere flux_q = bucket_depth/(max_bucket_depth_land*0.75) * rho_drag * (q_surf0 - q_atm) ! flux of water vapor (Kg/(m**2 s)) end where elsewhere flux_q = rho_drag * (q_surf0 - q_atm) ! flux of water vapor (Kg/(m**2 s)) end where - - depth_change_lh_1d = flux_q * dt/dens_h2o + + depth_change_lh_1d = flux_q * dt/dens_h2o where (flux_q > 0.0 .and. bucket_depth < depth_change_lh_1d) ! where more evaporation than what's in bucket, empty bucket flux_q = bucket_depth * dens_h2o / dt depth_change_lh_1d = flux_q * dt / dens_h2o - end where - + end where + where (bucket_depth <= 0.0) dedt_surf = 0. dedq_surf = 0. @@ -623,19 +619,19 @@ subroutine surface_flux_1d ( & elsewhere dedt_surf = rho_drag * (q_sat1 - q_sat) *del_temp_inv end where - + end where - end where + end where else -!RG otherwise revert to simple land model +! otherwise revert to simple land model where (avail) where (land) -!s Simplified land model uses simple prefactor in front of qsurf0. Land is therefore basically the same as sea, but with this prefactor, hence the changes to dedq_surf and dedt_surf also. +! Simplified land model uses simple prefactor in front of qsurf0. Land is therefore basically the same as sea, but with this prefactor, hence the changes to dedq_surf and dedt_surf also. flux_q = rho_drag * land_evap_prefactor * (land_humidity_prefactor*q_surf0 - q_atm) ! flux of water vapor (Kg/(m**2 s)) dedq_surf = 0 dedt_surf = rho_drag * land_evap_prefactor * (land_humidity_prefactor*q_sat1 - q_sat) *del_temp_inv -! dedq_surf = rho_drag +! dedq_surf = rho_drag ! dedt_surf = 0 elsewhere flux_q = rho_drag * (q_surf0 - q_atm) ! flux of water vapor (Kg/(m**2 s)) @@ -646,7 +642,7 @@ subroutine surface_flux_1d ( & end where endif -!RG end Add bucket changes +! end of Add bucket changes where (avail) @@ -713,9 +709,9 @@ subroutine surface_flux_0d ( & w_atm_0, u_star_0, b_star_0, q_star_0, & dhdt_surf_0, dedt_surf_0, dedq_surf_0, drdt_surf_0, & dhdt_atm_0, dedq_atm_0, dtaudu_atm_0, dtaudv_atm_0, & - ex_del_m_0, ex_del_h_0, ex_del_q_0, & !mp586 for 10m winds and 2m temp - temp_2m_0, u_10m_0, v_10m_0, & !mp586 for 10m winds and 2m temp - q_2m_0, rh_2m_0, & !2m q and RH + ex_del_m_0, ex_del_h_0, ex_del_q_0, & + temp_2m_0, u_10m_0, v_10m_0, & + q_2m_0, rh_2m_0, & dt, land_0, seawater_0, avail_0 ) ! ---- arguments ----------------------------------------------------------- @@ -730,9 +726,9 @@ subroutine surface_flux_0d ( & dhdt_surf_0, dedt_surf_0, dedq_surf_0, drdt_surf_0, & dhdt_atm_0, dedq_atm_0, dtaudu_atm_0,dtaudv_atm_0, & w_atm_0, u_star_0, b_star_0, q_star_0, & - cd_m_0, cd_t_0, cd_q_0, & - ex_del_m_0, ex_del_h_0, ex_del_q_0, & !mp586 for 10m winds and 2m temp - temp_2m_0, u_10m_0, v_10m_0, & !mp586 for 10m winds and 2m temp + cd_m_0, cd_t_0, cd_q_0, & + ex_del_m_0, ex_del_h_0, ex_del_q_0, & + temp_2m_0, u_10m_0, v_10m_0, & q_2m_0, rh_2m_0 real, intent(inout) :: q_surf_0 real, intent(in) :: dt @@ -750,16 +746,16 @@ subroutine surface_flux_0d ( & dhdt_surf, dedt_surf, dedq_surf, drdt_surf, & dhdt_atm, dedq_atm, dtaudu_atm,dtaudv_atm, & w_atm, u_star, b_star, q_star, & - cd_m, cd_t, cd_q, & - ex_del_m, ex_del_h, ex_del_q, & !mp586 for 10m winds and 2m temp - temp_2m, u_10m, v_10m, & !mp586 for 10m winds and 2m temp - q_2m, rh_2m !Add 2m q and RH + cd_m, cd_t, cd_q, & + ex_del_m, ex_del_h, ex_del_q, & + temp_2m, u_10m, v_10m, & + q_2m, rh_2m real, dimension(1) :: q_surf - real, dimension(1) :: bucket_depth !RG Add bucket - real, dimension(1) :: depth_change_lh_1d !RG Add bucket - real, dimension(1) :: depth_change_conv_1d, depth_change_cond_1d !RG Add bucket - real :: max_bucket_depth_land !RG Add bucket + real, dimension(1) :: bucket_depth + real, dimension(1) :: depth_change_lh_1d + real, dimension(1) :: depth_change_conv_1d, depth_change_cond_1d + real :: max_bucket_depth_land avail = .true. @@ -787,8 +783,8 @@ subroutine surface_flux_0d ( & call surface_flux_1d ( & t_atm, q_atm, u_atm, v_atm, p_atm, z_atm, & p_surf, t_surf, t_ca, q_surf, & - bucket, bucket_depth, max_bucket_depth_land, & !RG Add bucket - depth_change_lh_1d, depth_change_conv_1d, depth_change_cond_1d, & !RG Add bucket + bucket, bucket_depth, max_bucket_depth_land, & + depth_change_lh_1d, depth_change_conv_1d, depth_change_cond_1d, & u_surf, v_surf, & rough_mom, rough_heat, rough_moist, rough_scale, gust, & flux_t, flux_q, flux_r, flux_u, flux_v, & @@ -796,9 +792,9 @@ subroutine surface_flux_0d ( & w_atm, u_star, b_star, q_star, & dhdt_surf, dedt_surf, dedq_surf, drdt_surf, & dhdt_atm, dedq_atm, dtaudu_atm, dtaudv_atm, & - ex_del_m, ex_del_h, ex_del_q, & !mp586 for 10m winds and 2m temp - temp_2m, u_10m, v_10m, & !mp586 for 10m winds and 2m temp - q_2m, rh_2m, & !Add 2m q and RH + ex_del_m, ex_del_h, ex_del_q, & + temp_2m, u_10m, v_10m, & + q_2m, rh_2m, & dt, land, seawater, avail ) flux_t_0 = flux_t(1) @@ -822,22 +818,22 @@ subroutine surface_flux_0d ( & cd_m_0 = cd_m(1) cd_t_0 = cd_t(1) cd_q_0 = cd_q(1) - ex_del_m_0 = ex_del_m(1) !mp586 for 10m winds and 2m temp - ex_del_h_0 = ex_del_h(1) !mp586 for 10m winds and 2m temp - ex_del_q_0 = ex_del_q(1) !mp586 for 10m winds and 2m temp - temp_2m_0 = temp_2m(1) !mp586 for 10m winds and 2m temp - u_10m_0 = u_10m(1) !mp586 for 10m winds and 2m temp - v_10m_0 = v_10m(1) !mp586 for 10m winds and 2m temp - q_2m_0 = q_2m(1) !Add 2m q - rh_2m_0 = rh_2m(1) !Add 2m RH + ex_del_m_0 = ex_del_m(1) + ex_del_h_0 = ex_del_h(1) + ex_del_q_0 = ex_del_q(1) + temp_2m_0 = temp_2m(1) + u_10m_0 = u_10m(1) + v_10m_0 = v_10m(1) + q_2m_0 = q_2m(1) + rh_2m_0 = rh_2m(1) end subroutine surface_flux_0d subroutine surface_flux_2d ( & t_atm, q_atm_in, u_atm, v_atm, p_atm, z_atm, & p_surf, t_surf, t_ca, q_surf, & - bucket, bucket_depth, max_bucket_depth_land, & !RG Add bucket - depth_change_lh, depth_change_conv, depth_change_cond, & !RG Add bucket + bucket, bucket_depth, max_bucket_depth_land, & + depth_change_lh, depth_change_conv, depth_change_cond, & u_surf, v_surf, & rough_mom, rough_heat, rough_moist, rough_scale, gust, & flux_t, flux_q, flux_r, flux_u, flux_v, & @@ -845,9 +841,9 @@ subroutine surface_flux_2d ( & w_atm, u_star, b_star, q_star, & dhdt_surf, dedt_surf, dedq_surf, drdt_surf, & dhdt_atm, dedq_atm, dtaudu_atm, dtaudv_atm, & - ex_del_m, ex_del_h, ex_del_q, & !mp586 for 10m winds and 2m temp - temp_2m, u_10m, v_10m, & !mp586 for 10m winds and 2m temp - q_2m, rh_2m, & !Add 2m q and RH + ex_del_m, ex_del_h, ex_del_q, & + temp_2m, u_10m, v_10m, & + q_2m, rh_2m, & dt, land, seawater, avail ) ! ---- arguments ----------------------------------------------------------- @@ -863,16 +859,16 @@ subroutine surface_flux_2d ( & dhdt_atm, dedq_atm, dtaudu_atm,dtaudv_atm, & w_atm, u_star, b_star, q_star, & cd_m, cd_t, cd_q, & - ex_del_m, ex_del_h, ex_del_q, & !mp586 for 10m winds and 2m temp - temp_2m, u_10m, v_10m, & !mp586 for 10m winds and 2m temp - q_2m, rh_2m !Add 2m q and RH + ex_del_m, ex_del_h, ex_del_q, & + temp_2m, u_10m, v_10m, & + q_2m, rh_2m real, intent(inout), dimension(:,:) :: q_surf - logical, intent(in) :: bucket !RG Add bucket - real, intent(inout), dimension(:,:) :: bucket_depth ! RG Add bucket - real, intent(inout), dimension(:,:) :: depth_change_lh ! RG Add bucket - real, intent(in), dimension(:,:) :: depth_change_conv, depth_change_cond ! RG Add bucket - real, intent(in) :: max_bucket_depth_land ! RG Add bucket + logical, intent(in) :: bucket + real, intent(inout), dimension(:,:) :: bucket_depth + real, intent(inout), dimension(:,:) :: depth_change_lh + real, intent(in), dimension(:,:) :: depth_change_conv, depth_change_cond + real, intent(in) :: max_bucket_depth_land real, intent(in) :: dt ! ---- local vars ----------------------------------------------------------- @@ -882,8 +878,8 @@ subroutine surface_flux_2d ( & call surface_flux_1d ( & t_atm(:,j), q_atm_in(:,j), u_atm(:,j), v_atm(:,j), p_atm(:,j), z_atm(:,j), & p_surf(:,j), t_surf(:,j), t_ca(:,j), q_surf(:,j), & - bucket, bucket_depth(:,j), max_bucket_depth_land, & !RG Add bucket - depth_change_lh(:,j), depth_change_conv(:,j), depth_change_cond(:,j), & !RG Add bucket + bucket, bucket_depth(:,j), max_bucket_depth_land, & + depth_change_lh(:,j), depth_change_conv(:,j), depth_change_cond(:,j), & u_surf(:,j), v_surf(:,j), & rough_mom(:,j), rough_heat(:,j), rough_moist(:,j), rough_scale(:,j), gust(:,j), & flux_t(:,j), flux_q(:,j), flux_r(:,j), flux_u(:,j), flux_v(:,j), & @@ -891,8 +887,8 @@ subroutine surface_flux_2d ( & w_atm(:,j), u_star(:,j), b_star(:,j), q_star(:,j), & dhdt_surf(:,j), dedt_surf(:,j), dedq_surf(:,j), drdt_surf(:,j), & dhdt_atm(:,j), dedq_atm(:,j), dtaudu_atm(:,j), dtaudv_atm(:,j), & - ex_del_m(:,j), ex_del_h(:,j), ex_del_q(:,j), & !mp586 for 10m winds and 2m temp - temp_2m(:,j), u_10m(:,j), v_10m(:,j), & !mp586 for 10m winds and 2m temp + ex_del_m(:,j), ex_del_h(:,j), ex_del_q(:,j), & + temp_2m(:,j), u_10m(:,j), v_10m(:,j), & q_2m(:,j), rh_2m(:,j), & dt, land(:,j), seawater(:,j), avail(:,j) ) end do diff --git a/src/extra/env/maths2 b/src/extra/env/maths2 new file mode 100644 index 000000000..e693bc85e --- /dev/null +++ b/src/extra/env/maths2 @@ -0,0 +1,6 @@ +echo loadmodules for maths2 machines + +export F90=mpiifort +export CC=mpiicc + +export GFDL_MKMF_TEMPLATE=maths2 diff --git a/src/extra/model/column/field_table b/src/extra/model/column/field_table new file mode 100644 index 000000000..c2d63b9dd --- /dev/null +++ b/src/extra/model/column/field_table @@ -0,0 +1,10 @@ + +"TRACER", "atmos_mod", "sphum" + "longname", "specific humidity" + "units", "kg/kg" + "numerical_representation", "grid" + "hole_filling", "off" + "advect_vert", "finite_volume_parabolic" + "robert_filter", "on" + "profile_type", "fixed", "surface_value=0.0" / + diff --git a/src/extra/model/column/path_names b/src/extra/model/column/path_names new file mode 100644 index 000000000..e270ee283 --- /dev/null +++ b/src/extra/model/column/path_names @@ -0,0 +1,262 @@ +atmos_column/column.F90 +atmos_column/column_init_cond.F90 +atmos_column/column_grid.F90 +atmos_column/column_initialize_fields.F90 +atmos_param/diffusivity/diffusivity.F90 +atmos_param/edt/edt.F90 +atmos_param/entrain/entrain.F90 +atmos_param/hs_forcing/hs_forcing.F90 +atmos_param/lscale_cond/lscale_cond.F90 +atmos_param/my25_turb/my25_turb.F90 +atmos_param/qe_moist_convection/qe_moist_convection.F90 +atmos_param/betts_miller/betts_miller.f90 +atmos_param/ras/ras.f90 +atmos_param/sea_esf_rad/null/rad_utilities.F90 +atmos_param/shallow_conv/shallow_conv.F90 +atmos_param/stable_bl_turb/stable_bl_turb.F90 +atmos_param/strat_cloud/null/strat_cloud.F90 +atmos_param/cloud_simple/cloud_simple.F90 +atmos_param/cloud_simple/lcl.F90 +atmos_param/cloud_simple/large_scale_cloud.F90 +atmos_param/cloud_simple/marine_strat_cloud.F90 +atmos_param/cloud_simple/cloud_cover_diags.F90 +atmos_param/cloud_simple/cloud_spookie.F90 +atmos_param/two_stream_gray_rad/two_stream_gray_rad.F90 +atmos_param/qflux/qflux.f90 +atmos_param/monin_obukhov/monin_obukhov_interfaces.h +atmos_param/monin_obukhov/monin_obukhov_kernel.F90 +atmos_param/monin_obukhov/monin_obukhov.F90 +atmos_param/dry_convection/dry_convection.f90 +atmos_param/rayleigh_bottom_drag/rayleigh_bottom_drag.F90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/parkind.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/parrrtm.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/rrlw_cld.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/rrlw_con.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/rrlw_kg01.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/rrlw_kg02.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/rrlw_kg03.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/rrlw_kg04.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/rrlw_kg05.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/rrlw_kg06.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/rrlw_kg07.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/rrlw_kg08.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/rrlw_kg09.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/rrlw_kg10.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/rrlw_kg11.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/rrlw_kg12.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/rrlw_kg13.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/rrlw_kg14.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/rrlw_kg15.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/rrlw_kg16.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/rrlw_ncpar.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/rrlw_ref.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/rrlw_tbl.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/rrlw_vsn.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/rrlw_wvn.f90 +atmos_param/rrtm_radiation/rrtm_radiation.F90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/src/mcica_random_numbers.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/src/rrtmg_lw_cldprop.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/src/rrtmg_lw_rad.nomcica.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/src/rrtmg_lw_rtrn.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/src/rrtmg_lw_setcoef.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/src/mcica_subcol_gen_lw.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/src/rrtmg_lw_init.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/src/rrtmg_lw_rtrnmc.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/src/rrtmg_lw_taumol.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/src/rrtmg_lw_cldprmc.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/src/rrtmg_lw_k_g.f90 +atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/src/rrtmg_lw_rtrnmr.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/modules/parkind.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/modules/parrrsw.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/modules/rrsw_aer.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/modules/rrsw_cld.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/modules/rrsw_con.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/modules/rrsw_kg16.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/modules/rrsw_kg17.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/modules/rrsw_kg18.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/modules/rrsw_kg19.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/modules/rrsw_kg20.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/modules/rrsw_kg21.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/modules/rrsw_kg22.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/modules/rrsw_kg23.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/modules/rrsw_kg24.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/modules/rrsw_kg25.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/modules/rrsw_kg26.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/modules/rrsw_kg27.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/modules/rrsw_kg28.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/modules/rrsw_kg29.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/modules/rrsw_ncpar.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/modules/rrsw_ref.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/modules/rrsw_tbl.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/modules/rrsw_vsn.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/modules/rrsw_wvn.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/src/mcica_random_numbers.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/src/mcica_subcol_gen_sw.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/src/rrtmg_sw_rad.nomcica.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/src/rrtmg_sw_cldprop.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/src/rrtmg_sw_cldprmc.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/src/rrtmg_sw_init.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/src/rrtmg_sw_k_g.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/src/rrtmg_sw_reftra.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/src/rrtmg_sw_setcoef.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/src/rrtmg_sw_spcvrt.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/src/rrtmg_sw_spcvmc.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/src/rrtmg_sw_taumol.f90 +atmos_param/rrtm_radiation/rrtmg_sw/gcm_model/src/rrtmg_sw_vrtqdr.f90 +atmos_param/damping_driver/damping_driver.f90 +atmos_param/mg_drag/mg_drag.f90 +atmos_param/cg_drag/cg_drag.f90 +atmos_param/topo_drag/topo_drag.f90 +atmos_param/vert_diff/vert_diff.F90 +atmos_param/vert_turb_driver/vert_turb_driver.F90 +atmos_shared/interpolator/interpolator.F90 +atmos_shared/vert_advection/vert_advection.F90 +atmos_solo/atmos_model.F90 +atmos_spectral/driver/solo/atmosphere.F90 +atmos_spectral/driver/solo/idealized_moist_phys.F90 +atmos_spectral/driver/solo/mixed_layer.F90 +atmos_spectral/init/vert_coordinate.F90 +atmos_spectral/model/press_and_geopot.F90 +atmos_spectral/model/tracer_type.F90 +atmos_spectral/tools/spec_mpp.F90 +coupler/surface_flux.F90 +shared/axis_utils/axis_utils.F90 +shared/constants/constants.F90 +shared/astronomy/astronomy.f90 +shared/diag_manager/diag_axis.F90 +shared/diag_manager/diag_data.F90 +shared/diag_manager/diag_grid.F90 +shared/diag_manager/diag_manager.F90 +shared/diag_manager/diag_output.F90 +shared/diag_manager/diag_table.F90 +shared/diag_manager/diag_util.F90 +shared/fft/fft99.F90 +shared/fft/fft.F90 +shared/field_manager/field_manager.F90 +shared/field_manager/fm_util.F90 +shared/field_manager/parse.inc +shared/fms/fms.F90 +shared/fms/fms_io.F90 +shared/fms/read_data_2d.inc +shared/fms/read_data_3d.inc +shared/fms/read_data_4d.inc +shared/fms/test_fms_io.F90 +shared/fms/write_data.inc +shared/horiz_interp/horiz_interp_bicubic.F90 +shared/horiz_interp/horiz_interp_bilinear.F90 +shared/horiz_interp/horiz_interp_conserve.F90 +shared/horiz_interp/horiz_interp.F90 +shared/horiz_interp/horiz_interp_spherical.F90 +shared/horiz_interp/horiz_interp_type.F90 +shared/include/fms_platform.h +shared/memutils/memuse.c +shared/memutils/memutils.F90 +shared/mosaic/constant.h +shared/mosaic/create_xgrid.c +shared/mosaic/create_xgrid.h +shared/mosaic/gradient_c2l.c +shared/mosaic/gradient_c2l.h +shared/mosaic/gradient.F90 +shared/mosaic/grid.F90 +shared/mosaic/interp.c +shared/mosaic/interp.h +shared/mosaic/mosaic.F90 +shared/mosaic/mosaic_util.c +shared/mosaic/mosaic_util.h +shared/mosaic/read_mosaic.c +shared/mosaic/read_mosaic.h +shared/mpp/affinity.c +shared/mpp/include/mpp_chksum.h +shared/mpp/include/mpp_chksum_int.h +shared/mpp/include/mpp_chksum_scalar.h +shared/mpp/include/mpp_comm.inc +shared/mpp/include/mpp_comm_mpi.inc +shared/mpp/include/mpp_comm_nocomm.inc +shared/mpp/include/mpp_comm_sma.inc +shared/mpp/include/mpp_data_mpi.inc +shared/mpp/include/mpp_data_nocomm.inc +shared/mpp/include/mpp_data_sma.inc +shared/mpp/include/mpp_define_nest_domains.inc +shared/mpp/include/mpp_do_check.h +shared/mpp/include/mpp_do_checkV.h +shared/mpp/include/mpp_do_get_boundary.h +shared/mpp/include/mpp_do_global_field.h +shared/mpp/include/mpp_domains_comm.inc +shared/mpp/include/mpp_domains_define.inc +shared/mpp/include/mpp_domains_misc.inc +shared/mpp/include/mpp_domains_reduce.inc +shared/mpp/include/mpp_domains_util.inc +shared/mpp/include/mpp_do_redistribute.h +shared/mpp/include/mpp_do_update_ad.h +shared/mpp/include/mpp_do_update.h +shared/mpp/include/mpp_do_update_nest.h +shared/mpp/include/mpp_do_update_nonblock.h +shared/mpp/include/mpp_do_updateV_ad.h +shared/mpp/include/mpp_do_updateV.h +shared/mpp/include/mpp_do_updateV_nonblock.h +shared/mpp/include/mpp_error_a_a.h +shared/mpp/include/mpp_error_a_s.h +shared/mpp/include/mpp_error_s_a.h +shared/mpp/include/mpp_error_s_s.h +shared/mpp/include/mpp_gather.h +shared/mpp/include/mpp_get_boundary.h +shared/mpp/include/mpp_global_field.h +shared/mpp/include/mpp_global_reduce.h +shared/mpp/include/mpp_global_sum_ad.h +shared/mpp/include/mpp_global_sum.h +shared/mpp/include/mpp_global_sum_tl.h +shared/mpp/include/mpp_io_connect.inc +shared/mpp/include/mpp_io_misc.inc +shared/mpp/include/mpp_io_read.inc +shared/mpp/include/mpp_io_util.inc +shared/mpp/include/mpp_io_write.inc +shared/mpp/include/mpp_read_2Ddecomp.h +shared/mpp/include/mpp_reduce_mpi.h +shared/mpp/include/mpp_reduce_nocomm.h +shared/mpp/include/mpp_reduce_sma.h +shared/mpp/include/mpp_sum.inc +shared/mpp/include/mpp_sum_mpi.h +shared/mpp/include/mpp_sum_nocomm.h +shared/mpp/include/mpp_sum_sma.h +shared/mpp/include/mpp_transmit.inc +shared/mpp/include/mpp_transmit_mpi.h +shared/mpp/include/mpp_transmit_nocomm.h +shared/mpp/include/mpp_transmit_sma.h +shared/mpp/include/mpp_update_domains2D_ad.h +shared/mpp/include/mpp_update_domains2D.h +shared/mpp/include/mpp_update_domains2D_nonblock.h +shared/mpp/include/mpp_update_nest_domains.h +shared/mpp/include/mpp_util.inc +shared/mpp/include/mpp_util_mpi.inc +shared/mpp/include/mpp_util_nocomm.inc +shared/mpp/include/mpp_util_sma.inc +shared/mpp/include/mpp_write_2Ddecomp.h +shared/mpp/include/mpp_write.h +shared/mpp/include/system_clock.h +shared/mpp/mpp_data.F90 +shared/mpp/mpp_domains.F90 +shared/mpp/mpp.F90 +shared/mpp/mpp_io.F90 +shared/mpp/mpp_memutils.F90 +shared/mpp/mpp_parameter.F90 +shared/mpp/mpp_pset.F90 +shared/mpp/mpp_utilities.F90 +shared/mpp/nsclock.c +shared/mpp/test_mpp_domains.F90 +shared/mpp/test_mpp.F90 +shared/mpp/test_mpp_io.F90 +shared/mpp/test_mpp_pset.F90 +shared/mpp/threadloc.c +shared/platform/platform.F90 +shared/random_numbers/MersenneTwister.F90 +shared/random_numbers/random_numbers.F90 +shared/sat_vapor_pres/sat_vapor_pres.F90 +shared/sat_vapor_pres/sat_vapor_pres_k.F90 +shared/time_interp/time_interp_external.F90 +shared/time_interp/time_interp.F90 +shared/time_manager/get_cal_time.F90 +shared/time_manager/time_manager.F90 +shared/topography/gaussian_topog.F90 +shared/topography/topography.F90 +shared/tracer_manager/tracer_manager.F90 +shared/tridiagonal/tridiagonal.F90 diff --git a/src/extra/model/dry/path_names b/src/extra/model/dry/path_names index 6ba7695f8..6a974f397 100644 --- a/src/extra/model/dry/path_names +++ b/src/extra/model/dry/path_names @@ -9,6 +9,11 @@ atmos_param/betts_miller/betts_miller.f90 atmos_param/sea_esf_rad/null/rad_utilities.F90 atmos_param/shallow_conv/shallow_conv.F90 atmos_param/cloud_simple/cloud_simple.F90 +atmos_param/cloud_simple/lcl.F90 +atmos_param/cloud_simple/large_scale_cloud.F90 +atmos_param/cloud_simple/marine_strat_cloud.F90 +atmos_param/cloud_simple/cloud_cover_diags.F90 +atmos_param/cloud_simple/cloud_spookie.F90 atmos_param/stable_bl_turb/stable_bl_turb.F90 atmos_param/strat_cloud/null/strat_cloud.F90 atmos_param/two_stream_gray_rad/two_stream_gray_rad.F90 diff --git a/src/extra/model/grey/path_names b/src/extra/model/grey/path_names index 51c284f52..1bdea444c 100644 --- a/src/extra/model/grey/path_names +++ b/src/extra/model/grey/path_names @@ -11,6 +11,11 @@ atmos_param/shallow_conv/shallow_conv.F90 atmos_param/stable_bl_turb/stable_bl_turb.F90 atmos_param/strat_cloud/null/strat_cloud.F90 atmos_param/cloud_simple/cloud_simple.F90 +atmos_param/cloud_simple/lcl.F90 +atmos_param/cloud_simple/large_scale_cloud.F90 +atmos_param/cloud_simple/marine_strat_cloud.F90 +atmos_param/cloud_simple/cloud_cover_diags.F90 +atmos_param/cloud_simple/cloud_spookie.F90 atmos_param/two_stream_gray_rad/two_stream_gray_rad.F90 atmos_param/qflux/qflux.f90 atmos_param/monin_obukhov/monin_obukhov_interfaces.h diff --git a/src/extra/model/isca/path_names b/src/extra/model/isca/path_names index eebdfd2b0..4b08c4edb 100644 --- a/src/extra/model/isca/path_names +++ b/src/extra/model/isca/path_names @@ -12,6 +12,11 @@ atmos_param/shallow_conv/shallow_conv.F90 atmos_param/stable_bl_turb/stable_bl_turb.F90 atmos_param/strat_cloud/null/strat_cloud.F90 atmos_param/cloud_simple/cloud_simple.F90 +atmos_param/cloud_simple/lcl.F90 +atmos_param/cloud_simple/large_scale_cloud.F90 +atmos_param/cloud_simple/marine_strat_cloud.F90 +atmos_param/cloud_simple/cloud_cover_diags.F90 +atmos_param/cloud_simple/cloud_spookie.F90 atmos_param/two_stream_gray_rad/two_stream_gray_rad.F90 atmos_param/qflux/qflux.f90 atmos_param/monin_obukhov/monin_obukhov_interfaces.h @@ -44,7 +49,7 @@ atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/rrlw_ref.f90 atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/rrlw_tbl.f90 atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/rrlw_vsn.f90 atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/modules/rrlw_wvn.f90 -atmos_param/rrtm_radiation/rrtm_radiation.f90 +atmos_param/rrtm_radiation/rrtm_radiation.F90 atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/src/mcica_random_numbers.f90 atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/src/rrtmg_lw_cldprop.f90 atmos_param/rrtm_radiation/rrtmg_lw/gcm_model/src/rrtmg_lw_rad.nomcica.f90 diff --git a/src/extra/model/socrates/path_names b/src/extra/model/socrates/path_names index c92ad053f..59dc4cc24 100644 --- a/src/extra/model/socrates/path_names +++ b/src/extra/model/socrates/path_names @@ -12,6 +12,11 @@ atmos_param/shallow_conv/shallow_conv.F90 atmos_param/stable_bl_turb/stable_bl_turb.F90 atmos_param/strat_cloud/null/strat_cloud.F90 atmos_param/cloud_simple/cloud_simple.F90 +atmos_param/cloud_simple/lcl.F90 +atmos_param/cloud_simple/large_scale_cloud.F90 +atmos_param/cloud_simple/marine_strat_cloud.F90 +atmos_param/cloud_simple/cloud_cover_diags.F90 +atmos_param/cloud_simple/cloud_spookie.F90 atmos_param/two_stream_gray_rad/two_stream_gray_rad.F90 atmos_param/qflux/qflux.f90 atmos_param/monin_obukhov/monin_obukhov_interfaces.h diff --git a/src/extra/model/socrates_column/field_table b/src/extra/model/socrates_column/field_table new file mode 100644 index 000000000..c2d63b9dd --- /dev/null +++ b/src/extra/model/socrates_column/field_table @@ -0,0 +1,10 @@ + +"TRACER", "atmos_mod", "sphum" + "longname", "specific humidity" + "units", "kg/kg" + "numerical_representation", "grid" + "hole_filling", "off" + "advect_vert", "finite_volume_parabolic" + "robert_filter", "on" + "profile_type", "fixed", "surface_value=0.0" / + diff --git a/src/extra/model/socrates_column/path_names b/src/extra/model/socrates_column/path_names new file mode 100644 index 000000000..92c7dbe95 --- /dev/null +++ b/src/extra/model/socrates_column/path_names @@ -0,0 +1,584 @@ +atmos_column/column.F90 +atmos_column/column_init_cond.F90 +atmos_column/column_grid.F90 +atmos_column/column_initialize_fields.F90 +atmos_param/diffusivity/diffusivity.F90 +atmos_param/edt/edt.F90 +atmos_param/entrain/entrain.F90 +atmos_param/hs_forcing/hs_forcing.F90 +atmos_param/lscale_cond/lscale_cond.F90 +atmos_param/my25_turb/my25_turb.F90 +atmos_param/qe_moist_convection/qe_moist_convection.F90 +atmos_param/betts_miller/betts_miller.f90 +atmos_param/ras/ras.f90 +atmos_param/sea_esf_rad/null/rad_utilities.F90 +atmos_param/shallow_conv/shallow_conv.F90 +atmos_param/stable_bl_turb/stable_bl_turb.F90 +atmos_param/strat_cloud/null/strat_cloud.F90 +atmos_param/cloud_simple/cloud_simple.F90 +atmos_param/cloud_simple/lcl.F90 +atmos_param/cloud_simple/large_scale_cloud.F90 +atmos_param/cloud_simple/marine_strat_cloud.F90 +atmos_param/cloud_simple/cloud_cover_diags.F90 +atmos_param/cloud_simple/cloud_spookie.F90 +atmos_param/two_stream_gray_rad/two_stream_gray_rad.F90 +atmos_param/qflux/qflux.f90 +atmos_param/monin_obukhov/monin_obukhov_interfaces.h +atmos_param/monin_obukhov/monin_obukhov_kernel.F90 +atmos_param/monin_obukhov/monin_obukhov.F90 +atmos_param/dry_convection/dry_convection.f90 +atmos_param/rayleigh_bottom_drag/rayleigh_bottom_drag.F90 +atmos_param/damping_driver/damping_driver.f90 +atmos_param/mg_drag/mg_drag.f90 +atmos_param/cg_drag/cg_drag.f90 +atmos_param/topo_drag/topo_drag.f90 +atmos_param/vert_diff/vert_diff.F90 +atmos_param/vert_turb_driver/vert_turb_driver.F90 +atmos_shared/interpolator/interpolator.F90 +atmos_shared/vert_advection/vert_advection.F90 +atmos_solo/atmos_model.F90 +atmos_spectral/driver/solo/atmosphere.F90 +atmos_spectral/driver/solo/idealized_moist_phys.F90 +atmos_spectral/driver/solo/mixed_layer.F90 +atmos_spectral/init/vert_coordinate.F90 +atmos_spectral/model/press_and_geopot.F90 +atmos_spectral/model/tracer_type.F90 +atmos_spectral/tools/spec_mpp.F90 +coupler/surface_flux.F90 +shared/axis_utils/axis_utils.F90 +shared/constants/constants.F90 +shared/astronomy/astronomy.f90 +shared/diag_manager/diag_axis.F90 +shared/diag_manager/diag_data.F90 +shared/diag_manager/diag_grid.F90 +shared/diag_manager/diag_manager.F90 +shared/diag_manager/diag_output.F90 +shared/diag_manager/diag_table.F90 +shared/diag_manager/diag_util.F90 +shared/fft/fft99.F90 +shared/fft/fft.F90 +shared/field_manager/field_manager.F90 +shared/field_manager/fm_util.F90 +shared/field_manager/parse.inc +shared/fms/fms.F90 +shared/fms/fms_io.F90 +shared/fms/read_data_2d.inc +shared/fms/read_data_3d.inc +shared/fms/read_data_4d.inc +shared/fms/test_fms_io.F90 +shared/fms/write_data.inc +shared/horiz_interp/horiz_interp_bicubic.F90 +shared/horiz_interp/horiz_interp_bilinear.F90 +shared/horiz_interp/horiz_interp_conserve.F90 +shared/horiz_interp/horiz_interp.F90 +shared/horiz_interp/horiz_interp_spherical.F90 +shared/horiz_interp/horiz_interp_type.F90 +shared/include/fms_platform.h +shared/memutils/memuse.c +shared/memutils/memutils.F90 +shared/mosaic/constant.h +shared/mosaic/create_xgrid.c +shared/mosaic/create_xgrid.h +shared/mosaic/gradient_c2l.c +shared/mosaic/gradient_c2l.h +shared/mosaic/gradient.F90 +shared/mosaic/grid.F90 +shared/mosaic/interp.c +shared/mosaic/interp.h +shared/mosaic/mosaic.F90 +shared/mosaic/mosaic_util.c +shared/mosaic/mosaic_util.h +shared/mosaic/read_mosaic.c +shared/mosaic/read_mosaic.h +shared/mpp/affinity.c +shared/mpp/include/mpp_chksum.h +shared/mpp/include/mpp_chksum_int.h +shared/mpp/include/mpp_chksum_scalar.h +shared/mpp/include/mpp_comm.inc +shared/mpp/include/mpp_comm_mpi.inc +shared/mpp/include/mpp_comm_nocomm.inc +shared/mpp/include/mpp_comm_sma.inc +shared/mpp/include/mpp_data_mpi.inc +shared/mpp/include/mpp_data_nocomm.inc +shared/mpp/include/mpp_data_sma.inc +shared/mpp/include/mpp_define_nest_domains.inc +shared/mpp/include/mpp_do_check.h +shared/mpp/include/mpp_do_checkV.h +shared/mpp/include/mpp_do_get_boundary.h +shared/mpp/include/mpp_do_global_field.h +shared/mpp/include/mpp_domains_comm.inc +shared/mpp/include/mpp_domains_define.inc +shared/mpp/include/mpp_domains_misc.inc +shared/mpp/include/mpp_domains_reduce.inc +shared/mpp/include/mpp_domains_util.inc +shared/mpp/include/mpp_do_redistribute.h +shared/mpp/include/mpp_do_update_ad.h +shared/mpp/include/mpp_do_update.h +shared/mpp/include/mpp_do_update_nest.h +shared/mpp/include/mpp_do_update_nonblock.h +shared/mpp/include/mpp_do_updateV_ad.h +shared/mpp/include/mpp_do_updateV.h +shared/mpp/include/mpp_do_updateV_nonblock.h +shared/mpp/include/mpp_error_a_a.h +shared/mpp/include/mpp_error_a_s.h +shared/mpp/include/mpp_error_s_a.h +shared/mpp/include/mpp_error_s_s.h +shared/mpp/include/mpp_gather.h +shared/mpp/include/mpp_get_boundary.h +shared/mpp/include/mpp_global_field.h +shared/mpp/include/mpp_global_reduce.h +shared/mpp/include/mpp_global_sum_ad.h +shared/mpp/include/mpp_global_sum.h +shared/mpp/include/mpp_global_sum_tl.h +shared/mpp/include/mpp_io_connect.inc +shared/mpp/include/mpp_io_misc.inc +shared/mpp/include/mpp_io_read.inc +shared/mpp/include/mpp_io_util.inc +shared/mpp/include/mpp_io_write.inc +shared/mpp/include/mpp_read_2Ddecomp.h +shared/mpp/include/mpp_reduce_mpi.h +shared/mpp/include/mpp_reduce_nocomm.h +shared/mpp/include/mpp_reduce_sma.h +shared/mpp/include/mpp_sum.inc +shared/mpp/include/mpp_sum_mpi.h +shared/mpp/include/mpp_sum_nocomm.h +shared/mpp/include/mpp_sum_sma.h +shared/mpp/include/mpp_transmit.inc +shared/mpp/include/mpp_transmit_mpi.h +shared/mpp/include/mpp_transmit_nocomm.h +shared/mpp/include/mpp_transmit_sma.h +shared/mpp/include/mpp_update_domains2D_ad.h +shared/mpp/include/mpp_update_domains2D.h +shared/mpp/include/mpp_update_domains2D_nonblock.h +shared/mpp/include/mpp_update_nest_domains.h +shared/mpp/include/mpp_util.inc +shared/mpp/include/mpp_util_mpi.inc +shared/mpp/include/mpp_util_nocomm.inc +shared/mpp/include/mpp_util_sma.inc +shared/mpp/include/mpp_write_2Ddecomp.h +shared/mpp/include/mpp_write.h +shared/mpp/include/system_clock.h +shared/mpp/mpp_data.F90 +shared/mpp/mpp_domains.F90 +shared/mpp/mpp.F90 +shared/mpp/mpp_io.F90 +shared/mpp/mpp_memutils.F90 +shared/mpp/mpp_parameter.F90 +shared/mpp/mpp_pset.F90 +shared/mpp/mpp_utilities.F90 +shared/mpp/nsclock.c +shared/mpp/test_mpp_domains.F90 +shared/mpp/test_mpp.F90 +shared/mpp/test_mpp_io.F90 +shared/mpp/test_mpp_pset.F90 +shared/mpp/threadloc.c +shared/platform/platform.F90 +shared/random_numbers/MersenneTwister.F90 +shared/random_numbers/random_numbers.F90 +shared/sat_vapor_pres/sat_vapor_pres.F90 +shared/sat_vapor_pres/sat_vapor_pres_k.F90 +shared/time_interp/time_interp_external.F90 +shared/time_interp/time_interp.F90 +shared/time_manager/get_cal_time.F90 +shared/time_manager/time_manager.F90 +shared/topography/gaussian_topog.F90 +shared/topography/topography.F90 +shared/tracer_manager/tracer_manager.F90 +shared/tridiagonal/tridiagonal.F90 +atmos_param/socrates/src/trunk/src/aux/cdf_struc.finc +atmos_param/socrates/src/trunk/src/aux/cdl_struc.finc +atmos_param/socrates/src/trunk/src/aux/dec_disort.finc +atmos_param/socrates/src/trunk/src/aux/call_disort.finc +atmos_param/socrates/src/trunk/src/general/batch_error_main.finc +atmos_param/socrates/src/trunk/src/general/aerosol_component.finc +atmos_param/socrates/src/trunk/src/radiance_core/gauss_angle.F90 +atmos_param/socrates/src/trunk/src/radiance_core/solver_mix_direct.F90 +atmos_param/socrates/src/trunk/src/radiance_core/set_dirn_weights.F90 +atmos_param/socrates/src/trunk/src/radiance_core/calc_brdf.F90 +atmos_param/socrates/src/trunk/src/radiance_core/triple_solar_source.F90 +atmos_param/socrates/src/trunk/src/radiance_core/eval_uplm.F90 +atmos_param/socrates/src/trunk/src/radiance_core/shell_sort.F90 +atmos_param/socrates/src/trunk/src/radiance_core/rad_pcf.F90 +atmos_param/socrates/src/trunk/src/radiance_core/check_phf_term.F90 +atmos_param/socrates/src/trunk/src/radiance_core/set_n_source_coeff.F90 +atmos_param/socrates/src/trunk/src/radiance_core/calc_surf_rad.F90 +atmos_param/socrates/src/trunk/src/radiance_core/solve_band_random_overlap.F90 +atmos_param/socrates/src/trunk/src/radiance_core/scale_absorb.F90 +atmos_param/socrates/src/trunk/src/radiance_core/calculate_density.F90 +atmos_param/socrates/src/trunk/src/radiance_core/calc_flux_ipa.F90 +atmos_param/socrates/src/trunk/src/radiance_core/opt_prop_ice_cloud.F90 +atmos_param/socrates/src/trunk/src/radiance_core/diff_planck_source_tbl.F90 +atmos_param/socrates/src/trunk/src/radiance_core/eig_sys.F90 +atmos_param/socrates/src/trunk/src/radiance_core/adjust_ir_radiance.F90 +atmos_param/socrates/src/trunk/src/radiance_core/set_rad_layer.F90 +atmos_param/socrates/src/trunk/src/radiance_core/def_dimen.F90 +atmos_param/socrates/src/trunk/src/radiance_core/mcica_column.F90 +atmos_param/socrates/src/trunk/src/radiance_core/interp1d.F90 +atmos_param/socrates/src/trunk/src/radiance_core/calc_uplm_zero.F90 +atmos_param/socrates/src/trunk/src/radiance_core/spline_fit.F90 +atmos_param/socrates/src/trunk/src/radiance_core/gaussian_weight_pcf.F90 +atmos_param/socrates/src/trunk/src/radiance_core/gas_list_pcf.F90 +atmos_param/socrates/src/trunk/src/radiance_core/trans_source_coeff.F90 +atmos_param/socrates/src/trunk/src/radiance_core/band_solver.F90 +atmos_param/socrates/src/trunk/src/radiance_core/mcica_sample.F90 +atmos_param/socrates/src/trunk/src/radiance_core/solver_mix_direct_hogan.F90 +atmos_param/socrates/src/trunk/src/radiance_core/calc_uplm_sol.F90 +atmos_param/socrates/src/trunk/src/radiance_core/sph_matrix_solver.F90 +atmos_param/socrates/src/trunk/src/radiance_core/def_spectrum.F90 +atmos_param/socrates/src/trunk/src/radiance_core/solver_triple_app_scat.F90 +atmos_param/socrates/src/trunk/src/radiance_core/grey_opt_prop.F90 +atmos_param/socrates/src/trunk/src/radiance_core/calc_gauss_weight_90.F90 +atmos_param/socrates/src/trunk/src/radiance_core/sum_k.F90 +atmos_param/socrates/src/trunk/src/radiance_core/ses_rescale_contm.F90 +atmos_param/socrates/src/trunk/src/radiance_core/spline_evaluate.F90 +atmos_param/socrates/src/trunk/src/radiance_core/cg_kappa_ms.F90 +atmos_param/socrates/src/trunk/src/radiance_core/def_bound.F90 +atmos_param/socrates/src/trunk/src/radiance_core/solve_band_random_overlap_resort_rebin.F90 +atmos_param/socrates/src/trunk/src/radiance_core/monochromatic_gas_flux.F90 +atmos_param/socrates/src/trunk/src/radiance_core/set_cloud_pointer.F90 +atmos_param/socrates/src/trunk/src/radiance_core/set_cloud_geometry.F90 +atmos_param/socrates/src/trunk/src/radiance_core/rescale_phase_fnc.F90 +atmos_param/socrates/src/trunk/src/radiance_core/monochromatic_radiance_sph.F90 +atmos_param/socrates/src/trunk/src/radiance_core/inter_k.F90 +atmos_param/socrates/src/trunk/src/radiance_core/solve_band_one_gas.F90 +atmos_param/socrates/src/trunk/src/radiance_core/calc_top_rad.F90 +atmos_param/socrates/src/trunk/src/radiance_core/set_n_cloud_parameter.F90 +atmos_param/socrates/src/trunk/src/radiance_core/set_level_weights.F90 +atmos_param/socrates/src/trunk/src/radiance_core/solve_band_k_eqv_scl.F90 +atmos_param/socrates/src/trunk/src/radiance_core/set_matrix_pentadiagonal.F90 +atmos_param/socrates/src/trunk/src/radiance_core/mix_app_scat.F90 +atmos_param/socrates/src/trunk/src/radiance_core/def_out.F90 +atmos_param/socrates/src/trunk/src/radiance_core/sol_scat_cos.F90 +atmos_param/socrates/src/trunk/src/radiance_core/copy_clr_full.F90 +atmos_param/socrates/src/trunk/src/radiance_core/eigenvalue_tri.F90 +atmos_param/socrates/src/trunk/src/radiance_core/solver_homogen_direct.F90 +atmos_param/socrates/src/trunk/src/radiance_core/rescale_continuum.F90 +atmos_param/socrates/src/trunk/src/radiance_core/mixed_solar_source.F90 +atmos_param/socrates/src/trunk/src/radiance_core/def_aer.F90 +atmos_param/socrates/src/trunk/src/radiance_core/opt_prop_inhom_corr_cairns.F90 +atmos_param/socrates/src/trunk/src/radiance_core/rebin_esft_terms.F90 +atmos_param/socrates/src/trunk/src/radiance_core/mix_column.F90 +atmos_param/socrates/src/trunk/src/radiance_core/prsc_gather_spline.F90 +atmos_param/socrates/src/trunk/src/radiance_core/calc_cg_coeff.F90 +atmos_param/socrates/src/trunk/src/radiance_core/inter_pt_lookup.F90 +atmos_param/socrates/src/trunk/src/radiance_core/opt_prop_ukca_aerosol.F90 +atmos_param/socrates/src/trunk/src/radiance_core/scale_wenyi.F90 +atmos_param/socrates/src/trunk/src/radiance_core/triple_column.F90 +atmos_param/socrates/src/trunk/src/radiance_core/single_scattering_all.F90 +atmos_param/socrates/src/trunk/src/radiance_core/inter_pt.F90 +atmos_param/socrates/src/trunk/src/radiance_core/overlap_coupled.F90 +atmos_param/socrates/src/trunk/src/radiance_core/def_cld.F90 +atmos_param/socrates/src/trunk/src/radiance_core/solar_coefficient_basic.F90 +atmos_param/socrates/src/trunk/src/radiance_core/build_sph_matrix.F90 +atmos_param/socrates/src/trunk/src/radiance_core/solve_band_k_eqv.F90 +atmos_param/socrates/src/trunk/src/radiance_core/augment_tiled_radiance.F90 +atmos_param/socrates/src/trunk/src/radiance_core/column_solver.F90 +atmos_param/socrates/src/trunk/src/radiance_core/augment_radiance.F90 +atmos_param/socrates/src/trunk/src/radiance_core/def_control.F90 +atmos_param/socrates/src/trunk/src/radiance_core/two_coeff_basic.F90 +atmos_param/socrates/src/trunk/src/radiance_core/sph_solver.F90 +atmos_param/socrates/src/trunk/src/radiance_core/solver_no_scat.F90 +atmos_param/socrates/src/trunk/src/radiance_core/copy_clr_sol.F90 +atmos_param/socrates/src/trunk/src/radiance_core/solar_source.F90 +atmos_param/socrates/src/trunk/src/radiance_core/opt_prop_water_cloud.F90 +atmos_param/socrates/src/trunk/src/radiance_core/legendre_weight.F90 +atmos_param/socrates/src/trunk/src/radiance_core/solve_band_without_gas.F90 +atmos_param/socrates/src/trunk/src/radiance_core/diff_albedo_basis.F90 +atmos_param/socrates/src/trunk/src/radiance_core/increment_rad_cf.F90 +atmos_param/socrates/src/trunk/src/radiance_core/single_scat_sol.F90 +atmos_param/socrates/src/trunk/src/radiance_core/opt_prop_aerosol.F90 +atmos_param/socrates/src/trunk/src/radiance_core/solve_band_ses.F90 +atmos_param/socrates/src/trunk/src/radiance_core/def_ss_prop.F90 +atmos_param/socrates/src/trunk/src/radiance_core/prsc_opt_prop.F90 +atmos_param/socrates/src/trunk/src/radiance_core/layer_part_integ.F90 +atmos_param/socrates/src/trunk/src/radiance_core/two_coeff_fast_lw.F90 +atmos_param/socrates/src/trunk/src/radiance_core/gas_optical_properties.F90 +atmos_param/socrates/src/trunk/src/radiance_core/single_scattering.F90 +atmos_param/socrates/src/trunk/src/radiance_core/monochromatic_ir_radiance.F90 +atmos_param/socrates/src/trunk/src/radiance_core/hemi_sph_integ.F90 +atmos_param/socrates/src/trunk/src/radiance_core/two_coeff_cloud.F90 +atmos_param/socrates/src/trunk/src/radiance_core/read_spectrum.F90 +atmos_param/socrates/src/trunk/src/radiance_core/inter_t_lookup.F90 +atmos_param/socrates/src/trunk/src/radiance_core/solver_triple.F90 +atmos_param/socrates/src/trunk/src/radiance_core/two_stream.F90 +atmos_param/socrates/src/trunk/src/radiance_core/solver_triple_hogan.F90 +atmos_param/socrates/src/trunk/src/radiance_core/monochromatic_radiance_tseq.F90 +atmos_param/socrates/src/trunk/src/radiance_core/cloud_maxcs_split.F90 +atmos_param/socrates/src/trunk/src/radiance_core/def_atm.F90 +atmos_param/socrates/src/trunk/src/radiance_core/two_coeff.F90 +atmos_param/socrates/src/trunk/src/radiance_core/two_coeff_region.F90 +atmos_param/socrates/src/trunk/src/radiance_core/quicksort.F90 +atmos_param/socrates/src/trunk/src/radiance_core/rescale_tau_omega.F90 +atmos_param/socrates/src/trunk/src/radiance_core/calc_radiance_ipa.F90 +atmos_param/socrates/src/trunk/src/radiance_core/two_coeff_region_fast_lw.F90 +atmos_param/socrates/src/trunk/src/radiance_core/diff_planck_source_poly.F90 +atmos_param/socrates/src/trunk/src/radiance_core/set_truncation.F90 +atmos_param/socrates/src/trunk/src/radiance_core/monochromatic_radiance.F90 +atmos_param/socrates/src/trunk/src/radiance_core/aggregate_cloud.F90 +atmos_param/socrates/src/trunk/src/radiance_core/radiance_calc.F90 +atmos_param/socrates/src/trunk/src/radiance_core/ir_source.F90 +atmos_param/socrates/src/trunk/src/scatter/conjugate_gradient_cloud_90.f90 +atmos_param/socrates/src/trunk/src/scatter/method_weight_pcf.f90 +atmos_param/socrates/src/trunk/src/scatter/select_weight_scatter_90.f90 +atmos_param/socrates/src/trunk/src/scatter/measure_particle_pcf.f90 +atmos_param/socrates/src/trunk/src/scatter/prec_integral_tcf.f90 +atmos_param/socrates/src/trunk/src/scatter/def_s_scat_prop.f90 +atmos_param/socrates/src/trunk/src/scatter/db_scatter_integral.f90 +atmos_param/socrates/src/trunk/src/scatter/weightings_90.f90 +atmos_param/socrates/src/trunk/src/scatter/def_db_ss_mono.f90 +atmos_param/socrates/src/trunk/src/scatter/cloud_fitting.f90 +atmos_param/socrates/src/trunk/src/scatter/shape_particle_pcf.f90 +atmos_param/socrates/src/trunk/src/scatter/number_particle_90.f90 +atmos_param/socrates/src/trunk/src/scatter/db_interp_ss_mono.f90 +atmos_param/socrates/src/trunk/src/scatter/db_read_single_wavelength.f90 +atmos_param/socrates/src/trunk/src/scatter/get_refract_index.f90 +atmos_param/socrates/src/trunk/src/scatter/read_scatter_block_90.f90 +atmos_param/socrates/src/trunk/src/scatter/proj_area_particle.f90 +atmos_param/socrates/src/trunk/src/scatter/line_search_cloud_90.f90 +atmos_param/socrates/src/trunk/src/scatter/volume_particle.f90 +atmos_param/socrates/src/trunk/src/scatter/distribution_pcf.f90 +atmos_param/socrates/src/trunk/src/scatter/size_integral_90.f90 +atmos_param/socrates/src/trunk/src/scatter/particle_size_90.f90 +atmos_param/socrates/src/trunk/src/scatter/max_size_acf.f90 +atmos_param/socrates/src/trunk/src/scatter/write_average_90.f90 +atmos_param/socrates/src/trunk/src/scatter/adt_mitchell96.f90 +atmos_param/socrates/src/trunk/src/scatter/get_db_wavelengths.f90 +atmos_param/socrates/src/trunk/src/scatter/decompose_phf_90.f90 +atmos_param/socrates/src/trunk/src/scatter/cloud_fit_parm_acf.f90 +atmos_param/socrates/src/trunk/src/scatter/cloud_fit_90.f90 +atmos_param/socrates/src/trunk/src/scatter/ice_db_read_geometry.f90 +atmos_param/socrates/src/trunk/src/scatter/def_sct_db.f90 +atmos_param/socrates/src/trunk/src/scatter/open_average_90.f90 +atmos_param/socrates/src/trunk/src/scatter/def_size_dist.f90 +atmos_param/socrates/src/trunk/src/scatter/parm_integ_acf.f90 +atmos_param/socrates/src/trunk/src/scatter/bna_factor_ccf.f90 +atmos_param/socrates/src/trunk/src/scatter/def_db_crystal_geometry.f90 +atmos_param/socrates/src/trunk/src/scatter/get_wavelengths.f90 +atmos_param/socrates/src/trunk/src/scatter/weightings_single_90.f90 +atmos_param/socrates/src/trunk/src/scatter/scatter_algorithm_pcf.f90 +atmos_param/socrates/src/trunk/src/scatter/db_type_ucf.f90 +atmos_param/socrates/src/trunk/src/scatter/scatter_integral_90.f90 +atmos_param/socrates/src/trunk/src/correlated_k/voigt_profile.f90 +atmos_param/socrates/src/trunk/src/correlated_k/adjust_path.f90 +atmos_param/socrates/src/trunk/src/correlated_k/func_scale_90.f90 +atmos_param/socrates/src/trunk/src/correlated_k/read_pt_line_90.f90 +atmos_param/socrates/src/trunk/src/correlated_k/set_condition_ck_90.f90 +atmos_param/socrates/src/trunk/src/correlated_k/caviar_continuum_v1_0.f90 +atmos_param/socrates/src/trunk/src/correlated_k/rad_weight_90.f90 +atmos_param/socrates/src/trunk/src/correlated_k/select_weight_ck_90.f90 +atmos_param/socrates/src/trunk/src/correlated_k/trans_k_dist.f90 +atmos_param/socrates/src/trunk/src/correlated_k/type_residual_pcf.f90 +atmos_param/socrates/src/trunk/src/correlated_k/map_shell.f90 +atmos_param/socrates/src/trunk/src/correlated_k/terminate_scale_90.f90 +atmos_param/socrates/src/trunk/src/correlated_k/ckd_continuum_v2_4.f90 +atmos_param/socrates/src/trunk/src/correlated_k/write_fit_90.f90 +atmos_param/socrates/src/trunk/src/correlated_k/ck_parm_acf.f90 +atmos_param/socrates/src/trunk/src/correlated_k/fit_parabola_90.f90 +atmos_param/socrates/src/trunk/src/correlated_k/func_scale_derivative_90.f90 +atmos_param/socrates/src/trunk/src/correlated_k/optimal_k.f90 +atmos_param/socrates/src/trunk/src/correlated_k/open_file_out_90.f90 +atmos_param/socrates/src/trunk/src/correlated_k/residual_gradient_90.f90 +atmos_param/socrates/src/trunk/src/correlated_k/scale_ck_fit_90.f90 +atmos_param/socrates/src/trunk/src/correlated_k/read_ref_pt_90.f90 +atmos_param/socrates/src/trunk/src/correlated_k/corr_k_single.f90 +atmos_param/socrates/src/trunk/src/correlated_k/planck_90.f90 +atmos_param/socrates/src/trunk/src/correlated_k/exponent_fit_90.f90 +atmos_param/socrates/src/trunk/src/correlated_k/conjugate_gradient_90.f90 +atmos_param/socrates/src/trunk/src/correlated_k/line_prof_corr_mod.f90 +atmos_param/socrates/src/trunk/src/correlated_k/set_extern_ckd_frn_data.f90 +atmos_param/socrates/src/trunk/src/correlated_k/set_g_point_90.f90 +atmos_param/socrates/src/trunk/src/correlated_k/bi_interp.f90 +atmos_param/socrates/src/trunk/src/correlated_k/residual_trans_90.f90 +atmos_param/socrates/src/trunk/src/correlated_k/set_extern_ckd_self_data.f90 +atmos_param/socrates/src/trunk/src/correlated_k/line_search_90.f90 +atmos_param/socrates/src/trunk/src/correlated_k/read_hitran.f90 +atmos_param/socrates/src/trunk/src/correlated_k/read_nc.f90 +atmos_param/socrates/src/trunk/src/correlated_k/ckd_extern_data.f90 +atmos_param/socrates/src/trunk/src/correlated_k/def_hitran_record.f90 +atmos_param/socrates/src/trunk/src/correlated_k/d_planck_90.f90 +atmos_param/socrates/src/trunk/src/correlated_k/scale_parameters_acf.f90 +atmos_param/socrates/src/trunk/src/correlated_k/offset_residual_trans_acf.f90 +atmos_param/socrates/src/trunk/src/correlated_k/hitran_cnst.f90 +atmos_param/socrates/src/trunk/src/correlated_k/ck_fit_pcf.f90 +atmos_param/socrates/src/trunk/src/aux/qsat_wat.F90 +atmos_param/socrates/src/trunk/src/aux/qsat_gill.F90 +atmos_param/socrates/src/trunk/src/aux/write_cdf.f90 +atmos_param/socrates/src/trunk/src/aux/read_cdf.f90 +atmos_param/socrates/src/trunk/src/aux/aerosol_representation_pcf.f90 +atmos_param/socrates/src/trunk/src/aux/aerosol_profile_pcf.f90 +atmos_param/socrates/src/trunk/src/aux/write_samson.f90 +atmos_param/socrates/src/trunk/src/aux/filter_function.f90 +atmos_param/socrates/src/trunk/src/aux/qsat_alg_pcf.f90 +atmos_param/socrates/src/trunk/src/aux/method_merge_pcf.f90 +atmos_param/socrates/src/trunk/src/aux/rand_gauss.f90 +atmos_param/socrates/src/trunk/src/general/make_block_2_1.f90 +atmos_param/socrates/src/trunk/src/general/make_block_11.f90 +atmos_param/socrates/src/trunk/src/general/make_block_12.f90 +atmos_param/socrates/src/trunk/src/general/sum_unity.f90 +atmos_param/socrates/src/trunk/src/general/trapezoid_90.f90 +atmos_param/socrates/src/trunk/src/general/get_free_unit.F90 +atmos_param/socrates/src/trunk/src/general/rayleigh_scatter.f90 +atmos_param/socrates/src/trunk/src/general/make_block_18.f90 +atmos_param/socrates/src/trunk/src/general/remove_negative_gas_90.f90 +atmos_param/socrates/src/trunk/src/general/make_block_17.f90 +atmos_param/socrates/src/trunk/src/general/make_block_1.f90 +atmos_param/socrates/src/trunk/src/general/solar_intensity_90.f90 +atmos_param/socrates/src/trunk/src/general/make_block_19.f90 +atmos_param/socrates/src/trunk/src/general/make_block_0.f90 +atmos_param/socrates/src/trunk/src/general/make_block_10.f90 +atmos_param/socrates/src/trunk/src/general/make_block_14.f90 +atmos_param/socrates/src/trunk/src/general/read_solar_spectrum.f90 +atmos_param/socrates/src/trunk/src/general/remove_negative_cont_90.f90 +atmos_param/socrates/src/trunk/src/general/make_block_3_1.f90 +atmos_param/socrates/src/trunk/src/general/set_interactive.f90 +atmos_param/socrates/src/trunk/src/general/make_block_8.f90 +atmos_param/socrates/src/trunk/src/general/make_block_3.f90 +atmos_param/socrates/src/trunk/src/general/make_block_15.f90 +atmos_param/socrates/src/trunk/src/general/make_block_9.f90 +atmos_param/socrates/src/trunk/src/general/read_instrument_response_90.f90 +atmos_param/socrates/src/trunk/src/general/make_block_4.f90 +atmos_param/socrates/src/trunk/src/general/map_heap_func.f90 +atmos_param/socrates/src/trunk/src/general/make_block_6.f90 +atmos_param/socrates/src/trunk/src/general/out_spectrum.f90 +atmos_param/socrates/src/trunk/src/general/make_block_2.f90 +atmos_param/socrates/src/trunk/src/general/rayleigh_jeans_tail.f90 +atmos_param/socrates/src/trunk/src/general/solar_intensity.f90 +atmos_param/socrates/src/trunk/src/general/make_block_5.f90 +atmos_param/socrates/src/trunk/src/general/rayleigh_scatter_h2he.f90 +atmos_param/socrates/src/trunk/src/modules_gen/dimensions_field_cdf_ucf.f90 +atmos_param/socrates/src/trunk/src/modules_gen/def_refract.f90 +atmos_param/socrates/src/trunk/src/modules_gen/scatter_pp_pcf.f90 +atmos_param/socrates/src/trunk/src/modules_gen/def_std_io_icf.f90 +atmos_param/socrates/src/trunk/src/modules_gen/dimensions_cdl_ucf.f90 +atmos_param/socrates/src/trunk/src/modules_gen/refract_re_ccf.f90 +atmos_param/socrates/src/trunk/src/modules_gen/def_inst_flt.f90 +atmos_param/socrates/src/trunk/src/modules_gen/dimensions_pp_ucf.f90 +atmos_param/socrates/src/trunk/src/modules_gen/weighting_pcf.f90 +atmos_param/socrates/src/trunk/src/modules_gen/error_pcf.f90 +atmos_param/socrates/src/trunk/src/modules_gen/file_type_pcf.f90 +atmos_param/socrates/src/trunk/src/modules_gen/def_data_in_icf.f90 +atmos_param/socrates/src/trunk/src/modules_gen/dimensions_cdf_ucf.f90 +atmos_param/socrates/src/trunk/src/modules_gen/unit_list_pcf.f90 +atmos_param/socrates/src/trunk/src/modules_gen/realtypefx_rd.f90 +atmos_param/socrates/src/trunk/src/modules_gen/def_solarspec.f90 +atmos_param/socrates/src/trunk/src/modules_gen/interp_mode_pcf.f90 +atmos_param/socrates/src/trunk/src/modules_gen/dimensions_fixed_pcf.f90 +atmos_param/socrates/src/trunk/src/modules_gen/dimensions_field_ucf.f90 +atmos_param/socrates/src/trunk/src/modules_gen/input_head_pcf.f90 +atmos_param/socrates/src/trunk/src/radiation_control/close_cloud_gen.F90 +atmos_param/socrates/src/trunk/src/radiation_control/mcica_order.F90 +atmos_param/socrates/src/trunk/src/radiation_control/rand_no_mcica.F90 +atmos_param/socrates/src/trunk/src/radiation_control/set_moist_aerosol_properties.F90 +atmos_param/socrates/src/trunk/src/radiation_control/mcica_mod.F90 +atmos_param/socrates/src/trunk/src/radiation_control/cld_generator_mod.F90 +atmos_param/socrates/src/trunk/src/radiation_control/open_cloud_gen.F90 +atmos_param/socrates/src/trunk/src/um/out_nml.f90 +atmos_param/socrates/src/trunk/src/um/def_um_nml.f90 +atmos_param/socrates/src/trunk/src/modules_core/errormessagelength_mod.F90 +atmos_param/socrates/src/trunk/src/modules_core/dimensions_spec_ucf.F90 +atmos_param/socrates/src/trunk/src/modules_core/rad_ccf.F90 +atmos_param/socrates/src/trunk/src/modules_core/yomhook.F90 +atmos_param/socrates/src/trunk/src/modules_core/parkind1.F90 +atmos_param/socrates/src/trunk/src/modules_core/file_manager.F90 +atmos_param/socrates/src/trunk/src/modules_core/missing_data_mod.F90 +atmos_param/socrates/src/trunk/src/modules_core/vectlib_mod.F90 +atmos_param/socrates/src/trunk/src/modules_core/ereport_mod.F90 +atmos_param/socrates/src/trunk/src/modules_core/realtype_rd.f90 +atmos_param/socrates/src/trunk/src/modules_core/filenamelength_mod.F90 +atmos_param/socrates/src/trunk/src/scatter/grow_particles.f +atmos_param/socrates/src/trunk/src/scatter/mie_scatter.f +atmos_param/socrates/src/trunk/src/scatter/adt_integral.f +atmos_param/socrates/src/trunk/src/scatter/gamma_fnc.f +atmos_param/socrates/src/trunk/src/scatter/refractive_index.f +atmos_param/socrates/src/trunk/src/aux/output_vert_cdl.f +atmos_param/socrates/src/trunk/src/aux/assign_input_opt_cdf.f +atmos_param/socrates/src/trunk/src/aux/assign_input_ss_cdl.f +atmos_param/socrates/src/trunk/src/aux/split_cdl_line.f +atmos_param/socrates/src/trunk/src/aux/input_cloud_cdf.f +atmos_param/socrates/src/trunk/src/aux/assign_viewing_geom_cdl.f +atmos_param/socrates/src/trunk/src/aux/read_samson_p_field.f +atmos_param/socrates/src/trunk/src/aux/output_opt_profile_cdl.f +atmos_param/socrates/src/trunk/src/aux/input_cloud_cdl.f +atmos_param/socrates/src/trunk/src/aux/output_radiance_cdl.f +atmos_param/socrates/src/trunk/src/aux/fnc_density.f +atmos_param/socrates/src/trunk/src/aux/calc_volume_fraction.f +atmos_param/socrates/src/trunk/src/aux/calc_cdl_stride.f +atmos_param/socrates/src/trunk/src/aux/interp.f +atmos_param/socrates/src/trunk/src/aux/merge_pressure.f +atmos_param/socrates/src/trunk/src/aux/angular_control_cdf.f +atmos_param/socrates/src/trunk/src/aux/extinction_profile.f +atmos_param/socrates/src/trunk/src/aux/read_genln2_flux.f +atmos_param/socrates/src/trunk/src/aux/write_cdl.f +atmos_param/socrates/src/trunk/src/aux/find_var_cdl.f +atmos_param/socrates/src/trunk/src/aux/assign_input_vert_cdf.f +atmos_param/socrates/src/trunk/src/aux/input_aerosol_cdf.f +atmos_param/socrates/src/trunk/src/aux/assign_input_novert_cdl.f +atmos_param/socrates/src/trunk/src/aux/find_dimen_cdl.f +atmos_param/socrates/src/trunk/src/aux/output_flux_cdl.f +atmos_param/socrates/src/trunk/src/aux/assign_input_opt_cdl.f +atmos_param/socrates/src/trunk/src/aux/output_horiz_cdl.f +atmos_param/socrates/src/trunk/src/aux/seaalbedo_driver.f +atmos_param/socrates/src/trunk/src/aux/assign_viewing_geom_cdf.f +atmos_param/socrates/src/trunk/src/aux/angular_control.f +atmos_param/socrates/src/trunk/src/aux/output_vert_cdf.f +atmos_param/socrates/src/trunk/src/aux/output_view_cdl.f +atmos_param/socrates/src/trunk/src/aux/read_raw_profile.f +atmos_param/socrates/src/trunk/src/aux/qsat_gg_ice.f +atmos_param/socrates/src/trunk/src/aux/output_flux_cdf.f +atmos_param/socrates/src/trunk/src/aux/assign_surface_char_cdf.f +atmos_param/socrates/src/trunk/src/aux/name_length.f +atmos_param/socrates/src/trunk/src/aux/sort_raw_profile.f +atmos_param/socrates/src/trunk/src/aux/read_averaged_scatter.f +atmos_param/socrates/src/trunk/src/aux/write_cdl_field.f +atmos_param/socrates/src/trunk/src/aux/planck_ss_source.f +atmos_param/socrates/src/trunk/src/aux/output_photolysis_cdf.f +atmos_param/socrates/src/trunk/src/aux/output_radiance_cdf.f +atmos_param/socrates/src/trunk/src/aux/interpolate_p.f +atmos_param/socrates/src/trunk/src/aux/write_profile.f +atmos_param/socrates/src/trunk/src/aux/assign_surface_char_cdl.f +atmos_param/socrates/src/trunk/src/aux/planck_cumul.f +atmos_param/socrates/src/trunk/src/aux/input_aerosol_cdl.f +atmos_param/socrates/src/trunk/src/aux/assign_input_novert_cdf.f +atmos_param/socrates/src/trunk/src/aux/output_surf_cdl.f +atmos_param/socrates/src/trunk/src/aux/mono_rad_ss.f +atmos_param/socrates/src/trunk/src/aux/assign_horiz_cdl.f +atmos_param/socrates/src/trunk/src/aux/qsat.f +atmos_param/socrates/src/trunk/src/aux/set_state.f +atmos_param/socrates/src/trunk/src/aux/l_find_component.f +atmos_param/socrates/src/trunk/src/aux/qsat_gg.f +atmos_param/socrates/src/trunk/src/aux/read_cdl.f +atmos_param/socrates/src/trunk/src/aux/assign_input_vert_cdl.f +atmos_param/socrates/src/trunk/src/aux/output_photolysis_cdl.f +atmos_param/socrates/src/trunk/src/general/non_blank.f +atmos_param/socrates/src/trunk/src/general/remove_blank.f +atmos_param/socrates/src/trunk/src/general/simpsons_rule.f +atmos_param/socrates/src/trunk/src/general/point_bracket.f +atmos_param/socrates/src/trunk/src/general/trapezoid.f +atmos_param/socrates/src/trunk/src/general/planck.f +atmos_param/socrates/src/trunk/src/general/read_line.f +atmos_param/socrates/src/trunk/src/general/make_block_6_1.f +atmos_param/socrates/src/trunk/src/general/calc_thermal_coeff.f +atmos_param/socrates/src/trunk/src/general/open_file_out.f +atmos_param/socrates/src/trunk/src/general/back_substitute.f +atmos_param/socrates/src/trunk/src/general/open_file_in.f +atmos_param/socrates/src/trunk/src/general/integrate_spline.f +atmos_param/socrates/src/trunk/src/general/rayleigh_scatter_air.f +atmos_param/socrates/src/trunk/src/general/lock_code.f +atmos_param/socrates/src/trunk/src/general/make_block_6_2.f +atmos_param/socrates/src/trunk/src/general/inner_bracket.f +atmos_param/socrates/src/trunk/src/general/svd_decompose.f +atmos_param/socrates/src/trunk/src/general/calc_planck_tbl.f +atmos_param/socrates/src/trunk/src/general/read_word.f +atmos_param/socrates/interface/read_control.F90 +atmos_param/socrates/interface/set_atm.F90 +atmos_param/socrates/interface/set_cld.F90 +atmos_param/socrates/interface/socrates_set_cld.F90 +atmos_param/socrates/interface/set_dimen.F90 +atmos_param/socrates/interface/socrates_config_mod.f90 +atmos_param/socrates/interface/compress_spectrum.F90 +atmos_param/socrates/interface/set_aer.F90 +atmos_param/socrates/interface/set_bound.F90 +atmos_param/socrates/interface/set_control.F90 +atmos_param/socrates/interface/socrates_calc.F90 +atmos_param/socrates/interface/socrates_interface.F90 +atmos_param/socrates/interface/soc_constants.f90 diff --git a/src/extra/python/isca/__init__.py b/src/extra/python/isca/__init__.py index 28da6f612..830b10774 100644 --- a/src/extra/python/isca/__init__.py +++ b/src/extra/python/isca/__init__.py @@ -83,4 +83,4 @@ def emit(self, event, *args, **kwargs): from isca.experiment import Experiment, DiagTable, Namelist, FailedRunError -from isca.codebase import IscaCodeBase, SocratesCodeBase, DryCodeBase, GreyCodeBase, ShallowCodeBase, BarotropicCodeBase +from isca.codebase import IscaCodeBase, SocratesCodeBase, DryCodeBase, GreyCodeBase, ShallowCodeBase, BarotropicCodeBase, ColumnCodeBase, SocColumnCodeBase diff --git a/src/extra/python/isca/codebase.py b/src/extra/python/isca/codebase.py index 0a08a9307..c411ff928 100644 --- a/src/extra/python/isca/codebase.py +++ b/src/extra/python/isca/codebase.py @@ -7,7 +7,7 @@ from isca import GFDL_WORK, GFDL_BASE, GFDL_SOC, _module_directory, get_env_file from .loghandler import Logger -from .helpers import url_to_folder, destructive, useworkdir, mkdir, cd, git, P, git_run_in_directory +from .helpers import url_to_folder, destructive, useworkdir, mkdir, git, P, git_run_in_directory, check_for_sh_stdout import pdb @@ -137,7 +137,7 @@ def is_clean(self): @property def git_commit(self): - return self.git.log('-1', '--format="%H"').stdout.decode('utf8') + return check_for_sh_stdout(self.git.log('-1', '--format="%H"')) # @property # def git_diff(self): @@ -162,11 +162,12 @@ def write_source_control_status(self, outfile): # write out the git commit id of GFDL_BASE file.write("\n\n*---commit hash used for code in GFDL_BASE, including this python module---*:\n") - file.write(gfdl_git.log('-1', '--format="%H"').stdout.decode('utf8')) + gfdl_git_out = check_for_sh_stdout(gfdl_git.log('-1', '--format="%H"')) + file.write(gfdl_git_out) # if there are any uncommited changes in the working directory, # add those to the file too - source_status = self.git.status("-b", "--porcelain").stdout.decode('utf8') + source_status = check_for_sh_stdout(self.git.status("-b", "--porcelain")) # filter the source status for changes in specific files filetypes = ('.f90', '.inc', '.c') source_status = [line for line in source_status.split('\n') @@ -178,7 +179,7 @@ def write_source_control_status(self, outfile): file.write("*---git status output (only f90 and inc files)---*:\n") file.write('\n'.join(source_status)) file.write('\n\n*---git diff output---*\n') - source_diff = self.git.diff('--no-color').stdout.decode('utf8') + source_diff = check_for_sh_stdout(self.git.diff('--no-color')) file.write(source_diff) def read_path_names(self, path_names_file): @@ -347,6 +348,59 @@ def __init__(self, *args, **kwargs): self.disable_rrtm() self.simlink_to_soc_code() +class SocColumnCodeBase(CodeBase): + """Isca without RRTM but with the Met Office radiation scheme, Socrates. THIS VERSION FOR SINGLE COLUMN USE. + """ + #path_names_file = P(_module_directory, 'templates', 'moist_path_names') + name = 'socrates_column' + executable_name = 'soc_column_isca.x' + + def column_model(self): + self.compile_flags.append('-DCOLUMN_MODEL') + self.log.info('USING SINGLE COLUMN MODEL') + + def disable_rrtm(self): + # add no compile flag + self.compile_flags.append('-DRRTM_NO_COMPILE') + self.log.info('RRTM compilation disabled.') + + def simlink_to_soc_code(self): + #Make symlink to socrates source code if one doesn't already exist. + socrates_desired_location = self.codedir+'/src/atmos_param/socrates/src/trunk' + + #First check if socrates is in correct place already + if os.path.exists(socrates_desired_location): + link_correct = os.path.exists(socrates_desired_location+'/src/') + if link_correct: + socrates_code_in_desired_location=True + else: + socrates_code_in_desired_location=False + if os.path.islink(socrates_desired_location): + self.log.info('Socrates source code symlink is in correct place, but is to incorrect location. Trying to correct.') + os.unlink(socrates_desired_location) + else: + self.log.info('Socrates source code is in correct place, but folder structure is wrong. Contents of the folder '+socrates_desired_location+' should include a src folder.') + else: + socrates_code_in_desired_location=False + self.log.info('Socrates source code symlink does not exist. Creating.') + + # If socrates is not in the right place already, then attempt to make symlink to location of code provided by GFDL_SOC + if socrates_code_in_desired_location: + self.log.info('Socrates source code already in correct place. Continuing.') + else: + if GFDL_SOC is not None: + sh.ln('-s', GFDL_SOC, socrates_desired_location) + elif GFDL_SOC is None: + error_mesg = 'Socrates code is required for SocratesCodebase, but source code is not provided in location GFDL_SOC='+ str(GFDL_SOC) + self.log.error(error_mesg) + raise OSError(error_mesg) + + def __init__(self, *args, **kwargs): + super(SocColumnCodeBase, self).__init__(*args, **kwargs) + self.column_model() + self.disable_rrtm() + self.simlink_to_soc_code() + class GreyCodeBase(CodeBase): """The Frierson model. This is the closest to the Frierson model, with moist dynamics and a @@ -375,6 +429,27 @@ def __init__(self, *args, **kwargs): self.disable_rrtm() self.disable_soc() +class ColumnCodeBase(CodeBase): + """This contains code that will allow one to use all model physics in a single column configuration (i.e. without calling the dynamical core) + """ + #path_names_file = P(_module_directory, 'templates', 'moist_path_names') + name = 'column' + executable_name = 'column_isca.x' + + def column_model(self): + self.compile_flags.append('-DCOLUMN_MODEL') + self.log.info('USING SINGLE COLUMN MODEL') + + def disable_soc(self): + # add no compile flag + self.compile_flags.append('-DSOC_NO_COMPILE') + self.log.info('SOCRATES compilations diabled.') + + def __init__(self, *args, **kwargs): + super(ColumnCodeBase, self).__init__(*args, **kwargs) + self.column_model() + self.disable_soc() + class DryCodeBase(GreyCodeBase): """The Held-Suarez model. diff --git a/src/extra/python/isca/experiment.py b/src/extra/python/isca/experiment.py index d176033d5..9495bd178 100755 --- a/src/extra/python/isca/experiment.py +++ b/src/extra/python/isca/experiment.py @@ -47,7 +47,6 @@ class Experiment(Logger, EventEmitter): 'num_fourier': 42, 'num_spherical': 43, }, - 'T21': { 'lon_max': 64, 'lat_max': 32, diff --git a/src/extra/python/isca/helpers.py b/src/extra/python/isca/helpers.py index b1bc089d8..e17ce48e2 100644 --- a/src/extra/python/isca/helpers.py +++ b/src/extra/python/isca/helpers.py @@ -4,7 +4,7 @@ import sh mkdir = sh.mkdir.bake('-p') -cd = sh.cd +# cd = sh.cd git = sh.git.bake('--no-pager') P = os.path.join @@ -66,11 +66,19 @@ def git_run_in_directory(GFDL_BASE_DIR, dir_in): try: codedir_git = git.bake('-C', GFDL_BASE_DIR) - git_test = codedir_git.log('-1', '--format="%H"').stdout + git_test = check_for_sh_stdout(codedir_git.log('-1', '--format="%H"')) baked_git_fn = git.bake('-C', dir_in) except: codedir_git = git.bake('--git-dir='+GFDL_BASE_DIR+'/.git', '--work-tree='+GFDL_BASE_DIR) - git_test = codedir_git.log('-1', '--format="%H"').stdout + git_test = check_for_sh_stdout(codedir_git.log('-1', '--format="%H"')) baked_git_fn = git.bake('--git-dir='+dir_in+'/.git', '--work-tree='+dir_in) - return baked_git_fn \ No newline at end of file + return baked_git_fn + +def check_for_sh_stdout(input_exp): + """Versions of sh>2.* have started returning str types rather than a sh.RunningCommand type. To distinguish these possibilites, this function looks at the output of a sh expression, and asks for stdout and decodes it only if the type is a sh.RunningCommand.""" + + if type(input_exp)==sh.RunningCommand: + input_exp=input_exp.stdout.decode('utf8') + + return input_exp \ No newline at end of file diff --git a/src/extra/python/isca/templates/mkmf.template.maths2 b/src/extra/python/isca/templates/mkmf.template.maths2 new file mode 100755 index 000000000..fa6151185 --- /dev/null +++ b/src/extra/python/isca/templates/mkmf.template.maths2 @@ -0,0 +1,28 @@ +# template for the Intel fortran compiler +# typical use with mkmf +# mkmf -t template.ifc -c"-Duse_libMPI -Duse_netCDF" path_names /usr/local/include +CPPFLAGS = `nc-config --cflags` +NETCDF_LIBS = `nc-config --libs` + +# FFLAGS: +# -fpp: Use the fortran preprocessor +# -stack_temps: Put temporary runtime arrays on the stack, not heap. +# -safe_cray_ptr: Cray pointers don't alias other variables. +# -ftz: Denormal numbers are flushed to zero. +# -assume byterecl: Specifies the units for the OPEN statement as bytes. +# -shared-intel: Load intel libraries dynamically +# -i4: 4 byte integers +# -r8: 8 byte reals +# -g: Generate symbolic debugging info in code +# -O2: Level 2 speed optimisations +# -diag-disable 6843: +# This suppresses the warning: `warning #6843: A dummy argument with an explicit INTENT(OUT) declaration is not given an explicit value.` of which +# there are a lot of instances in the GFDL codebase. +FFLAGS = $(CPPFLAGS) -fpp -stack_temps -safe_cray_ptr -ftz -assume byterecl -shared-intel -i4 -r8 -g -O2 -diag-disable 6843 -mcmodel large +#FFLAGS = $(CPPFLAGS) -fltconsistency -stack_temps -safe_cray_ptr -ftz -shared-intel -assume byterecl -g -O0 -i4 -r8 -check -warn -warn noerrors -debug variable_locations -inline_debug_info -traceback +FC = $(F90) +LD = $(F90) $(NETCDF_LIBS) +#CC = mpicc + +LDFLAGS = -lnetcdff -lnetcdf -lmpi -shared-intel -lhdf5_hl -lhdf5 -lm -lz -lsz -lbz2 -lxml2 -lcurl +CFLAGS = -D__IFC diff --git a/src/extra/python/isca/templates/mkmf.template.ubuntu_conda b/src/extra/python/isca/templates/mkmf.template.ubuntu_conda index a9a74ec92..bd3dd5a83 100755 --- a/src/extra/python/isca/templates/mkmf.template.ubuntu_conda +++ b/src/extra/python/isca/templates/mkmf.template.ubuntu_conda @@ -18,8 +18,8 @@ NC_LIB=`nc-config --flibs` # -O2: Level 2 speed optimisations FFLAGS = $(CPPFLAGS) $(NC_LIB) -cpp -fcray-pointer \ - -O2 -ffree-line-length-none -fno-range-check \ - -fdefault-real-8 -fdefault-double-8 + -O2 -ffree-line-length-none -fno-range-check \ + -fdefault-real-8 -fdefault-double-8 -fallow-invalid-boz -fallow-argument-mismatch FC = $(F90) LD = $(F90) diff --git a/src/extra/python/requirements.txt b/src/extra/python/requirements.txt index e2c9a6499..722b8d75b 100644 --- a/src/extra/python/requirements.txt +++ b/src/extra/python/requirements.txt @@ -1,7 +1,7 @@ sh jinja2 -git+git://github.com/marshallward/f90nml.git#egg=f90nml +f90nml numpy pandas xarray -tqdm \ No newline at end of file +tqdm