source: LMDZ6/trunk/libf/phylmd/ecrad/radsurf_save.F90 @ 4586

Last change on this file since 4586 was 3908, checked in by idelkadi, 3 years ago

Online implementation of the radiative transfer code ECRAD in the LMDZ model.

  • Inclusion of the ecrad directory containing the sources of the ECRAD code
    • interface routine : radiation_scheme.F90
  • Adaptation of compilation scripts :
    • compilation under CPP key CPP_ECRAD
    • compilation with option "-rad ecard" or "-ecard true"
    • The "-rad old/rtm/ecran" build option will need to replace the "-rrtm true" and "-ecrad true" options in the future.
  • Runing LMDZ simulations with ecrad, you need :
    • logical key iflag_rrtm = 2 in physiq.def
    • namelist_ecrad (DefLists?)
    • the directory "data" containing the configuration files is temporarily placed in ../libfphylmd/ecrad/
  • Compilation and execution are tested in the 1D case. The repository under svn would allow to continue the implementation work: tests, verification of the results, ...
File size: 5.4 KB
Line 
1! radsurf_save.f90 - Save surface data to NetCDF files
2!
3! (C) Copyright 2017- ECMWF.
4!
5! This software is licensed under the terms of the Apache Licence Version 2.0
6! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
7!
8! In applying this licence, ECMWF does not waive the privileges and immunities
9! granted to it by virtue of its status as an intergovernmental organisation
10! nor does it submit to any jurisdiction.
11!
12! Author:  Robin Hogan
13! Email:   r.j.hogan@ecmwf.int
14!
15
16module radsurf_save
17
18  public :: save_surface_fluxes
19
20contains
21
22  !------------------------------------------------------------------
23  ! Save fluxes in "surface_flux" to NetCDF file_name
24  subroutine save_surface_fluxes(file_name, config, surface_flux, iverbose)
25
26    use yomhook,                  only : lhook, dr_hook
27
28    use easy_netcdf
29
30    use radiation_io,             only : nulout
31    use radiation_config,         only : config_type, IGasModelMonochromatic
32    use radsurf_flux,             only : surface_flux_type
33
34    character(len=*),        intent(in)  :: file_name
35    type(config_type),       intent(in)  :: config
36    type(surface_flux_type), intent(in)  :: surface_flux
37
38    type(netcdf_file)                    :: out_file
39    integer                              :: ncol
40
41    character(5), parameter :: default_lw_units_str = 'W m-2'
42    character(5)            :: lw_units_str
43
44    integer, optional, intent(in) :: iverbose
45    integer                       :: i_local_verbose
46
47    integer :: nfacet, ntile
48
49    real(jprb) :: hook_handle
50
51    if (lhook) call dr_hook('radsurf_save:save_surface_fluxes',0,hook_handle)
52
53    if (present(iverbose)) then
54      i_local_verbose = iverbose
55    else
56      i_local_verbose = config%iverbose
57    end if
58
59    ncol   = 0
60    ntile  = 0
61    nfacet = 0
62    if (allocated(surface_flux%lw_dn_facet)) then
63      ncol   = size(surface_flux%lw_dn_facet,1)
64      nfacet = size(surface_flux%lw_dn_facet,2)
65      ntile  = size(surface_flux%lw_abs_canopy,2)
66    else if (allocated(surface_flux%sw_dn_facet)) then
67      ncol   = size(surface_flux%sw_dn_facet,1)
68      nfacet = size(surface_flux%sw_dn_facet,2)
69      ntile  = size(surface_flux%sw_abs_canopy,2)
70    end if
71
72    if (ncol == 0) then
73      write(nulout,'(a)') 'Warning: surface-flux structure contains no data to write'
74    else
75
76      if (config%i_gas_model == IGasModelMonochromatic &
77           .and. config%mono_lw_wavelength > 0.0_jprb) then
78        lw_units_str = 'W m-3'
79      else
80        lw_units_str = default_lw_units_str
81      end if
82
83      ! Open the file
84      call out_file%create(trim(file_name), iverbose=i_local_verbose)
85
86      ! Variables stored internally with column varying fastest, but in
87      ! output file column varies most slowly so need to transpose
88      call out_file%transpose_matrices(.true.)
89
90      ! Define dimensions
91      call out_file%define_dimension("column", ncol)
92      if (ntile > 0) then
93        call out_file%define_dimension("tile",  ntile)
94        call out_file%define_dimension("facet", nfacet)
95      end if
96
97      if (allocated(surface_flux%lw_dn_facet)) then
98        call out_file%define_variable("flux_dn_lw_facet", &
99             &  dim2_name="column", dim1_name="facet", units_str=lw_units_str, &
100             &  long_name="Longwave flux into facet of surface")
101        call out_file%define_variable("flux_up_lw_facet", &
102             &  dim2_name="column", dim1_name="facet", units_str=lw_units_str, &
103             &  long_name="Longwave flux out of facet of surface")
104        call out_file%define_variable("absorption_lw_canopy", &
105             &  dim2_name="column", dim1_name="tile", units_str=lw_units_str, &
106             &  long_name="Longwave absorption by tile canopy")
107      end if
108      if (allocated(surface_flux%sw_dn_facet)) then
109        call out_file%define_variable("flux_dn_sw_facet", &
110             &  dim2_name="column", dim1_name="facet", units_str="W m-2", &
111             &  long_name="Shortwave flux into facet of surface")
112        call out_file%define_variable("flux_dn_direct_sw_facet", &
113             &  dim2_name="column", dim1_name="facet", units_str="W m-2", &
114             &  long_name="Shortwave direct flux into facet of surface")
115        call out_file%define_variable("flux_up_sw_facet", &
116             &  dim2_name="column", dim1_name="facet", units_str="W m-2", &
117             &  long_name="Shortwave flux out of facet of surface")
118        call out_file%define_variable("absorption_sw_canopy", &
119             &  dim2_name="column", dim1_name="tile", units_str="W m-2", &
120             &  long_name="Shortwave absorption by tile canopy")
121      end if
122
123      if (allocated(surface_flux%lw_dn_facet)) then
124        call out_file%put("flux_dn_lw_facet", surface_flux%lw_dn_facet)
125        call out_file%put("flux_up_lw_facet", surface_flux%lw_up_facet)
126        call out_file%put("absorption_lw_canopy", surface_flux%lw_abs_canopy)
127      end if
128      if (allocated(surface_flux%sw_dn_facet)) then
129        call out_file%put("flux_dn_sw_facet", surface_flux%sw_dn_facet)
130        call out_file%put("flux_dn_direct_sw_facet", surface_flux%sw_dn_direct_facet)
131        call out_file%put("flux_up_sw_facet", surface_flux%sw_up_facet)
132        call out_file%put("absorption_sw_canopy", surface_flux%sw_abs_canopy)
133      end if
134     
135      ! Close file
136      call out_file%close()
137
138    end if
139    if (lhook) call dr_hook('radsurf_save:save_surface_fluxes',1,hook_handle)
140     
141    end subroutine save_surface_fluxes
142   
143end module radsurf_save
Note: See TracBrowser for help on using the repository browser.