#include "dims.h" ! module fields_module implicit none ! #include "params.h" ! ! integer,parameter :: nfprog = 24 ! number of prognostic fields tiegcm integer,parameter :: nfprog = 52 ! number of prognostic fields timegcm ! (required to restart) integer,parameter :: | len_name = 16, ! char length of field short name | len_long_name = 56, ! char length of field long name | len_units = 16 ! char length of field units ! ! Field type: type field character(len=len_name) :: name ! short name character(len=len_long_name) :: long_name ! long name character(len=len_units) :: units ! units logical :: prognostic ! true if a prognostic ! (if false, is a diagnostic) logical :: magnetic ! true if field is on magnetic grid ! (if false, is geographic) ! ! Pointer to fields data in field type is currently used only ! by secondary history diagnostic fields, created dynamically ! by user calls to addfsech. ! real, pointer :: data(:,:,:) ! the data (nlon,nlat,nlev) end type field ! ! Global array of prognostic field types: ! (these are all fields necessary to restart the model, and are ! always written to primary histories. These include several ! fields at time n-1 (named *_NM). May contain fields not truly ! prognostic). ! type(field) :: fprog(nfprog) ! ! Global array of secondary history fields (may contain both ! prognostics and diagnostics): ! type(field) :: fsech(mxfsech) type(field) :: fsechmag(mxfsech) ! ! If fakeflds is true, use fake dimensions for fields ! (for dry runs, testing, etc) logical,parameter :: fakeflds = .false. ! logical,parameter :: fakeflds = .true. ! contains !----------------------------------------------------------------------- subroutine set_fprog ! ! Set prognostic field types. These are the minimum set of fields ! required to restart the model, i.e., minimum set to be written ! to primary histories. These will be dimensioned (lon,lat,lev,time). ! These are defined in the same order as the data in the f and fg ! arrays (with the exception of NPHIH, which is not included). ! This is so the data can be dumped contiguously from fg onto the ! netcdf history file from a loop (see nc_wrhist in nchist_mod.F). ! ! Local: integer :: i ! ! integer,parameter :: nfprog = 52 ! number of prognostic fields timegcm ! Fields 1-34: ! | NT ,NU ,NV ,NPS ,NPS2 ,NPN4S , ! | NPNOZ ,NPCO ,NPCO2 ,NPH2O ,NPH2 ,NPHOX , ! | NOP ,NPCH4 ,NPAR ,NPHE ,NPNAT ,NPO21D , ! | NPNO2 ,NPNO ,NPO3 ,NPO1 ,NPOH ,NPHO2 , ! | NPH ,NPN2D ,NTI ,NTE ,NE ,NO2P , ! | NW ,NZ ,NPHI ,NPHIH , ! ! data fproc_names ! fields 1-33 read by post-proc: ! + /'TN ','UN ','VN ','O2 ','OX ', ! + 'N4S ','NOZ ','CO ','CO2 ','H2O ', ! + 'H2 ','HOX ','O+ ','CH4 ','AR ', ! + 'HE ','NAT ','O21D ','NO2 ','NO ', ! + 'O3 ','O1 ','OH ','HO2 ','H ', ! + 'N2D ','TI ','TE ','NE ','O2+ ', ! + 'W ','Z ','POTEN '/ ! ! Define prognostic fields with name, units, and long_name: ! call mkfld(fprog(1 ),'TN' ,'DEG K','NEUTRAL TEMPERATURE') call mkfld(fprog(2 ),'UN' ,'CM/S' ,'NEUTRAL ZONAL WIND') call mkfld(fprog(3 ),'VN' ,'CM/S' ,'NEUTRAL MERIDIONAL WIND') call mkfld(fprog(4 ),'O2' ,'MMR' ,'MOLECULAR OXYGEN') call mkfld(fprog(5 ),'OX' ,'MMR' ,'OX GROUP (O+O3)') call mkfld(fprog(6 ),'N4S' ,'MMR' ,'N4S') call mkfld(fprog(7 ),'NOZ' ,'MMR' ,'NO GROUP (NO+NO2)') call mkfld(fprog(8 ),'CO' ,'MMR' ,'CARBON MONOXIDE') call mkfld(fprog(9 ),'CO2' ,'MMR' ,'CARBON DIOXIDE') call mkfld(fprog(10),'H2O' ,'MMR' ,'WATER VAPOR') call mkfld(fprog(11),'H2' ,'MMR' ,'MOLECULAR HYDROGEN') call mkfld(fprog(12),'HOX' ,'MMR' ,'HYDROGEN GROUP (OH+HO2+H)') call mkfld(fprog(13),'OP' ,'CM^3' ,'O+ ION') call mkfld(fprog(14),'CH4' ,'MMR' ,'METHANE') call mkfld(fprog(15),'AR' ,'MMR' ,'ARGON') call mkfld(fprog(16),'HE' ,'MMR' ,'HELIUM') call mkfld(fprog(17),'NAT' ,'MMR' ,'TOTAL SODIUM') call mkfld(fprog(18),'O21D','MMR' ,'O21D') call mkfld(fprog(19),'NO2' ,'MMR' ,'NITROGEN DIOXIDE') call mkfld(fprog(20),'NO' ,'MMR' ,'NITRIC OXIDE') call mkfld(fprog(21),'O3' ,'MMR' ,'OZONE') call mkfld(fprog(22),'O1' ,'MMR' ,'ATOMIC OXYGEN') call mkfld(fprog(23),'OH' ,'MMR' ,'HYDROXYL') call mkfld(fprog(24),'HO2' ,'MMR' ,'HYDROGEN DIOXIDE') call mkfld(fprog(25),'H' ,'MMR' ,'HYDROGEN') call mkfld(fprog(26),'N2D' ,'MMR' ,'N2D') call mkfld(fprog(27),'TI' ,'DEG K','ION TEMPERATURE') call mkfld(fprog(28),'TE' ,'DEG K','ELECTRON TEMPERATURE') call mkfld(fprog(29),'NE' ,'CM^3' ,'ELECTRON DENSITY') call mkfld(fprog(30),'O2P' ,'CM^3' ,'O2+ ION') call mkfld(fprog(31),'W' ,'CM/S' , | 'VERTICAL VELOCITY (PLUS UP)') call mkfld(fprog(32),'Z' ,'CM' ,'GEOPOTENTIAL HEIGHT') call mkfld(fprog(33),'POTEN','VOLTS','ELECTRIC POTENTIAL') ! ! 2d electric potential is not necessary to start the model, but ! is on old cray-blocked histories with 1 level only. ! call mkfld(fprog(34),'POTEN','VOLTS','2D ELECTRIC POTENTIAL') ! 1 level ! ! Fields at previous time step: ! | NTNM ,NUNM ,NVNM ,NPSNM ,NPS2NM ,NN4SNM , ! | NPNOZNM ,NPCONM ,NPCO2NM ,NPH2ONM ,NPH2NM ,NPHOXNM , ! | NOPNM ,NPCH4NM ,NPARNM ,NPHENM ,NPNATNM ,NMS , ! | NVC , ! call mkfld(fprog(34),'TN_NM','DEG K', | 'NEUTRAL TEMPERATURE (TIME N-1)') call mkfld(fprog(35),'UN_NM','CM/S', | 'NEUTRAL ZONAL WIND (TIME N-1)') call mkfld(fprog(36),'VN_NM','CM/S', | 'NEUTRAL MERIDIONAL WIND (TIME N-1)') call mkfld(fprog(37),'O2_NM' ,'MMR','MOLECULAR OXYGEN (TIME N-1)') call mkfld(fprog(38),'OX_NM' ,'MMR','OXYGEN GROUP (TIME N-1)') call mkfld(fprog(39),'N4S_NM','MMR','N4S (TIME N-1)') call mkfld(fprog(40),'NOZ_NM','MMR','NO GROUP (TIME N-1)') call mkfld(fprog(41),'CO_NM' ,'MMR','CARBON MONOXIDE (TIME N-1)') call mkfld(fprog(42),'CO2_NM','MMR','CARBON DIOXIDE (TIME N-1)') call mkfld(fprog(43),'H2O_NM','MMR','WATER VAPOR (TIME N-1)') call mkfld(fprog(44),'H2_NM' ,'MMR', | 'MOLECULAR HYDROGEN (TIME N-1)') call mkfld(fprog(45),'HOX_NM','MMR','HYDROGEN GROUP (TIME N-1)') call mkfld(fprog(46),'OP_NM' ,'MMR','O+ (TIME N-1)') call mkfld(fprog(47),'CH4_NM','MMR','METHANE (TIME N-1)') call mkfld(fprog(48),'AR_NM' ,'MMR','ARGON (TIME N-1)') call mkfld(fprog(49),'HE_NM' ,'MMR','HELIUM (TIME N-1)') call mkfld(fprog(50),'NAT_NM','MMR','TOTAL SODIUM (TIME N-1)') call mkfld(fprog(51),'NMS' ,'MMR','MBAR') call mkfld(fprog(52),'NVC' ,'MMR','NVC') ! do i=1,nfprog fprog(i)%prognostic = .true. enddo ! ! do i=1,nfprog ! call print_fld(fprog(i)) ! enddo ! end subroutine set_fprog !----------------------------------------------------------------------- subroutine set_fsech(secflds,nfsech) ! ! Initialize secondary history fields type array fsech: ! type (field) :: fsech(mxfsech) (mxfsech is in params.h) ! On input, secflds(mxfsech) contains field names requested by user ! (these may be prognostics or diagnostics) ! ! Args: character(len=*),intent(in) :: secflds(mxfsech) integer,intent(out) :: nfsech ! ! Local: integer :: i,iprog,idiag,ier character(len=len_name) :: fprog_names(nfprog) ! ! External: integer,external :: strloc ! fsech(:)%name = ' ' ! init fsech(:)%long_name = ' ' ! init fsech(:)%units = ' ' ! init fsech(:)%magnetic = .false. ! init nfsech = 0 fprog_names(:) = fprog(:)%name do i=1,mxfsech if (len_trim(secflds(i)) > 0) then nfsech = nfsech+1 iprog = strloc(fprog_names,nfprog,secflds(i)) ! ! Is a prognostic: define fsech(i) from fprog(iprog): ! if (iprog > 0) then call mkfld(fsech(nfsech),fprog(iprog)%name, | fprog(iprog)%units,fprog(iprog)%long_name) fsech(nfsech)%prognostic = .true. ! ! Is a diagnostic: define fsech(i)%name from input field name. ! Set units and long_name blank (will be optionally defined in ! user called sub addfsech) ! else ! is diagnostic fsech(nfsech)%name = secflds(i) fsech(nfsech)%units = ' ' fsech(nfsech)%long_name = ' ' fsech(nfsech)%prognostic = .false. ! ! Allocate pointer to data for 3d diagnostic field and initialize ! the data to spval. The field should be defined later by user-called ! sub addfsech. ! allocate(fsech(nfsech)%data(zimxp,zjmx,zkmxp),stat=ier) if (ier /= 0) then write(6,"(/,'>>> WARNING fset_fsech:', | ' error allocating fsech(nfsech)%data: nfsech=', | i3)") nfsech else write(6,"('set_fsech: i=',i2,' nfsech=',i2, | ' fsech(nfsech)%name=',a,' allocated data where:', | ' zimxp=',i3,' zjmx=',i3,' zkmxp=',i3)") | i,nfsech,fsech(nfsech)%name,zimxp,zjmx,zkmxp endif fsech(nfsech)%data = spval ! array op endif endif enddo end subroutine set_fsech !----------------------------------------------------------------------- subroutine set_fsechmag(secfmag) ! ! Args: character(len=*),intent(in) :: secfmag(mxfsech) ! ! Local: integer :: i,iprog,idiag,nfsech,ier ! fsechmag(:)%name = ' ' ! init fsechmag(:)%long_name = ' ' ! init fsechmag(:)%units = ' ' ! init fsechmag(:)%magnetic = .true. ! init nfsech = 0 do i=1,mxfsech if (len_trim(secfmag(i)) > 0) then nfsech = nfsech+1 ! ! All magnetic grid fields are diagnostic: fsechmag(nfsech)%name = secfmag(i) fsechmag(nfsech)%units = ' ' fsechmag(nfsech)%long_name = ' ' fsechmag(nfsech)%prognostic = .false. ! ! Allocate pointer to data for 3d diagnostic field and initialize ! the data to spval. The field should be defined later by user-called ! sub addfsech. ! Magnetic grid dimensions are imaxmp (longitudes), jmaxm (latitudes), ! and zkmxp+3. The vertical is zkmxp+3 because magnetic fields are ! dimensioned (-2:KMAXP), e.g., see transmag.h. ! allocate(fsechmag(nfsech)%data(imaxmp,jmaxm,zkmxp+3), | stat=ier) if (ier /= 0) then write(6,"(/,'>>> WARNINNG set_fsechmag:', | ' error allocating fsechmag(nfsech)%data: nfsech=', | i3)") nfsech else write(6,"('set_fsechmag: i=',i2,' nfsech=',i2, | ' fsechmag(nfsech)%name=',a,' allocated data where:', | ' imaxmp=',i3,' jmaxm=',i3,' zkmxp+3=',i3)") | i,nfsech,fsechmag(nfsech)%name,imaxmp,jmaxm,zkmxp+3 endif fsechmag(nfsech)%data = spval ! array op endif enddo end subroutine set_fsechmag !----------------------------------------------------------------------- subroutine mkfld(f,name,units,long_name) ! ! Args: type(field),intent(out) :: f character(len=*) :: name,units,long_name ! ! Local: integer :: l_name,l_units,l_long_name ! l_name = len_trim(name) if (l_name > len_name) then write(6,"('>>> mkfld: field name too long (will use max', | ' char len of ',i2,')')") len_name write(6,"(' long_name will be: ',a)") long_name(1:len_name) l_name = len_name endif ! l_units = len_trim(units) if (l_units > len_units) then write(6,"('>>> mkfld: field units too long (will use max', | ' char len of ',i3,')')") len_units write(6,"(' units will be: ',a)") units(1:len_units) l_units = len_units endif ! l_long_name = len_trim(long_name) if (l_long_name > len_long_name) then write(6,"('>>> mkfld: field long_name too long (will use max', | ' char len of ',i3,')')") len_long_name write(6,"(' long_name will be: ',a)") long_name(1:len_units) l_long_name = len_long_name endif ! f%name = ' ' f%units = ' ' f%long_name = ' ' ! f%name(1:l_name) = trim(name) f%units(1:l_units) = trim(units) f%long_name(1:l_long_name) = trim(long_name) end subroutine mkfld !----------------------------------------------------------------------- subroutine print_fld(f) ! ! Print a field type to stdout: ! type(field),intent(in) :: f ! write(6,"(/,'Field name = ',a)") trim(f%name) write(6,"( ' units = ',a)") trim(f%units) write(6,"( ' long_name = ',a)") trim(f%long_name) write(6,"( ' prognostic = ',l1)") f%prognostic end subroutine print_fld !----------------------------------------------------------------------- integer function findnx(name) #include "index.h" ! ! Given a field short name "name", return integer "pointer" index ! for that field in the fg-array. E.g., if name=='TN', return NT. ! Input "name" must be one of fprog(:)%name. ! ! Args: character(len=*),intent(in) :: name ! if (.not.any(fprog%name==name)) then write(6,"('>>> findnx: unrecognized field name: ',a)") | trim(name) findnx = -1 return endif ! select case (trim(name)) case('TN') ; findnx = NT case('UN') ; findnx = NU case('VN') ; findnx = NV case('O2') ; findnx = NPS case('OX') ; findnx = NPS2 case('N4S') ; findnx = NPN4S case('NOZ') ; findnx = NPNOZ case('CO') ; findnx = NPCO case('CO2') ; findnx = NPCO2 case('H2O') ; findnx = NPH2O case('H2') ; findnx = NPH2 case('HOX') ; findnx = NPHOX case('OP') ; findnx = NOP case('CH4') ; findnx = NPCH4 case('AR') ; findnx = NPAR case('HE') ; findnx = NPHE case('NAT') ; findnx = NPNAT case('O21D') ; findnx = NPO21D case('NO2') ; findnx = NPNO2 case('NO') ; findnx = NPNO case('O3') ; findnx = NPO3 case('O1') ; findnx = NPO1 case('OH') ; findnx = NPOH case('HO2') ; findnx = NPHO2 case('H') ; findnx = NPH case('N2D') ; findnx = NPN2D case('TI') ; findnx = NTI case('TE') ; findnx = NTE case('NE') ; findnx = NE case('O2P') ; findnx = NO2P case('W') ; findnx = NW case('Z') ; findnx = NZ case('POTEN') ; findnx = NPHI ! case('TN_NM') ; findnx = NTNM case('UN_NM') ; findnx = NUNM case('VN_NM') ; findnx = NVNM case('O2_NM') ; findnx = NPSNM case('OX_NM') ; findnx = NPS2NM case('N4S_NM') ; findnx = NN4SNM case('NOZ_NM') ; findnx = NPNOZNM case('CO_NM') ; findnx = NPCONM case('CO2_NM') ; findnx = NPCO2NM case('H2O_NM') ; findnx = NPH2ONM case('H2_NM') ; findnx = NPH2NM case('HOX_NM') ; findnx = NPHOXNM case('OP_NM') ; findnx = NOPNM case('CH4_NM') ; findnx = NPCH4NM case('AR_NM') ; findnx = NPARNM case('HE_NM') ; findnx = NPHENM case('NAT_NM') ; findnx = NPNATNM case('NMS') ; findnx = NMS case('NVC') ; findnx = NVC ! case default write(6,"(/,'>>> findnx: unrecognized field name: ',a)") | trim(name) findnx = -1 end select end function findnx end module fields_module