fv_control_tlmadm.F90

Go to the documentation of this file.

!***********************************************************************
!*                   GNU General Public License                        *
!* This file is a part of fvGFS.                                       *
!*                                                                     *
!* fvGFS is free software; you can redistribute it and/or modify it    *
!* and are expected to follow the terms of the GNU General Public      *
!* License as published by the Free Software Foundation; either        *
!* version 2 of the License, or (at your option) any later version.    *
!*                                                                     *
!* fvGFS 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.                            *
!*                                                                     *
!* For the full text of the GNU General Public License,                *
!* write to: Free Software Foundation, Inc.,                           *
!*           675 Mass Ave, Cambridge, MA 02139, USA.                   *
!* or see:   http://www.gnu.org/licenses/gpl.html                      *
!***********************************************************************
!
!----------------
! FV contro panel
!----------------

!Prepare the FV_AtmP derived type that holds the perturbation variables and the 
!coefficients used for advection, remapping and damping in the tangent linear
!and adjoint versions of FV3.

module fv_control_tlmadm_mod

 use fv_arrays_nlm_mod,     only: fv_atmos_type 
 use fv_arrays_tlmadm_mod, only: fv_atmos_pert_type, allocate_fv_atmos_pert_type, deallocate_fv_atmos_pert_type 
 use fms_mod,           only: open_namelist_file, check_nml_error, close_file
 use mpp_mod,           only: stdlog, mpp_pe, mpp_root_pe

 implicit none
 private

 integer, public :: ngrids = 1

!Convenience pointer to AtmP(n)
 logical, pointer :: split_hord 
 integer, pointer :: hord_mt_pert 
 integer, pointer :: hord_vt_pert 
 integer, pointer :: hord_tm_pert 
 integer, pointer :: hord_dp_pert 
 integer, pointer :: hord_tr_pert 
 logical, pointer :: split_kord 
 integer, pointer :: kord_mt_pert 
 integer, pointer :: kord_wz_pert 
 integer, pointer :: kord_tm_pert 
 integer, pointer :: kord_tr_pert 
 logical, pointer :: split_damp 
 logical, pointer :: do_vort_damp_pert 
 integer, pointer :: nord_pert 
 real,    pointer :: dddmp_pert 
 real,    pointer :: d2_bg_pert 
 real,    pointer :: d4_bg_pert
 real,    pointer :: vtdm4_pert 
 real,    pointer :: d2_bg_k1_pert
 real,    pointer :: d2_bg_k2_pert
 real,    pointer :: d2_bg_ks_pert
 logical, pointer :: split_damp_tr 
 integer, pointer :: nord_tr_pert 
 real,    pointer :: trdm2_pert
 integer, pointer :: n_sponge_pert
 logical, pointer :: hord_ks_pert
 integer, pointer :: hord_mt_ks_pert 
 integer, pointer :: hord_vt_ks_pert 
 integer, pointer :: hord_tm_ks_pert 
 integer, pointer :: hord_dp_ks_pert 
 integer, pointer :: hord_tr_ks_pert 
 logical, pointer :: hord_ks_traj 
 integer, pointer :: hord_mt_ks_traj
 integer, pointer :: hord_vt_ks_traj
 integer, pointer :: hord_tm_ks_traj
 integer, pointer :: hord_dp_ks_traj
 integer, pointer :: hord_tr_ks_traj


 public fv_init_pert, fv_end_pert

 contains

!-------------------------------------------------------------------------------

 subroutine fv_init_pert(Atm, AtmP) 

 type(fv_atmos_type), allocatable, intent(inout), target :: atm(:)
 type(fv_atmos_pert_type), allocatable, intent(inout), target :: atmp(:)

 integer :: n, ntilesme

  allocate(atmp(ngrids))

  call run_setup_pert(atmp,atm)

  ntilesme = size(atmp(:)) 

  do n=1,ntilesme

     call allocate_fv_atmos_pert_type( atmp(n), atm(n)%bd%isd, atm(n)%bd%ied, atm(n)%bd%jsd, atm(n)%bd%jed, &
                                                atm(n)%bd%isc, atm(n)%bd%iec, atm(n)%bd%jsc, atm(n)%bd%jec, &
                                                atm(n)%flagstruct%npz,  atm(n)%flagstruct%ncnst )

  enddo

 end subroutine fv_init_pert

!-------------------------------------------------------------------------------

 subroutine fv_end_pert(AtmP)

  type(fv_atmos_pert_type), intent(inout) :: atmp(:)

  integer :: n, ntilesme

  ntilesme = size(atmp(:)) 

  do n=1,ntilesme

   call deallocate_fv_atmos_pert_type(atmp(n))

  enddo

 end subroutine fv_end_pert

!-------------------------------------------------------------------------------

 subroutine setup_pointers_pert(AtmP)

  type(fv_atmos_pert_type), intent(INOUT), target :: AtmP

   !Linearized model pointers
   split_hord        => atmp%flagstruct%split_hord
   hord_mt_pert      => atmp%flagstruct%hord_mt_pert
   hord_vt_pert      => atmp%flagstruct%hord_vt_pert
   hord_tm_pert      => atmp%flagstruct%hord_tm_pert
   hord_dp_pert      => atmp%flagstruct%hord_dp_pert
   hord_tr_pert      => atmp%flagstruct%hord_tr_pert
   split_kord        => atmp%flagstruct%split_kord
   kord_mt_pert      => atmp%flagstruct%kord_mt_pert
   kord_wz_pert      => atmp%flagstruct%kord_wz_pert
   kord_tm_pert      => atmp%flagstruct%kord_tm_pert
   kord_tr_pert      => atmp%flagstruct%kord_tr_pert
   split_damp        => atmp%flagstruct%split_damp
   nord_pert         => atmp%flagstruct%nord_pert
   dddmp_pert        => atmp%flagstruct%dddmp_pert
   d2_bg_pert        => atmp%flagstruct%d2_bg_pert
   d4_bg_pert        => atmp%flagstruct%d4_bg_pert
   do_vort_damp_pert => atmp%flagstruct%do_vort_damp_pert
   d2_bg_k1_pert     => atmp%flagstruct%d2_bg_k1_pert
   d2_bg_k2_pert     => atmp%flagstruct%d2_bg_k2_pert
   d2_bg_ks_pert     => atmp%flagstruct%d2_bg_ks_pert
   vtdm4_pert        => atmp%flagstruct%vtdm4_pert
   split_damp_tr     => atmp%flagstruct%split_damp_tr
   nord_tr_pert      => atmp%flagstruct%nord_tr_pert
   trdm2_pert        => atmp%flagstruct%trdm2_pert
   n_sponge_pert     => atmp%flagstruct%n_sponge_pert
   hord_ks_pert      => atmp%flagstruct%hord_ks_pert
   hord_mt_ks_pert   => atmp%flagstruct%hord_mt_ks_pert
   hord_vt_ks_pert   => atmp%flagstruct%hord_vt_ks_pert
   hord_tm_ks_pert   => atmp%flagstruct%hord_tm_ks_pert
   hord_dp_ks_pert   => atmp%flagstruct%hord_dp_ks_pert
   hord_tr_ks_pert   => atmp%flagstruct%hord_tr_ks_pert
   hord_ks_traj      => atmp%flagstruct%hord_ks_traj 
   hord_mt_ks_traj   => atmp%flagstruct%hord_mt_ks_traj
   hord_vt_ks_traj   => atmp%flagstruct%hord_vt_ks_traj
   hord_tm_ks_traj   => atmp%flagstruct%hord_tm_ks_traj
   hord_dp_ks_traj   => atmp%flagstruct%hord_dp_ks_traj
   hord_tr_ks_traj   => atmp%flagstruct%hord_tr_ks_traj

  end subroutine setup_pointers_pert

!-------------------------------------------------------------------------------

 subroutine run_setup_pert(AtmP,Atm)

  type(fv_atmos_pert_type), intent(inout), target :: AtmP(:)
  type(fv_atmos_type), intent(inout), target :: Atm(:)

  integer :: f_unit, n, ierr, ios, unit
  character(len=80) :: nested_grid_filename
 
  namelist /fv_core_pert_nml/split_hord, hord_mt_pert, hord_vt_pert, hord_tm_pert, hord_dp_pert, hord_tr_pert, &
                             split_kord, kord_mt_pert, kord_wz_pert, kord_tm_pert, kord_tr_pert, split_damp, do_vort_damp_pert, &
                             nord_pert, dddmp_pert, d2_bg_pert, d4_bg_pert, vtdm4_pert, d2_bg_k1_pert, d2_bg_k2_pert, d2_bg_ks_pert, &
                             split_damp_tr, nord_tr_pert, trdm2_pert, &
                             n_sponge_pert, &
                             hord_ks_traj, hord_mt_ks_traj, hord_vt_ks_traj, hord_tm_ks_traj, hord_dp_ks_traj, hord_tr_ks_traj, &
                             hord_ks_pert, hord_mt_ks_pert, hord_vt_ks_pert, hord_tm_ks_pert, hord_dp_ks_pert, hord_tr_ks_pert

  do n=1,size(atmp)

     call setup_pointers_pert(atmp(n))

     if (size(atmp) == 1) then
        f_unit = open_namelist_file('inputpert.nml')
     else if (n == 1) then
        f_unit = open_namelist_file('inputpert.nml')
     else 
        write(nested_grid_filename,'(A10, I2.2, A4)') 'input_nest_pert', n, '.nml'
        f_unit = open_namelist_file(nested_grid_filename)
     endif

     !Read linearized FVCORE namelist
     rewind(f_unit)
     read (f_unit,fv_core_pert_nml,iostat=ios)
     ierr = check_nml_error(ios,'fv_core_pert_nml')

     call close_file(f_unit)

     unit = stdlog()
     write(unit, nml=fv_core_pert_nml)

     !Unless specfied the trajectory uses the coeffs suitable for the perts
     if (.not. atmp(n)%flagstruct%split_damp) then
        atm(n)%flagstruct%nord         = atmp(n)%flagstruct%nord_pert
        atm(n)%flagstruct%dddmp        = atmp(n)%flagstruct%dddmp_pert
        atm(n)%flagstruct%d2_bg        = atmp(n)%flagstruct%d2_bg_pert
        atm(n)%flagstruct%d4_bg        = atmp(n)%flagstruct%d4_bg_pert
        atm(n)%flagstruct%do_vort_damp = atmp(n)%flagstruct%do_vort_damp_pert
        atm(n)%flagstruct%vtdm4        = atmp(n)%flagstruct%vtdm4_pert
        atm(n)%flagstruct%d2_bg_k1     = atmp(n)%flagstruct%d2_bg_k1_pert
        atm(n)%flagstruct%d2_bg_k2     = atmp(n)%flagstruct%d2_bg_k2_pert
     endif

     !Unless specfied the trajectory uses the coeffs suitable for the perts
     if (.not. atmp(n)%flagstruct%split_damp_tr) then
        atm(n)%flagstruct%nord_tr = atmp(n)%flagstruct%nord_tr_pert
        atm(n)%flagstruct%trdm2   = atmp(n)%flagstruct%trdm2_pert
     endif

     !Unless specfied the trajectory uses hord suitable for the perts
     if (.not. atmp(n)%flagstruct%split_hord) then
        atm(n)%flagstruct%hord_mt = atmp(n)%flagstruct%hord_mt_pert
        atm(n)%flagstruct%hord_vt = atmp(n)%flagstruct%hord_vt_pert
        atm(n)%flagstruct%hord_tm = atmp(n)%flagstruct%hord_tm_pert
        atm(n)%flagstruct%hord_dp = atmp(n)%flagstruct%hord_dp_pert
        atm(n)%flagstruct%hord_tr = atmp(n)%flagstruct%hord_tr_pert
     endif

     !Unless specfied the trajectory uses hord suitable for the perts
     if (.not. atmp(n)%flagstruct%split_kord) then
        atm(n)%flagstruct%kord_mt = atmp(n)%flagstruct%kord_mt_pert
        atm(n)%flagstruct%kord_wz = atmp(n)%flagstruct%kord_wz_pert
        atm(n)%flagstruct%kord_tm = atmp(n)%flagstruct%kord_tm_pert
        atm(n)%flagstruct%kord_tr = atmp(n)%flagstruct%kord_tr_pert
     endif

     if (mpp_pe() == mpp_root_pe()) then

        print*, ''
        print*, '|-----------------------------------------------|'
        print*, '| Advection, remapping and damping coefficients |'
        print*, '|-----------------------------------------------|'
        print*, ''
        print*, ' Splitting (off for speed, on for accuracy)'
        print*, '  split_hord = ', split_hord
        print*, '  split_kord = ', split_kord
        print*, '  split_damp = ', split_damp
        print*, '  split_damp_tr = ', split_damp_tr
        print*, ''
        print*, ' Advection of the trajectory'
        print*, '  hord_mt = ', atm(n)%flagstruct%hord_mt
        print*, '  hord_vt = ', atm(n)%flagstruct%hord_vt
        print*, '  hord_tm = ', atm(n)%flagstruct%hord_tm
        print*, '  hord_dp = ', atm(n)%flagstruct%hord_dp
        print*, '  hord_tr = ', atm(n)%flagstruct%hord_tr
        print*, ''
        print*, ' Advection of the perturbations'
        print*, '  hord_mt_pert = ', atmp(n)%flagstruct%hord_mt_pert
        print*, '  hord_vt_pert = ', atmp(n)%flagstruct%hord_vt_pert
        print*, '  hord_tm_pert = ', atmp(n)%flagstruct%hord_tm_pert
        print*, '  hord_dp_pert = ', atmp(n)%flagstruct%hord_dp_pert
        print*, '  hord_tr_pert = ', atmp(n)%flagstruct%hord_tr_pert
        print*, ''
        print*, ' Number of sponge layers for the perturbations'
        print*, '  n_sponge_pert = ', atmp(n)%flagstruct%n_sponge_pert 
        print*, ''
        print*, ' Sponge layer advection of the trajecotry'
        print*, '  hord_ks_traj = '   , atmp(n)%flagstruct%hord_ks_traj
        print*, '  hord_mt_ks_traj = ', atmp(n)%flagstruct%hord_mt_ks_traj
        print*, '  hord_vt_ks_traj = ', atmp(n)%flagstruct%hord_vt_ks_traj
        print*, '  hord_tm_ks_traj = ', atmp(n)%flagstruct%hord_tm_ks_traj
        print*, '  hord_dp_ks_traj = ', atmp(n)%flagstruct%hord_dp_ks_traj
        print*, '  hord_tr_ks_traj = ', atmp(n)%flagstruct%hord_tr_ks_traj
        print*, ' '
        print*, ' Sponge layer advection of the perturbations'
        print*, '  hord_ks_pert = '   , atmp(n)%flagstruct%hord_ks_pert
        print*, '  hord_mt_ks_pert = ', atmp(n)%flagstruct%hord_mt_ks_pert
        print*, '  hord_vt_ks_pert = ', atmp(n)%flagstruct%hord_vt_ks_pert
        print*, '  hord_tm_ks_pert = ', atmp(n)%flagstruct%hord_tm_ks_pert
        print*, '  hord_dp_ks_pert = ', atmp(n)%flagstruct%hord_dp_ks_pert
        print*, '  hord_tr_ks_pert = ', atmp(n)%flagstruct%hord_tr_ks_pert
        print*, ''
        print*, ' Remapping of the trajectory'
        print*, '  kord_mt = ', atm(n)%flagstruct%kord_mt
        print*, '  kord_wz = ', atm(n)%flagstruct%kord_wz
        print*, '  kord_tm = ', atm(n)%flagstruct%kord_tm
        print*, '  kord_tr = ', atm(n)%flagstruct%kord_tr
        print*, ''              
        print*, ' Remapping of the perturbations'
        print*, '  kord_mt_pert = ', atmp(n)%flagstruct%kord_mt_pert
        print*, '  kord_wz_pert = ', atmp(n)%flagstruct%kord_wz_pert
        print*, '  kord_tm_pert = ', atmp(n)%flagstruct%kord_tm_pert
        print*, '  kord_tr_pert = ', atmp(n)%flagstruct%kord_tr_pert
        print*, ''
        print*, ' Dynamics damping, trajectory'
        print*, '  nord         = ', atm(n)%flagstruct%nord
        print*, '  dddmp        = ', atm(n)%flagstruct%dddmp       
        print*, '  d2_bg        = ', atm(n)%flagstruct%d2_bg
        print*, '  d4_bg        = ', atm(n)%flagstruct%d4_bg
        print*, '  do_vort_damp = ', atm(n)%flagstruct%do_vort_damp
        print*, '  vtdm4        = ', atm(n)%flagstruct%vtdm4
        print*, '  d2_bg_k1     = ', atm(n)%flagstruct%d2_bg_k1
        print*, '  d2_bg_k2     = ', atm(n)%flagstruct%d2_bg_k2
   
        print*, ''
        print*, ' Dynamics damping, perturbations'
        print*, '  nord_pert         = ', atmp(n)%flagstruct%nord_pert
        print*, '  dddmp_pert        = ', atmp(n)%flagstruct%dddmp_pert
        print*, '  d2_bg_pert        = ', atmp(n)%flagstruct%d2_bg_pert
        print*, '  d4_bg_pert        = ', atmp(n)%flagstruct%d4_bg_pert
        print*, '  do_vort_damp_pert = ', atmp(n)%flagstruct%do_vort_damp_pert
        print*, '  vtdm4_pert        = ', atmp(n)%flagstruct%vtdm4_pert
        print*, '  d2_bg_k1_pert     = ', atmp(n)%flagstruct%d2_bg_k1_pert
        print*, '  d2_bg_k2_pert     = ', atmp(n)%flagstruct%d2_bg_k2_pert
        print*, '  d2_bg_ks_pert     = ', atmp(n)%flagstruct%d2_bg_ks_pert
        print*, ''
        print*, ' Tracer damping, trajectory'
        print*, '  nord_tr = ', atm(n)%flagstruct%nord_tr
        print*, '  trdm2   = ', atm(n)%flagstruct%trdm2
        print*, ''
        print*, ' Tracer damping, perturbations'
        print*, '  nord_tr_pert = ', atmp(n)%flagstruct%nord_tr_pert
        print*, '  trdm2_pert   = ', atmp(n)%flagstruct%trdm2_pert
        print*, ''
        print*, '|-----------------------------------------------|'
        print*, ''

     endif

   enddo

  end subroutine run_setup_pert
       
end module fv_control_tlmadm_mod