! module flds_hist use fields implicit none ! ! mxfhist = max number of fields on history. ! nf_hist = number of fields actually on the history. ! f_hist(1:nf_hist) = field structures for all fields on the history ! integer,parameter :: mxfhist=500 type(field) :: f_hist(mxfhist) integer :: nf_hist ! number of fields on the history ! ! Names of fields on source history necessary to restart the model ! These fields should have f%restart="yes". ! integer,parameter :: nf_restart = 31 character(len=8) :: fnames_restart(nf_restart) = (/ |'ZP ','ZPHT ','TN ','XNO ','XNO1D ','XNN2 ', |'XNO2 ','TE ','TI ','XNE ','XN2D ','XN4S ', |'XNNO ','XNNO2 ','XNNOZ ','XNHE ','XNARG ','XNH2O ', |'XNH2 ','XNCH4 ','XNOH ','XNHO2 ','XNH2O2 ','XNH ', |'XNHTOT ','XNCO ','XNCO2 ','XNO3 ','XNAS ','XNAT ', |'XNN2O '/) ! ! Diaghist fields are diagnostics that are on the histories, but not ! calculated in the model. I don't know how they were originally ! calculated. I will continue to pass them through the histories: ! integer,parameter :: nf_diaghist = 13 character(len=8) :: fnames_diaghist(nf_diaghist) = (/ |'QNC ','QN1D ','QO3PR ','DICHM ','DNCHM ','XNCH4L ', |'XNNOY ','XNHNO3 ','XNN2O5 ','XNH2O2L ','XNNO3 ','XN4SL ', |'AMAS '/) integer,parameter :: nfdiags=81 character(len=8) :: fdiags(nfdiags) = (/ |'SHT ','AMAS ','RHO ','XNEEE ','XNPI ','XNNI ', |'XIOP ','XINOP ','XINP ','XIN2P ','XIO2P ','QNTOT ', |'XIRCOOL ','DO2T ','DO3T ','SPED ','SHAL ','PARCD ', |'QTIN ','EDY ','QNN ','QNC ','QSRC ','QSRB ', |'QN1D ','XLEN ','QO3PR ','QIAN ','QJOUL ','QNO3 ', |'QNLYA ','XNOC ','XCO2C ','XO3PC ','HCM ','HCE ', |'DICHM ','DNCHM ','DO2LYA ','DO2SRC ','DO2SRB ','QNIGHT ', |'QOP ','QNOP ','QO2P ','QN2P ','QNP ','QNSPE ', |'GWHEAT ','QPRO ','QPROH ','QCR ','QIXRAY ','XNCH4L ', |'XNNOY ','XNHNO3 ','XNN2O5 ','XNH2O2L ','XNNO3 ','XN4SL ', |'XNO21D ','XNO21S ','ZPMS ','ZPMHT ','SHTMS ','AMASS ', |'TNMS ','XOM ','XN2M ','XO2M ','XN4SM ','XNHEM ', |'XNARGM ','XNHM ','RHOMS ','E5577 ','EO200 ','E6300 ', |'ECO215 ','ENO53 ','SR63 '/) contains !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - subroutine init_fhist ! ! Initialize restart field structures that are to be written to output ! histories (this does not include data). ! use params,only: nlev implicit none ! ! Local: integer :: i,ii real,target,dimension(nlev) :: p_edy character(len=8) :: fnames(mxfhist) logical :: found ! ! External: logical,external :: findf ! util.F ! ! Define f_hist(1:nf_restart) with restart fields (restart fields are ! put on the history by default): ! nf_hist = nf_restart ! init nf_hist fnames(1:nf_hist) = fnames_restart(1:nf_restart) ! do i=1,nf_hist ! ! If fnames(i) is found in fmodules, then findf defines f_hist from ! the appropriate module (fmodules.F). This effectively allocates ! f_hist%data, but they are zero until read by read_source. ! found = findf(fnames(i),f_hist(i)) if (.not.found) then write(6,"('>>> WARNING init_fhist: Could not find field ', | a)") trim(fnames(i)) else f_hist(i)%restart = "yes" ! is a restart field endif enddo ! i=1,nf_hist ! ! Add default diags: do i=1,nfdiags nf_hist = nf_hist+1 found = findf(fdiags(i),f_hist(nf_hist)) if (.not.found) then write(6,"('>>> WARNING init_fhist: Could not find field ', | a)") trim(fdiags(i)) else f_hist(nf_hist)%restart = "no" ! is not a restart field endif enddo ! i=1,nfdiags ! ! Print fields table: call print_ftable(f_hist ,nf_hist ,'restart ') ! ! Print short_names and var_names of fields on history file: write(6,"(/,'Short names of fields on output history:')") write(6,"(8a9)") f_hist(1:nf_hist)%short_name write(6,"(/,'Var names of fields on output history:')") write(6,"(8a9)") f_hist(1:nf_hist)%var_name end subroutine init_fhist !----------------------------------------------------------------------- subroutine addfhist(f,varname,shortname,longname,units,nlevs, | itimedep,logplt) ! ! Add field f(nlevs) to output history. Field may be time-dependent ! or time-independent. ! use params,only: nlev use input,only: istep,nstep ! ! Args: integer,intent(in) :: nlevs,itimedep,logplt real,intent(in) :: f(nlevs) character(len=*),intent(in) :: varname,shortname,longname,units ! ! Local: integer :: i,istat logical :: onhist ! if (nlevs /= nlev) then write(6,"(/,'>>> addfhist: array dimension nlevs=',i3,' must ', | 'be same as nlev=',i3,' for this run of the model.')") | nlevs,nlev call shutdown('addfhist nlevs') endif ! ! Make sure field name has not been used: onhist = .false. ! write(6,"('addfhist checking for field ',a,' nf_hist=',i4, ! | ' f_hist(1:nf_hist)%var_names = ',/,(8a10))") varname, ! | nf_hist,f_hist(1:nf_hist)%var_name(1:10) do i=1,nf_hist if (trim(f_hist(i)%var_name)==trim(varname)) then ! write(6,"(/,'Note addfhist: have already defined field ', ! | a)") varname onhist = .true. endif enddo ! i=1,nf_hist ! ! Define new field: if (.not.onhist) then ! ! Increment number of fields on output history (only in first timestep): nf_hist = nf_hist+1 ! global module data ! ! Define names and units in f_hist: f_hist(nf_hist)%short_name = ' ' if (len(shortname) <= len_shortname) then f_hist(nf_hist)%short_name(1:len(shortname)) = shortname else f_hist(nf_hist)%short_name = shortname(1:len_shortname) endif f_hist(nf_hist)%var_name = ' ' if (len(varname) <= len_varname) then f_hist(nf_hist)%var_name(1:len(varname)) = varname else f_hist(nf_hist)%var_name = varname(1:len_varname) endif f_hist(nf_hist)%long_name = ' ' if (len(longname) <= len_longname) then f_hist(nf_hist)%long_name(1:len(longname)) = longname else f_hist(nf_hist)%long_name = longname(1:len_longname) endif f_hist(nf_hist)%units = ' ' if (len(units) <= len_units) then f_hist(nf_hist)%units(1:len(units)) = units else f_hist(nf_hist)%units = units(1:len_units) endif f_hist(nf_hist)%logplt = logplt ! ! Field is not necessary for model restart (is diagnostic): f_hist(nf_hist)%restart = "no" ! ! Define time-dependence: if (itimedep <= 0) then f_hist(nf_hist)%timedep = "time-independent" else f_hist(nf_hist)%timedep = "time-dependent" endif ! ! Allocate and define data: if (.not.associated(f_hist(nf_hist)%data)) then allocate(f_hist(nf_hist)%data(nlev),stat=istat) if (istat /= 0) then write(6,"(/,'>>> addfhist: error allocating data for ', | 'field ',a,' nlev=',i3)") trim(shortname),nlev endif endif f_hist(nf_hist)%data(:) = f(:) ! write(6,"('Addfhist: Defined ',a,' output field ',i4,' ',a, ! | ': Min,Max=',2e12.4)") ! | trim(f_hist(nf_hist)%timedep),nf_hist, ! | trim(f_hist(nf_hist)%var_name), ! | minval(f_hist(nf_hist)%data),maxval(f_hist(nf_hist)%data) endif ! .not.onhist ! ! Update data: ! ! If field is time-dependent 2-d (time,lev), save data every time this ! routine is called: ! if (itimedep > 0) then f_hist(nf_hist)%data(:) = f(:) ! write(6,"('Addfhist: Updated 2-d output field ',i4,' ',a, ! | ': Min,Max=',2e12.4)") nf_hist,f_hist(nf_hist)%var_name(1:9), ! | minval(f_hist(nf_hist)%data),maxval(f_hist(nf_hist)%data) ! ! If field is time-independent 1-d (lev), save data only at last ! timestep: ! elseif (itimedep <=0 .and. istep==nstep) then f_hist(nf_hist)%data(:) = f(:) ! write(6,"('Addfhist: Updated 1-d output field ',i4,' ',a, ! | ': Min,Max=',2e12.4)") nf_hist,f_hist(nf_hist)%var_name, ! | minval(f_hist(nf_hist)%data),maxval(f_hist(nf_hist)%data) endif end subroutine addfhist !----------------------------------------------------------------------- end module flds_hist