! module fields_module implicit none ! include "params.h" ! for mxfsech ! integer,parameter :: nfprog = 24 ! number of prognostic fields ! (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: character(len=8) :: names(nfprog) character(len=16) :: units(nfprog) character(len=56) :: long_names(nfprog) integer :: i ! ! 'TN' ,'UN','VN','O2','O1' ,'N4S','NO','OP' ! 'N2D','TI','TE','NE','O2P','W' ,'Z' ! ! 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 ),'O1' ,'MMR' ,'ATOMIC OXYGEN') call mkfld(fprog(6 ),'N4S','MMR' ,'N4S') call mkfld(fprog(7 ),'NO' ,'MMR' ,'NITRIC OXIDE') call mkfld(fprog(8 ),'OP' ,'CM^3' ,'O+ ION') call mkfld(fprog(9 ),'N2D','MMR' ,'N2D') call mkfld(fprog(10),'TI' ,'DEG K','ION TEMPERATURE') call mkfld(fprog(11),'TE' ,'DEG K','ELECTRON TEMPERATURE') call mkfld(fprog(12),'NE' ,'CM^3' ,'ELECTRON DENSITY') call mkfld(fprog(13),'O2P','CM^3' ,'O2+ ION') call mkfld(fprog(14),'W' ,'CM/S' , | 'VERTICAL VELOCITY (PLUS UP)') call mkfld(fprog(15),'Z' ,'KM' ,'GEOPOTENTIAL HEIGHT') call mkfld(fprog(16),'POTEN','VOLTS','ELECTRIC POTENTIAL') call mkfld(fprog(17),'TN_NM','DEG K', | 'NEUTRAL TEMPERATURE (TIME N-1)') call mkfld(fprog(18),'UN_NM','CM/S', | 'NEUTRAL ZONAL WIND (TIME N-1)') call mkfld(fprog(19),'VN_NM','CM/S', | 'NEUTRAL MERIDIONAL WIND (TIME N-1)') call mkfld(fprog(20),'O2_NM','MMR','MOLECULAR OXYGEN (TIME N-1)') call mkfld(fprog(21),'O1_NM','MMR','ATOMIC OXYGEN (TIME N-1)') call mkfld(fprog(22),'N4S_NM','MMR','N4S (TIME N-1)') call mkfld(fprog(23),'NO_NM' ,'MMR','NO (TIME N-1)') call mkfld(fprog(24),'OP_NM' ,'MMR','O+ (TIME N-1)') ! 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 ! ! External: integer,external :: strloc ! fsech(:)%name = ' ' ! init fsech(:)%long_name = ' ' ! init fsech(:)%units = ' ' ! init fsech(:)%magnetic = .false. ! init nfsech = 0 do i=1,mxfsech if (len_trim(secflds(i)) > 0) then nfsech = nfsech+1 iprog = strloc(fprog%name,mxfsech,secflds(i)) ! ! Is a prognostic: define fsech(i) from fprog(iprog): ! integer function strloc(strarray,nstr,str) ! 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) write(6,"(/,'>>> WARNINNG fset_fsech:', | ' error allocating fsech(nfsech)%data: nfsech=', | i3)") nfsech 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 ! ! External: integer,external :: strloc ! 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) write(6,"('set_fsechmag: i=',i2,' nfsech=',i2,' name=',a)") | i,nfsech,fsechmag(nfsech)%name 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) write(6,"(/,'>>> WARNINNG set_fsechmag:', | ' error allocating fsechmag(nfsech)%data: nfsech=', | i3)") nfsech 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 ! ! Field "pointers" of "old" fg (and f) array: ! ! 1 NT 0 KMAXP1 1 1 ! 2 NU 29 KMAXP1 -1 1 ! 3 NV 58 KMAXP1 -1 -1 ! 4 NPS 87 KMAXP1 1 1 ! 5 NPS2 116 KMAXP1 1 1 ! 6 NPN4S 145 KMAXP1 1 1 ! 7 NPNO 174 KMAXP1 1 1 ! 8 NOP 203 KMAXP1 1 1 ! 9 NPN2D 232 KMAXP1 0 0 ! 10 NTI 261 KMAXP1 1 1 ! 11 NTE 290 KMAXP1 1 1 ! 12 NE 319 KMAXP1 0 0 ! 13 NO2P 348 KMAXP1 0 0 ! 14 NW 377 KMAXP1 1 1 ! 15 NZ 406 KMAXP1 1 1 ! 16 NPHI 435 KMAXP1 1 1 ! NPHIH is not written to new histories ! 17 NPHIH 464 1 1 1 ! 18 NTNM 465 KMAXP1 1 1 ! 19 NUNM 494 KMAXP1 -1 1 ! 20 NVNM 523 KMAXP1 -1 -1 ! 21 NPSNM 552 KMAXP1 1 1 ! 22 NPS2NM 581 KMAXP1 1 1 ! 23 NN4SNM 610 KMAXP1 1 1 ! 24 NPNONM 639 KMAXP1 1 1 ! 25 NOPNM 668 KMAXP1 1 1 ! 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('O1') ; findnx = NPS2 case('N4S') ; findnx = NPN4S case('NO') ; findnx = NPNO case('OP') ; findnx = NOP 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('O1_NM') ; findnx = NPS2NM case('N4S_NM') ; findnx = NN4SNM case('NO_NM') ; findnx = NPNONM case('OP_NM') ; findnx = NOPNM case default write(6,"(/,'>>> findnx: unrecognized field name: ',a)") | trim(name) findnx = -1 end select end function findnx !----------------------------------------------------------------------- end module fields_module