! module fields implicit none ! ! Field module contains field type def, field structures, and related ! parameters: ! ! ! Derived type definition of a field: ! ! field%known: if T, is known by the processor ! (otherwise was user-defined in the model) ! field%derived: if T, is derived by processor from history fields, ! (otherwise is read from history) ! These 2 elements define 3 types of fields: ! known and underived (known=T, derived=F) (get field from history) ! known and derived (known=T, derived=T) (calculate in processor) ! unknown and underived (known=F, derived=F) (user-defined from model) ! (there are no unknown derived fields, but this might be added later) ! field%requested: if T, was requested by user (requested=F means field ! is needed to calculate a derived field, but was not requested by user) ! field%fneed(:) = fields needed to calculate a derived field ! (unallocated if field is not derived) ! field%fcomponents = components of (underived) family species ! (e.g. components of OX are O1 and O3) (unallocated if not applicable) ! field%wt = molecular weight of field (0. if not applicable) ! field%nlev = number of vertical levels (typically same as history%nzp) ! field%dlev = delta vertical coord (typically dlev) ! field%vtype = character descriptor of vertical coord type ! (vtype is "ZP", "HEIGHT", or "HT-INDEP") ! field%zptype = "MIDPOINTS" if model calculated field at zp midpoints ! "INTERFACES" if model calculated field at zp interfaces ! field%zptype_req = Requested zptype (see grid_levels in input.F) ! field%lev(nlev) = vertical coordinate array of the field. This will ! will be midpoints or interfaces for log pressure fields, however ! fof2 and hmf2 and integrated fields are height-independent ! (field%nlev=1). Also, oh vibrational states and emissions are on a ! height scale (see oh_alt, etc below). ! type field character(len=8) :: fname8 ! short name character(len=56) :: fname56 ! long name character(len=16) :: units ! units character(len=16) :: type ! scaler,vector,density,etc character(len=8) :: vtype ! character descriptor of vertical coords ! (typically either "HEIGHT" or "ZP") character(len=8) :: difftype ! blank, or "PERCENT" or "RAW" character(len=16) :: zptype ! default zp levels (INTERFACES or MIDPOINTS) character(len=16) :: zptype_req! requested zp levels (INTERFACES or MIDPOINTS) integer :: nlev ! number of vertical levels real,pointer :: lev(:)=>NULL() ! levels coord array (ht or zp of zptype) real :: dlev ! delta lev real :: vregion(2) ! vertical "range of interest" (bot,top) logical known ! is known to proc (user-defined if unknown) logical derived ! is derived field (calc by proc) logical requested ! was requested by user character(len=8), pointer :: fneed(:)=>NULL() ! fields needed for derivation character(len=8), pointer :: fcomponents(:)=>NULL() ! components of family real, pointer :: data(:,:,:)=>NULL() ! the data (nlon,nlat,nlev) real :: wt ! molecular weight real :: cmin,cmax,cint ! optionally provided by user (fmnmxint) real :: scalefac ! optionally provided by user (fscale) end type field ! ! fields_known(mxfknown) are fields known by the processor, i.e., not ! user defined. These include fields on the primary histories and ! processor derived fields. The data part of these fields is never ! defined. ! integer,parameter :: mxfknown=175 ! max number of fields known to proc integer :: nfknown ! number of known fields defined type (field),save :: flds_known(mxfknown) ! ! flds(:) are all the fields requested by the user, plus fields needed ! for derived fields, but not requested (fields needed but not requested ! are deallocated after the derivations). Each field is either known by ! the processor or was defined by the user from the model. ! type (field), allocatable, save :: flds(:) type (field), allocatable, save :: flds_cntr(:) ! ! Vertical height scale for OH vibrational levels and emission bands: ! (30 to 120 by 1 km) ! integer,parameter :: nohvlev=10, ! number of oh vib levels + nohband=39 ! number of oh emission bands real,parameter :: oh_kmbot=30., ! bottom altitude of oh (km) + oh_kmtop=120. ! top altitude of oh (km) ! nohalt = number of oh altitudes: ! integer,parameter :: nohalt=ifix(oh_kmtop)-ifix(oh_kmbot)+1 integer,parameter :: nohalt=120-30+1 real :: oh_alt(nohalt) ! ! doppler fields: integer,parameter :: nfdop=3 ! number of doppler fields (t,u,v) character(len=8) :: doppler_snames(nfdop)= + (/'DOP-TN ','DOP-UN ','DOP-VN '/) character(len=56) :: doppler_fnames(nfdop)= + (/'DOPPLER TEMPERATURE ', + 'DOPPLER ZONAL WIND ', + 'DOPPLER MERIDIONAL WIND '/) character(len=16) :: doppler_units(nfdop)= + (/'DEG K ','M/S ','M/S '/) ! ! doppler_emis(4) are the emission fields for which doppler fields ! can be calculated. ! (doppler fields are *not* calculated for ECO215u and EN053u) ! (doppler fields can also be calculated for OH emission bands) character(len=8) :: doppler_emis(4)= + (/'E6300','E5577','EO200','EOH83'/) ! integer,parameter :: mxnaf = 13 ! max number of Na sp ! ! Labels for greenline emission components (see ie5577(5) in input): integer,parameter :: ne5577 = 5 character(len=16) :: e5577lab(ne5577) = + (/'[O1 RECOMB] ','[O2+ RECOMB] ','[PHOTO-E] ', + '[AIRGLOW] ','[O2 LYMAN-BETA] '/) ! ! 3d geopotential height at midpoints and interfaces: real,allocatable :: z_ifaces(:,:,:), z_midpts(:,:,:) real,allocatable :: zcntr_ifaces(:,:,:), zcntr_midpts(:,:,:) ! contains !------------------------------------------------------------------- subroutine set_ohalt integer :: i do i=1,nohalt oh_alt(i) = oh_kmbot+float(i-1) enddo return end subroutine set_ohalt !------------------------------------------------------------------- subroutine printfields_table(f,nf) integer,intent(in) :: nf type (field), intent(in) :: f(nf) integer :: i ! write(6,"(/72('-'))") write(6,"(5x,'Name',5x,'Units',12x,'Type',13x,'Vtype'/)") do i=1,nf if (len_trim(f(i)%fname8) > 0) + write(6,"(i3,2x,a8,2(1x,a16),1x,a8)") + i,f(i)%fname8,f(i)%units,f(i)%type,f(i)%vtype enddo write(6,"(72('-')/)") end subroutine printfields_table !------------------------------------------------------------------- subroutine printfield(f) use proc,only: spval implicit none ! ! Print a field structure to stdout: ! ! Arg: type (field), intent(in) :: f ! ! Locals: real fmin,fmax integer :: i ! write(6,"(/72('-'),/'Printfield:')") write(6,"(' fname8 = ',a)") f%fname8 write(6,"(' fname56 = ',a)") f%fname56 write(6,"(' units = ',a)") f%units write(6,"(' type = ',a)") f%type write(6,"(' nlev = ',i6)") f%nlev write(6,"(' dlev = ',f5.1)") f%dlev write(6,"(' vtype = ',a)") f%vtype write(6,"(' zptype = ',a)") trim(f%zptype) write(6,"(' known = ',l1)") f%known write(6,"(' derived = ',l1)") f%derived write(6,"(' requested = ',l1)") f%requested if (associated(f%fneed)) then write(6,"(' Derived field: fields needed to calculate = ')", + advance="NO") do i=1,size(f%fneed) write(6,"(a,' ')",advance="NO") + f%fneed(i)(1:len_trim(f%fneed(i))) if (mod(i,6) == 0) write(6,"(' ')") enddo write(6,"(' ')") else write(6,"(' (not a derived field)')") endif if (associated(f%data)) then fmin = minval(f%data) fmax = maxval(f%data) if (fmax == spval .or. fmin == spval) then call fminmax(f%data,size(f%data),fmin,fmax) write(6,"(' data min,max = ',2e12.4, + ' (found missing data)')") fmin,fmax else write(6,"(' data min,max = ',2e12.4, + ' (no missing data found)')") fmin,fmax endif else write(6,"(' (data unallocated)')") endif write(6,"('End Printfield',/,72('-')/)") return end subroutine printfield !------------------------------------------------------------------- subroutine fldinit(f) ! ! Initialize a field structure (not including data or needed fields): ! use proc,only: ispval,spval implicit none type(field),intent(out) :: f ! ! Note f90 pads undefined chars w/ blanks after assignment, so its ! only necessary to assign a single blank for any length string: ! f%fname8 = " " f%fname56 = " " f%type = " " f%difftype= " " f%zptype= " " f%zptype_req= " " f%units = " " f%nlev = ispval f%dlev = spval f%vregion = spval ! f%vtype = "ZP " ! default f%known = .false. f%derived = .false. f%requested = .false. f%wt = 0. ! ! Default cmin=cmax=cint=0 allows ncarg to find fmin,fmax, and ! choose cint. If user sets fmnmxint, then these are set accordingly ! by setmnmxint, called by main tgcmproc. f%cmin = 0. f%cmax = 0. f%cint = 0. ! ! Default scale factor of 1. (reset from fscale if provided by user) f%scalefac = 1. ! ! Nullify defines the pointer as empty. This is important for testing ! later with the associated function, esp for code built on linux w/ ! pgf90: nullify(f%lev) return end subroutine fldinit !------------------------------------------------------------------- subroutine fldminmax(f) use proc,only: iohglb implicit none type(field) :: f(:) integer :: nf,i real :: fmin,fmax ! nf = size(f) if (nf <= 0) then write(6,"('>>> WARNING fldminmax: no fields?')") return endif floop: do i=1,nf if (.not.associated(f(i)%data)) cycle floop if ((trim(f(i)%type)=='OH-BAND'.or.trim(f(i)%type)=='OH-VIB') + .and.iohglb<=0) cycle floop call fminmax(f(i)%data,size(f(i)%data),fmin,fmax) write(6,"('Field ',a,' 3d min,max=',2e12.4, + ' (field ',i3,')')") f(i)%fname8,fmin,fmax,i enddo floop write(6,"(' ')") return end subroutine fldminmax end module fields