ecearth3/sources/tm5mp/proj/bacchus/dims.F90

!
#define TRACEBACK write (gol,'("in ",a," (",a,", line",i5,")")') rname, __FILE__, __LINE__; call goErr
#define IF_NOTOK_RETURN(action) if (rc/=0) then; TRACEBACK; action; return; end if
#define IF_ERROR_RETURN(action) if (rc> 0) then; TRACEBACK; action; return; end if
!
#include "tm5.inc"
!
!#################################################################

MODULE DIMS

  use GO, only : gol, goPr, goErr
  
  use binas, only : pi
  
  use dims_grid
  use dims_levels
  use global_types

  IMPLICIT NONE
  PUBLIC
  
  private :: pi
    
  ! --- const -------------------------------------

  character(len=*), parameter, private ::  mname = 'module Dims'

  ! --- const --------------------------------------

  character(len=100) :: datadir  = ''

  real,parameter          :: gtor = pi/180.0
  real,parameter          :: one  = 1.0
  real,parameter          :: zero = 0.0
  integer,parameter       :: nlat180 = 180
  integer,parameter       :: nlon360 = 360
  real,dimension(nlat180) :: dxy11      ! surface area in 1x1 

  real,parameter          :: dlat = dy*gtor
  real,parameter          :: dlon = dx*gtor

  ! define the parent child structure:

  integer,dimension(nregions,0:nregions) :: children

  ! children(r,0) = total number of children for region r (zero if childless)
  ! children(r,1) = number of first  child of region r, 
  ! children(r,2) = number of second child of region r, etc.

  ! grid-coordinates of each region with respect its parent 
  ! (will be calculated at start program)

  integer,dimension(1:nregions) :: ibeg,iend,jbeg,jend,lbeg,lend
  integer,dimension(nregions)   :: isr,ier,jsr,jer  ! scope of the region
  ! depends on NPtouch/SPtouch, Xcyc
  ! calculated in determine_children_etc
  ! _________________________________________________________________________
  !
  ! sequence of steps that is used to process the algorithm.
  ! nsplitsteps contans total steps
  ! n_operators the number of different operators
  ! The routine process_region calls the corresponding routines, 
  ! depending on splitorder.
  ! x = x-advection
  ! y = y-advection
  ! z = z-advection
  ! v = vertical mixing SGS
  ! s = sources
  ! c = chemistry....

  integer,parameter                          :: nsplitsteps = 12
  integer,parameter                          :: n_operators = nsplitsteps/2
  character,dimension(nsplitsteps),parameter :: splitorder  = &
       (/'x','y','z','v','s','c','c','s','v','z','y','x'/) 

  ! splitorderzoom contains the fully expanded list of operations 
  ! for the children
  character,dimension(nregions,maxref*nsplitsteps) :: splitorderzoom
  ! status keeps track of the operations per region
  integer,dimension(nregions)                      :: status

  integer,parameter                                :: zoom_mode = 1

  ! _________________________________________________________________________
  ! advection scheme:
#ifdef secmom
  character(5),parameter :: adv_scheme = '2nd_m'
#else
  character(5),parameter :: adv_scheme = 'slope'
#endif

  ! limits the slopes to physical values
  logical                :: limits       = .true.
  logical                :: limits_extra = .true.   ! used in secmom advection
  
  ! numbers of CFL violations and CFL numbers
  integer,dimension(nregions,3)    :: nxi
  integer,dimension(nregions,3)    :: nloop_max = 0
  real,dimension(nregions,3)       :: xi

  ! small number with respect to the altitude unit (used in the advectz part)
  real,parameter:: epsz=0.0001
  ! _________________________________________________________________________
  ! some timing variables to be used in chemistry applications 
  ! calculated by calc_sm, called in ss_monthly_update
  real                        :: sec_day,sec_month,sec_year   !
  integer,dimension(12)       :: mlen       !length of the 12 month in days

  logical                     :: okdebug=.true.     
  integer                     :: revert=1    ! if -1 reverses time and winds...
  integer                     :: istart            
  integer                     :: ndiag,ninst,ncheck,ntrans    
  integer                     :: itau,itaui,itaue,itaut,itau0,nwrite, nsrce
  integer,dimension(nregions) :: itaur   ! itau count for the different regions
  integer                     :: nread = 6*3600
  ! read of 6-hourly fields is staggered with three hours.
  integer,parameter           :: staggered = 3*3600
  integer                     :: ndyn, ndiff, nchem, nconv
  integer                     :: ndyn_max
  integer,dimension(6)        :: idate,idatei,idatee,idatet,idate0,sdate_simulation
  logical                     :: newyr,newmonth,newday,newsrun,newhour(nregions)
  integer                     :: julday0,iyear0
  integer                     :: icalendo
  integer                     :: ndiagp1,ndiagp2
  integer                     :: nstep,nstep0
  real                        :: cpu0,cpu1
  real,dimension(nregions)    :: areag

  !    main control variables, accessible through namelist 'inputz'
  !    all times (unless noted) are given in seconds.
  !    internally model time is kept in seconds (variables itau...) since
  !    1st-jan-iyear0, 00:00:00
  !   (iyear0 now defined as the actual year at start)
  !---------------------------------------------------------------------------
  !    name    type      default   purpose
  !    ----    ----      -------   -------
  !
  !    ndyn    integer   1*3600    length of full advection step
  !    nconv   integer   1*3600    interval for convection calculation
  !    ndiff   integer   0         interval for horizontal diffusion calc
  !    nchem   integer   0         interval for chemistry calculations 
  !    nsrce   integer   24*3600   interval for source calculation
  !    limits  logical   .true.    if set to .true. then
  !                                the slopes are limited
  !                                such that no negative tracer
  !                                masses should occur
  !    istart  integer   10        start/restart options:
  !                                1  coldstart with initial fields set to 0
  !                                2  coldstart with initial fields computed
  !                                   in sr trace1 in sources_sinks...
  !                                3  coldstart with initial
  !                                   fields read from model output (save file)
  !                                4  coldstart with initial
  !                                   fields read from model output stored 
  !                                   in mixing ratio (no slopes).
  !    nread   integer   12*3600        interval for input of massfluxes and convection info
  !    nwrite  integer   0         interval for alternate output of restart 
  !                                status on files save1.b and save2.b
  !    ninst   integer   0         interval for output of instantaneous 
  !                                tracer mix ratio fields
  !    ncheck  integer   0         interval for output of tracer mix ratio 
  !                                at checkpoints
  !    ndiag   integer   12*3600   interval for computing mean quantities
  !CMK ndiagp1 and ndiagp2 not implemented yet...
  !    ndiagp1 integer   -2        interval for output of
  !                                -1   daily
  !                                -2   monthly
  !                                -3   yearly
  !                                >=0  interval in seconds
  !    ndiagp2 integer   -2        interval for output of time averaged fields
  !                                -1   daily
  !                                -2   monthly
  !                                -3   yearly
  !                                >=0  interval in seconds
  !
  !    name      type     default  purpose
  !    ----      ----     -------  -------
  !
  !    icalendo  integer  2        calendar type
  !                                1 permanent 360 day year calendar
  !                                2 real calendar
  !                                3 permanent 365 day year calendar
  !                                4 permanent 366 day year calendar
  !    iyear0    integer  1980     base year for calendar calculations 
  !                                (because of overflow problems this should
  !                                deviate on a 32 bit machine
  !                                not more than +-65 years from
  !                                any year actually used in the
  !                                model runs----> iyear0 now just the run year
  !
  !  date/times are expressed as yr,month,day,hour,min,sec
  !
  !    idatei(6) integer (1980 1 1 0 0 0) date/time for start of model run
  !    idatee(6) integer (1980 1 1 0 0 0) date/time for end of model run
  !    idatet(6) integer (1980 1 1 0 0 0) date/time after which instan-
  !                                taneous output is written (controlled
  !                                by 'ninst') 
  !
  !    okdebug   logical  true     TM5 debugging
  !    itau      integer           current model time
  !    idate(6)  integer           date corresponding to itau
  !    itaui     integer           start time (corresponds to idatei)
  !    itaue     integer           end time (corresponds to idatee)
  !    itaut     integer           time after which instantaneous output is 
  !                                written (corresponds to idatet)
  !    itau0                       time/date when diagnostic arrays
  !    idate0(6) integer           were last reset
  !    julday0   integer           julian day of base time 1st-jan-iyear0, 0h
  !                                Needed only when icalendo == 2
  !    idacc(8)  integer           counters:
  !                                idacc(1)   no of times averaged tracer
  !                                mix ratio is calculated
  !                                others are not used at present
  !    newyr     logical .true.    if at beginning of a new year
  !    newmonth  logical .true.    if at beginning of a new month
  !    newday    logical .true.    if at beginning of a new day (i.e. at 00Z)
  !    newsrun   logical .true.    if at beginning of a new run or 
  !                                   at beginning of a continuation run
  !    nstep     integer           advection step counter for current run 
  !                                or continuation run
  !    nstep0    integer           not needed
  !    cpu0      real              process time at beginning of run (in sec)
  !    cpu1      real              process time at last reset time instant 
  !    areag     real(nregions)    surface of globe and regions
  !    itaur     integer(nregions) time counter per region
  !
  !---------------------------------------------------------------------------

  character(len=160) xlabel
  !
  !    variable      type      purpose
  !    --------      ----      -------
  !
  !    xlabel        char*160  run text label.
  !                            last 8 characters contain model version info
  !
  !----------------------------------------------------------------------------
  integer,dimension(nregions) :: unit_mix
  ! 
  integer,parameter :: kinput0=5 
  !                        main control output
  integer,parameter :: kmain=6
  !                        secondary control input
  integer,parameter :: kdebug=9
  !                        temporary scratch files
  integer,parameter :: ktemp1=1

  !    czeta          real 1.        scaling factor for convection
  !    czetak         real 1.        scaling factor for vertical diffusion

  real              :: czeta,czetak


  ! levels not zoomed yet ...
  integer, parameter  ::  zbeg(nregions_max) = 0
  integer, parameter  ::  zend(nregions_max) = lm(1)

  
  
CONTAINS
  
  !--------------------------------------------------------------------------
  !                    TM5                                                  !
  !--------------------------------------------------------------------------
  !BOP
  !
  ! !IROUTINE:   CHECKSHAPE
  !
  ! !DESCRIPTION: compare two vectors (typically shape of arrays)
  !\\
  !\\
  ! !INTERFACE:
  !
  SUBROUTINE CHECKSHAPE( shp1, shp2, rc )
    !
    ! !INPUT PARAMETERS:
    !
    integer, intent(in)  :: shp1(:)
    integer, intent(in)  :: shp2(:)
    !
    ! !OUTPUT PARAMETERS:
    !
    integer, intent(out) :: rc      ! return code
    !
    ! !REVISION HISTORY: 
    !    1 Mar 2012 - P. Le Sager - added rc output for traceback to work
    !
    ! !REMARKS:
    !
    !EOP
    !------------------------------------------------------------------------
    !BOC

    character(len=*), parameter    ::  rname = mname//', CheckShape'

    if ( size(shp1) /= size(shp2) ) then
       write(gol,'("array shapes should have same length:")'); call goErr
       write(gol,'("  shp1 : ",i4)') shp1                    ; call goErr
       write(gol,'("  shp2 : ",i4)') shp2                    ; call goErr
       rc=1
       IF_NOTOK_RETURN(rc=1)
    end if

    if ( any( shp1 /= shp2 ) ) then
       write (gol,'(" array shapes are not equal:")') ; call goErr
       write (gol,'("   shp1 : ",i4)') shp1           ; call goErr
       write (gol,'("   shp2 : ",i4)') shp2           ; call goErr
       rc=1
       IF_NOTOK_RETURN(rc=1)
    end if

    rc=0
    
  END SUBROUTINE CHECKSHAPE
  !EOC

END MODULE DIMS