! subroutine dynamics(istep,do_rtc) ! ! Call dynamics layer of the model for current time step. ! Routines that do not have to do message-passing are generally called ! from inside a latitude scan in this routine. Routines that do have ! to make mpi calls are called once from this routine, and latitude ! scan(s) are inside the called routine. ! ! ----------------------------------------------------------------- ! Titan TGCM modifications. Latest version: 9/16/04 S. W. BOUGHER ! Titan TGCM modifications. Latest version: 9/17,20/04 S. W. BOUGHER ! Titan TGCM modifications. Latest version: 9/22/04 S. W. BOUGHER (TEST#1) ! Titan TGCM modifications. Latest version: 1/26/05 S. W. BOUGHER (TEST#1 WARMING) ! Titan TGCM modifications. Latest version: 1/27/05 S. W. BOUGHER (TEST#2) ! Titan TGCM modifications. Latest version: 4/07/05 S. W. BOUGHER (TEST#2) ! Titan TGCM modifications. Latest version: 4/11/05 S. W. BOUGHER (TEST#3) ! Titan TGCM modifications. Latest version: 4/12/05 S. W. BOUGHER (TEST#3b) ! Titan TGCM modifications. Latest version: 4/13/05 S. W. BOUGHER (TEST#4) ! -- add all subs used from qrj_module (8) ! -- add all subs used from hcncool_module (2) ! -- add all subs used from hdif_module (3) ! ----------------------------------------------------------------- ! -- Stubs available for all subroutine calls prior to testing ! -- Sequential testing with addfsech diagnostic plots to check ! ----------------------------------------------------------------- ! ! Include the option of setting the lower boundary by using GSWM output ! this affects subroutine dt and duv ! use fields_module use mpi_module,only: lon0,lon1,lat0,lat1,mytidi #ifdef MPI use mpi_module,only: distribute_1d,mp_close #endif use bndry_module,only: bndcmp use qrj_module,only: qrj, euvac, ssflux, alloc_q, init_sflux, | init_sigmas, init_euvac, init_qrj use chapman_module,only: chapman use hcncool_module,only: hcncool,init_hcn use hdif_module,only: hdif3,hdif_bndlons,hdif_periodic ! use chemrates_module,only: chemrates_tdep ! use n4s_module,only: comp_n4s,minor_n4s implicit none ! ! Args: integer,intent(in) :: istep logical,intent(in) :: do_rtc ! ! VT vampir tracing: ! #ifdef VT #include "VT.inc" #endif ! ! Local: integer :: i,j,n,lat,ier logical :: debug=.false. ! logical :: debug=.true. real :: time0,tsec,rtc0_qrj,rtc_qrj ! do j=lat0,lat1 ! do i=lon0,lon1 ! write(6,"('enter dynamics: itp=',i3,' lat=',i3, ! | ' (lat0,1=',2i3,') i=',i3,' (lon0,1=',2i3,') un(:,i)=', ! | /,(6e12.4))") itp,j,lat0,lat1,i,lon0,lon1,un(:,i,j,itp) ! enddo ! i=lon0,lon1 ! enddo ! j=lat0,lat1 ! if (debug) write(6,"(/,'Enter dynamics.')") ! ----------------------------------------------------------------- ! Set Lower Boundary Conditions: call bndcmp ! ----------------------------------------------------------------- ! if (debug) write(6,"('dynamics after bndcmp')") ! ! ----------------------------------------------------------------- ! Calculate specific heat and molecular viscosity. ! f4d itp fields are input, f3d fields are output. (09/16/04). Working. ! ----------------------------------------------------------------- ! if (do_rtc) call timer(time0,tsec,'begin') do lat=lat0,lat1 call cpktkm( | tn(levd0,lond0,lat,itp), ! 4d input | ch4(levd0,lond0,lat,itp), ! 4d input | h2(levd0,lond0,lat,itp), ! 4d input | cp(levd0,lond0,lat), ! 3d output | kt(levd0,lond0,lat), ! 3d output | km(levd0,lond0,lat), ! 3d output | 1,nlevp1,lon0,lon1,lat) enddo ! lat=lat0,lat1 if (do_rtc) then call timer(time0,tsec,'end') ! write(6,"('Dynamics step ',i4,': rtc time for cpktkm=',f8.2)") ! | istep,tsec endif if (debug) write(6,"('dynamics after cpktkm')") ! ! ----------------------------------------------------------------- ! Calculate omega for vertical velocity: ! (latitude scan is inside swdot) ! ----------------------------------------------------------------- ! ! do lat=lat0,lat1 ! do i=lon0,lon1 ! write(6,"('dynamics before swdot: lat=',i3,' (lat0,1=',2i3, ! | ') i=',i3,' (lon0,1=',2i3,') un(:,i)=', ! | /,(6e12.4))") lat,lat0,lat1,i,lon0,lon1,un(:,i,lat,itp) ! enddo ! i=lon0,lon1 ! enddo ! lat=lat0,lat1 ! if (do_rtc) call timer(time0,tsec,'begin') if (debug) write(6,"('dynamics before swdot')") call swdot( | un(levd0,lond0,latd0,itp), ! un input | vc(levd0,lond0,latd0,itp), ! vc input | w (levd0,lond0,latd0,itc), ! omega output | 1,nlevp1,lon0,lon1,lat0,lat1,lat0,lat1) if (do_rtc) then call timer(time0,tsec,'end') ! write(6,"('Dynamics step ',i4,': rtc time for swdot=',f8.2)") ! | istep,tsec endif if (debug) write(6,"('dynamics after swdot')") ! ! ----------------------------------------------------------------- ! Calculate column densities and line integrals of ch4, h2, and n2. ! Prognostics z,tn,ch4,h2,barm are input, diagnostics vch4,vh2,vn2, ! scch4,sch2,scn2 are output. (09/21/04) Working. ! ----------------------------------------------------------------- ! if (do_rtc) call timer(time0,tsec,'begin') do lat=lat0,lat1 call chapman( | z (levd0,lond0,lat,itc), ! updated Z from addiag | tn (levd0,lond0,lat,itp), ! 4d in | ch4 (levd0,lond0,lat,itp), ! 4d in | h2 (levd0,lond0,lat,itp), ! 4d in | barm (levd0,lond0,lat,itp), ! 4d in | vch4 (levd0,lond0,lat), ! 3d out | vh2 (levd0,lond0,lat), ! 3d out | vn2 (levd0,lond0,lat), ! 3d out | scch4(levd0,lond0,lat), ! 3d out | sch2 (levd0,lond0,lat), ! 3d out | scn2 (levd0,lond0,lat), ! 3d out | 1,nlevp1,lon0,lon1,lat) enddo ! lat=lat0,lat1 if (do_rtc) then call timer(time0,tsec,'end') ! write(6,"('Dynamics step ',i4,': rtc time for chapman=',f8.2)") ! | istep,tsec endif if (debug) write(6,"('dynamics after chapman')") ! ! ----------------------------------------------------------------- ! Calculate temperature dependent reaction rates (chemrates_module): ! ----------------------------------------------------------------- ! ! if (do_rtc) call timer(time0,tsec,'begin') ! do lat=lat0,lat1 ! call chemrates_tdep( ! | tn (levd0,lond0,lat,itp), ! | te (levd0,lond0,lat,itp), ! | ti (levd0,lond0,lat,itp), ! | scn2(levd0,lond0,lat), ! | vn2 (levd0,lond0,lat), ! | 1,nlevp1,lon0,lon1,lat) ! enddo ! if (do_rtc) then ! call timer(time0,tsec,'end') ! write(6,"('Dynamics step ',i4,': rtc time for chemrates=', ! | f8.2)") istep,tsec ! endif ! if (debug) write(6,"('dynamics after chemrates_tdep')") ! ! Latitude scan for qrj ! if (do_rtc) then call timer(time0,tsec,'begin') rtc_qrj = 0. endif ! #ifdef VT code = 122 ; state = 'ions' ; activity='ModelCode' call vtbegin(122,ier) #endif ! ----------------------------------------------------------------- ! Calculate (N2+CH4) ionization + dissociation and heating rates: ! Note timer has barrier calls, and timing for qrj is ! inside j-loop. ! Working (4/07/05) ! ----------------------------------------------------------------- do lat=lat0,lat1 if (do_rtc) call timer(rtc0_qrj,tsec,'begin') call qrj( | scch4(levd0,lond0,lat), | sch2 (levd0,lond0,lat), | scn2 (levd0,lond0,lat), | tn (levd0,lond0,lat,itp), | ch4 (levd0,lond0,lat,itp), | h2 (levd0,lond0,lat,itp), | xnmbari(levd0,lond0,lat), | cp(levd0,lond0,lat), | 1,nlevp1,lon0,lon1,lat) if (do_rtc) then call timer(rtc0_qrj,tsec,'end') rtc_qrj = rtc_qrj+tsec endif ! if (debug) write(6,"('dynamics after qrj: lat=',i3)") lat enddo ! lat=lat0,lat1 for qrj #ifdef VT code = 122 ; state = 'ions' ; activity='ModelCode' call vtend(122,ier) #endif ! ! ----------------------------------------------------------------- ! Electron density: from Photochemical Ions only (dev. elden scheme) ! 3-D Fields : PCE ONLY (most hydrocarbon ions) ! -- Number densities (only) ! 4-D Fields : Ion diffusion and transport is crucial for N+? ! | nplus (levd0,lond0,lat,itp), ! N+ at current time step ! | nplus (levd0,lond0,lat,itc), ! N+ updated by sub nplus ! -- Both Number densities plus mass mixing ratios ! ----------------------------------------------------------------- ! ! if (do_rtc) call timer(time0,tsec,'begin') ! do lat=lat0,lat1 ! call elden( ! | tn (levd0,lond0,lat,itp), ! | barm (levd0,lond0,lat,itp), ! | n2 (levd0,lond0,lat,itp), ! | ch4 (levd0,lond0,lat,itp), ! | h2 (levd0,lond0,lat,itp), ! | h (levd0,lond0,lat,itp), ! | hcn (levd0,lond0,lat,itp), ! | n4s (levd0,lond0,lat,itp), ! | ch3 (levd0,lond0,lat,itp), ! | nplus (levd0,lond0,lat), ! N+ output ! | n2p (levd0,lond0,lat), ! N2+ output ! | ch3p (levd0,lond0,lat), ! CH3+ output ! | ch5p (levd0,lond0,lat), ! CH5+ output ! | c2h5P (levd0,lond0,lat), ! C2H5P+ output ! | h2cnp (levd0,lond0,lat), ! H2CH+ output ! | hevp (levd0,lond0,lat), ! HEV+ output ! | ne (levd0,lond0,lat,itc), ! electron density output ! | 1,nlevp1,lon0,lon1,lat) ! enddo ! lat=lat0,lat1 ! if (do_rtc) then ! call timer(time0,tsec,'end') ! write(6,"('Dynamics step ',i4,': rtc time for elden=', ! | f8.2)") istep,tsec ! endif ! if (debug) write(6,"('dynamics after oplus')") ! ! ----------------------------------------------------------------- ! Advance n4s: ! ----------------------------------------------------------------- ! ! if (do_rtc) call timer(time0,tsec,'begin') ! do lat=lat0,lat1 ! call comp_n4s( ! | tn (levd0,lond0,lat,itp), ! TN (deg K) ! | o2 (levd0,lond0,lat,itp), ! O2 (mmr) ! | o1 (levd0,lond0,lat,itp), ! O (mmr) ! | barm (levd0,lond0,lat,itp), ! mean mol weight ! | xnmbarm(levd0,lond0,lat), ! p0*e(-z)*barm ! | no (levd0,lond0,lat,itp), ! NO ! | n2d (levd0,lond0,lat,itc), ! N(2D) from comp_n2d ! | ne (levd0,lond0,lat,itp), ! Ne ! | o2p (levd0,lond0,lat,itp), ! O2+ ! | op (levd0,lond0,lat,itp), ! O+ ! | n2p (levd0,lond0,lat), ! N2+ from elden ! | nplus (levd0,lond0,lat), ! N+ from elden ! | nop (levd0,lond0,lat), ! NO+ from elden ! | 1,nlevp1,lon0,lon1,lat) ! enddo ! lat=lat0,lat1 ! if (do_rtc) then ! call timer(time0,tsec,'end') ! write(6,"('Dynamics step ',i4,': rtc time for comp_n4s=',f8.2)") ! | istep,tsec ! endif ! if (debug) write(6,"('dynamics after comp_n4s')") ! ! ----------------------------------------------------------------- ! Minor_n4s calls sub minor, which has 3d mpi calls, including gather/scatter ! for fft filtering. Full 3d task subdomains are passed. ! ----------------------------------------------------------------- ! ! if (do_rtc) call timer(time0,tsec,'begin') ! call minor_n4s( ! | tn (levd0,lond0,latd0,itp), ! TN (deg K) ! | o2 (levd0,lond0,latd0,itp), ! O2 (mmr) ! | o1 (levd0,lond0,latd0,itp), ! O (mmr) ! | n4s (levd0,lond0,latd0,itp), ! n4s from previous step ! | n4s_nm (levd0,lond0,latd0,itp), ! n4s at time n-1 ! | n4s (levd0,lond0,latd0,itc), ! output n4s ! | n4s_nm (levd0,lond0,latd0,itc), ! output n4s at time n-1 ! | 1,nlevp1,lon0,lon1,lat0,lat1) ! if (do_rtc) then ! call timer(time0,tsec,'end') ! write(6,"('Dynamics step ',i4,': rtc time for minor_n4s=', ! | f8.2)") istep,tsec ! endif ! if (debug) write(6,"('dynamics after minor_n4s')") ! ! ----------------------------------------------------------------- ! Explicit cooling terms: 4d fields inputs; 3d field output ! ----------------------------------------------------------------- if (do_rtc) call timer(time0,tsec,'begin') do lat=lat0,lat1 call hcncool( | tn (levd0,lond0,lat,itp), | ch4 (levd0,lond0,lat,itp), | h2 (levd0,lond0,lat,itp), | hcn (levd0,lond0,lat,itp), | barm(levd0,lond0,lat,itp), | cp (levd0,lond0,lat), | z (levd0,lond0,lat,itc), ! updated Z from addiag | xnmbari(levd0,lond0,lat), ! used to get number density | cool_explicit(levd0,lond0,lat), ! output explicit cooling | 1,nlevp1,lon0,lon1,lat) enddo ! lat=lat0,lat1 if (do_rtc) then call timer(time0,tsec,'end') ! write(6,"('Dynamics step ',i4,': rtc time for hcncool=',f8.2)") ! | istep,tsec endif ! if (debug) write(6,"('dynamics after hcncool')") ! ! ----------------------------------------------------------------- ! Calculate horizontal diffusion terms for t,u,v,ch4,h2, using ! coefficients from hdif2 (hdif2 was called from advance). ! ! ----------------------------------------------------------------- ! Make boundary longitudes available for inputs to hdif3: call hdif_bndlons(kldt,kldu,kldv,kldch4,kldh2, | 1,nlevp1,lon0,lon1,lat0,lat1) ! ----------------------------------------------------------------- ! Make hdt,u,v,ch4,h2: ! ----------------------------------------------------------------- do lat=lat0,lat1 call hdif3( | cp(levd0,lond0,lat), ! specific heat input | kldt , ! 3d input from hdif2 for tn | kldu , ! 3d input from hdif2 for un | kldv , ! 3d input from hdif2 for vn | kldch4, ! 3d input from hdif2 for ch4 | kldh2, ! 3d input from hdif2 for h2 | hdt (levd0,lond0,lat), ! 2d tn output at current lat | hdu (levd0,lond0,lat), ! 2d un output at current lat | hdv (levd0,lond0,lat), ! 2d vn output at current lat | hdch4(levd0,lond0,lat), ! 2d ch4 output at current lat | hdh2(levd0,lond0,lat), ! 2d h2 output at current lat | 1,nlevp1,lon0,lon1,lat) enddo ! lat=lat0,lat1 ! if (debug) write(6,"('dynamics after hdif3')") ! ! Periodic points for horizontal diffusion terms output from hdif3: ! This may not be necessary. call hdif_periodic(hdt,hdu,hdv,hdch4,hdh2, | 1,nlevp1,lon0,lon1,lat0,lat1) ! ! ----------------------------------------------------------------- ! Advance neutral temperature: ! ----------------------------------------------------------------- ! call dt( | tn (levd0,lond0,latd0,itp), | tn_nm (levd0,lond0,latd0,itp), | un (levd0,lond0,latd0,itp), | vn (levd0,lond0,latd0,itp), | ch4 (levd0,lond0,latd0,itp), | h2 (levd0,lond0,latd0,itp), | barm (levd0,lond0,latd0,itp), ! mean molecular weight | cp (levd0,lond0,latd0), ! specific heat (cpktkm.F) | kt (levd0,lond0,latd0), ! molecular diffusion (cpktkm.F) | km (levd0,lond0,latd0), ! molecular viscosity (cpktkm.F) | hdt (levd0,lond0,latd0), ! horizontal diffusion (hdif.F) | cool_explicit(levd0,lond0,latd0), ! explicit cooling (hcncool.F) | w (levd0,lond0,latd0,itc), ! updated W (swdot.F) | tn (levd0,lond0,latd0,itc), ! output updated tn | tn_nm (levd0,lond0,latd0,itc), ! output updated tn at time n-1 | 1,nlevp1,lon0,lon1,lat0,lat1) ! if (debug) write(6,"('dynamics after dt')") ! ! ----------------------------------------------------------------- ! Advance neutral velocities: ! ----------------------------------------------------------------- ! ! call duv( ! | tn (levd0,lond0,latd0,itp), ! neutral temperature ! | tn (levd0,lond0,latd0,itc), ! updated neutral temperature (dt.F) ! | tn_nm (levd0,lond0,latd0,itp), ! tn at time n-1 ! | un (levd0,lond0,latd0,itp), ! zonal velocity ! | vn (levd0,lond0,latd0,itp), ! meridional velocity ! | un_nm (levd0,lond0,latd0,itp), ! zonal velocity at time n-1 ! | vn_nm (levd0,lond0,latd0,itp), ! meridional velocity at time n-1 ! | w (levd0,lond0,latd0,itc), ! updated vertical velocity (swdot.F) ! | barm (levd0,lond0,latd0,itp), ! mean molecular weight ! | z (levd0,lond0,latd0,itp), ! geopotential height ! | hdu (levd0,lond0,latd0), ! horizontal diffusion of U (hdif3.F) ! | hdv (levd0,lond0,latd0), ! horizontal diffusion of V (hdif3.F) ! | km (levd0,lond0,latd0), ! molecular viscosity (cpktkm.F) ! | un (levd0,lond0,latd0,itc), ! output updated un ! | un_nm (levd0,lond0,latd0,itc), ! output updated un at time n-1 ! | vn (levd0,lond0,latd0,itc), ! output updated vn ! | vn_nm (levd0,lond0,latd0,itc), ! output updated vn at time n-1 ! | 1,nlevp1,lon0,lon1,lat0,lat1) ! if (debug) write(6,"('dynamics after duv')") ! ! ----------------------------------------------------------------- ! Sources and sinks for major species composition H2, CH4: ! subroutine comp_h2ch4(tn,ch4,h2,barm,hcn,ch3,n4s,h,ne, ! | n2p,nplus,h2chp,c2h5p,ch5p,lev0,lev1,lon0,lon1,lat) ! Assume (Spring 2005) that ch4 and h2 are inert: chemical lifetime ! long wrt diffusion and dynamics. Add chemistry later (e.g. h2) ! ----------------------------------------------------------------- ! Advance ch4, h2: ! subroutine comp(tn,ch4,ch4_nm,h2,h2_nm,un,vn,w,hdch4,hdh2, ! | ch4_upd,ch4nm_upd,h2_upd,h2nm_upd, ! | lev0,lev1,lon0,lon1,lat0,lat1) ! ----------------------------------------------------------------- ! ! call comp( ! | tn (levd0,lond0,latd0,itp), ! neutral temperature ! | ch4 (levd0,lond0,latd0,itp), ! CH4 (mmr) ! | ch4_nm (levd0,lond0,latd0,itp), ! CH4 (mmr) at time n-1 ! | h2 (levd0,lond0,latd0,itp), ! H2 (mmr) ! | h2_nm (levd0,lond0,latd0,itp), ! H2 (mmr) at time n-1 ! | un (levd0,lond0,latd0,itp), ! zonal velocity ! | vn (levd0,lond0,latd0,itp), ! meridional velocity ! | w (levd0,lond0,latd0,itp), ! vertical velocity ! | hdch4 (levd0,lond0,latd0), ! CH4 horizontal diffusion (hdif3) ! | hdh2 (levd0,lond0,latd0), ! H2 horizontal diffusion (hdif3) ! | ch4 (levd0,lond0,latd0,itc), ! output: CH4 updated for current step ! | ch4_nm (levd0,lond0,latd0,itc), ! output: CH4 updated for previous step ! | h2 (levd0,lond0,latd0,itc), ! output: H2 updated for current step ! | h2_nm (levd0,lond0,latd0,itc), ! output: H2 updated for previous step ! | 1,nlevp1,lon0,lon1,lat0,lat1) ! if (debug) write(6,"('dynamics after comp')") ! ! ----------------------------------------------------------------- if (debug) write(6,"('dynamics returning')") ! ----------------------------------------------------------------- end subroutine dynamics