controlmod.f90

CCSM Research Tools: Community Atmosphere Model (CAM)

! ----------------------------------------------------------------------
! Restart pointer file
! ----------------------------------------------------------------------

! split the full pathname of the restart pointer file into a 
! directory name and a file name
! check if the directory exists and if not, make it 

    rpntdir = ' '
    rpntfil = ' '
    do n = len_trim(rpntpath),0,-1     
       if (rpntpath(n:n) ==  '/') then
          rpntdir = rpntpath(1:n-1)
          rpntfil = rpntpath(n+1:len_trim(rpntpath))
          go to 100
       endif
    enddo
    rpntdir = '.'        ! no "/" found, set path = "."
    rpntfil = rpntpath   ! no "/" found, use whole input string.
100 continue

    if (masterproc) then
       write(6,*) 'Successfully initialized run control settings'
       write(6,*)
    endif

    return
  end subroutine control_init

!=======================================================================

#if (defined SPMD)

  subroutine control_spmd()

!----------------------------------------------------------------------- 
! 
! Purpose: 
! Distribute namelist data all processors. The cpp SPMD definition 
! provides for the funnelling of all program i/o through the master 
! processor. Processor 0 either reads restart/history data from the 
! disk and distributes it to all processors, or collects data from 
! all processors and writes it to disk.
! 
! Method: 
! 
! Author: Mariana Vertenstein
! 
!-----------------------------------------------------------------------

#if (defined OFFLINE) || (defined COUP_CSM)
    use time_manager, only : calendar, dtime, nestep, nelapse, start_ymd, &
                             start_tod, stop_ymd, stop_tod, ref_ymd, ref_tod
#endif
    use mpishorthand

! ------------------------ local variables -----------------------------
    integer ier       !error code
!-----------------------------------------------------------------------

! run control variables

    call mpi_bcast (caseid, len(caseid), mpichar, 0, mpicom, ier)
    call mpi_bcast (ctitle, len(ctitle), mpichar, 0, mpicom, ier)
    call mpi_bcast (nsrest, 1, mpiint, 0, mpicom, ier)

#if (defined OFFLINE) || (defined COUP_CSM)
    call mpi_bcast (nestep, 1, mpiint, 0, mpicom, ier)
    call mpi_bcast (nelapse, 1, mpiint, 0, mpicom, ier)
    call mpi_bcast (dtime, 1, mpiint, 0, mpicom, ier)
    call mpi_bcast (calendar, 32, mpichar, 0, mpicom, ier)
    call mpi_bcast (start_ymd, 1, mpiint, 0, mpicom, ier)
    call mpi_bcast (start_tod, 1, mpiint, 0, mpicom, ier)
    call mpi_bcast (stop_ymd, 1, mpiint, 0, mpicom, ier)
    call mpi_bcast (stop_tod, 1, mpiint, 0, mpicom, ier)
    call mpi_bcast (ref_ymd, 1, mpiint, 0, mpicom, ier)
    call mpi_bcast (ref_tod, 1, mpiint, 0, mpicom, ier)
#endif

! initial file variables

    call mpi_bcast (nrevsn, len(nrevsn), mpichar, 0, mpicom, ier)
    call mpi_bcast (finidat, len(finidat), mpichar, 0, mpicom, ier)
    call mpi_bcast (fsurdat, len(fsurdat), mpichar, 0, mpicom, ier)
#if (defined RTM)
    call mpi_bcast (frivinp_rtm, len(frivinp_rtm), mpichar, 0, mpicom, ier)
#endif

! surface dataset generation variables

    if (fsurdat == ' ') then
       call mpi_bcast (mksrf_fvegtyp, len(mksrf_fvegtyp), mpichar, 0, mpicom, ier)
       call mpi_bcast (mksrf_fsoitex, len(mksrf_fsoitex), mpichar, 0, mpicom, ier)
       call mpi_bcast (mksrf_fsoicol, len(mksrf_fsoicol), mpichar, 0, mpicom, ier)
       call mpi_bcast (mksrf_flanwat, len(mksrf_flanwat), mpichar, 0, mpicom, ier)
       call mpi_bcast (mksrf_furban, len(mksrf_furban), mpichar, 0, mpicom, ier)
       call mpi_bcast (mksrf_fglacier, len(mksrf_fglacier), mpichar, 0, mpicom, ier)
       call mpi_bcast (mksrf_flai, len(mksrf_flai), mpichar, 0, mpicom, ier)
    endif

! physics variables

    call mpi_bcast (conchk, 1, mpilog, 0, mpicom, ier)
    call mpi_bcast (irad, 1, mpiint, 0, mpicom, ier)
    call mpi_bcast (csm_doflxave, 1, mpilog, 0, mpicom, ier)
    call mpi_bcast (rtm_nsteps, 1, mpiint, 0, mpicom, ier)
    call mpi_bcast (wrtdia, 1, mpilog, 0, mpicom, ier)

! history and restart file variables
    
    call mpi_bcast (hist_dov2xy, size(hist_dov2xy), mpilog, 0, mpicom, ier)
    call mpi_bcast (hist_nhtfrq, size(hist_nhtfrq), mpiint, 0, mpicom, ier)
    call mpi_bcast (hist_mfilt, size(hist_mfilt), mpiint, 0, mpicom, ier)
    call mpi_bcast (hist_ndens, 1, mpiint, 0, mpicom, ier)
    call mpi_bcast (hist_chntyp, len(hist_chntyp(1,1))*size(hist_chntyp), mpichar, 0, mpicom, ier)
    call mpi_bcast (hist_fldadd, len(hist_fldadd(1))*size(hist_fldadd), mpichar, 0, mpicom, ier)
    call mpi_bcast (hist_fldaux1, len(hist_fldaux1(1))*size(hist_fldaux1), mpichar, 0, mpicom, ier)
    call mpi_bcast (hist_fldaux2, len(hist_fldaux2(1))*size(hist_fldaux2), mpichar, 0, mpicom, ier)
    call mpi_bcast (hist_crtinic, len(hist_crtinic), mpichar, 0, mpicom, ier)
    call mpi_bcast (rpntpath, len(rpntpath), mpichar, 0, mpicom, ier)

! long term archiving variables

    call mpi_bcast (mss_irt, 1, mpiint, 0, mpicom, ier)
    call mpi_bcast (mss_wpass, len(mss_wpass), mpichar, 0, mpicom, ier)
    call mpi_bcast (archive_dir, len(archive_dir), mpichar, 0, mpicom, ier)

    return
  end subroutine control_spmd
#endif

!=======================================================================

  subroutine control_print

!----------------------------------------------------------------------- 
! 
! Purpose: 
! Write out run control variables
!
! Method: 
!
! Author: Mariana Vertenstein
! 
!-----------------------------------------------------------------------

! ------------------------ local variables -----------------------------
    integer i  !loop index
!-----------------------------------------------------------------------

    write(6,*) 'define run:'
    write(6,*) '   run type              = ',runtyp(nsrest+1)
    write(6,*) '   case title            = ',trim(ctitle)
    write(6,*) 'input data files:'
    write(6,*) '   PFT physiology = ',trim(fpftcon)
    if (mkfsurdat) then
       write(6,*) '   generated surface dataset using raw data'
       write(6,*) '     plant types  = ',trim(mksrf_fvegtyp)
       write(6,*) '     inland water = ',trim(mksrf_flanwat)
       write(6,*) '     glacier      = ',trim(mksrf_fglacier)
       write(6,*) '     urban        = ',trim(mksrf_furban)
       write(6,*) '     soil texture = ',trim(mksrf_fsoitex)
       write(6,*) '     soil color   = ',trim(mksrf_fsoicol)
       write(6,*) '     lai and sai  = ',trim(mksrf_flai)
#if (defined OFFLINE)
       if (mksrf_offline_fgrid /= ' ') then
          write (6,*)'   land grid and mask obtained from = ',trim(mksrf_offline_fgrid)
       endif
       if (mksrf_offline_fnavyoro  /= ' ') then
          write (6,*)'   land mask obtained obtained from = ',trim(mksrf_offline_fnavyoro)
          write (6,*)'   regular grid is generated by model with'
          write (6,*)'      northern edge (degrees)  = ',mksrf_offline_edgen
          write (6,*)'      southern edge (degrees)  = ',mksrf_offline_edges
          write (6,*)'      western  edge (degrees)  = ',mksrf_offline_edgew
          write (6,*)'      eastern  edge (degrees)  = ',mksrf_offline_edgee
       endif
#endif
    else
       write(6,*) '   surface data   = ',trim(fsurdat)
    end if
    if (nsrest == 0 .and. finidat == ' ') write(6,*) '   initial data created by model'
    if (nsrest == 0 .and. finidat /= ' ') write(6,*) '   initial data   = ',trim(finidat)
    if (nsrest /= 0) write(6,*) '   restart data   = ',trim(nrevsn)
#if (defined OFFLINE)
    if (offline_atmdir /= ' ') then
       write(6,*) '   atmosperic forcing data    = ',trim(offline_atmdir) 
    end if
#elif (defined COUP_CAM)
    write(6,*) '   atmosperhic forcing data is from cam model'
#elif (defined COUP_CSM)
    write(6,*) '   atmospheric forcint data is from csm flux coupler'
#endif
#if (defined RTM)
    if (frivinp_rtm /= ' ') write(6,*) '   RTM river data       = ',trim(frivinp_rtm)
#endif
    write(6,*) 'history and restart parameters:'
    if (hist_ndens == 1) then
       write(6,*)'   history tape data will be double precision'
    else if (hist_ndens == 2) then
       write(6,*)'   history tape data will be single precision'
    end if
    write(6,101) (i,hist_dov2xy(i),i=1,nhist)
    write(6,*) '   there will be ',nhist,' history files'
    do i = 1, nhist
       if (hist_nhtfrq(i)==0) then
          write(6,*) '   history file ',i,' is monthly averaged'
       else
          write(6,*) '   history file ',i,' time interval (iterations)= ', hist_nhtfrq(i)
       endif
    end do
    write(6,104) (i,hist_mfilt(i),i=1,nhist)
    if (mss_irt /= 0) then 
       write(6,*)'   mass store path                    = ',trim(archive_dir) 
       write(6,*)'   mass store retention (days)        = ',mss_irt
       write(6,*)'   mass store write password          = ',mss_wpass
    endif
    write(6,*)'   restart pointer file directory     = ',trim(rpntdir)
    write(6,*)'   restart pointer file name          = ',trim(rpntfil)
    if (hist_crtinic == 'MONTHLY') then
       write(6,*)'initial datasets will be written monthly'
    else if (hist_crtinic == 'YEARLY') then
       write(6,*)'initial datasets will be written yearly'
    else
       write(6,*)'initial datasets will not be produced'
    endif
    write(6,*) 'model physics parameters:'
#if (defined PERGRO)
    write(6,*) '   flag for random perturbation test is set'
#else
    write(6,*) '   flag for random perturbation test is not set'
#endif
    write(6,*) '   energy and water conservation checks   = ',conchk
    write(6,*) '   solar radiation frequency (iterations) = ',irad
#if (defined COUP_CSM)
    write(6,*) 'communication with the flux coupler'
    if (csm_doflxave) then
       write(6,*)'    data will be sent to the flux coupler ', &
            'only when an albedo calculation is performed '
       write(6,*)'     fluxes will be averaged on steps where ', &
            'communication with the flux coupler does not occur'
    else
       write(6,*)'    data will be sent and received to/from ', &
            'the flux coupler at every time step except for nstep=1'
    endif
#endif
#if (defined RTM)
    if (rtm_nsteps > 1) then
       write(6,*)'river runoff calculation performed only every ',rtm_nsteps,' nsteps'
    else
       write(6,*)'river runoff calculation performed every time step'
    endif
#endif       
    if (nsrest == 1) then
       write(6,*) 'restart warning:'
       write(6,*) '   Namelist not checked for agreement with initial run.'
       write(6,*) '   Namelist should not differ except for ending time step and run type'
    end if
    if (nsrest == 3) then
       write(6,*) 'branch warning:'
       write(6,*) '   Namelist not checked for agreement with initial run.'
       write(6,*) '   Surface data set and reference date should not differ from initial run'
    end if
#if (defined COUP_CSM)       
    write(6,*) '   last time step determined by flux coupler'
#endif
       
101 format (1x,'   history fields are grid-average    = ',4(i1,':',l1,' '))
104 format (1x,'   time samples per history file      = ',4(i1,':',i2,' '))

  end subroutine control_print

!=======================================================================

end module controlMod