/fis/hao/tgcm/bin/Diffsrc executing from /ptmp/foster/ganglu_tiegcm_amie/modsrc2 at Tue Apr 21 17:14:46 MDT 2009 Using tgcmroot from TGCMROOT env var: /fis/hao/tgcm Source code directory = /fis/hao/tgcm/tiegcm1.92/src ======================================================================== Diff of /fis/hao/tgcm/tiegcm1.92/src/advance.F and /ptmp/foster/ganglu_tiegcm_amie/modsrc2/advance.F 1d0 < module advance_module 3,6c2 < ! This software is part of the NCAR TIE-GCM. Use is governed by the < ! Open Source Academic Research License Agreement contained in the file < ! tiegcmlicense.txt. < ! --- > module advance_module 20,36c16,22 < use weimer_module,only: weimer01 ! Weimer 2001 model < use wei05sc,only: weimer05, ! Weimer 2005 model < | wei05sc_fac ! field-aligned current diagnostic (nmlonp1,nmlat) < use input_module,only: start,step,idynamo=>dynamo,f107,f107a, < | calendar_advance,gpi_ncfile,potential_model,wei05sc_ncfile, < | imf_ncfile < use input_module,only: < | power ,power_time ,ntimes_power, rd_power, < | ctpoten,ctpoten_time,ntimes_ctpoten, < | bximf ,bximf_time ,ntimes_bximf, < | byimf ,byimf_time ,ntimes_byimf, < | bzimf ,bzimf_time ,ntimes_bzimf, < | swden ,swden_time ,ntimes_swden, < | swvel ,swvel_time ,ntimes_swvel, < | al ,al_time ,ntimes_al < use init_module,only: istep,uthr,iter,secs,iday,iyear < use cons_module,only: dt,re,cs,racs,ylatm,rtd --- > use weimer_module,only: weimer01 > use input_module,only: start,step,iaurora=>aurora,idynamo=>dynamo, > | f107,f107a,ctpoten,power,calendar_advance,ntimes_ctpoten, > | ctpoten_time,ntimes_power,power_time,potential_model, > | iamie,amie_ibkg,amiesh,amienh > use init_module,only: istep,uthr,iter,secs,iday,iyear,igetgpi > use cons_module,only: dt 41,42c27 < use aurora_module,only: aurora_cons,cusp2d,drzl2d,alfa2d,nflx2d, < | eflux2d --- > use aurora_module,only: aurora_cons,cusp2d,drzl2d,alfa2d,nflx2d 45,46c30,31 < use dynamo_module,only: prep_dynamo,dynamo, < | phihm,nmlat0,zpotenm3d --- > use dynamo_module,only: prep_dynamo,prep_dynamo_dyn0,dynamo, > | nodynamo,phihm,nmlat0,zpotenm3d 48d32 < use imf_module,only: getimf 50c34,35 < use params_module,only: nlonp4,nlat,nlev --- > use params_module,only: nlonp4,nlat > use amie_module,only: getamie,tiepot 52,56d36 < use addfld_module,only: addfld < #if defined(INTERCOMM) || defined(CISMAH) < use cism_coupling_module,only: import, export, geng,gflx < #endif < 65,66c45 < | mp_periodic_f4d,mp_updatephi,mp_updateemphi,mp_updateemlam, < | mp_updateemz --- > | mp_periodic_f4d,mp_updatephi 82,84d60 < #if defined(INTERCOMM) || defined(CISMAH) < integer :: cmodeltime(4) !CISM coupling time < #endif 90c66,67 < real :: secs_per_step,dday, --- > real :: w_ik(nlonp4,nlevp1) > real :: secs_per_step, 105,106c82 < logical,external :: wrhist < real,external :: hp_from_bz_swvel --- > logical,external :: wrhist,time2print 120a97 > ! 123d99 < if (debug) write(6,"('advance after update modeltime..')") 142,143d117 < if (debug) < | write(6,"('advance calling mp_gather2root for prim..')") 145d118 < if (debug) write(6,"('advance calling outhist..')") 147d119 < if (debug) write(6,"('advance after outhist..')") 153,158d124 < < tlbc_glb(lon0:lon1,lat0:lat1) = tlbc(lon0:lon1,lat0:lat1) < ulbc_glb(lon0:lon1,lat0:lat1) = ulbc(lon0:lon1,lat0:lat1) < vlbc_glb(lon0:lon1,lat0:lat1) = vlbc(lon0:lon1,lat0:lat1) < < if (debug) write(6,"('advance calling outhist..')") 160d125 < if (debug) write(6,"('advance after outhist..')") 192,194d156 < #if defined(INTERCOMM) || defined(CISMAH) < cmodeltime=modeltime !!! CISM ad hoc coupling < #endif 198d159 < if (debug) write(6,"('advance after update time params..')") 199a161,172 > ! Report to stdout (data is actually from previous step): > if (time2print(nstep,istep)) then > if (istep > 1) then > write(6,"('Step ',i6,' of ',i6,' mtime=',3i3, > | ' secs/step (',a,') =',f6.2)") istep,nstep,modeltime(1:3), > | timing_type,secs_per_step > else > write(6,"('Step ',i6,' of ',i6,' mtime=',3i3)") > | istep,nstep,modeltime(1:3) > endif > endif ! time2print > ! 206d178 < if (calendar_advance > 0) dday = float(iday)+secs/86400. 208,211c180,181 < ! Interpolate input parameters to current model time, if time-dependent < ! values were read from input. If namelist read parameter indices_interp < ! is zero, interpolation is not done. < ! --- > ! Interpolate power and/or ctpoten to current model time, if time-dependent > ! values were read from input: 217,228d186 < if (ntimes_bximf > 0) < | call set_index(bximf_time,ntimes_bximf,nsecs,bximf,'bximf') < if (ntimes_byimf > 0) < | call set_index(byimf_time,ntimes_byimf,nsecs,byimf,'byimf') < if (ntimes_bzimf > 0) < | call set_index(bzimf_time,ntimes_bzimf,nsecs,bzimf,'bzimf') < if (ntimes_swden > 0) < | call set_index(swden_time,ntimes_swden,nsecs,swden,'swden') < if (ntimes_swvel > 0) < | call set_index(swvel_time,ntimes_swvel,nsecs,swvel,'swvel') < if (ntimes_al > 0) < | call set_index(al_time,ntimes_al,nsecs,al,'al') 231c189 < if (len_trim(gpi_ncfile) > 0) then --- > if (igetgpi > 0) then 238,251d195 < ! Get imf data if necessary: < if (len_trim(imf_ncfile) > 0) then < iprint = 0 < if (istep==1) iprint = 1 < call getimf(iyear,iday,int(secs),istep,iprint) < endif < ! < ! If the potential model is Weimer and power was not provided < ! by namelist, then calculate power from bz and swvel. < if (potential_model(1:6)=='WEIMER'.and. < | rd_power==spval) then < power = hp_from_bz_swvel(bzimf,swvel) < endif < ! 255d198 < #if defined(INTERCOMM) || defined(CISMAH) 257c200,206 < ! Receive aurora parameters from the M-I coupler for CISM --- > ! Get AMIE data > if (iamie==1) then > iprint = 0 > if (istep==1) iprint = 1 > if (iprint>0) write(6,"('advance calling getamie...')") > call getamie(iyear,iday,int(secs),amie_ibkg,iprint) > endif 259,293d207 < if (mytid==0) call import < ! < ! Scatter data to other tasks if using MPI, periodic points already added < ! in ci_receive. Only need to scatter auroral characteristic energy and < ! flux, potential is used in dynamo which is a serial code < ! < #ifdef MPI < call cism_scatter(geng,lon0,lon1,lat0,lat1) < call cism_scatter(gflx,lon0,lon1,lat0,lat1) < #endif < #endif < < ! < ! Report to stdout: < if (time2print(nstep,istep)) then < if (istep > 1) then < write(6,"('Step ',i6,' of ',i6,' mtime=',4i3, < | ' secs/step (',a,') =',f6.2)") istep,nstep,modeltime, < | timing_type,secs_per_step < else < write(6,"('Step ',i6,' of ',i6,' mtime=',3i3)") < | istep,nstep,modeltime(1:3) < endif < if (len_trim(gpi_ncfile) > 0) then < write(6,"('GPI run: power=',f7.2,' ctpoten=',f7.2,' f107=', < | f7.2,' f107a=',f7.2)") power,ctpoten,f107,f107a < endif < if (len_trim(imf_ncfile) > 0) then < write(6,"('IMF run: bx=',f7.2,' by=',f7.2,' bz=',f7.2, < | ' swvel=',f7.2,' swden=',f7.2,' ctpoten=',f7.2, < | ' power=',f7.2)") bximf,byimf,bzimf,swvel,swden, < | ctpoten,power < endif < endif ! time2print < ! 309,310d222 < ! subroutine addiag(tn,o2,o1,vn,vc,barm,xnmbar,xnmbari,xnmbarm,z, < ! | zg,lon0,lon1,lev0,lev1,lat0,lat1) 313,317c225,229 < | tn (levd0,lond0,latd0,itp), ! in < | o2 (levd0,lond0,latd0,itp), ! in < | o1 (levd0,lond0,latd0,itp), ! in < | vn (levd0,lond0,latd0,itp), ! in < | vc (levd0,lond0,latd0,itp), ! out --- > | tn (levd0,lond0,latd0,itp), ! in > | o2 (levd0,lond0,latd0,itp), ! in > | o1 (levd0,lond0,latd0,itp), ! in > | vn (levd0,lond0,latd0,itp), ! in > | vc (levd0,lond0,latd0,itp), ! out 319,323c231,234 < | xnmbar (levd0,lond0,latd0), ! out < | xnmbari(levd0,lond0,latd0), ! out < | xnmbarm(levd0,lond0,latd0), ! out < | z (levd0,lond0,latd0,itp), ! out (note itp is output) < | zg (levd0,lond0,latd0), ! out (z with varying grav) --- > | xnmbar (levd0,lond0,latd0), ! out > | xnmbari(levd0,lond0,latd0), ! out > | xnmbarm(levd0,lond0,latd0), ! out > | z (levd0,lond0,latd0,itp), ! out (note itp is output) 388c299 < ! Get high latitude (Heelis or Weimer) colatitudes, NH pfrac, and poten phihm. --- > ! Get high latitude (Heelis or other) colatitudes, NH pfrac, and poten phihm. 392,398c303,321 < if (potential_model == 'WEIMER01') then < if (byimf==0..and.bzimf==0.) then < write(6,"(/,'>>> WARNING: byimf and bzimf are both zero', < | ' before call to weimer01.',/,'This will cause the ', < | 'weimer model to produce NaNs, so I am setting bzimf ', < | 'to .01')") < bzimf = .01 --- > ! If an amie run, ignore potential_model, and use electric potential from > ! amie module. > ! > if (iamie <= 0) then > if (potential_model == 'WEIMER') then > call weimer01 > if (debug) write(6,"('advance after weimer01: istep=',i4)") > | istep > elseif (potential_model == 'HEELIS') then > call heelis > if (debug) write(6,"('advance after heelis: istep=',i4)") > | istep > else ! potential_model='NONE' > do j=1,nmlat0 > do i=1,nmlonp1 > phihm(i,j) = 0. > enddo ! i=1,nmlonp1 > enddo ! j=1,nmlat0 > call colath 400,409d322 < call weimer01 < if (debug) write(6,"('advance after weimer01: istep=',i4)")istep < < ! write(6,"('wei01: mtime=',i3,',',i2,',',i2,' by,bz=',2f6.2, < ! | ' swvel=',f8.2,' swden=',f6.2,' al=',f8.2,' phihm min,max=', < ! | 2e12.4)") modeltime(1:3),byimf,bzimf,swvel,swden,al, < ! | minval(phihm),maxval(phihm) < < elseif (potential_model == 'WEIMER05'.or. < | potential_model == 'WEIMER') then 411,435c324,329 < ! sub weimer05 (wei05sc.F), calculates mag electric potential in phihm. < ! (if byimf==bzimf==0, then weimer05 will set bzimf = .01) < ! < call weimer05(byimf,bzimf,swvel,swden,wei05sc_ncfile,istep) < if (debug) write(6,"('advance after weimer05: istep=',i4)")istep < < ! write(6,"('wei05: mtime=',i3,',',i2,',',i2,' by,bz=',2f8.2, < ! | ' swvel=',f8.2,' swden=',f6.2,' phihm min,max=', < ! | 2e12.4)") modeltime(1:3),byimf,bzimf,swvel,swden, < ! | minval(phihm),maxval(phihm) < < call addfld ('W05_EPOT','Weimer05 Electric Potential', < | 'V',phihm,'mlon',1,nmlonp1,'mlat',1,nmlat,0) < call addfld ('W05_FAC','Weimer05 Field-Aligned Current', < | ' ',wei05sc_fac,'mlon',1,nmlonp1,'mlat',1,nmlat,0) < < elseif (potential_model == 'HEELIS') then < call heelis < if (debug) write(6,"('advance after heelis: istep=',i4)") istep < else ! potential_model='NONE' < do j=1,nmlat0 < do i=1,nmlonp1 < phihm(i,j) = 0. < enddo ! i=1,nmlonp1 < enddo ! j=1,nmlat0 --- > ! If an amie run, use tiepot from amie.F: > ! (phihm and tiepot are dimensioned (nmlonp1,nmlat)) > else > phihm = tiepot ! whole array op > ! call fminmax(phihm,nmlonp1*nmlat,fmin,fmax) > ! write(6,"('advance: amie phihm min,max=',2e12.4)") fmin,fmax 453,462c347,354 < ! call addfld ('CUSP','2D CUSP','0-1', < ! | cusp2d(lon0:lon1,lat0:lat1),'lon',lon0,lon1,'lat',lat0,lat1,0) < ! call addfld ('DRIZZLE','2D DRIZZLE','0-1', < ! | drzl2d(lon0:lon1,lat0:lat1),'lon',lon0,lon1,'lat',lat0,lat1,0) < ! call addfld ('ALFA','2D ALFA','keV', < ! | alfa2d(lon0:lon1,lat0:lat1),'lon',lon0,lon1,'lat',lat0,lat1,0) < ! call addfld ('NFLUX','2D NFLUX','#/cm2-s', < ! | nflx2d(lon0:lon1,lat0:lat1),'lon',lon0,lon1,'lat',lat0,lat1,0) < ! call addfld ('EFLUX','2D EFLUX','mW/m^2', < ! | eflux2d(lon0:lon1,lat0:lat1),'lon',lon0,lon1,'lat',lat0,lat1,0) --- > ! call addfsech_ij ('CUSP','2D CUSP','0-1',cusp2d,1,nlonp4, > ! | 1,nlat) > ! call addfsech_ij ('DRIZZLE','2D DRIZZLE','0-1',drzl2d,1, > ! | nlonp4,1,nlat) > ! call addfsech_ij ('ALFA','2D ALFA','keV',alfa2d,1, > ! | nlonp4,1,nlat) > ! call addfsech_ij ('NFLUX','2D NFLUX','#/cm3?',nflx2d,1, > ! | nlonp4,1,nlat) 472c364,382 < ! Calculate addition to electrodynamo RHS (current due to plasma --- > ! idynamo==0 -> Do not call dynamo. However, if potential_model is > ! requested, set electric potential accordingly. > if (idynamo <= 0) then > if (trim(potential_model) /= 'NONE') then > call prep_dynamo_dyn0( > | z (levd0,lond0,latd0,itp), > | 1,nlevp1,lon0,lon1,lat0,lat1) > if (debug) write(6,"('advance after prep_dynamo_dyn0')") > if (mytid==0) then > call nodynamo > if (debug) write(6,"('advance after nodynamo')") > endif > endif ! potential_model /= NONE > ! > ! idynamo > 0 -> All tasks call prep_dynamo, and master task calls dynamo: > ! > else > ! > ! calculate addition to electrodynamo RHS (current due to plasma 475,476c385,386 < if(j_pg) then < call magpres_grav ( --- > if(j_pg) then > call magpres_grav ( 489c399,414 < endif --- > endif > ! > call prep_dynamo( > | tn (levd0,lond0,latd0,itp), > | un (levd0,lond0,latd0,itp), > | vn (levd0,lond0,latd0,itp), > | w (levd0,lond0,latd0,itp), > | z (levd0,lond0,latd0,itp), > | barm (levd0,lond0,latd0,itp), > | ped (levd0,lond0,latd0), ! from lamdas.F > | hall (levd0,lond0,latd0), ! from lamdas.F > | 1,nlevp1,lon0,lon1,lat0,lat1) > if (debug) write(6,"('advance after prep_dynamo')") > if (mytid==0) call dynamo > if (debug) write(6,"('advance after dynamo')") > endif 491,514d415 < ! Prepare inputs to dynamo and gather to master task: < ! < call prep_dynamo( < | tn (levd0,lond0,latd0,itp), < | un (levd0,lond0,latd0,itp), < | vn (levd0,lond0,latd0,itp), < | w (levd0,lond0,latd0,itp), < | z (levd0,lond0,latd0,itp), < | barm (levd0,lond0,latd0,itp), < | ped (levd0,lond0,latd0), ! from lamdas.F < | hall (levd0,lond0,latd0), ! from lamdas.F < | 1,nlevp1,lon0,lon1,lat0,lat1) < ! < ! Only master task calls dynamo: < ! < if (debug) write(6,"('advance after prep_dynamo')") < if (mytid==0) call dynamo < if (debug) write(6,"('advance after dynamo')") < #if defined(INTERCOMM) || defined(CISMAH) < ! < ! Send conductance and neutral wind current to M-I coupler for CISM < ! < if (mytid==0) call export(cmodeltime) < #endif 532,535c433 < call mp_updatephi < call mp_updateemphi ! am 12/12/05 should be gathered if we stick to this < call mp_updateemlam < call mp_updateemz --- > if (idynamo > 0) call mp_updatephi 559a458,463 > ! > ! Comment this mp_gather2root call if sech fields were written by > ! the master task only (e.g. from serial dynamo). > ! This call can also be commented out if only progostics are saved > ! on secondary histories (i.e., addfsech was not called) > ! 564,568c468,472 < elseif (time2write.and.ntask==1) then < do i=1,nf4d < foutput(:,lon0:lon1,lat0:lat1,i) = < | f4d(i)%data(:,lon0:lon1,lat0:lat1,itc) < enddo --- > ! > ! Saving extraoutput here from master only - G. Lu, Aug. 27, 2003 > call prep_output(1,nlevp1,lon0,lon1,lat0,lat1) > if (mytid==0) call extraoutput > ! 581,583d484 < tlbc_glb(lon0:lon1,lat0:lat1) = tlbc(lon0:lon1,lat0:lat1) < ulbc_glb(lon0:lon1,lat0:lat1) = ulbc(lon0:lon1,lat0:lat1) < vlbc_glb(lon0:lon1,lat0:lat1) = vlbc(lon0:lon1,lat0:lat1) 726d626 < use input_module,only: indices_interp 771,776c671,672 < if (indices_interp > 0) then < outindex = finterp_bigints(rindex(4,i),rindex(4,i+1),nsec0, < | nsec1,msecs) < else < outindex = rindex(4,i) < endif --- > outindex = finterp_bigints(rindex(4,i),rindex(4,i+1),nsec0, > | nsec1,msecs) 796,804d691 < !----------------------------------------------------------------------- < ! < logical function time2print(nstep,istep) < implicit none < integer,intent(in) :: nstep,istep < time2print = .false. < if (nstep <= 100 .or. (nstep > 100 .and. mod(istep,10)==0)) < | time2print = .true. < end function time2print ======================================================================== >>> WARNING: Cannot find source file /fis/hao/tgcm/tiegcm1.92/src/amie.F ======================================================================== Diff of /fis/hao/tgcm/tiegcm1.92/src/aurora.F and /ptmp/foster/ganglu_tiegcm_amie/modsrc2/aurora.F 1a2,3 > ! Pre-processor macros for grid resolution: > ! 4,7d5 < ! This software is part of the NCAR TIE-GCM. Use is governed by the < ! Open Source Academic Research License Agreement contained in the file < ! tiegcmlicense.txt. < ! 30c28 < ! which goes to 1/e over twice the 1/e-width of the aurora at the --- > ! which goes to 1/e over twice the half-width of the aurora at the 54,57d51 < ! 1/4/08 btf: Updating with Liying and Wenbin's mods, see e1,e2, h1,h2, < ! and mods to gpi.F. < ! 1/24/08 btf:Changed alfad,ed, alfac,ec as per Wenbin. < ! 61c55,56 < | pi ! 4.*atan(1.) --- > | pi, ! 4.*atan(1.) > | crit ! may be changed from default if amie run 63c58,60 < use addfld_module,only: addfld --- > use amie_module,only: crad,phida,ekvg,efxg,hpi_sh_amie, > | hpi_nh_amie,pcp_sh_amie,pcp_nh_amie > use input_module,only: iamie 72,76d68 < ! 11/08 EMERY added eflux=flux*fac_p2e*alfa (fac_p2e=2*1.602e-9, so 2*alfa in this factor) < real, parameter:: fac_p2e = 3.204e-9 ! convert from particle to energy flux < < real,parameter :: h2deg = 15. ! convert from hours to degrees < 86d77 < ! 1/24/08 btf: reduce alfad to 0.5, as per Wenbin: 88,89c79,85 < real,parameter :: alfad = 0.5 < real :: ed ! set in sub aurora_cons as function of hem power --- > real,parameter :: > ! | alfad = 2.0, > ! | ed = 0.5 > ! Reduce the drizl intensity - G. Lu, July 28, 2006 > ! | alfad = 2.0, ed = 0.11 > ! Reset the drizl intensity for October 2003 storm - G. Lu, April 6, 2007 > | alfad = 2.0, ed = 0.5 97,103c93,95 < ! 1/24/08 btf: As per Wenbin: alfac = 0.1 (old tiegcm1.8 value was 1.0), < ! and ec is set as function of hemispheric power in aurora_cons < ! (old tiegcm1.8 value for ec was 0.5) < ! < real,parameter :: alfac = 0.1 < real :: ec ! set in sub aurora_cons (function of hem power) < ! --- > real,parameter :: > | alfac = 1.0, > | ec = 0.5 108,109c100,101 < ! h1: Gaussian 1/e-width of the noon auroral oval in degrees < ! h2: Gaussian 1/e-width of the midnight auroral oval in degrees --- > ! h1: Gaussian half-width of the noon auroral oval in degrees > ! h2: Gaussian half-width of the midnight auroral oval in degrees 147,148c139,140 < | phid(2), ! dayside convection entrance in MLT (subtract 12h since 0=noon) converted to radians (f(By)) < | phin(2), ! night convection entrance in MLT (subtract 12h since 0=noon) converted to radians (f(By)) --- > | phid(2), ! dayside convection entrance in MLT converted to radians (f(By)) > | phin(2), ! night convection entrance in MLT converted to radians (f(By)) 149a142 > | rradp(2), ! radius of polar-cap circle in radians for drizls 152,155c145,148 < | rrote, ! MLT of maximum auroral energy flux converted to radians < | rroth, ! MLT of maximum auroral Gaussian 1/e-width converted to radians < | h0, ! average of noon and midnight Gaussian 1/e-widths < | rh, ! difference ratio of 1/e-widths (rh=(h2-h1)/(h2+h1)) --- > | rrote, ! clockwise rotation from noon of peak dayside energy flux (e1) > | rroth, ! clockwise rotation from noon of dayside h1 Gaussian half-width > | h0, ! average of noon and midnight Gaussian half-widths > | rh, ! difference ratio of half-widths (rh=(h2-h1)/(h2+h1)) 162,171c155,164 < | offc(2), ! offset of convection towards 0 MLT relative to magnetic pole (rad) < | dskofc(2), ! offset of convection in radians towards 18 MLT (f(By)) < | psim(2), ! maximum potential in the morning cell (V) < | psie(2), ! minimum potential in the evening cell (V) < | pcen(2), ! potential at the center (offc,dskofc) of the convection pattern (V, f(By)) < | phidp0(2), ! angle curvature of convection on plus side of dayside entrance (rad) < | phidm0(2), ! angle curvature of convection on minus side of dayside entrance (rad) < | phinp0(2), ! angle curvature of convection on plus side of nightside entrance (rad) < | phinm0(2), ! angle curvature of convection on minus side of nightside entrance (rad) < | rr1(2) ! exponential fall-off of convection from convection radius --- > | offc(2), ! > | dskofc(2), ! > | psim(2), ! > | psie(2), ! > | pcen(2), ! > | phidp0(2), ! > | phidm0(2), ! > | phinp0(2), ! > | phinm0(2), ! > | rr1(2) 175,180c168,170 < | dlat_aur(nlon), ! = rlatm = magnetic latitude (radians) < | dlon_aur(nlon), ! = rlonm-sunlons = magnetic longitude (or MLT-12 where 0=noon) converted to radians < | colat(nlon), ! auroral magnetic co-latitude from offset center (radians) < | sinlat(nlon), coslat(nlon), ! sin,cos of dlat_aur (rlatm) magnetic latitude < | coslon(nlon), sinlon(nlon), ! sin,cos of dlon_aur+offset < | alon(nlon) ! auroral magnetic longitude where 0=noon shifted by -offset (radians) --- > | dlat_aur(nlon), dlon_aur(nlon), > | colat(nlon), sinlat(nlon), coslat(nlon), > | coslon(nlon), sinlon(nlon), alon(nlon) 188,190c178,179 < | qteaur(nlonp4,nlat), ! for electron temperature < | eflux(nlonp4),eflux2(nlonp4),eflux3(nlonp4) ! energy flux < ! 11/08 EMERY added energy flux eflux and eflux2d --- > | qteaur(nlonp4,nlat) ! for electron temperature > ! TEMP 192,193c181 < | alfa2d(nlonp4,nlat),nflx2d(nlonp4,nlat), < | eflux2d(nlonp4,nlat) --- > | alfa2d(nlonp4,nlat),nflx2d(nlonp4,nlat) 198a187 > 208a198,199 > use hist_module,only: modeltime > use init_module,only: iyear 212,213c203 < | power, ! hemispheric power (GW) (e.g., 16.) < | potential_model ! electric potential model used --- > | power ! hemispheric power (GW) (e.g., 16.) 222,223c212 < real :: arad(2) < real :: byloc ! local by --- > real :: arad(2),hp_amie,c25,c35 272,280d260 < ! Add limits to byimf if use the Heelis convection pattern,this is to have < ! asymmetric dawn and dusk convection cells and By effect. --Wenbin Wang 12/02/2008 < ! < byloc = byimf ! init local from original namelist input < If (potential_model == 'HEELIS') then < if (byloc > 7.0) byloc = 7.0 < if (byloc < -11.0) byloc = -11.0 < endif < 282,284c262 < ! 8/1/06 btf: change conditional as per Richmond suggestion: < ! if (power >= 0.01) plevel = 2.09*alog(power) < if (power >= 1.00) plevel = 2.09*alog(power) --- > if (power >= 0.01) plevel = 2.09*alog(power) 288,293c266,273 < ! modified by LQIAN, 2007 < ! produce realistic oval compared to NOAA empirical auroral oval and TIMED/GUVI < ! e1 formula given by Wenbin base on POLARVIS image; < ! e2 formula based on Emery et al original auroral parameterization report < e1 = max(0.50, -2.15 + 0.62*plevel) < e2=1.+0.11*power --- > e1 = (1.0 + 0.10 * power) > ! e2 = (1.0 + 0.40 * power) > ! Reduce the night auroral energy flux - G. Lu, Jul 21, 2006 > e2 = (1.0 + 0.20 * power) > ! Values from corrections to Emery et al Parameterization report: > ! e1 = max(0.50, -2.15 + 0.62*plevel) > ! e2 = 0.95 + 0.117 * power > ! 297,308c277,285 < ! 1/24/08 btf: Set ec and ed as function of power, as per Wenbin: < ec=(0.24+0.0067*power)/5. < ed=0.0012+0.0006*power < ! < ! h1 = Gaussian 1/e-width of the noon auroral oval in degrees < ! h2 = Gaussian 1/e-width of the midnight auroral oval in degrees < ! modified by LQIAN, 2007 < ! produce realistic oval compared to NOAA empirical auroral oval and TIMED/GUVI < ! h1 formula given by Wenbin base on POLARVIS image; < ! h2 formula based on Emery et al original auroral parameterization report < h1 = min(2.35, 0.83 + 0.33*plevel) < h2=2.5+0.025*max(power,55.)+0.01*min(0.,power-55.) --- > ! h1 = Gaussian half-width of the noon auroral oval in degrees > ! h2 = Gaussian half-width of the midnight auroral oval in degrees > h1 = 2. + 0.05 * power > ! h2 = 3. + 0.40 * power > ! Reduce the night auroral bndy width - G. Lu, Jul 21, 2006 > h2 = 3. + 0.08 * power > ! Values from corrections to Emery et al Parameterization report: > ! h1 = min(2.35, 0.83 + 0.33*plevel) > ! h2 = 2.87 + 0.15*plevel 324,326c301,305 < ! < ! 1/4/08 btf: New values for alfa_1 and alfa_2, as per Wenbin < alfa_1 = 1.5 --- > rradp(isouth) = (arad(isouth)-0.5)*dtr > rradp(inorth) = (arad(inorth)-0.5)*dtr > ! alfa_1 = 2. > ! alfa_2 = 2. > alfa_1 = 1.5 327a307,309 > ! Values from 10/05/94 HPI estimates (50% or more higher than old estimates): > ! alfa_1 = min(1.5,1.25+0.05*plevel) > ! alfa_2 = 1.2 + 0.095*plevel 330,345c312,319 < < ! 12/8/08 scs: In-lined rotation units and cleaned up comments < ! Old rotation angles were: roth = 12.18 - 0.89 * plevel < ! rote = 2.62 - 0.55 * plevel < < ! roth = MLT of max width of aurora in hours < ! rote = MLT of max energy flux of aurora in hours < < roth = 0.81 - 0.06 * plevel < rote = 0.17 - 0.04 * plevel < < ! Convert MLT from hours to degrees to radians < < rroth = roth * h2deg * dtr < rrote = rote * h2deg * dtr < --- > ! > ! btf 1/22/04: correct rotation by removing the *15.: > ! roth = (12.18 - 0.89 * plevel) * 15. > ! rote = ( 2.62 - 0.55 * plevel) * 15. > roth = (12.18 - 0.89 * plevel) > rote = ( 2.62 - 0.55 * plevel) > rroth = roth * dtr > rrote = rote * dtr 369,402c343,354 < ! tiegcm1.9 < ! offc(isouth) = 1.*dtr < ! offc(inorth) = 1.*dtr < ! dskofc(isouth) = 0. < ! dskofc(inorth) = 0. < ! phid(isouth) = 0. < ! phid(inorth) = 0. < ! phin(isouth) = 180.*dtr < ! phin(inorth) = 180.*dtr < ! psim(:) = 0.50 * ctpoten * 1000. < ! psie(:) = -0.50 * ctpoten * 1000. < ! pcen(isouth) = 0. < ! pcen(inorth) = 0. < ! phidp0(:) = 90.*dtr < ! phidm0(:) = 90.*dtr < ! phinp0(:) = 90.*dtr < ! phinm0(:) = 90.*dtr < ! rr1(:) = -2.6 < ! < ! tiegcm original with assymmetry and By effect < ! write(6,"(/,'byloc (local by)=',f8.3)") byloc < < offc(isouth) = 1.1*dtr < offc(inorth) = 1.1*dtr < dskofc(isouth) = (-0.08 + 0.15*byloc)*dtr < dskofc(inorth) = (-0.08 - 0.15*byloc)*dtr < phid(isouth) = (9.39 + 0.21*byloc - 12.) * h2deg * dtr < phid(inorth) = (9.39 - 0.21*byloc - 12.) * h2deg * dtr < phin(isouth) = (23.50 + 0.15*byloc - 12.) * h2deg * dtr < phin(inorth) = (23.50 - 0.15*byloc - 12.) * h2deg * dtr < psim(:) = 0.44 * ctpoten * 1000. < psie(:) = -0.56 * ctpoten * 1000. < pcen(isouth) = (-0.168 + 0.027*byloc) * ctpoten * 1000. < pcen(inorth) = (-0.168 - 0.027*byloc) * ctpoten * 1000. --- > offc(isouth) = 1.*dtr > offc(inorth) = 1.*dtr > dskofc(isouth) = 0. > dskofc(inorth) = 0. > phid(isouth) = 0. > phid(inorth) = 0. > phin(isouth) = 180.*dtr > phin(inorth) = 180.*dtr > psim(:) = 0.50 * ctpoten * 1000. > psie(:) = -0.50 * ctpoten * 1000. > pcen(isouth) = 0. > pcen(inorth) = 0. 408a361,426 > ! Recalculate some parameters if an amie run: > if (iamie > 0) then > theta0(:) = crad(:) ! radians from amie module > if (theta0(isouth) > 65.) theta0(isouth) = 65. > if (theta0(inorth) > 65.) theta0(inorth) = 65. > phid(:) = phida(:) ! radians from amie module > ! hp_amie = max(hpi_sh_amie,hpi_nh_amie) > hp_amie = 0.5*(hpi_sh_amie+hpi_nh_amie) > plevel = 2.09*alog(hp_amie) > h1 = min(2.35,0.83+0.33*plevel) > h2 = 2.87 + 0.15*plevel > h0 = 0.5 * (h1 + h2) * dtr > h2 = 4.5 + 0.08*hp_amie > ! For Sep 10 (Day 253) 2005 storm interval > h2 = 4.5 + 0.11*hp_amie > ! For October 2003 storm interval > ! h2 = 4.5 + 0.20*hp_amie > roth = (12.18- 0.89*plevel) > rote = (2.62 - 0.55*plevel) > rroth = roth * dtr > rrote = rote * dtr > ! rradp(isouth) = crad(isouth)-1.5*dtr > ! rradp(inorth) = crad(inorth)-2.5*dtr > rradp(isouth) = crad(isouth) + h2*dtr > rradp(inorth) = crad(inorth) + h2*dtr > if (rradp(isouth) > 29.*dtr) rradp(isouth) = 29.*dtr > if (rradp(inorth) > 29.*dtr) rradp(inorth) = 29.*dtr > ! if (rradp(isouth) > 31.*dtr) rradp(isouth) = 31.*dtr > ! if (rradp(inorth) > 31.*dtr) rradp(inorth) = 31.*dtr > rrad(isouth) = rradp(isouth) + 0.5*dtr > rrad(inorth) = rradp(inorth) + 0.5*dtr > ! > ! Set critical colatitude crit(2) 40 deg -- G. Lu 5/11/98 > ! Therefore, crit2 = 40, crit1 = 25-30, depending on theta0 > ! > c35 = min(30.,(theta0(1)+theta0(2))*0.5 + 5.0) > c25 = max(25.,c35) > crit(1) = c25 * dtr > if (iyear == 2004) then > c25 = max(30.,c35) > crit(1) = c25 * dtr > crit(2) = 40. * dtr > ! Move CRIT to 3-degree lower for Nov. 10, 2004 > if (modeltime(1) == 315) then > crit(2) = (c25+5.)*dtr > crit(2) = 45.*dtr > if (pcp_nh_amie*1.e-3 > 200.) then > crit(1) = crit(1) + (pcp_nh_amie*1.e-3 - 200.)*0.05*dtr > crit(2) = crit(2) + (pcp_nh_amie*1.e-3 - 200.)*0.05*dtr > crit(2) = max(crit(1),crit(2)) > endif > endif > ! Move CRIT to higher latitude for more penetration E-field for Nov. 9, 2004 > if (modeltime(1) == 314 .and. modeltime(2) > 19 .and. > | pcp_nh_amie*1.e-3 > 200.) then > crit(1) = crit(1) - (pcp_nh_amie*1.e-3 - 200.)*0.05*dtr > crit(2) = crit(2) - (pcp_nh_amie*1.e-3 - 200.)*0.06*dtr > crit(2) = min(crit(1),crit(2)) > endif > write(6,"('crad =',f6.2,' rrad=',f6.2,' rradp=',f6.2, > | ' pcp_nh_amie=',f8.1,' crit(2)=',2f6.2)") crad(1)/dtr, > | rrad(1)/dtr,rradp(1)/dtr,pcp_nh_amie*1.e-3,crit/dtr > endif !end of Nov 2004 modes > > endif > ! 411a430 > write(6,"(' iamie=',i2)") iamie 416,418c435 < write(6,"(' auroral radius = max of rhp,rcp=',2f10.3)") rhp,rcp < write(6,"(' roth, rote (MLT) =',2f10.3)") roth,rote < write(6,"(' 1/e-widths = h1,h2=',2f10.3)") h1,h2 --- > write(6,"(' half-widths = h1,h2,h0=',3f8.3)") h1,h2,h0/dtr 438c455 < use params_module,only: nlat,zibot,dz --- > use params_module,only: nlat,zsb,dz 440c457 < use qrj_module,only: ! for diag only --- > use qrj_module,only: ! for addfsech debug only 458c475 < integer :: i,ier --- > integer :: i,nlevs,ier 468a486,487 > nlevs = lev1-lev0+1 ! for addfsech calls > ! 470,475c489,494 < ! call addfld('QO2P_PRE',' ',' ',qo2p(lev0:lev1,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QOP_PRE' ,' ',' ',qop(lev0:lev1,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QN2P_PRE',' ',' ',qn2p(lev0:lev1,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('QO2P_PRE',' ',' ',qo2p(lev0:lev1,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('QOP_PRE' ,' ',' ',qop(lev0:lev1,lon0:lon1,lat) , > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('QN2P_PRE',' ',' ',qn2p(lev0:lev1,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) 525a545 > ! TEMP 532d551 < eflux2d(i,lat)=eflux(i) 542,543c561 < ! 11/08 EMERY added eflux=flux*fac_p2e*alfa - (better for falfa1 if alfa quite variable) < call aurora_ions(fac_p2e, --- > call aurora_ions( 546d563 < | eflux(lon0:lon1), eflux2(lon0:lon1), eflux3(lon0:lon1), 548c565 < | tn,o2,o1,barm,zibot,dz,lev0,lev1,lon0,lon1,lat) --- > | tn,o2,o1,barm,zsb,dz,lev0,lev1,lon0,lon1,lat) 561a579,580 > ! (if this is an amie run, then theta0 and phid have been taken > ! from amie, see aurora_cons) 612,614d630 < #if defined(INTERCOMM) || defined(CISMAH) < use cism_coupling_module,only: geng,gflx !CISM < #endif 623c639 < | halfwidth, ! oval 1/e-width --- > | halfwidth, ! oval half-width 625c641,642 < --- > real,parameter :: s10=0.174532925 > real :: clat 641c658 < ! Auroral oval 1/e-width (equation (1) in Roble,1987): --- > ! Auroral oval half-width (equation (1) in Roble,1987): 674,675d690 < ! 11/08 EMERY added eflux=flux*fac_p2e*alfa < eflux(i+2) = flux(i+2)*fac_p2e*alfa(i+2) 680d694 < eflux2(i+2) = flux2(i+2)*fac_p2e*alfa2(i+2) 685d698 < eflux3(i+2) = flux3(i+2)*fac_p2e*alfa3(i+2) 689d701 < enddo ! i=1,nlon 690a703,724 > ! Recalculate alfa, flux, drizl if an amie run (as in old sub amiepa): > if (iamie > 0) then > ! > ! Insure ekvg mean energy >= 1.: > ekvg(i,lat) = max(ekvg(i,lat),1.) > alfa(i+2) = ekvg(i,lat)/2. > flux(i+2) = efxg(i,lat)/(2.*alfa(i+2)*1.602e-9) > clat = acos(sin(abs(dlat_aur(i)))) > alfa2(i+2) = alfa20 > ! drizl(i+2) = exp(-((clat-crad(ihem)+ > ! | abs(clat-crad(ihem)))/(2.*s10))**2) > ! flux2(i+2) = e20*(1.-re2*coslamda(i))* > ! | exp(-((clat-crad(ihem))/ > ! | halfwidth(i))**2) / (2.*alfa2(i+2)*1.602E-9) > drizl(i+2) = exp(-((clat-rradp(ihem)+ > | abs(clat-rradp(ihem)))/(1*s10))**2) > flux2(i+2) = e20*(1.-re2*coslamda(i))* > | exp(-((clat-rrad(ihem))/ > | halfwidth(i))**2) / (2.*alfa2(i+2)*1.602E-9) > endif > enddo ! i=1,nlon > 695d728 < eflux (i) = eflux(nlon+i) 701,702d733 < eflux2 (i) = eflux2(nlon+i) < eflux3 (i) = eflux3(nlon+i) 706d736 < eflux (nlonp2+i) = eflux(i+2) 710d739 < flux2 (nlonp2+i) = flux2(i+2) 712,713d740 < eflux2 (nlonp2+i) = eflux2(i+2) < eflux3 (nlonp2+i) = eflux3(i+2) 716,731d742 < ! < ! Replacing with M-I coupler values. Warning: alfa and flux can not be < ! zero, otherwise the model will blow up. Set to small values here. This < ! will not change simulations. < ! Wenbin wang < ! < #if defined(INTERCOMM) || defined(CISMAH) < do i=1,nlonp4 < alfa(i)=geng(i,lat)+0.01 < flux(i)=gflx(i,lat)+0.01 < if(alfa(i)<=0.)alfa(i)=0.01 < if(flux(i)<=0.)flux(i)=0.01 < eflux(i) = flux(i)*fac_p2e*alfa(i) < ! write(6,*)alfa(i),flux(i),i,lat < enddo < #endif 732a744,752 > ! if (lat == 12) write(6,"('drizl: min,max = ',2e12.4, > ! | 'h0= ',e12.4)")minval(drizl),maxval(drizl),h0 > ! if (lat == 12) write(6,"('crad =',2e10.4, > ! | ' rrad=',2e10.4,' rradp=',2e10.4)") crad,rrad,rradp > ! if (lat == 12) write(6,"('dtheta = ',/,(8e10.4))") > ! | dtheta > ! if (lat == 12) write(6,"('drizl = ',/,(8e10.4))") > ! | drizl > ! 736,739c756,757 < ! 11/08 EMERY added eflux=flux*fac_p2e*alfa (better when alfa quite variable) < subroutine aurora_ions (fac_p2e,drizl,cusp,alfa1,alfa2,alfa3, < | eflux1,eflux2,eflux3,flux1,flux2,flux3, < | tn,o2,o1,barm,zpbot,dzp,lev0,lev1,lon0,lon1,lat) --- > subroutine aurora_ions(drizl,cusp,alfa1,alfa2,alfa3,flux1,flux2, > | flux3,tn,o2,o1,barm,zpbot,dzp,lev0,lev1,lon0,lon1,lat) 765d782 < use addfld_module,only: addfld 769d785 < real,intent(in) :: fac_p2e ! convert from particle to energy flux 771,773c787,788 < real,intent(in),dimension(lon0:lon1) :: drizl,cusp, < | alfa1,alfa2,alfa3,eflux1,eflux2,eflux3,flux1,flux2,flux3 < ! 11/08 EMERY added eflux=flux*fac_p2e*alfa as eflux1 --- > real,intent(in),dimension(lon0:lon1) :: > | drizl,cusp,alfa1,alfa2,alfa3,flux1,flux2,flux3 791a807,808 > real,dimension(lev0:lev1,lon0:lon1) :: flux_ik,alfa_ik, > | flux2_ik,cusp_ik 792a810 > nlevs = lev1-lev0+1 ! for addfsech calls 841,848c859,866 < ! call addfld('ALFA1',' ',' ',alfa1_ion,'lev',lev0,lev1, < ! | 'lon',lon0,lon1,lat) < ! call addfld('ALFA2',' ',' ',alfa2_ion,'lev',lev0,lev1, < ! | 'lon',lon0,lon1,lat) < ! call addfld('CUSP',' ',' ',cusp_ion,'lev',lev0,lev1, < ! | 'lon',lon0,lon1,lat) < ! call addfld('DRIZL',' ',' ',drizl_ion,'lev',lev0,lev1, < ! | 'lon',lon0,lon1,lat) --- > ! call addfsech('ALFA1',' ',' ',alfa1_ion,lon0,lon1,nlevs,nlevs-1, > ! | lat) > ! call addfsech('ALFA2',' ',' ',alfa2_ion,lon0,lon1,nlevs,nlevs-1, > ! | lat) > ! call addfsech('CUSP' ,' ',' ',cusp_ion ,lon0,lon1,nlevs,nlevs-1, > ! | lat) > ! call addfsech('DRIZL',' ',' ',drizl_ion,lon0,lon1,nlevs,nlevs-1, > ! | lat) 859,863c877,878 < ! 11/08 EMERY added eflux=flux*fac_p2e*alfa; eflux1 better than flux1 if alfa quite variable < falfa1(i) = eflux1(i)/fac_p2e ! s7 This should be equivalent to alfa1*flux1 < ! falfa1(i) = alfa1(i)*flux1(i) ! s7 < falfa2(i) = eflux2(i)/fac_p2e ! s8 This should be equivalent to alfa2*flux2 < ! falfa2(i) = alfa2(i)*flux2(i) ! s8 --- > falfa1(i) = alfa1(i)*flux1(i) ! s7 > falfa2(i) = alfa2(i)*flux2(i) ! s8 866,867c881 < falfa3(i) = eflux3(i)/fac_p2e ! s13 This should be equivalent to alfa3*flux3 < ! falfa3(i) = alfa3(i)*flux3(i) ! s13 (high energy electrons) --- > falfa3(i) = alfa3(i)*flux3(i) ! s13 (high energy electrons) 879a894,898 > > alfa_ik(k,i) = alfa1(i) > flux_ik(k,i) = falfa1(i) > flux2_ik(k,i) = fdrizl(i) > cusp_ik(k,i) = fcusp(i) 910a930,937 > call addfsech('ALFA',' ',' ',alfa_ik,lon0,lon1,nlevs,nlevs-1, > | lat) > call addfsech('FLUX',' ',' ',flux_ik,lon0,lon1,nlevs,nlevs-1, > | lat) > call addfsech('FLUX2',' ',' ',flux2_ik,lon0,lon1,nlevs,nlevs-1, > | lat) > call addfsech('CUSP',' ',' ',cusp_ik,lon0,lon1,nlevs,nlevs-1, > | lat) 920,931c947,965 < ! call addfld('BARMT' ,' ',' ',barm_t(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('QSUM' ,' ',' ',qsum ,'lev',lev0,lev1, < ! | 'lon',lon0,lon1,lat) < ! call addfld('DENOM' ,' ',' ',denom(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('QO2P_AUR',' ',' ',qo2p_aur(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('QOP_AUR' ,' ',' ',qop_aur(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('QN2P_AUR',' ',' ',qn2p_aur(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('BARMT' ,' ',' ',barm_t ,lon0,lon1,nlevs,nlevs-1, > ! | lat) > ! call addfsech('QSUM' ,' ',' ',qsum ,lon0,lon1,nlevs,nlevs-1, > ! | lat) > ! call addfsech('DENOM' ,' ',' ',denom ,lon0,lon1,nlevs,nlevs-1, > ! | lat) > ! call addfsech('QO2P_AUR',' ',' ',qo2p_aur,lon0,lon1,nlevs,nlevs-1, > ! | lat) > ! call addfsech('QOP_AUR' ,' ',' ',qop_aur ,lon0,lon1,nlevs,nlevs-1, > ! | lat) > ! call addfsech('QN2P_AUR',' ',' ',qn2p_aur,lon0,lon1,nlevs,nlevs-1, > ! | lat) > > ! call addfsech('QO2P_PRE',' ',' ',qo2p(:,:,lat),lon0,lon1,nlevs, > ! | nlevs,lat) > ! call addfsech('QOP_PRE' ,' ',' ',qop (:,:,lat),lon0,lon1,nlevs, > ! | nlevs,lat) > ! call addfsech('QN2P_PRE',' ',' ',qn2p(:,:,lat),lon0,lon1,nlevs, > ! | nlevs,lat) 950,972d983 < ! TIEGCM-1.9x bug fix from Wenbin's old LTR/CMIT-2.5 code < #if defined(INTERCOMM) || defined(CISMAH) < if(1.5*qo2p_aur(lev0,i) > 0.5*qo2p_aur(lev0+1,i))then < qo2p(lev0,i,lat) = qo2p(lev0,i,lat)+1.5*qo2p_aur(lev0,i)- < | 0.5*qo2p_aur(lev0+1,i) < endif !!! CISM fix < if(1.5*qop_aur (lev0,i) > 0.5*qop_aur (lev0+1,i))then < qop (lev0,i,lat) = qop (lev0,i,lat)+1.5*qop_aur (lev0,i)- < | 0.5*qop_aur (lev0+1,i) < endif < if(1.5*qn2p_aur(lev0,i) > 0.5*qn2p_aur(lev0+1,i))then < qn2p(lev0,i,lat) = qn2p(lev0,i,lat)+1.5*qn2p_aur(lev0,i)- < | 0.5*qn2p_aur(lev0+1,i) < endif < if(1.5*qn2p_aur(lev0,i) > 0.5*qn2p_aur(lev0+1,i))then < qnp (lev0,i,lat) = qnp (lev0,i,lat)+ .22/.7 * < | (1.5*qn2p_aur(lev0,i)-0.5*qn2p_aur(lev0+1,i)) < endif < if(1.5*qn2p_aur(lev0,i) > 0.5*qn2p_aur(lev0+1,i))then < qtef(lev0,i,lat) = qtef(lev0,i,lat)+1.57*(1.5*qn2p_aur(lev0,i)- < | 0.5*qn2p_aur(lev0+1,i)) < endif < #else 983d993 < #endif 998,1005c1008,1015 < ! call addfld('QO2P',' ',' ',qo2p(lev0:lev1,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QOP' ,' ',' ',qop(lev0:lev1,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QN2P' ,' ',' ',qn2p(lev0:lev1,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QNP' ,' ',' ',qnp(lev0:lev1,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('QO2P',' ',' ',qo2p(lev0:lev1,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('QOP' ,' ',' ',qop (lev0:lev1,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('QN2P',' ',' ',qn2p(lev0:lev1,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('QNP' ,' ',' ',qnp (lev0:lev1,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) ======================================================================== Diff of /fis/hao/tgcm/tiegcm1.92/src/bndry.F and /ptmp/foster/ganglu_tiegcm_amie/modsrc2/bndry.F 4,7d3 < ! This software is part of the NCAR TIE-GCM. Use is governed by the < ! Open Source Academic Research License Agreement contained in the file < ! tiegcmlicense.txt. < ! 13,15c9 < use cons_module,only: t0,pi,atm_amu,gask,grav,freq_semidi, < | re,dlamda,tbound,tgrad,cs,cor,tn < use params_module,only: nlat,nlonp4,nlevp1,dz,zibot --- > ! 4/4/05 btf: added gswm routines (eliminating bndry_gswm.F) 17,22c11,13 < ! GSWM boundary perturbation (see gswm.F): < use gswm_module,only: < | gswm_mi_di_z, gswm_mi_sdi_z, gswm_nm_di_z, gswm_nm_sdi_z, < | gswm_mi_di_t, gswm_mi_sdi_t, gswm_nm_di_t, gswm_nm_sdi_t, < | gswm_mi_di_u, gswm_mi_sdi_u, gswm_nm_di_u, gswm_nm_sdi_u, < | gswm_mi_di_v, gswm_mi_sdi_v, gswm_nm_di_v, gswm_nm_sdi_v --- > use cons_module,only: t0,pi,atm_amu,gask,grav,freq_semidi, > | re,dlamda,tbound,tgrad,cs,cor,tn,freq_ann > use params_module,only: nlat,nlonp4,nlevp1,dz 27,31c18,22 < | zb(nlat),zb2(nlat), < | tb(nlat),tb2(nlat), < | ub(nlat),ub2(nlat), < | vb(nlat),vb2(nlat), < | bnd(nlonp4),bnd2(nlonp4) --- > | zb(nlat),zb2(nlat),zba(nlat), > | tb(nlat),tb2(nlat),tba(nlat), > | ub(nlat),ub2(nlat),uba(nlat), > | vb(nlat),vb2(nlat),vba(nlat), > | bnd(nlonp4),bnd2(nlonp4),bnda(nlonp4) 33c24 < real :: b(nlonp4,2,2),fb(nlonp4,2) ! for bndry_comp --- > real :: b(nlonp4,2,2),fb(nlonp4,2) 35,37d25 < ! OX bottom boundary (set in sub comp_ox, and used in sub bndry_comp): < ! real :: xoxlb(nlonp4,nlat) < ! 42,47c30 < use init_module,only: igswm_mi_di,igswm_mi_sdi, ! GSWM input flags < | iday,iter ! for dday calculation < use input_module,only: step < ! use chemrates_module,only: co2mix < ! use cco2gr_module,only: cco2gr,set_cco2_data < ! --- > use init_module,only: igetgswmdi,igetgswmsdi ! GSWM input flags 53d35 < real :: dday 56a39,40 > write(6,"(/,72('-'))") > write(6,"('Set Lower Boundary Conditions:')") 59,61c43,46 < if(igswm_mi_sdi == 0) call bndry_semidiurnal ! check for GSWM semidiurnal < if(igswm_mi_di == 0) call bndry_diurnal ! check for GSWM diurnal < dday = float(iday)+amod(float(iter)*float(step),86400.)/86400. --- > if(igetgswmsdi == 0) call bndry_semidiurnal ! check for GSWM semidiurnal > if(igetgswmdi == 0) call bndry_diurnal ! check for GSWM diurnal > call bndry_annual > write(6,"(72('-'),/)") 67d51 < ! 314a299,494 > subroutine bndry_annual > ! > ! 2/00: 1998 spherepack lib code (sphpac.f) replaces old lib > ! alfpac.f for legendre polynomials and Hough functions. > ! This routine calculates complex ZBA,TBA,UBA,VBA. > ! > C **** TIDAL BOUNDARY CONDITION FOR ANNUAL MODE > ! > use input_module,only: tideann > use init_module,only: iday > ! > ! For 1998 spherepack lib code (sphpac.f) > ! (replaces old alfpac.f) > ! > integer,parameter :: nalf=24, malf=2 > ! > ! Local: > real :: p(nlat,nalf,malf),hough(nlat,0:6,2),cp(nalf/2+1) > complex :: dzb(nlat),zzb(nlat) > real :: B(6,24),RL(0:6),scale,rt2,rm,factor,xdot(24),ydot(24), > | pi,ptscal,ptjm(2*nlat+1),theta,w(nlat) > integer :: n,l,m,k,i,jm,mp1,ld,j > COMPLEX CC(0:6,0:6),CL(0:6),EXPT > ! > DATA ((B(I,J),I = 1,6),J = 1,12)/ > 1-0.882922, 0.000000,-0.345087, 0.000000,-0.202228, 0.000000, > 2 0.000000,-0.930826, 0.000000,-0.301357, 0.000000,-0.152720, > 3-0.466226, 0.000000, 0.567457, 0.000000, 0.407114, 0.000000, > 4 0.000000,-0.362673, 0.000000, 0.694431, 0.000000, 0.438014, > 5-0.055436, 0.000000, 0.711847, 0.000000,-0.163050, 0.000000, > 6 0.000000,-0.044983, 0.000000, 0.625545, 0.000000,-0.325772, > 7-0.002909, 0.000000, 0.225723, 0.000000,-0.749160, 0.000000, > 8 0.000000,-0.002773, 0.000000, 0.186467, 0.000000,-0.723674, > 9-0.000086, 0.000000, 0.034940, 0.000000,-0.435919, 0.000000, > * 0.000000,-0.000103, 0.000000, 0.029425, 0.000000,-0.379254, > 1-0.000002, 0.000000, 0.003267, 0.000000,-0.122687, 0.000000, > 2 0.000000,-0.000003, 0.000000, 0.002928, 0.000000,-0.104008/ > DATA ((B(I,J),I = 1,6),J = 13,24)/ > 3 0.0 , 0.000000, 0.000206, 0.000000,-0.021267, 0.000000, > 4 0.0 , 0.0 , 0.000000, 0.000202, 0.000000,-0.018228, > 5 0.0 , 0.0 , 0.000009, 0.000000,-0.002540, 0.000000, > 6 0.0 , 0.0 , 0.000000, 0.000010, 0.000000,-0.002252, > 7 0.0 , 0.0 , 0.0 , 0.000000,-0.000223, 0.000000, > 8 0.0 , 0.0 , 0.0 , 0.0 , 0.000000,-0.000208, > 9 0.0 , 0.0 , 0.0 , 0.0 ,-0.000015, 0.000000, > * 0.0 , 0.0 , 0.0 , 0.0 , 0.000000,-0.000015, > 1 0.0 , 0.0 , 0.0 , 0.0 ,-0.000001, 0.000000, > 2 0.0 , 0.0 , 0.0 , 0.0 , 0.000000,-0.000001, > 3 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , 0.000000, > 4 0.0 , 0.0 , 0.0 , 0.0 , 0.0 , 0.0 / > DATA (RL(N),N=1,6)/ > 1 -10.8409E5,-7.0243E5,-2.4874E5,-1.9696E5,-1.0694E5, > 2 -0.9119E5/ > C **** > C **** ANNUAL BOUNDARY COEFFICIENTS FOR LOWER BOUNDARY AT > C **** Z = -7. > C **** > DATA((CC(K,N),N=0,6),K=0,3)/ > 1 ( 0.136291E+03, 0.000000E+00),(-0.200536E-01, 0.000000E+00), > 2 ( 0.423456E+00, 0.000000E+00),(-0.143623E-02, 0.000000E+00), > 3 ( 0.262889E+00, 0.000000E+00),( 0.365122E-02, 0.000000E+00), > 4 ( 0.102716E+00, 0.000000E+00),( 0.826209E+00,-0.116536E-01), > 5 (-0.455993E+00,-0.311380E-02),( 0.271258E-01,-0.373420E-01), > 6 (-0.433095E-01, 0.165546E-01),( 0.713386E-02,-0.112538E-01), > 7 (-0.153849E-01, 0.103063E-01),( 0.214366E-02,-0.570878E-02), > 8 (-0.316298E+00, 0.115053E+00),(-0.159072E-01,-0.245495E-02), > 9 ( 0.302211E+00,-0.132446E-01),( 0.230750E-02, 0.170566E-03), > * ( 0.100434E+00,-0.299227E-02),( 0.264555E-02,-0.137723E-03), > 1 ( 0.499098E-01,-0.110255E-02),(-0.520584E-03,-0.114124E-02), > 2 ( 0.178599E-01, 0.561092E-02),( 0.557591E-03, 0.176165E-02), > 3 (-0.148151E-02, 0.749397E-03),(-0.617325E-03, 0.778743E-03), > 4 (-0.530835E-03, 0.641767E-03),(-0.964206E-03, 0.551394E-03)/ > DATA((CC(K,N),N=0,6),K=4,6)/ > 1 (-0.137927E-02, 0.866386E-03),(-0.242825E-02, 0.441184E-03), > 2 ( 0.120715E-02,-0.136729E-02),( 0.122657E-03, 0.316213E-04), > 3 ( 0.390769E-03,-0.162978E-03),( 0.378377E-03,-0.195668E-04), > 4 ( 0.366912E-03,-0.681579E-04),(-0.470068E-03,-0.118650E-05), > 5 ( 0.120025E-02,-0.797459E-03),( 0.622700E-03,-0.424648E-04), > 6 (-0.537275E-03, 0.101658E-03),( 0.222407E-03,-0.828812E-05), > 7 (-0.209097E-03, 0.828365E-04),( 0.945940E-04, 0.317248E-04), > 8 ( 0.341903E-03, 0.192246E-04),( 0.129833E-03, 0.247156E-04), > 9 (-0.610206E-03, 0.591081E-06),(-0.102160E-03,-0.434110E-04), > * ( 0.196672E-04,-0.305687E-04),(-0.905354E-04,-0.813929E-04), > 1 ( 0.569460E-05,-0.116661E-03)/ > C****************************** > DATA SCALE/1./ > C****************************** > real,external :: sddot ! in util.F > ! > RT2 = SQRT(2.) > if (tideann==0) goto 13 > JM = 2*nlat+1 > C **** > C **** HEIGHT VARIATION > C **** > DO 1 N = 1,6 > CL(N) = -CSQRT(CMPLX(gask/(atm_amu*grav*RL(N))* > 1 (T0(1)*2./7.+(T0(2)-T0(1))/dz)-.25))-.5*CI > 1 CONTINUE > CL(0) = 0. > C **** > C **** SET UP LEGENDRE POLYNOMIALS > C **** > ! > ! Using new (1998) spherepack (sphpac.f): > ! (nalf=24, see cbndrya.h) > ! > pi = 4.*atan(1.) > do n=1,nalf > do m=0,1 > mp1=m+1 > call alfk(n,m,cp) > do j=1,jm > theta = float(j-1)*pi/float(jm-1) > call lfpt(n,m,theta,cp,ptscal) > ptjm(j) = ptscal > enddo > do j=1,nlat > p(j,n,mp1) = ptjm(2*(nlat+1-j)) > enddo > enddo > m = 0 > rm = float(m) > do j=1,nlat > p(j,n,2)=sqrt(float(n*(n+1)-m*(m+1)))*p(j,n,2)-rm*tn(j)* > | p(j,n,1) > enddo > enddo > C **** > C **** NOW EVALUATE HOUGH FUNCTIONS > C **** > DO 4 L=1,6 > DO 4 LD=1,2 > DO 4 J=1,nlat > xdot(:) = p(j,:,ld) > ydot(:) = b(l,:) > HOUGH(J,L,LD)=sddot(24,xdot,ydot) > 4 CONTINUE > C **** > C **** HOUGH FUNCTION OF ORDE ZERO` > C **** > DO 5 J =1,nlat > HOUGH(J,0,1) = 1./RT2 > HOUGH(J,0,2) = 0. > 5 CONTINUE > C **** > C **** GENERATE ZBA, TBA, UBA, VBA > C **** > DO 6 J = 1,nlat > ZBA(J) = 0. > TBA(J) = 0. > UBA(J) = 0. > VBA(J) = 0. > 6 CONTINUE > C **** > C **** SUMMATION OVER FREQUENCY, K, CALCULATION OF PHASE FACTOR > C **** > DO 7 K = 0,6 > EXPT = CEXP(CI*FLOAT(K*(IDAY-1))*86400.*freq_ann) > C **** > C **** SUMMATION OVER ORDER, N > C **** > DO 7 N = 0,6 > FACTOR = SCALE > IF(K.EQ.0.AND.N.EQ.0)FACTOR = 1. > DO 7 J = 1,nlat > ZZB(J) = CC(K,N)*HOUGH(J,N,1)*EXPT*1.E5*FACTOR > DZB(J) = CC(K,N)*HOUGH(J,N,2)*EXPT*1.E5*FACTOR > W(J) = grav/(re*((FLOAT(K)*freq_ann)**2-COR(J)**2)) > ZBA(J) = ZBA(J)+ZZB(J) > TBA(J) = TBA(J)+CI*atm_amu*grav/gask*CL(N)*ZZB(J) > UBA(J) = UBA(J)+W(J)*(COR(J)*DZB(J)-RM*FLOAT(K)*freq_ann/ > 1 CS(J)*ZZB(J)) > VBA(J) = VBA(J)+CI*W(J)*(FLOAT(K)*freq_ann*DZB(J)-RM*COR(J)/ > 1 CS(J)*ZZB(J)) > 7 CONTINUE > GO TO 11 > 13 CONTINUE > C **** > C **** ZERO BOUNDARY CONDITION > C **** > DO 12 J = 1,nlat > ZBA(J) = CC(0,0)*1./RT2*1.E5 > TBA(J) = 0. > UBA(J) = 0. > VBA(J) = 0. > 12 CONTINUE > 11 CONTINUE > C **** > C **** LONGITUDINAL STRUCTURE > C **** > DO 8 I = 1,nlonp4 > BNDA(I) = 1. > 8 CONTINUE > end subroutine bndry_annual > !----------------------------------------------------------------------- 471,472c651,653 < use init_module,only: iter,igswm_mi_di,igswm_mi_sdi, < | igswm_nm_di,igswm_nm_sdi --- > use init_module,only: iter,igetgswmdi,igetgswmsdi, > | igetgswmnmdi,igetgswmnmsdi > ! use bndry_module,only: tb,tb2,tba,bnd,bnd2,bnda,ci 473a655,656 > use gswm_module,only: tndi_gswm,tnsdi_gswm, ! GSWM tides > | tnnmidi_gswm,tnnmisdi_gswm 494,495c677 < ! GSWM migrating diurnal and semi-diurnal: < if(igswm_mi_di == 1.and.igswm_mi_sdi == 1) then --- > if(igetgswmdi == 1.and.igetgswmsdi == 1) then 498,499c680,683 < tnlbc(i,lat) = gswm_mi_sdi_t(i,lat)+tbound ! semidiurnal tide < tnlbc(i,lat) = tnlbc(i,lat)+ gswm_mi_di_t(i,lat) ! diurnal tide --- > tnlbc(i,lat) = tnsdi_gswm(i,lat)+tbound ! semidiurnal tide > tnlbc(i,lat) = tnlbc(i,lat)+ tndi_gswm(i,lat)! diurnal tide > tnlbc(i,lat) = tnlbc(i,lat)+ > | real(tba(lat)*bnda(i)*expta) ! annual tide 503,504c687 < ! GSWM migrating semi-diurnal: < elseif(igswm_mi_di == 0.and.igswm_mi_sdi == 1) then --- > elseif(igetgswmdi == 0.and.igetgswmsdi == 1) then 507c690 < tnlbc(i,lat) = gswm_mi_sdi_t(i,lat)+tbound ! semidiurnal tide --- > tnlbc(i,lat) = tnsdi_gswm(i,lat)+tbound ! semidiurnal tide 509a693,694 > tnlbc(i,lat) = tnlbc(i,lat)+ > | real(tba(lat)*bnda(i)*expta) ! annual tide 513,514c698 < ! GSWM migrating diurnal: < elseif(igswm_mi_di == 1.and.igswm_mi_sdi == 0) then --- > elseif(igetgswmdi == 1.and.igetgswmsdi == 0) then 517,518c701,704 < tnlbc(i,lat) = real(tb(lat)*bnd(i)*expt)+tbound ! semidiurnal tide < tnlbc(i,lat) = tnlbc(i,lat)+ gswm_mi_di_t(i,lat) ! diurnal tide --- > tnlbc(i,lat) = real(tb(lat)*bnd(i)*expt)+tbound ! semidiurnal tide > tnlbc(i,lat) = tnlbc(i,lat)+ tndi_gswm(i,lat) ! diurnal tide > tnlbc(i,lat) = tnlbc(i,lat)+ > | real(tba(lat)*bnda(i)*expta) ! annual tide 523d708 < ! No gswm: 526c711 < tnlbc(i,lat) = real(tb(lat)*bnd(i)*expt)+tbound ! semidiurnal tide --- > tnlbc(i,lat) = real(tb(lat)*bnd(i)*expt)+tbound ! semidiurnal tide 528a714,715 > tnlbc(i,lat) = tnlbc(i,lat)+ > | real(tba(lat)*bnda(i)*expta) ! annual tide 533,534c720,722 < ! GSWM non-migrating diurnal: < if(igswm_nm_di == 1) then ! nonmigrating diurnal tide --- > if(igetgswmnmdi == 1) then ! nonmigrating diurnal tide > ! write(6,"('BNDRY: getting tnnmidi_gswm >>>',/,(8e12.4))") > ! | tnnmidi_gswm(lon0,lat0:lat1) 537c725 < tnlbc(i,lat) = tnlbc(i,lat)+ gswm_nm_di_t(i,lat) --- > tnlbc(i,lat) = tnlbc(i,lat)+ tnnmidi_gswm(i,lat) 542,543c730 < ! GSWM non-migrating semi-diurnal: < if(igswm_nm_sdi == 1) then ! nonmigrating semidiurnal tide --- > if(igetgswmnmsdi == 1) then ! nonmigrating semidiurnal tide 546c733 < tnlbc(i,lat) = tnlbc(i,lat)+ gswm_nm_sdi_t(i,lat) --- > tnlbc(i,lat) = tnlbc(i,lat)+ tnnmisdi_gswm(i,lat) 550a738 > 560,561c748,750 < use init_module,only: iter,igswm_mi_di,igswm_mi_sdi, < | igswm_nm_di,igswm_nm_sdi --- > use init_module,only: iter,igetgswmdi,igetgswmsdi, > | igetgswmnmdi,igetgswmnmsdi > ! use bndry_module,only: zb,zb2,zba,bnd,bnd2,bnda,ci 562a752,753 > use gswm_module,only: zdi_gswm,zsdi_gswm, ! GSWM tides > | znmidi_gswm,znmisdi_gswm 581,582c772 < ! GSWM migrating diurnal and semi-diurnal: < if(igswm_mi_di == 1.and.igswm_mi_sdi == 1) then --- > if(igetgswmdi == 1.and.igetgswmsdi == 1) then 585,586c775,777 < z(i,j) = gswm_mi_sdi_z(i,j) ! semidiurnal tide < z(i,j) = z(i,j)+ gswm_mi_di_z(i,j) ! diurnal tide --- > z(i,j) = zsdi_gswm(i,j) ! semidiurnal tide > z(i,j) = z(i,j)+ zdi_gswm(i,j) ! diurnal tide > z(i,j) = z(i,j)+real(zba(j)*bnda(i)*expta) ! annual tide 589,591c780 < ! < ! GSWM migrating semi-diurnal: < elseif(igswm_mi_di == 0.and.igswm_mi_sdi == 1) then --- > elseif(igetgswmdi == 0.and.igetgswmsdi == 1) then 594,595c783,785 < z(i,j) = gswm_mi_sdi_z(i,j) ! semidiurnal tide < z(i,j) = z(i,j)+real(zb2(j)*bnd2(i)*expt2) ! diurnal tide --- > z(i,j) = zsdi_gswm(i,j) ! semidiurnal tide > z(i,j) = z(i,j)+real(zb2(j)*bnd2(i)*expt2)! diurnal tide > z(i,j) = z(i,j)+real(zba(j)*bnda(i)*expta) ! annual tide 598,600c788 < ! < ! GSWM migrating diurnal: < elseif(igswm_mi_di == 1.and.igswm_mi_sdi == 0) then --- > elseif(igetgswmdi == 1.and.igetgswmsdi == 0) then 604c792,793 < z(i,j) = z(i,j)+ gswm_mi_di_z(i,j) ! diurnal tide --- > z(i,j) = z(i,j)+ zdi_gswm(i,j) ! diurnal tide > z(i,j) = z(i,j)+real(zba(j)*bnda(i)*expta) ! annual tide 607,608d795 < ! < ! No gswm: 613a801 > z(i,j) = z(i,j)+real(zba(j)*bnda(i)*expta) ! annual tide 618,619c806 < ! GSWM non-migrating diurnal: < if(igswm_nm_di == 1) then ! nonmigrating diurnal tide --- > if(igetgswmnmdi == 1) then ! nonmigrating diurnal tide 622c809 < z(i,j) = z(i,j)+ gswm_nm_di_z(i,j) --- > z(i,j) = z(i,j)+ znmidi_gswm(i,j) 627,628c814 < ! GSWM non-migrating semi-diurnal: < if(igswm_nm_sdi == 1) then ! nonmigrating semidiurnal tide --- > if(igetgswmnmsdi == 1) then ! nonmigrating semidiurnal tide 631c817 < z(i,j) = z(i,j)+ gswm_nm_sdi_z(i,j) --- > z(i,j) = z(i,j)+ znmisdi_gswm(i,j) 634a821 > ! 639,641c826,833 < use init_module,only: igswm_mi_di,igswm_mi_sdi, < | igswm_nm_di,igswm_nm_sdi < ! --- > > use init_module,only: igetgswmdi,igetgswmsdi, > | igetgswmnmdi,igetgswmnmsdi > ! use bndry_module,only: ub,ub2,uba,vb,vb2,vba,bnd,bnd2,bnda,ci > use gswm_module,only: ! GSWM tides > | undi_gswm,unsdi_gswm,unnmidi_gswm,unnmisdi_gswm, > | vndi_gswm,vnsdi_gswm,vnnmidi_gswm,vnnmisdi_gswm > 643,644c835,837 < ! < ! Args: --- > > > ! Args: 654,655c847,848 < ! GSWM migrating diurnal and semi-diurnal: < if(igswm_mi_di == 1.and.igswm_mi_sdi == 1) then --- > ! > if(igetgswmdi == 1.and.igetgswmsdi == 1) then 657,660c850,856 < unlbc(i) = gswm_mi_sdi_u(i,lat) ! semidiurnal tide < vnlbc(i) = gswm_mi_sdi_v(i,lat) < unlbc(i) = unlbc(i) + gswm_mi_di_u(i,lat) ! diurnal tide < vnlbc(i) = vnlbc(i) + gswm_mi_di_v(i,lat) --- > unlbc(i) = unsdi_gswm(i,lat) ! semidiurnal tide > vnlbc(i) = vnsdi_gswm(i,lat) > unlbc(i) = unlbc(i) + undi_gswm(i,lat) ! diurnal tide > vnlbc(i) = vnlbc(i) + vndi_gswm(i,lat) > unlbc(i) = unlbc(i) + real(uba(lat)*bnda(i)*expta)! annual tide > vnlbc(i) = vnlbc(i) + real(vba(lat)*bnda(i)*expta) > ! 664,666c860 < ! < ! GSWM migrating semi-diurnal: < elseif(igswm_mi_di == 0.and.igswm_mi_sdi == 1) then --- > elseif(igetgswmdi == 0.and.igetgswmsdi == 1) then 668,669c862,863 < unlbc(i) = gswm_mi_sdi_u(i,lat) ! semidiurnal tide < vnlbc(i) = gswm_mi_sdi_v(i,lat) --- > unlbc(i) = unsdi_gswm(i,lat) ! semidiurnal tide > vnlbc(i) = vnsdi_gswm(i,lat) 671a866,868 > unlbc(i) = unlbc(i) + real(uba(lat)*bnda(i)*expta) ! annual tide > vnlbc(i) = vnlbc(i) + real(vba(lat)*bnda(i)*expta) > ! 675,677c872 < ! < ! GSWM migrating diurnal: < elseif(igswm_mi_di == 1.and.igswm_mi_sdi == 0) then --- > elseif(igetgswmdi == 1.and.igetgswmsdi == 0) then 681,682c876,880 < unlbc(i) = unlbc(i) + gswm_mi_di_u(i,lat) ! diurnal tide < vnlbc(i) = vnlbc(i) + gswm_mi_di_v(i,lat) --- > unlbc(i) = unlbc(i) + undi_gswm(i,lat) ! diurnal tide > vnlbc(i) = vnlbc(i) + vndi_gswm(i,lat) > unlbc(i) = unlbc(i) + real(uba(lat)*bnda(i)*expta)! annual tide > vnlbc(i) = vnlbc(i) + real(vba(lat)*bnda(i)*expta) > ! 686,687d883 < ! < ! No gswm: 693a890,892 > unlbc(i) = unlbc(i) + real(uba(lat)*bnda(i)*expta)! annual tide > vnlbc(i) = vnlbc(i) + real(vba(lat)*bnda(i)*expta) > ! 699,700c898 < ! GSWM non-migrating diurnal: < if(igswm_nm_di == 1) then ! nonmigrating diurnal tide --- > if(igetgswmnmdi == 1) then ! nonmigrating diurnal tide 702,703c900,902 < unlbc(i) = unlbc(i) + gswm_nm_di_u(i,lat) < vnlbc(i) = vnlbc(i) + gswm_nm_di_v(i,lat) --- > unlbc(i) = unlbc(i) + unnmidi_gswm(i,lat) > vnlbc(i) = vnlbc(i) + vnnmidi_gswm(i,lat) > ! 709,710c908 < ! GSWM non-migrating semi-diurnal: < if(igswm_nm_sdi == 1) then ! nonmigrating semidiurnal tide --- > if(igetgswmnmsdi == 1) then ! nonmigrating semidiurnal tide 712,713c910,912 < unlbc(i) = unlbc(i) + gswm_nm_sdi_u(i,lat) < vnlbc(i) = vnlbc(i) + gswm_nm_sdi_v(i,lat) --- > unlbc(i) = unlbc(i) + unnmisdi_gswm(i,lat) > vnlbc(i) = vnlbc(i) + vnnmisdi_gswm(i,lat) > ! 717a917 > ! ======================================================================== Diff of /fis/hao/tgcm/tiegcm1.92/src/comp_n2d.F and /ptmp/foster/ganglu_tiegcm_amie/modsrc2/comp_n2d.F 5,8d4 < ! This software is part of the NCAR TIE-GCM. Use is governed by the < ! Open Source Academic Research License Agreement contained in the file < ! tiegcmlicense.txt. < ! 17d12 < use addfld_module,only: addfld 42c37 < integer ::i0,i1,nk,nkm1 --- > integer ::i0,i1,nk,nkm1 ! for addfsech 47c42 < ! For addfld: --- > ! For addfsech: 75,80c70,73 < ! call addfld('N2D_PROD' ,' ',' ',n2d_prod(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',i0,i1,lat) < ! call addfld('N2D_LOSS' ,' ',' ',n2d_loss(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',i0,i1,lat) < ! call addfld('N2D_UPD' ,' ',' ',n2d(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',i0,i1,lat) --- > call addfsech('N2D_PROD' ,' ',' ',n2d_prod,i0,i1,nk,nkm1,lat) > call addfsech('N2D_LOSS' ,' ',' ',n2d_loss,i0,i1,nk,nkm1,lat) > ! call addfsech('N2D_UPD' ,' ',' ',n2d(:,lon0:lon1), > ! | i0,i1,nk,nkm1,lat) ======================================================================== Diff of /fis/hao/tgcm/tiegcm1.92/src/comp_n4s.F and /ptmp/foster/ganglu_tiegcm_amie/modsrc2/comp_n4s.F 3,7d2 < ! < ! This software is part of the NCAR TIE-GCM. Use is governed by the < ! Open Source Academic Research License Agreement contained in the file < ! tiegcmlicense.txt. < ! 9d3 < use addfld_module,only: addfld 81d74 < use fields_module,only: tlbc ! lower boundary interface level of TN 102c95 < integer ::i0,i1,nk,nkm1 --- > integer ::i0,i1,nk,nkm1 ! for addfsech 104c97,98 < real,dimension(lev0:lev1,lon0:lon1) :: xn2 ! n2 (mmr) --- > real,dimension(lev0:lev1,lon0:lon1) :: xn2, ! n2 (mmr) > | n4seq 118,119d111 < ! xnmbar_lbc = p0*expz(1)*expzmid_inv*barm(lev0,i)/ < ! | (boltz*tn(lev1,i)) 121c113 < | (boltz*tlbc(i,lat)) --- > | (boltz*tn(lev1,i)) 164c156,162 < enddo ! k=lev0,lev1-1 --- > ! Update n4s in assumed photochemical equilibrium > ! > ! > n4seq(k,i)=rmass_n4s*n4s_prod(k,i,lat)/ > | (n4s_loss(k,i,lat)*xnmbarm(k,i)) > ! > enddo ! k=lev0,lev1-1 167,173c165,174 < ! call addfld('MBAR_N4S' ,' ',' ',xnmbarm(lev0:lev1-1,i0:i1), < ! | 'lev',lev0,lev1-1,'lon',i0,i1,lat) < ! call addfld('N4S_PROD',' ',' ',n4s_prod(lev0:lev1-1,i0:i1,lat), < ! | 'lev',lev0,lev1-1,'lon',i0,i1,lat) < ! call addfld('N4S_LOSS',' ',' ',n4s_loss(lev0:lev1-1,i0:i1,lat), < ! | 'lev',lev0,lev1-1,'lon',i0,i1,lat) < --- > ! call addfsech('XNMBAR' ,' ',' ',xnmbarm(:,i0:i1), > ! | i0,i1,nk,nkm1,lat) > call addfsech('N4S_PROD',' ',' ',n4s_prod(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) > call addfsech('N4S_LOSS',' ',' ',n4s_loss(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) > call addfsech('N4S_EQ',' ',' ',n4seq(:,i0:i1), > | i0,i1,nk,nkm1,lat) > ! > ! 197a199 > integer ::i0,i1,nk,nkm1 ! for addfsech 199a202,205 > i0 = lon0 > i1 = lon1 > nk = lev1-lev0+1 > nkm1 = nk-1 213,218c219,222 < ! call addfld('N4S_OUT' ,' ',' ', < ! | n4s_out(lev0:lev1-1,lon0:lon1,lat), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('N4S_TM1' ,' ',' ', < ! | n4s_nm1_out(lev0:lev1-1,lon0:lon1,lat), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('N4S_OUT' ,' ',' ',n4s_out(:,i0:i1,lat), > ! | i0,i1,nk,nkm1,lat) > ! call addfsech('N4S_TM1' ,' ',' ',n4s_nm1_out(:,i0:i1,lat), > ! | i0,i1,nk,nkm1,lat) ======================================================================== Diff of /fis/hao/tgcm/tiegcm1.92/src/comp_no.F and /ptmp/foster/ganglu_tiegcm_amie/modsrc2/comp_no.F 3,7d2 < ! < ! This software is part of the NCAR TIE-GCM. Use is governed by the < ! Open Source Academic Research License Agreement contained in the file < ! tiegcmlicense.txt. < ! 9d3 < use addfld_module,only: addfld 11a6,11 > ! real,dimension(nlonp4,nlat) :: no_ubc ! upper boundary > ! real,dimension(nlonp4,3,nlat) :: no_lbc ! lower boundary > ! real,dimension(nlevp1,nlonp4,nlat) :: > ! | no_prod, ! production of no > ! | no_loss ! loss of no > ! 67d66 < use fields_module,only: tlbc ! lower boundary interface level of TN 83,84c82,83 < integer ::i0,i1,nk,nkm1 < real,dimension(lev0:lev1,lon0:lon1) :: --- > integer ::i0,i1,nk,nkm1 ! for addfsech > real,dimension(lev0:lev1,lon0:lon1) :: noeq, 101,103c100 < ! no_lbc(i,3,lat) = -nob(lat)*rmass_no*boltz*tn(lev1,i)/ < ! | (p0*expzmid_inv*expz(lev0)*barm(lev0,i)) < no_lbc(i,3,lat) = -nob(lat)*rmass_no*boltz*tlbc(i,lat)/ --- > no_lbc(i,3,lat) = -nob(lat)*rmass_no*boltz*tn(lev1,i)/ 126a124,126 > ! Update no in assumed photochemical equilibrium > noeq(k,i)=rmass_no*no_prod(k,i,lat)/ > | (no_loss(k,i,lat)*xnmbar(k,i)) 130,135c130,135 < ! call addfld('MBAR_NO' ,' ',' ',xnmbar(lev0:lev1-1,i0:i1), < ! | 'lev',lev0,lev1-1,'lon',i0,i1,lat) < ! call addfld('NO_PROD',' ',' ',no_prod(lev0:lev1-1,i0:i1,lat), < ! | 'lev',lev0,lev1-1,'lon',i0,i1,lat) < ! call addfld('NO_LOSS',' ',' ',no_loss(lev0:lev1-1,i0:i1,lat), < ! | 'lev',lev0,lev1-1,'lon',i0,i1,lat) --- > ! call addfsech('XNMBAR' ,' ',' ',xnmbar ,i0,i1,nk,nkm1,lat) > call addfsech('NO_PROD',' ',' ',no_prod(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) > call addfsech('NO_LOSS',' ',' ',no_loss(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) > call addfsech('NO_EQ',' ',' ',noeq(:,i0:i1),i0,i1,nk,nkm1,lat) 159a160 > integer ::nk,nkm1 ! for addfsech 160a162,164 > nk = lev1-lev0+1 > nkm1 = nk-1 > ! 173,178c177,180 < ! call addfld('NO_OUT' ,' ',' ', < ! | no_out(lev0:lev1-1,lon0:lon1,lat), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('NO_TM1' ,' ',' ', < ! | no_nm1_out(lev0:lev1-1,lon0:lon1,lat), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('NO_OUT' ,' ',' ',no_out(:,lon0:lon1,lat), > ! | lon0,lon1,nk,nkm1,lat) > ! call addfsech('NO_TM1' ,' ',' ',no_nm1_out(:,lon0:lon1,lat), > ! | lon0,lon1,nk,nkm1,lat) ======================================================================== Diff of /fis/hao/tgcm/tiegcm1.92/src/cons.F and /ptmp/foster/ganglu_tiegcm_amie/modsrc2/cons.F 2d1 < #include 4,8d2 < ! < ! This software is part of the NCAR TIE-GCM. Use is governed by the < ! Open Source Academic Research License Agreement contained in the file < ! tiegcmlicense.txt. < ! 10c4,5 < | dlev,nlev,nmlat,nmlon,nmlonp1,zmbot,zmtop,zibot,zitop,dlon --- > | dlev,nlev,nmlat,nmlon,nmlonp1,nmagphrlat,nmagphrlon, > | magphrlat1,magphrlat2,magphrlon1,plev1,zst 31,40c26,27 < ! < ! dipmin should be same as sin10 (see magfield.F): < ! < #if (NLAT==36 && NLON==72) < | dipmin = 0.17, ! minimum mag dip angle (5.0 deg horizontal res) < #elif (NLAT==72 && NLON==144) < | dipmin = 0.24, ! minimum mag dip angle (2.5 deg horizontal res) < #else < UNKNOWN NLAT,NLON ! compilation will stop here if unknown res < #endif --- > ! | dipmin = .005, ! minimum mag dip angle (tiegcm) (tgcm15=.005) > | dipmin = 0.17, ! minimum mag dip angle (tiegcm) 77a65,70 > ! 2/00: these were in modsrc.snoe (tgcm13mt), but were unused. > ! Low-energy protons: > ! real,parameter :: > ! alfalp = 10., > ! efluxlp = 1.e-20 > ! 94a88 > | freq_ann, ! frequency of annual tide C(25) 109,110c103 < | xmue(nlev+1), ! eddy viscosity (?) < | zbound ! background low bound of Z (formerly ZBA in annual tide) --- > | xmue(nlev+1) ! eddy viscosity (?) 116c109 < | dlatg, dlong, dlatm, dlonm, --- > | dlatg, dlong, dlatm, dlonm,dmagphrlon, 118a112,113 > | ylatmagphr(nmagphrlat), ! magnetosphere latitudes (radians) > | ylonmagphr(nmagphrlon), ! magnetosphere longitudes (radians) 130,131c125,127 < real,parameter :: < | crit(2) = (/0.261799387, 0.523598775/) --- > ! real,parameter :: > ! | crit(2) = (/0.261799387, 0.523598775/) > real :: crit(2) 133c129,132 < ! Kut is used in filtering longitudinal waves (see filter.F): --- > ! For filtering longitudinal waves (see filter.F): > ! integer,parameter :: kut(nlat) = > ! | (/1,2,3,5,6,7,9,10,11,13,14,15,17,17,17,17,17,17,17,17,17,17,17, > ! | 17,15,14,13,11,10,9,7,6,5,3,2,1/) 135,136c134,138 < #if (NLAT==36 && NLON==72) /* 5.0 deg horizontal resolution */ < integer,parameter :: kut(nlat) = --- > ! kut for wave numbers to filter: > integer :: kut(nlat) > ! > ! kut for tiegcm at dlat 5.0 degrees: > integer,parameter :: kut_5(36) = 139,156d140 < #elif (NLAT==72 && NLON==144) /* 2.5 deg horizontal resolution */ < integer,parameter :: kut(nlat) = < | (/1 ,1 ,2 ,2 ,4 ,4 ,8 ,8 ,10 ,10 ,12 ,12, < | 15 ,15 ,18 ,18 ,22 ,22 ,26 ,26 ,30 ,30 ,32 ,32, < | 34 ,34 ,34 ,34 ,34 ,34 ,34 ,34 ,34 ,34 ,34 ,34, < | 34 ,34 ,34 ,34 ,34 ,34 ,34 ,34 ,34 ,34 ,34 ,34, < | 32 ,32 ,30 ,30 ,26 ,26 ,22 ,22 ,18 ,18 ,15 ,15, < | 12 ,12 ,10 ,10 ,8 ,8 ,4 ,4 ,2 ,2 ,1 ,1/) < ! integer,parameter :: kut(nlat) = < ! | (/0 ,0 ,1 ,2 ,3 ,4 ,5 ,6 , 7 , 8 , 9 ,10, < ! | 15 ,15 ,17 ,17 ,17 ,17 ,17 ,17 ,17 ,17 ,17 ,17, < ! | 17 ,17 ,17 ,17 ,17 ,17 ,17 ,17 ,17 ,17 ,17 ,17, < ! | 17 ,17 ,17 ,17 ,17 ,17 ,17 ,17 ,17 ,17 ,17 ,17, < ! | 17 ,17 ,17 ,17 ,17 ,17 ,17 ,17 ,17 ,17 ,15 ,15, < ! | 10 , 9 , 8 , 7 ,6 ,5 ,4 ,3 ,2 ,1 ,0 ,0/) < #else < UNKNOWN NLAT,NLON ! compilation will stop here if unknown res < #endif 191a176,178 > > ! print *,' init_cons: pi=',pi > 200d186 < zbound = 136.291/sqrt(2.)*1.e5 ! background lower boundary of Z (cm) 207,209c193,195 < ! bottom midpoint z = zibot + 1/2 deltaz (deltaz==dz==0.5 or 0.25) < ! (zibot and dz are in params.h) < z = zibot+.5*dlev --- > ! bottom midpoint z = plev1 + 1/2 deltaz (deltaz==dz==0.5 or 0.25) > ! (plev1 and dz are in params.h) > z = plev1+.5*dlev 213,214c199,208 < dift(1) = 5.0e-6/prndtl < xmue(1) = 5.0e-6 --- > ! reduce Eddy diffusion by a factor of 2 - G. Lu, Jul 24, 2006 > ! difk(1) = 2.5e-6 > ! Increase Eddy diffusion by a factor of 2 - G. Lu, Dec 20, 2006 - Don't seem to affect Nmf2 very much > ! difk(1) = 10.0e-6 > ! dift(1) = 5.0e-6/prndtl > ! xmue(1) = 5.0e-6 > ! Change made by Roble on May 13, 2007 for Charley Barth > difk(1) = 2.0e-6 > dift(1) = 2.0e-6/prndtl > xmue(1) = 2.0e-6 248a243 > freq_ann = freq_semidi/(2.*365.25) ! was C(25) 251c246,255 < grav = 870. ! (is 945. in time-gcm) --- > if (plev1==-17.) then ! time-gcm > grav = 945. > elseif (plev1==-7.) then ! tiegcm > grav = 870. > else > write(6,"(/,'>>> WARNING: do not know how to assign gravity', > | ' constant with plev1=',f10.2)") plev1 > grav = 945. > write(6,"(' Default to grav=',f10.2,/)") grav > endif 253a258,262 > ! Set kut for wave filtering according to dlat (2.5 or 5.0): > call set_wave_filter(36,kut_5,nlat,kut) > write(6,"('init_cons: dlat=',f6.2,' nlat=',i3,' kut=',/,(12i4))") > | dlat,nlat,kut > ! 256a266,270 > ! Set default crit. If reading amie data, this may be changed > ! (see aurora.F). > crit(1) = 0.261799387 > crit(2) = 0.523598775 > ! 262,268c276,277 < write(6,"(' dz= ',f5.2)") dz < write(6,"(' dlat=',f6.2,' dlon=',f6.2)") dlat,dlon < write(6,"(' zbound (cm) = ',e12.6)") zbound < write(6,"(' zmbot, zmtop = ',2f8.3, < | ' (bottom,top midpoint levels)')") zmbot,zmtop < write(6,"(' zibot, zitop = ',2f8.3, < | ' (bottom,top interface levels)')") zibot,zitop --- > write(6,"(' zst=',f8.2,' plev1=',f8.2,' dlev=',f5.2)") > | zst,plev1,dlev 271,272c280,281 < write(6,"(' freq_3m3 = ',e10.4,' freq_semidi=',e10.4)") < | freq_3m3,freq_semidi --- > write(6,"(' freq_3m3 = ',e10.4,' freq_semidi=',e10.4, > | ' freq_ann=',e12.4)") freq_3m3,freq_semidi,freq_ann 275c284,286 < write(6,"(' kut (for filtering) = ',36i3)") kut --- > > ! write(6,"('kut = ',36i3)") kut > ! write(6,"('2*kut+3 = ',36i3)") 2*kut(:)+3 278a290,318 > subroutine set_wave_filter(nlat5,kut5,nlat,kut) > ! > ! Args: > integer,intent(in) :: nlat5,nlat > integer,intent(in) :: kut5(nlat5) > integer,intent(out) :: kut(nlat) > ! > ! Local: > integer :: j > ! > if (nlat==nlat5) then ! nlat==nlat5==36 (5x5 degree res) > do j=1,nlat > kut(j) = kut5(j) > enddo > elseif (nlat==nlat5*2) then ! nlat==72 (2.5x2.5 degree res) > do j=1,nlat5-1 > kut(j*2-1) = kut5(j) ! 1,3,5,...,65,67,69 > kut(j*2) = kut5(j) ! 2,4,6,...,66,68,70 > enddo > kut(nlat) = kut5(nlat5) > kut(nlat-1) = kut5(nlat5) > else > write(6,"('set_wave_filter: nlat=',i3,' dlat=',f8.3, > | ' not supported.')") nlat,dlat > call shutdown('dlat') > endif > ! write(6,"('set_wave_filter: nlat=',i3,' kut=',/,(12i4))") nlat,kut > end subroutine set_wave_filter > !----------------------------------------------------------------------- 293c333 < real :: rmin,rmax,rmag --- > real :: fac,rmin,rmax,rmag 299a340 > dmagphrlon = 360./float(nmagphrlon) 377a419,430 > > ! Define magnetospheric grid vars > do i=1,nmagphrlon > ylonmagphr(i) = magphrlon1+(i-1)*dmagphrlon > enddo > fac = pi/180. > rmax = 1./(cos(magphrlat1*fac))**2 > rmin = 1./(cos(magphrlat2*fac))**2 > do i=1,nmagphrlat > rmag = (rmax-(rmax-rmin)/(nmagphrlat-1)*real(i-1)) > ylatmagphr(i) = acos(sqrt(1./rmag))/fac > enddo ======================================================================== Diff of /fis/hao/tgcm/tiegcm1.92/src/dt.F and /ptmp/foster/ganglu_tiegcm_amie/modsrc2/dt.F 6,9d5 < ! This software is part of the NCAR TIE-GCM. Use is governed by the < ! Open Source Academic Research License Agreement contained in the file < ! tiegcmlicense.txt. < ! 13c9 < use params_module,only: nlonp4,dz,nlat,spval --- > use params_module,only: nlonp4,dz,nlat 18,19c14,16 < | gask,expzmid,expzmid_inv,dift,dtsmooth,dtsmooth_div2,kut < use bndry_module,only: tb,tb2,bnd,bnd2,ci,lbc_gswm_dt --- > | gask,expzmid,expzmid_inv,dift,kut_5,set_wave_filter,dtsmooth, > | dtsmooth_div2 > use bndry_module,only: tb,tb2,tba,bnd,bnd2,bnda,ci,lbc_gswm_dt 22,23d18 < use fields_module,only: tlbc,ulbc,vlbc,tlbc_nm < use addfld_module,only: addfld 55,56c50 < real,parameter :: joulefac = 1.5 ! joule heating multiplication factor < integer :: k,i,lonbeg,lonend,lat --- > integer :: k,i,lonbeg,lonend,lat,kutt(nlat) 58c52 < complex :: expt,expt2 --- > complex :: expt,expt2,expta 96a91 > expta = 1. 108a104,105 > tnlbc(i,lat) = tnlbc(i,lat)+ > | real(tba(lat)*bnda(i)*expta) ! annual tide 110a108 > call addfsech('TNLBC',' ',' ',tnlbc,lon0,lon1,nk,nkm1,lat) 112,116c110,114 < do k=lev0,lev1 < tnlbc_diag(k,:) = tnlbc(:,lat) < enddo < ! call addfld('TNLBC1',' ',' ',tnlbc_diag, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! write(6,"('dt: lat=',i3,' tnlbc=',/,(6e12.4))") lat,tnlbc(:,lat) > ! do k=lev0,lev1 > ! tnlbc_diag(k,:) = tnlbc(:,lat) > ! enddo > ! call addfsech('TNLBC',' ',' ',tnlbc_diag,lon0,lon1,nk,nkm1,lat) 124,125c122,123 < ! call addfld('HADVECTN',' ',' ',advec_tn(lev0:lev1-1,:,lat), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('HADVECTN',' ',' ',advec_tn(:,:,lat), > ! | lon0,lon1,nk,nkm1,lat) 131,132c129,130 < ! call addfld('ADVEC_TN',' ',' ',advec_tn(lev0:lev1-1,:,lat), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('ADVEC_TN',' ',' ',advec_tn(:,:,lat), > ! | lon0,lon1,nk,nkm1,lat) 165,174c163,170 < ! call addfld('CP' ,' ',' ',cp(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('TNSMOOTH' ,' ',' ',tnsmooth(:,:,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('ADVEC_TNa',' ',' ',advec_tn(lev0:lev1-1,:,lat), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('CPTN0',' ',' ',cptn, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('MBAR' ,' ',' ',mbar(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('CP' ,' ',' ',cp(:,lon0:lon1,lat), > ! | lon0,lon1,nk,nkm1,lat) > ! call addfsech('TNSMOOTH' ,' ',' ',tnsmooth(:,:,lat), > ! | lon0,lon1,nk,nkm1,lat) > ! call addfsech('ADVEC_TN',' ',' ',advec_tn(:,:,lat), > ! | lon0,lon1,nk,nkm1,lat) > call addfsech('CPTN0',' ',' ',cptn,lon0,lon1,nk,nkm1,lat) > ! call addfsech('MBAR' ,' ',' ',mbar,lon0,lon1,nk,nkm1,lat) 192c188,190 < total_heat(k,i) = total_heat(k,i)+qji_tn(k,i,lat)*joulefac --- > ! total_heat(k,i) = total_heat(k,i)+qji_tn(k,i,lat)*2. > ! Taking out the Joule heating multiplacation factor > total_heat(k,i) = total_heat(k,i)+qji_tn(k,i,lat) 195,196c193,199 < ! call addfld('HEATING1',' ',' ',total_heat(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > call addfsech('QTOTAL1',' ',' ',qtotal(:,:,lat), > | lon0,lon1,nk,nkm1,lat) > call addfsech('Q_HDT',' ',' ',hdt(:,:,lat), > | lon0,lon1,nk,nkm1,lat) > call addfsech('QJI_TN1',' ',' ',qji_tn(:,:,lat), > | lon0,lon1,nk,nkm1,lat) > call addfsech('HEATING',' ',' ',total_heat,lon0,lon1,nk,nkm1,lat) 209,214d211 < ! dudz(1,i) = (un(1,i,lat)+1./3.*un(2,i,lat)-4./3.* < ! | un(lev1,i,lat))/dz < ! dvdz(1,i) = (vn(1,i,lat)+1./3.*vn(2,i,lat)-4./3.* < ! | vn(lev1,i,lat))/dz < ! < ! Lower boundary is in ulbc,vlbc: 216c213 < | ulbc(i,lat))/dz --- > | un(lev1,i,lat))/dz 218c215 < | vlbc(i,lat))/dz --- > | vn(lev1,i,lat))/dz 239,246c236,238 < < ! call addfld('CPTN',' ',' ',cptn, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QM' ,' ',' ',qm(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('HEATING2',' ',' ',total_heat(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < --- > call addfsech('CPTN',' ',' ',cptn,lon0,lon1,nk,nkm1,lat) > call addfsech('QM' ,' ',' ',qm ,lon0,lon1,nk,nkm1,lat) > ! call addfsech('HEATING',' ',' ',total_heat,lon0,lon1,nk,nkm1,lat) 262,264c254 < ! tni(lev0,i) = tn(lev1,i,lat) ! bottom boundary is in top slot < < tni(lev0,i) = tlbc(i,lat) ! Lower boundary is in tlbc = tn(itp) --- > tni(lev0,i) = tn(lev1,i,lat) ! bottom boundary is in top slot 283,289c273,277 < ! call addfld('TNI',' ',' ',tni,'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('HG' ,' ',' ',h ,'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('DEN',' ',' ',rho,'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('G' ,' ',' ',g(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('F' ,' ',' ',f(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > call addfsech('TNI',' ',' ',tni,lon0,lon1,nk,nkm1,lat) > call addfsech('H' ,' ',' ',h ,lon0,lon1,nk,nkm1,lat) > call addfsech('DEN',' ',' ',rho,lon0,lon1,nk,nkm1,lat) > call addfsech('G' ,' ',' ',g ,lon0,lon1,nk,nkm1,lat) > call addfsech('F' ,' ',' ',f ,lon0,lon1,nk,nkm1,lat) 308,319c296,303 < ! call addfld('P_COEF0' ,' ',' ',p, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('Q_COEF0' ,' ',' ',q, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('R_COEF0' ,' ',' ',r, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('RHS0' ,' ',' ',rhs, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('COOL_IMP',' ',' ',cool_imp(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('COOL_EXP',' ',' ',cool_exp(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('P_COEF0' ,' ',' ',p,lon0,lon1,nk,nkm1,lat) > ! call addfsech('Q_COEF0' ,' ',' ',q,lon0,lon1,nk,nkm1,lat) > ! call addfsech('R_COEF0' ,' ',' ',r,lon0,lon1,nk,nkm1,lat) > ! call addfsech('RHS0' ,' ',' ',rhs,lon0,lon1,nk,nkm1,lat) > ! call addfsech('COOL_IMP',' ',' ',cool_imp(:,lon0:lon1,lat), > ! | lon0,lon1,nk,nkm1,lat) > ! call addfsech('COOL_EXP',' ',' ',cool_exp(:,lon0:lon1,lat), > ! | lon0,lon1,nk,nkm1,lat) 332,337c316,318 < ! call addfld('QPART' ,' ',' ',qpart(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('Q_COEF1',' ',' ',q , < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('RHS1' ,' ',' ',rhs , < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('QPART' ,' ',' ',qpart,lon0,lon1,nk,nkm1,lat) > ! call addfsech('Q_COEF1',' ',' ',q ,lon0,lon1,nk,nkm1,lat) > ! call addfsech('RHS1' ,' ',' ',rhs ,lon0,lon1,nk,nkm1,lat) 341,342c322 < ! call addfld('TNLBC2',' ',' ',tnlbc_diag, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('TNLBC',' ',' ',tnlbc_diag,lon0,lon1,nk,nkm1,lat) 353,360c333,337 < ! call addfld('P_COEF2',' ',' ',p, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('Q_COEF2',' ',' ',q, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('R_COEF2',' ',' ',r, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('RHS2' ,' ',' ',rhs, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > call addfsech('P_COEF2',' ',' ',p,lon0,lon1,nk,nkm1,lat) > call addfsech('Q_COEF2',' ',' ',q,lon0,lon1,nk,nkm1,lat) > call addfsech('R_COEF2',' ',' ',r,lon0,lon1,nk,nkm1,lat) > call addfsech('RHS2' ,' ',' ',rhs,lon0,lon1,nk,nkm1,lat) > 369,370c346,347 < ! call addfld('TN_SOLV','Updated TN from trsolv','K', < ! | tn_upd(:,lon0:lon1,lat),'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > call addfsech('TN_SOLV',' ',' ',tn_upd(:,lon0:lon1,lat), > | lon0,lon1,nk,nkm1,lat) 376c353 < ! call set_wave_filter(36,kut_5,nlat,kutt) --- > call set_wave_filter(36,kut_5,nlat,kutt) 379c356 < call filter_tn(tn_upd,lev0,lev1,lon0,lon1,lat0,lat1,kut) --- > call filter_tn(tn_upd,lev0,lev1,lon0,lon1,lat0,lat1,kutt) 383,384c360,362 < ! call addfld('TN_FILT',' ',' ',tn_upd(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > > call addfsech('TN_FILT',' ',' ',tn_upd(:,lon0:lon1,lat), > | lon0,lon1,nk,nkm1,lat) 393,394c371,372 < ! call addfld('TN_NMOUT',' ',' ',tn_nm_upd(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > call addfsech('TN_NMOUT',' ',' ',tn_nm_upd(:,lon0:lon1,lat), > | lon0,lon1,nk,nkm1,lat) 397c375 < ! tn_upd(lev1,lon0:lon1,lat) = tnlbc(:,lat) --- > tn_upd(lev1,lon0:lon1,lat) = tnlbc(:,lat) 399,406d376 < ! Put spval in top nlevp1 level: < tn_upd(lev1,lon0:lon1,lat) = spval < tn_nm_upd(lev1,lon0:lon1,lat) = spval < ! < ! Lower boundary is saved in tlbc (fields.F): < tlbc_nm(lon0:lon1,lat) = tlbc(lon0:lon1,lat) < tlbc(lon0:lon1,lat) = tnlbc(:,lat) < ! 429,430c399,400 < ! call addfld('TN_FINAL',' ',' ',tn_upd(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > call addfsech('TN_FINAL',' ',' ',tn_upd(:,lon0:lon1,lat), > | lon0,lon1,nk,nkm1,lat) ======================================================================== Diff of /fis/hao/tgcm/tiegcm1.92/src/duv.F and /ptmp/foster/ganglu_tiegcm_amie/modsrc2/duv.F 6,9d5 < ! This software is part of the NCAR TIE-GCM. Use is governed by the < ! Open Source Academic Research License Agreement contained in the file < ! tiegcmlicense.txt. < ! 12c8 < use params_module,only: nlonp4,dz,nlat,spval,nlonp2,nlon --- > use params_module,only: nlonp4,dz,nlat 15c11,12 < use bndry_module,only: ub,ub2,vb,vb2,bnd,bnd2,ci,lbc_gswm_duv --- > use bndry_module,only: ub,ub2,uba,vb,vb2,vba,bnd,bnd2,bnda,ci, > | lbc_gswm_duv 17,19c14,15 < | xmue,cor,tanphi=>tn,re,dtsmooth_div2,dtsmooth,kut < use fields_module,only: tlbc,ulbc,vlbc,tlbc_nm,ulbc_nm,vlbc_nm < use addfld_module,only: addfld --- > | xmue,cor,tanphi=>tn,re,kut_5,set_wave_filter,dtsmooth_div2, > | dtsmooth 21,22c17 < use mpi_module,only: mp_periodic_f3d,mp_periodic_f2d, < | mp_bndlons_f2d,mp_bndlats_f2d --- > use mpi_module,only: mp_periodic_f3d 60c55 < integer :: k,i,j,lat,lonbeg,lonend --- > integer :: k,i,lat,lonbeg,lonend,kutt(nlat) 97c92 < ! For addfld: --- > ! For addfsech: 126,129c121,125 < ! call addfld('ADVEC_U0','ADVEC_U0',' ',advec_un(:,:,lat), < ! | 'ilev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('ADVEC_V0','ADVEC_V0',' ',advec_vn(:,:,lat), < ! | 'ilev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('ADVEC_U0',' ',' ',advec_un(:,:,lat), > ! | lon0,lon1,nk,nkm1,lat) > ! call addfsech('ADVEC_V0',' ',' ',advec_vn(:,:,lat), > ! | lon0,lon1,nk,nkm1,lat) > 143,146c139,140 < ! call addfld('ZL','ZL',' ',zl(:,:,lat), < ! | 'ilev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('ZP','ZP',' ',zp(:,:,lat), < ! | 'ilev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('ZL',' ',' ',zl(:,:,lat),lon0,lon1,nk,nkm1,lat) > ! call addfsech('ZP',' ',' ',zp(:,:,lat),lon0,lon1,nk,nkm1,lat) 157,160c151,154 < ! call addfld('ADVEC_U1','ADVEC_U1',' ',advec_un(:,:,lat), < ! | 'ilev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('ADVEC_V1','ADVEC_V1',' ',advec_vn(:,:,lat), < ! | 'ilev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('ADVEC_U1',' ',' ',advec_un(:,:,lat), > ! | lon0,lon1,nk,nkm1,lat) > ! call addfsech('ADVEC_V1',' ',' ',advec_vn(:,:,lat), > ! | lon0,lon1,nk,nkm1,lat) 175,182c169,172 < ! call addfld('UNSMOOTH','UNSMOOTH',' ',unm_smooth(:,:,lat), < ! | 'ilev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('VNSMOOTH','VNSMOOTH',' ',vnm_smooth(:,:,lat), < ! | 'ilev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('UN_NM_DUV','UN_NM_DUV',' ',un_nm(:,lon0:lon1,lat), < ! | 'ilev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('VN_NM_DUV','VN_NM_DUV',' ',vn_nm(:,lon0:lon1,lat), < ! | 'ilev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('UNSMOOTH',' ',' ',unm_smooth(:,:,lat), > ! | lon0,lon1,nk,nkm1,lat) > ! call addfsech('VNSMOOTH',' ',' ',vnm_smooth(:,:,lat), > ! | lon0,lon1,nk,nkm1,lat) 201a192,195 > ! Annual tide: > unlbc(i) = unlbc(i) + real(uba(lat)*bnda(i)*expta) > vnlbc(i) = vnlbc(i) + real(vba(lat)*bnda(i)*expta) > ! 208,212c202,210 < ! call addfld('UNLBC_DUV','UNLBC_DUV',' ',unlbc_ij, < ! | 'lon',lon0,lon1,'lat',lat0,lat1,0) < ! call addfld('VNLBC_DUV','VNLBC_DUV',' ',vnlbc_ij, < ! | 'lon',lon0,lon1,'lat',lat0,lat1,0) < --- > ! call addfsech('UNLBC',' ',' ',unlbc_diag,lon0,lon1,nk,nkm1,lat) > ! call addfsech('VNLBC',' ',' ',vnlbc_diag,lon0,lon1,nk,nkm1,lat) > ! > ! Save 2d lon,lat boundaries to secondary history: > ! call addfsech_ij('UNLBC','UN Lower boundary','cm/s',unlbc_ij, > ! | lon0,lon1,lat0,lat1) > ! call addfsech_ij('VNLBC','VN Lower boundary','cm/s',vnlbc_ij, > ! | lon0,lon1,lat0,lat1) > ! 222,225c220,223 < ! call addfld('ADVEC_U2','ADVEC_U2',' ',advec_un(:,:,lat), < ! | 'ilev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('ADVEC_V2','ADVEC_V2',' ',advec_vn(:,:,lat), < ! | 'ilev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('ADVEC_U2',' ',' ',advec_un(:,:,lat), > ! | lon0,lon1,nk,nkm1,lat) > ! call addfsech('ADVEC_V2',' ',' ',advec_vn(:,:,lat), > ! | lon0,lon1,nk,nkm1,lat) 240,243c238,239 < ! call addfld('SS_UN',' ',' ',ss_un, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('SS_VN',' ',' ',ss_vn, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('SS_UN',' ',' ',ss_un,lon0,lon1,nk,nkm1,lat) > ! call addfsech('SS_VN',' ',' ',ss_vn,lon0,lon1,nk,nkm1,lat) 260a257 > ! write(6,"('duv: lat=',i2,' rtxmue=',/,(6e12.4))") lat,rtxmue 262,263c259 < ! tni(lev0,i) = tn(lev1,i,lat) ! lbc of tn is stored in top slot < tni(lev0,i) = tlbc_nm(i,lat) ! Lower boundary is in tlbc_nm --- > tni(lev0,i) = tn(lev1,i,lat) ! lbc of tn is stored in top slot 273,277c269,270 < ! call addfld('TNI' ,' ',' ',tni, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('DUV_G',' ',' ',g , < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < --- > ! call addfsech('TNI' ,' ',' ',tni,lon0,lon1,nk,nk,lat) > ! call addfsech('DUV_G',' ',' ',g ,lon0,lon1,nk,nk,lat) 287,289c280 < ! call addfld('DWDZ',' ',' ',dwdz, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < --- > ! call addfsech('DWDZ',' ',' ',dwdz,lon0,lon1,nk,nkm1,lat) 380,407c371,384 < ! call addfld('PP11',' ',' ',pp11, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('PP12',' ',' ',pp12, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('PP21',' ',' ',pp21, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('PP22',' ',' ',pp22, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QQ11',' ',' ',qq11, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QQ12',' ',' ',qq12, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QQ21',' ',' ',qq21, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QQ22',' ',' ',qq22, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('RR11',' ',' ',rr11, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('RR12',' ',' ',rr12, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('RR21',' ',' ',rr21, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('RR22',' ',' ',rr22, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('SS_UN',' ',' ',ss_un, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('SS_VN',' ',' ',ss_vn, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('PP11',' ',' ',pp11,lon0,lon1,nk,nkm1,lat) > ! call addfsech('PP12',' ',' ',pp12,lon0,lon1,nk,nkm1,lat) > ! call addfsech('PP21',' ',' ',pp21,lon0,lon1,nk,nkm1,lat) > ! call addfsech('PP22',' ',' ',pp22,lon0,lon1,nk,nkm1,lat) > ! call addfsech('QQ11',' ',' ',qq11,lon0,lon1,nk,nkm1,lat) > ! call addfsech('QQ12',' ',' ',qq12,lon0,lon1,nk,nkm1,lat) > ! call addfsech('QQ21',' ',' ',qq21,lon0,lon1,nk,nkm1,lat) > ! call addfsech('QQ22',' ',' ',qq22,lon0,lon1,nk,nkm1,lat) > ! call addfsech('RR11',' ',' ',rr11,lon0,lon1,nk,nkm1,lat) > ! call addfsech('RR12',' ',' ',rr12,lon0,lon1,nk,nkm1,lat) > ! call addfsech('RR21',' ',' ',rr21,lon0,lon1,nk,nkm1,lat) > ! call addfsech('RR22',' ',' ',rr22,lon0,lon1,nk,nkm1,lat) > ! call addfsech('SS_UN',' ',' ',ss_un,lon0,lon1,nk,nkm1,lat) > ! call addfsech('SS_VN',' ',' ',ss_vn,lon0,lon1,nk,nkm1,lat) 423,431c400,402 < ! Put spval in top nlevp1 level: < un_upd(lev1,i,lat) = spval < vn_upd(lev1,i,lat) = spval < ! < ! Lower boundary is in ulbc,vlbc (fields.F): < ulbc_nm(i,lat) = ulbc(i,lat) ! LB for un_nm(itc) = un(itp) < vlbc_nm(i,lat) = vlbc(i,lat) ! LB for vn_nm(itc) = vn(itp) < ulbc(i,lat) = unlbc(i) ! LB for un(itc) < vlbc(i,lat) = vnlbc(i) ! LB for vn(itc) --- > ! Store lower boundary conditions for U and V in top slot: > un_upd(lev1,i,lat) = unlbc(i) > vn_upd(lev1,i,lat) = vnlbc(i) 438,441c409,410 < ! call addfld('UNLBC',' ',' ',unlbc_diag, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('VNLBC',' ',' ',vnlbc_diag, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('UNLBC',' ',' ',unlbc_diag,lon0,lon1,nk,nkm1,lat) > ! call addfsech('VNLBC',' ',' ',vnlbc_diag,lon0,lon1,nk,nkm1,lat) 443,446c412,415 < ! call addfld('UN_SOLV',' ',' ',un_upd(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('VN_SOLV',' ',' ',vn_upd(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('UN_SOLV',' ',' ',un_upd(:,lon0:lon1,lat), > ! | lon0,lon1,nk,nk,lat) > ! call addfsech('VN_SOLV',' ',' ',vn_upd(:,lon0:lon1,lat), > ! | lon0,lon1,nk,nk,lat) 451,455c420,423 < ! call addfld('UNLBC_IJ','UNLBC_IJ','[cm/s]',unlbc_ij, < ! | 'lon',lon0,lon1,'lat',lat0,lat1,0) < ! call addfld('VNLBC_IJ','VNLBC_IJ','[cm/s]',vnlbc_ij, < ! | 'lon',lon0,lon1,'lat',lat0,lat1,0) < --- > ! call addfsech_ij('UNLBC_IJ','UNLBC_IJ','[cm/s]',unlbc_diag_ij, > ! | lon0,lon1,lat0,lat1) > ! call addfsech_ij('VNLBC_IJ','VNLBC_IJ','[cm/s]',vnlbc_diag_ij, > ! | lon0,lon1,lat0,lat1) 458c426 < ! call set_wave_filter(36,kut_5,nlat,kutt) --- > call set_wave_filter(36,kut_5,nlat,kutt) 462c430 < | lat0,lat1,kut) --- > | lat0,lat1,kutt) 464c432 < | lat0,lat1,kut) --- > | lat0,lat1,kutt) 469,472c437,440 < ! call addfld('UN_FILT',' ',' ',un_upd(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('VN_FILT',' ',' ',vn_upd(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('UN_FILT',' ',' ',un_upd(:,lon0:lon1,lat), > ! | lon0,lon1,nk,nk,lat) > ! call addfsech('VN_FILT',' ',' ',vn_upd(:,lon0:lon1,lat), > ! | lon0,lon1,nk,nk,lat) 474a443,448 > ! Store lower boundary conditions for U and V in top slot: > ! do i=lon0,lon1 > ! un_upd(lev1,i,lat) = unlbc(i) > ! vn_upd(lev1,i,lat) = vnlbc(i) > ! enddo ! i=lon0,lon1 > ! 483,486d456 < ! < ! put spval in top nlevp1 level: < unm_upd(lev1,i,lat) = spval < vnm_upd(lev1,i,lat) = spval 489,492c459,462 < ! call addfld('UN_NMOUT',' ',' ',unm_upd(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('VN_NMOUT',' ',' ',vnm_upd(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('UN_NMOUT',' ',' ',unm_upd(:,lon0:lon1,lat), > ! | lon0,lon1,nk,nkm1,lat) > ! call addfsech('VN_NMOUT',' ',' ',vnm_upd(:,lon0:lon1,lat), > ! | lon0,lon1,nk,nkm1,lat) 495a466 > ! 498,517d468 < ! Boundary longitudes and periodic points for ulbc: < call mp_bndlats_f2d(ulbc,lon0-2,lon1+2,lat0,lat1,1) < call mp_bndlats_f2d(vlbc,lon0-2,lon1+2,lat0,lat1,1) < call mp_bndlats_f2d(ulbc_nm,lon0-2,lon1+2,lat0,lat1,1) < call mp_bndlats_f2d(vlbc_nm,lon0-2,lon1+2,lat0,lat1,1) < < call mp_bndlons_f2d(ulbc,lon0,lon1,lat0-2,lat1+2,1) < call mp_bndlons_f2d(vlbc,lon0,lon1,lat0-2,lat1+2,1) < call mp_bndlons_f2d(ulbc_nm,lon0,lon1,lat0-2,lat1+2,1) < call mp_bndlons_f2d(vlbc_nm,lon0,lon1,lat0-2,lat1+2,1) < < call mp_periodic_f2d(ulbc(lon0:lon1,lat0:lat1), < | lon0,lon1,lat0,lat1) < call mp_periodic_f2d(vlbc(lon0:lon1,lat0:lat1), < | lon0,lon1,lat0,lat1) < call mp_periodic_f2d(ulbc_nm(lon0:lon1,lat0:lat1), < | lon0,lon1,lat0,lat1) < call mp_periodic_f2d(vlbc_nm(lon0:lon1,lat0:lat1), < | lon0,lon1,lat0,lat1) < 523,535d473 < #else < do j=lat0,lat1 < do i=1,2 < ulbc(i,j) = ulbc(nlon+i,j) < ulbc(nlonp2+i,j) = ulbc(i+2,j) < vlbc(i,j) = vlbc(nlon+i,j) < vlbc(nlonp2+i,j) = vlbc(i+2,j) < ulbc_nm(i,j) = ulbc_nm(nlon+i,j) < ulbc_nm(nlonp2+i,j) = ulbc_nm(i+2,j) < vlbc_nm(i,j) = vlbc_nm(nlon+i,j) < vlbc_nm(nlonp2+i,j) = vlbc_nm(i+2,j) < enddo < enddo 537d474 < ! 539,542c476,479 < ! call addfld('UN_FINAL',' ',' ',un_upd(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('VN_FINAL',' ',' ',vn_upd(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('UN_FINAL',' ',' ',un_upd(:,lon0:lon1,lat), > ! | lon0,lon1,nk,nk-1,lat) > ! call addfsech('VN_FINAL',' ',' ',vn_upd(:,lon0:lon1,lat), > ! | lon0,lon1,nk,nk-1,lat) 554,555c491 < use bndry_module,only: zb,zb2,bnd,bnd2,ci < use addfld_module,only: addfld --- > use bndry_module,only: zb,zb2,zba,bnd,bnd2,bnda,ci 595c531 < nk = lev1-lev0+1 ; nkm1=nk-1 ; nlevs = nk ! for addfld --- > nk = lev1-lev0+1 ; nkm1=nk-1 ; nlevs = nk ! for addfsech 608,609c544,547 < ! call addfld('TBAR',' ',' ',tbar(:,lon0:lon1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! if (lat <= lat1 .and. lat >= lat0) then > ! call addfsech('TBAR',' ',' ',tbar(:,lon0:lon1), > ! | lon0,lon1,nk,nkm1,lat) > ! endif 618,619c556,560 < ! call addfld('DZTBAR',' ',' ',dztbar(:,lon0:lon1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! if (lat >= lat0 .and. lat <= lat1) then > ! call addfsech('DZTBAR',' ',' ',dztbar(:,lon0:lon1), > ! | lon0,lon1,nk,nkm1,lat) > ! endif > 632a574,579 > > ! if (lat >= lat0 .and. lat <= lat1) then > ! call addfsech('ZTMP',' ',' ',ztmp(:,lon0:lon1,lat), > ! | lon0,lon1,nk,nkm1,lat) > ! endif > 651,652c598,599 < ! call addfld('ZTMP',' ',' ',ztmp(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('ZTMP',' ',' ',ztmp(:,lon0:lon1,lat), > ! | lon0,lon1,nk,nkm1,lat) 674,681c621,628 < ! if (lon0==1) then < ! zl(:,lon0:lon0+1,lat) = 0. < ! zp(:,lon0:lon0+1,lat) = 0. < ! endif < ! if (lon1==nlonp4) then < ! zl(:,lon1-1:lon1,lat) = 0. < ! zp(:,lon1-1:lon1,lat) = 0. < ! endif --- > if (lon0==1) then > zl(:,lon0:lon0+1,lat) = 0. > zp(:,lon0:lon0+1,lat) = 0. > endif > if (lon1==nlonp4) then > zl(:,lon1-1:lon1,lat) = 0. > zp(:,lon1-1:lon1,lat) = 0. > endif 683,705d629 < ! < ! This part is modified to restore the periodic boundary conditions < ! for zl and zp. zl and zp are horizontal pressure gradients. NaNs occurred before < ! because values at periodic points (lon=1,2 and 75,76) of tn_upd in dt.F were not given. < ! They are used in subroutine dldp to preform fouth order finite difference. < ! Now the halo longtudinal periodic boundary for tn_upd is set in dt.F, < ! so the forth order differencing in dldp can be made betwen lon=3 to 74 < ! (for 5 degree resolution), and so the values of periodic < ! points of zl and zp are now no longer NaNs. < ! Wenbin 04/24/08 < #ifdef MPI < call mp_periodic_f3d(zl(:,lon0:lon1,lat0:lat1), < | lev0,lev1,lon0,lon1,lat0,lat1) < call mp_periodic_f3d(zp(:,lon0:lon1,lat0:lat1), < | lev0,lev1,lon0,lon1,lat0,lat1) < #else < ! < ! Set periodic points for serial run: < zl(:,1:2,:) = zl(:,lonend-2:lonend-1,:) < zl(:,lonend+1:lonend+2,:) = zp(:,3:4,:) < zp(:,1:2,:) = zl(:,lonend-2:lonend-1,:) < zp(:,lonend+1:lonend+2,:) = zp(:,3:4,:) < #endif 712d635 < use addfld_module,only: addfld 745,746c668,669 < ! call addfld('DLDP_ZIN',' ',' ',zin(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('DLDP_ZIN',' ',' ',zin(:,lon0:lon1,lat), > ! | lon0,lon1,nk,nk-1,lat) 787,798c710,717 < ! call addfld('Z_JM2',' ',' ',z(:,lon0:lon1,lat-2), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('Z_JM1',' ',' ',z(:,lon0:lon1,lat-1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('Z_JP1',' ',' ',z(:,lon0:lon1,lat+1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('Z_JP2',' ',' ',z(:,lon0:lon1,lat+2), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('DLDP_ZL',' ',' ',zl(:,:,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('DLDP_ZP',' ',' ',zp(:,:,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('Z_JM2',' ',' ',z(:,lon0:lon1,lat-2),lon0,lon1, > ! | nk,nk-1,lat) > ! call addfsech('Z_JM1',' ',' ',z(:,lon0:lon1,lat-1),lon0,lon1, > ! | nk,nk-1,lat) > ! call addfsech('Z_JP1',' ',' ',z(:,lon0:lon1,lat+1),lon0,lon1, > ! | nk,nk-1,lat) > ! call addfsech('Z_JP2',' ',' ',z(:,lon0:lon1,lat+2),lon0,lon1, > ! | nk,nk-1,lat) 799a719,723 > ! call addfsech('DLDP_ZL',' ',' ',zl(:,:,lat),lon0,lon1, > ! | nk,nk-1,lat) > ! call addfsech('DLDP_ZP',' ',' ',zp(:,:,lat),lon0,lon1, > ! | nk,nk-1,lat) > 937c861 < integer :: i,j,nlevs --- > integer :: i,j,nlevs,nlons,nlats 946a871,872 > nlons = lon1-lon0+1 > nlats = lat1-lat0+1 ======================================================================== Diff of /fis/hao/tgcm/tiegcm1.92/src/dynamics.F and /ptmp/foster/ganglu_tiegcm_amie/modsrc2/dynamics.F 4,7d3 < ! This software is part of the NCAR TIE-GCM. Use is governed by the < ! Open Source Academic Research License Agreement contained in the file < ! tiegcmlicense.txt. < ! 22d17 < use params_module,only: dz 38,41c33,34 < use advance_module,only: time2print < use addfld_module,only: addfld < use init_module,only: iyear,secs < use hist_module,only: modeltime --- > use dyndiag_module,only: dyndiag > ! 54,72c47,49 < integer :: i,j,k,n,lat,ier < integer :: i0,i1,nk,nkm1,nlats,k0,k1 < logical,parameter :: debug=.false. ! add prints to stdout < real,parameter :: < | zpm9 = -9., ! zp -9.0 level < | zpm5 = -5. ! zp -5.0 level < integer :: nzpm9m5 ! number of levels from zp -9 to zp -5 < ! < ! If diags is set true, the following fields will be written to < ! secondary histories: < ! < ! SECFLDS = 'CP','KT','KM','W_OMEGA','UI_ExB','VI_ExB','WI_ExB', < ! 'SCO2','SCO1','SCN2','QTOTAL','QOP','QO2P','QN2P','QNP', < ! 'QNOP','OPLUS','XIOP2P','XIOP2D','NP_diag','N2P_diag', < ! 'NOP_diag','O2P_diag','ELDEN','LXX','LYY','LXY','LYX', < ! 'LAM1','SIGMAPED','SIGMAHAL','CMP_N4S','CMP_NO','QJI_TI', < ! 'T_ELEC','T_ION','COOL_IMPLICIT','COOL_EXPLICIT', < ! 'QJI_TN','TN_UPD','UN_UPD','VN_UPD','O2_UPD','O1_UPD' < ! --- > integer :: i,j,n,lat,ier > integer :: i0,i1,nk,nkm1,nlats > logical,parameter :: debug=.false. ! add prints to stdout 75a53,55 > ! External: > logical,external :: time2print > ! 77,78c57 < i0=lon0 ; i1=lon1 ; nk=nlevp1 ; nkm1=nk-1 ! for addfld < k0=1 ; k1=nlevp1 --- > i0=lon0 ; i1=lon1 ; nk=nlevp1 ; nkm1=nk-1 ! for addfsech 100,105c79,84 < call addfld('CP','CP',' ',cp(:,i0:i1,lat), < | 'lev',k0,k1,'lon',i0,i1,lat) < call addfld('KT','KT',' ',kt(:,i0:i1,lat), < | 'lev',k0,k1,'lon',i0,i1,lat) < call addfld('KM','KM',' ',km(:,i0:i1,lat), < | 'lev',k0,k1,'lon',i0,i1,lat) --- > call addfsech('CP' ,' ',' ',cp(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) > call addfsech('KT' ,' ',' ',kt(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) > call addfsech('KM' ,' ',' ',km(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) 117c96 < | 1,nlevp1,lon0,lon1,lat0,lat1) --- > | 1,nlevp1,lon0,lon1,lat0,lat1,lat0,lat1) 121,122c100,101 < call addfld('W_OMEGA','VERTICAL MOTION (DZp/DT)', < | 's-1',w(:,i0:i1,lat,itc),'lev',k0,k1,'lon',i0,i1,lat) --- > call addfsech('OMEGA' ,' ',' ',w(:,i0:i1,lat,itc), > | i0,i1,nk,nkm1,lat) 137,142c116,121 < call addfld('UI_ExB','Zonal ExB Ion Drift','cm/s', < | ui(:,i0:i1,lat),'lev',k0,k1,'lon',i0,i1,lat) < call addfld('VI_ExB','Meridional ExB Ion Drift','cm/s', < | vi(:,i0:i1,lat),'lev',k0,k1,'lon',i0,i1,lat) < call addfld('WI_ExB','Vertical ExB Ion Drift','cm/s', < | wi(:,i0:i1,lat),'lev',k0,k1,'lon',i0,i1,lat) --- > call addfsech('UIVEL' ,' ',' ',ui(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) > call addfsech('VIVEL' ,' ',' ',vi(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) > call addfsech('WIVEL' ,' ',' ',wi(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) 167,170d145 < ! < ! Post-processors cannot read 1.e80, so change these to < ! 1.e36 if saving on secondary histories (then change back < ! for rest of model): 172,177c147,152 < call addfld('SCO2','Chapman slant-column O2',' ', < | sco2(:,i0:i1,lat),'lev',k0,k1,'lon',i0,i1,lat) < call addfld('SCO1','Chapman slant-column O1',' ', < | sco1(:,i0:i1,lat),'lev',k0,k1,'lon',i0,i1,lat) < call addfld('SCN2','Chapman slant-column N2',' ', < | scn2(:,i0:i1,lat),'lev',k0,k1,'lon',i0,i1,lat) --- > call addfsech('SCO2' ,' ',' ',sco2(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) > call addfsech('SCO1' ,' ',' ',sco1(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) > call addfsech('SCN2' ,' ',' ',scn2(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) 200d174 < time1_qrj = 0. 204,205d177 < ! subroutine qrj(sco2,sco1,scn2,tn,no,o2,o1,n4s,xnmbari, < ! | lev0,lev1,lon0,lon1,lat) 207,224c179,196 < ! if (mod(istep,nstepqrj)==0) then < if (debug) write(6,"('dynamics call qrj: lat=',i3)") lat < call timer(time0,time1,'QRJ',0,0) ! start qrj timing for current lat < call qrj( < | sco2(levd0,lond0,lat), < | sco1(levd0,lond0,lat), < | scn2(levd0,lond0,lat), < | tn (levd0,lond0,lat,itp), < | no (levd0,lond0,lat,itp), < | o2 (levd0,lond0,lat,itp), < | o1 (levd0,lond0,lat,itp), < | n4s (levd0,lond0,lat,itp), < | xnmbari(levd0,lond0,lat), < | 1,nlevp1,lon0,lon1,lat) < call timer(time0,time1,'QRJ',1,0) ! end qrj timing for current lat < time1_qrj = time1_qrj+time1 < if (debug) write(6,"('dynamics after qrj: lat=',i3)") lat < ! endif --- > if (debug) write(6,"('dynamics call qrj: lat=',i3)") lat > call timer(time0,time1,'QRJ',0,0) ! start qrj timing for current lat > call qrj( > | sco2(levd0,lond0,lat), > | sco1(levd0,lond0,lat), > | scn2(levd0,lond0,lat), > | tn (levd0,lond0,lat,itp), > | no (levd0,lond0,lat,itp), > | o2 (levd0,lond0,lat,itp), > | o1 (levd0,lond0,lat,itp), > | n4s (levd0,lond0,lat,itp), > | xnmbari(levd0,lond0,lat), > | 1,nlevp1,lon0,lon1,lat) > call timer(time0,time1,'QRJ',1,0) ! end qrj timing for current lat > time1_qrj = time1_qrj+time1 > if (debug) write(6,"('dynamics after qrj: lat=',i3)") lat > call addfsech('QRJ_QOP' ,' ',' ',qop(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) 226,237c198,209 < call addfld('QTOTAL','Total Heating',' ', < | qtotal(:,i0:i1,lat),'ilev',k0,k1,'lon',i0,i1,lat) < call addfld('QOP' ,'QO+ from QRJ',' ', < | qop(:,i0:i1,lat),'ilev',k0,k1,'lon',i0,i1,lat) < call addfld('QO2P' ,'QO2+ from QRJ',' ', < | qo2p(:,i0:i1,lat),'ilev',k0,k1,'lon',i0,i1,lat) < call addfld('QN2P' ,'QN2+ from QRJ',' ', < | qn2p(:,i0:i1,lat),'ilev',k0,k1,'lon',i0,i1,lat) < call addfld('QNP' ,'QN+ from QRJ',' ', < | qnp(:,i0:i1,lat),'ilev',k0,k1,'lon',i0,i1,lat) < call addfld('QNOP' ,'QNO+ from QRJ',' ', < | qnop(:,i0:i1,lat),'ilev',k0,k1,'lon',i0,i1,lat) --- > call addfsech('QTOTAL' ,' ',' ',qtotal(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) > call addfsech('QOP' ,' ',' ',qop(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) > call addfsech('QO2P' ,' ',' ',qo2p(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) > call addfsech('QN2P' ,' ',' ',qn2p(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) > call addfsech('QNP' ,' ',' ',QNP(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) > call addfsech('QNOP' ,' ',' ',qnop(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) 261a234,237 > > call addfsech('QAUR_QOP' ,' ',' ',qop(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) > 311,316c287,292 < call addfld('OPLUS' ,'O+ Ion',' ',op(:,i0:i1,lat,itc), < | 'lev',k0,k1,'lon',i0,i1,lat) < call addfld('XIOP2P','O+(2P)',' ',xiop2p(:,i0:i1,lat), < | 'lev',k0,k1,'lon',i0,i1,lat) < call addfld('XIOP2D','O+(2D)',' ',xiop2d(:,i0:i1,lat), < | 'lev',k0,k1,'lon',i0,i1,lat) --- > call addfsech('OPLUS' ,' ',' ',op(:,i0:i1,lat,itc), > | i0,i1,nk,nkm1,lat) > call addfsech('XIOP2P',' ',' ',xiop2p(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) > call addfsech('XIOP2D',' ',' ',xiop2d(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) 334a311 > | z (levd0,lond0,lat,itc), ! updated Z from addiag 343,344d319 < ! < ! Ions and electron density are at interface levels (ilev): 347,356c322,331 < call addfld('NP_diag' ,'N+ Ion' ,'cm^3',nplus(:,i0:i1,lat), < | 'ilev',k0,k1,'lon',i0,i1,lat) < call addfld('N2P_diag','N2+ Ion','cm^3',n2p(:,i0:i1,lat), < | 'ilev',k0,k1,'lon',i0,i1,lat) < call addfld('NOP_diag','NO+ Ion','cm^3',nop(:,i0:i1,lat), < | 'ilev',k0,k1,'lon',i0,i1,lat) < call addfld('O2P_diag','O2+ Ion','cm^3',o2p(:,i0:i1,lat,itc), < | 'ilev',k0,k1,'lon',i0,i1,lat) < call addfld('ELDEN' ,'Electron Density','cm-3', < | ne (:,i0:i1,lat,itc),'ilev',k0,k1,'lon',i0,i1,lat) --- > call addfsech('NPLUS' ,' ',' ',nplus(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) > call addfsech('ELD_N2P',' ',' ',n2p(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) > call addfsech('ELD_NOP',' ',' ',nop(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) > call addfsech('ELD_O2P',' ',' ',o2p(:,i0:i1,lat,itc), > | i0,i1,nk,nkm1,lat) > call addfsech('ELD_NE' ,' ',' ',ne (:,i0:i1,lat,itc), > | i0,i1,nk,nkm1,lat) 358a334 > 362d337 < time1_cmpminor = 0. 384,397c359,372 < call addfld('LXX','Lamda XX',' ',lxx(:,i0:i1,lat), < | 'lev',k0,k1,'lon',i0,i1,lat) < call addfld('LYY','Lamda YY',' ',lyy(:,i0:i1,lat), < | 'lev',k0,k1,'lon',i0,i1,lat) < call addfld('LXY','Lamda XY',' ',lxy(:,i0:i1,lat), < | 'lev',k0,k1,'lon',i0,i1,lat) < call addfld('LYX','Lamda YX',' ',lyx(:,i0:i1,lat), < | 'lev',k0,k1,'lon',i0,i1,lat) < call addfld('LAM1','LAM1','1/s',lam1(:,i0:i1,lat), < | 'lev',k0,k1,'lon',i0,i1,lat) < call addfld('SIGMAPED','Pedersen Conductivity','S/m', < | ped(:,i0:i1,lat),'lev',k0,k1,'lon',i0,i1,lat) < call addfld('SIGMAHAL','Hall Conductivity','S/m', < | hall(:,i0:i1,lat),'lev',k0,k1,'lon',i0,i1,lat) --- > call addfsech('LXX',' ',' ',lxx(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) > call addfsech('LYY',' ',' ',lyy(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) > call addfsech('LXY',' ',' ',lxy(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) > call addfsech('LYX',' ',' ',lyx(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) > call addfsech('LAM1','lam1','1/s',lam1(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) > call addfsech('SIGMAPED',' ',' ',ped(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) > call addfsech('SIGMAHAL',' ',' ',hall(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) 420,421c395,396 < call addfld('CMP_N2D',' ',' ',n2d(:,i0:i1,lat,itc), < | 'lev',k0,k1,'lon',i0,i1,lat) --- > call addfsech('CMP_N2D',' ',' ',n2d(:,i0:i1,lat,itc), > | i0,i1,nk,nkm1,lat) 462,465c437,438 < do lat=lat0,lat1 < call addfld('CMP_N4S','N4S density','mmr', < | n4s(:,i0:i1,lat,itc),'lev',k0,k1,'lon',i0,i1,lat) < enddo --- > call addfsech('CMP_N4S',' ',' ',n4s(:,i0:i1,lat,itc), > | i0,i1,nk,nkm1,lat) 503,506c476,477 < do lat=lat0,lat1 < call addfld('CMP_NO','NO density','mmr', < | no(:,i0:i1,lat,itc),'lev',k0,k1,'lon',i0,i1,lat) < enddo --- > call addfsech('CMP_NO',' ',' ',no(:,i0:i1,lat,itc), > | i0,i1,nk,nkm1,lat) 525d495 < 575,576c545,546 < call addfld('QJI_TI','Joule Heating for TI',' ', < | qji_ti(:,i0:i1,lat),'lev',k0,k1,'lon',i0,i1,lat) --- > call addfsech('QJI_TI',' ',' ',qji_ti(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) 595,600d564 < if (diags) then < call addfld('T_ELEC','Electron Temperature','K', < | te(:,i0:i1,lat,itc),'lev',k0,k1,'lon',i0,i1,lat) < call addfld('T_ION' ,'Ion Temperature','K', < | ti(:,i0:i1,lat,itc),'lev',k0,k1,'lon',i0,i1,lat) < endif 601a566,573 > if (diags) then > do lat=lat0,lat1 > call addfsech('TE_UPD',' ',' ',te(:,i0:i1,lat,itc), > | i0,i1,nk,nkm1,lat) > call addfsech('TI_UPD',' ',' ',ti(:,i0:i1,lat,itc), > | i0,i1,nk,nkm1,lat) > enddo > endif 609,610c581,582 < | no (levd0,lond0,lat,itp), < | barm(levd0,lond0,lat,itp), --- > | no (levd0,lond0,lat,itp), > | barm(levd0,lond0,lat,itp), 630,633c602,605 < call addfld('COOL_IMP',' ',' ',cool_implicit(:,i0:i1,lat), < | 'lev',k0,k1,'lon',i0,i1,lat) < call addfld('COOL_EXP',' ',' ',cool_explicit(:,i0:i1,lat), < | 'lev',k0,k1,'lon',i0,i1,lat) --- > call addfsech('COOL_IMP',' ',' ',cool_implicit(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) > call addfsech('COOL_EXP',' ',' ',cool_explicit(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) 682,683c654,655 < call addfld('QJI_TN','Joule Heating for TN',' ', < | qji_ti(:,i0:i1,lat),'lev',k0,k1,'lon',i0,i1,lat) --- > call addfsech('QJI_TN',' ',' ',qji_tn(:,i0:i1,lat), > | i0,i1,nk,nkm1,lat) 684a657,670 > ! > ! Calculate 2d (lon,lat) diagnostics for secondary histories: > ! (see call dyndiag_sech below after lat loop) > ! > call dyndiag( > | ped (levd0,lond0,lat), ! pedersen conductivity > | hall(levd0,lond0,lat), ! hall conductivity > | qji_tn(levd0,lond0,lat), ! ion Joule heating for tn > | z (levd0,lond0,lat,itc), ! updated Z from addiag > | un (levd0,lond0,lat,itp), ! neutral zonal velocity > | vn (levd0,lond0,lat,itp), ! neutral meridional velocity > | ui (levd0,lond0,lat), ! ion zonal velocity > | vi (levd0,lond0,lat), ! ion meridional velocity > | 1,nlevp1,lon0,lon1,lat) 686c672 < if (debug) write(6,"('dynamics after qjoule_tn')") --- > if (debug) write(6,"('dynamics after qjoule_tn and dyndiag')") 715,720d700 < if (diags) then < do lat=lat0,lat1 < call addfld('TN_UPD','Updated TN','K', < | tn(:,i0:i1,lat,itc),'lev',k0,k1,'lon',i0,i1,lat) < enddo < endif 755,763c735 < if (diags) then < do lat=lat0,lat1 < call addfld('UN_UPD','Updated UN','cm/s', < | un(:,i0:i1,lat,itc),'lev',k0,k1,'lon',i0,i1,lat) < call addfld('VN_UPD','Updated VN','cm/s', < | vn(:,i0:i1,lat,itc),'lev',k0,k1,'lon',i0,i1,lat) < enddo < endif < ! --- > ! 815d786 < if (debug) write(6,"('dynamics returning')") ======================================================================== Diff of /fis/hao/tgcm/tiegcm1.92/src/dynamo.F and /ptmp/foster/ganglu_tiegcm_amie/modsrc2/dynamo.F 3,7d2 < ! < ! This software is part of the NCAR TIE-GCM. Use is governed by the < ! Open Source Academic Research License Agreement contained in the file < ! tiegcmlicense.txt. < ! 8a4,6 > ! BOP > ! !MODULE: dynamo_module > ! !DESCRIPTION: 26a25 > ! !USES: 31d29 < | nlonp2, ! nlon+2 42,45c40 < | nmlev, ! number of geomagnetic pressure levels (nmlev==nlevp1+3) < | nmlevp1,! number of geomagnetic midpoint levels < | nimlevp1,! number of geomagnetic interface levels < | spval --- > | nmlev ! number of geomagnetic pressure levels (nmlev==nlevp1+3) 48a44,46 > > ! !PUBLIC TYPES: > implicit none 50,52c48,49 < ! Routine to add fields to secondary histories: < use addfld_module,only: addfld < implicit none --- > ! !PUBLIC MEMBER FUNCTIONS: > ! !PUBLIC DATA MEMBERS: 168,170d164 < #if defined(INTERCOMM) || defined(CISMAH) < real,dimension(nmlonp1,nmlat) :: Zigm1 ! CISM, height-intergrated < ! ! Pedersen conductivity 172,180d165 < ! Parameters to be passed to LFM for CISM. Note the dimension of these variables is < ! defined to match mag2geo specifications, see detial in cons.F and Apex.F. < ! < real,dimension(nlonp1,0:nlatp1) :: < | gzigm2, ! sigma2 ! CISM height integrated Hall conductivity geographic < | gzigm1, ! sigma1 ! CISM height integrated Pedersen conductivity geographic < | gnsrhs ! nsrsh ! CISM height integrated neutral wind currents geographic < #endif < ! 218,220d202 < #if defined(INTERCOMM) || defined(CISMAH) < real :: nsrhs(nmlonp1,nmlat) ! CISM current < #endif 254c236 < integer,parameter :: icalkqlam = 0 --- > integer,parameter :: icalkqlam = 0 261,263d242 < real :: < | je13d_diag(nlonp4,nlat,nlevp1), ! 3d je1 geographic for addfld < | je23d_diag(nlonp4,nlat,nlevp1) ! 3d je1 geographic for addfld 270,271c249 < | je1oD_pg3d, ! plasma pressure, gravity (j_pg=true) a/cm^2 < | je2oD_pg3d ! plasma pressure, gravity (j_pg=true) a/cm^2 --- > | je1oD_pg3d ! plasma pressure, gravity (j_pg=true) a/cm^2 287a266 > real,dimension(nmlonp1,nmlat0) :: colatc ! NH fraction of potential 289d267 < real,dimension(nlonp4,nlat,nlevp1) :: dynpot_diag 290a269,274 > ! !REVISION HISTORY: > ! 05.02.04 > ! > ! EOP > !----------------------------------------------------------------------- > ! 292a277 > ! 293a279 > ! 295a282,285 > ! > ! BOP > ! !IROUTINE: prep_dynamo > ! !INTERFACE: 298,303c288 < ! < ! Prepare geographic-grid fields for input to the dynamo, and gather them < ! to the root task. This is executed by all tasks, and is called from < ! advance before the dynamo itself (which is executed by master task only). < ! calculate vertical velocity at half pressure level < ! --- > ! !USES: 304a290,293 > > ! !RETURN VALUE: > ! !PARAMETERS: > ! !ARGUMENTS: 318a308,318 > > ! !DESCRIPTION: > ! Prepare geographic-grid fields for input to the dynamo, and gather them > ! to the root task. This is executed by all tasks, and is called from > ! advance before the dynamo itself (which is executed by master task only). > ! calculate vertical velocity at half pressure level > ! > ! !REVISION HISTORY: > ! 05.02.04 > ! > ! EOP 319a320 > ! 355,381c356,358 < ! call addfld('SIGMAPED','sigma-ped','S/m', < ! | sigma_ped(lon0:lon1,lat,:),'lon',lon0,lon1,'lev', < ! | lev0,lev1,lat) < ! call addfld('SIGMAHAL','sigma-hall','S/m', < ! | sigma_hall(lon0:lon1,lat,:),'lon',lon0,lon1,'lev', < ! | lev0,lev1,lat) < ! call addfld('ZPOTEN','geop.height','cm', < ! | zpoten(lon0:lon1,lat,:),'lon',lon0,lon1,'ilev', < ! | lev0,lev1,lat) < ! call addfld('SCHEIGHT','scl.Height','cm', < ! | scheight(lon0:lon1,lat,:),'lon',lon0,lon1,'lev', < ! | lev0,lev1,lat) < ! call addfld('UNVEL','zonal neutral wind','cm/s', < ! | unvel(lon0:lon1,lat,:),'lon',lon0,lon1,'lev', < ! | lev0,lev1,lat) < ! call addfld('VNVEL','merid. neutral wind','cm/s', < ! | vnvel(lon0:lon1,lat,:),'lon',lon0,lon1,'lev', < ! | lev0,lev1,lat) < ! call addfld('WNVEL','upward neutral wind','cm/s', < ! | wnvel(lon0:lon1,lat,:),'lon',lon0,lon1,'lev', < ! | lev0,lev1,lat) < ! call addfld('JE1oD_PG','Je1(p,g)','A/cm^2', < ! | je1oD_full(lon0:lon1,lat,:),'lon',lon0,lon1,'lev', < ! | lev0,lev1,lat) < ! call addfld('JE2oD_PG','Je1(p,g)','A/cm^2', < ! | je2oD_full(lon0:lon1,lat,:),'lon',lon0,lon1,'lev', < ! | lev0,lev1,lat) --- > ! (In tgcm15, these calls are in lamdas.F) > ! This is executed by all mpi tasks, so the second mp_gather2root call > ! in advance should be executed: call mp_gather2root(itc,'prim') 382a360,385 > ! call addfsech_ik('SIGMAPED',' ',' ',sigma_ped(lon0:lon1,lat,:), > ! | lon0,lon1,nk,nk-1,lat) > ! call addfsech_ik('SIGMAHAL',' ',' ',sigma_hall(lon0:lon1,lat,:), > ! | lon0,lon1,nk,nk-1,lat) > ! call addfsech_ik('ZPOTEN' ,' ',' ',zpoten(lon0:lon1,lat,:), > ! | lon0,lon1,nk,nk-1,lat) > ! call addfsech_ik('SCHEIGHT',' ',' ',scheight(lon0:lon1,lat,:), > ! | lon0,lon1,nk,nk-1,lat) > ! call addfsech_ik('UNVEL' ,' ',' ',unvel(lon0:lon1,lat,:), > ! | lon0,lon1,nk,nk-1,lat) > ! call addfsech_ik('VNVEL' ,' ',' ',vnvel(lon0:lon1,lat,:), > ! | lon0,lon1,nk,nk-1,lat) > ! call addfsech_ik('WNVEL' ,' ',' ',wnvel(lon0:lon1,lat,:), > ! | lon0,lon1,nk,nk-1,lat) > ! call addfsech_ik('JE1oD_F',' ','A/cm^2',je1oD_full(lon0: > ! | lon1,lat,:),lon0,lon1,nk,nk-1,lat) > ! call addfsech_ik('JE2oD_F',' ','A/cm^2',je2oD_full(lon0: > ! | lon1,lat,:),lon0,lon1,nk,nk-1,lat) > > ! call addfsech('UNPREP',' ',' ',un(:,lon0:lon1,lat), > ! | lon0,lon1,nk,nk-1,lat) > ! call addfsech('VNPREP',' ',' ',vn(:,lon0:lon1,lat), > ! | lon0,lon1,nk,nk-1,lat) > ! call addfsech('ZPREP' ,' ',' ',z (:,lon0:lon1,lat), > ! | lon0,lon1,nk,nk-1,lat) > 395d397 < subroutine dynamo 397,406c399 < ! Transform needed fields to geomagnetic coordinates < ! Perform field-line integrations < ! Evaluate PDE coefficients and RHS < ! The PDE is divided by 1/ DT0DTS (in dyncal divided by 1/cos(theta_0) < ! Sigma_(phi phi) = zigm11/ rcos0s * dt0dts < ! Sigma_(lam lam) = zigm22 * rcos0s / dt0dts < ! Sigma_(phi lam) = +-(zigm2-zigmc) < ! Sigma_(lam phi) = -+(zigm2+zigmc) < ! K_(m phi)^D = rim(1) * dt0dts < ! K_(m lam)^D = +-rim(2) * rcos0s --- > ! BOP 407a401,412 > ! !IROUTINE: nodynamo > ! !INTERFACE: > subroutine nodynamo > ! > ! !DESCRIPTION: > ! 12/02: This routine solves for the 3-D electric potential and fields > ! when the dynamo flag is off (idynamo=0). Hence, the low-latitude > ! potential is zero, while the high-latitude potential is set > ! with potential_model='HEELIS','WEIMER', or 'NONE'. > ! > ! !USES: > use input_module,only: potential_model 411c416,504 < use input_module,only: potential_model --- > ! > ! !RETURN VALUE: > ! !PARAMETERS: > ! > ! !REVISION HISTORY: > ! 05.02.04 > ! > ! EOP > ! > ! Local: > integer :: i,j,k > real,dimension(nlonp1,0:nlatp1) :: phih ! potential in geographic > ! > ! Set phim=phihm of the chosen high-latitude model > do i=1,nmlonp1 > do j=1,nmlat > phim(i,j) = phihm(i,j) > enddo ! j=1,nmlat > enddo ! i=1,nmlonp1 > ! > ! transform geopotential height to mag. grid (used in subroutine threed) > call transf_dyn0 > ! > ! > ! Call threed to generate 3-d potential array in geomagnetic coordinates > ! from 2-d solver output phim, corrected for the SH potential. > ! phim3d(nmlonp1,nmlat,-2:nlevp1) is in fields.F. > ! > call threed > > ! > ! Transform phim3d to geographic coordinates in dynpot (fields.F): > ! phim3d(nmlonp1,nmlat,-2:nlevp1) ! 3d electric potential magnetic > ! dynpot(nlonp1,0:nlatp1,nlevp1), ! 3d electric potential geographic > ! > do k=1,nlevp1 > call mag2geo(phim3d(1,1,k),dynpot(1,0,k),im(1,0),jm(1,0), > | dim(1,0),djm(1,0),nlonp1,nmlonp1,nlon,nlat+2,nmlon,nmlat) > enddo ! k=1,nlevp1 > ! > ! Periodic point: > do k=1,nlevp1 > do j=0,nlatp1 > dynpot(nlonp1,j,k) = dynpot(1,j,k) > enddo ! j=0,nlatp1 > enddo ! k=1,nlevp1 > ! > ! Save electric potential on geographic coords to secondary history: > ! do j=1,nlat > ! call addfsech_ik('DYNPOT',' ',' ',dynpot(:,j,:), > ! | 1,nlonp1,nlevp1,nlevp1-1,j) > ! enddo ! j=1,nlat > ! > ! Transform single-level heelis magnetic potential phihm to geographic > ! in phih: > call mag2geo(phihm(1,1),phih(1,0),im(1,0),jm(1,0),dim(1,0), > | djm(1,0),nlonp1,nmlonp1,nlon,nlat+2,nmlon,nmlat) > ! > ! Periodic point: > do j=0,nlatp1 > phih(nlonp1,j) = phih(1,j) > enddo ! j=0,nlatp1 > ! > ! Save 2d heelis potential on geographic grid: > ! if (potential_model == 'WEIMER') then > ! call addfsech_ij('PHIH2D','2D WEIMER01 POTENTIAL (GEOG)','VOLTS' > ! | ,phih,1,nlonp1,1,nlat) > ! elseif (potential_model == 'HEELIS') then > ! call addfsech_ij('PHIH2D','2D HEELIS POTENTIAL (GEOG)','VOLTS', > ! | phih,1,nlonp1,1,nlat) > ! else > ! call addfsech_ij('PHIH2D','2D ZERO POTENTIAL (GEOG)','VOLTS', > ! | phih,1,nlonp1,1,nlat) > ! endif > end subroutine nodynamo > !----------------------------------------------------------------------- > ! > ! BOP > ! !IROUTINE: dynamo > ! !INTERFACE: > subroutine dynamo > ! !USES: > use cons_module,only: dlatm,dlonm,pi_dyn,ylatm,rtd,crit > use hist_module,only: modeltime > use init_module,only: iyear > use magfield_module,only: im,jm,dim,djm > use fields_module,only: dynpot,phim3d > use input_module,only: potential_model,iamie > use amie_module,only: pcp_nh_amie,pcp_sh_amie 413,415d505 < #if defined(INTERCOMM) || defined(CISMAH) < ! use cism_coupling_module,only: cism_pot2mag < #endif 416a507,525 > ! !DESCRIPTION: > ! Transform needed fields to geomagnetic coordinates > ! Perform field-line integrations > ! Evaluate PDE coefficients and RHS > ! The PDE is divided by 1/ DT0DTS (in dyncal divided by 1/cos(theta_0) > ! Sigma_(phi phi) = zigm11/ rcos0s * dt0dts > ! Sigma_(lam lam) = zigm22 * rcos0s / dt0dts > ! Sigma_(phi lam) = +-(zigm2-zigmc) > ! Sigma_(lam phi) = -+(zigm2+zigmc) > ! K_(m phi)^D = rim(1) * dt0dts > ! K_(m lam)^D = +-rim(2) * rcos0s > ! > ! !RETURN VALUE: > ! !PARAMETERS: > ! !REVISION HISTORY: > ! 05.02.04 > ! > ! EOP > ! 418,419c527,528 < integer :: i,j,jj,jjj,j0,jntl,k,n,ncc,nmaglat,nmaglon,ier < real :: sym,fac --- > integer :: i,j,jj,jjj,j0,jntl,k,n,ncc,nmaglat,nmaglon,ier,jfit > real :: sym,fac,phi_add 422c531,532 < real,dimension(nlonp4,nlat) :: phih_diag --- > real,dimension(nmlonp1,nmlat0) :: phisym ! symmetric amie potential > real,dimension(nmlonp1,nmlat) :: phiasym ! asymmetric amie potential 438,454d547 < #if defined(INTERCOMM) || defined(CISMAH) < ! < ! Calculate global neutral winds generated current to transfer to CISM M-I couplier < ! < call cism_ucurrent < ! < ! Transform height-integrated parameters from APEX coordinates to geographic < ! coordinates to be passed to the M-I coupled in the CISM < ! < call mag2geo(zigm1(1,1),gzigm1(1,0),im(1,0),jm(1,0),dim(1,0), < | djm(1,0),nlonp1,nmlonp1,nlon,nlat+2,nmlon,nmlat) < call mag2geo(zigm2(1,1),gzigm2(1,0),im(1,0),jm(1,0),dim(1,0), < | djm(1,0),nlonp1,nmlonp1,nlon,nlat+2,nmlon,nmlat) < call mag2geo(nsrhs(1,1),gnsrhs(1,0),im(1,0),jm(1,0),dim(1,0), < | djm(1,0),nlonp1,nmlonp1,nlon,nlat+2,nmlon,nmlat) < #endif < ! 578,589c671,676 < ! call addfld('ZIGM11','Sig^T_phiphi/cos lam0/d^2phi','S', < ! | zigm11,'mlon',1,nmlonp1,'mlat',1,nmlat,0) < ! call addfld('ZIGM22','Sig^T_lamlam*cos lam0/d^2lam','S', < ! | zigm22,'mlon',1,nmlonp1,'mlat',1,nmlat,0) < ! call addfld('ZIGMC','Sig^T_philam/(4dlam dphi)','S', < ! | zigmc,'mlon',1,nmlonp1,'mlat',1,nmlat,0) < ! call addfld('ZIGM2','Sig^T_lamphi/(4dlam dphi)','S', < ! | zigm2,'mlon',1,nmlonp1,'mlat',1,nmlat,0) < ! call addfld('RIM1','K_mphi^DT','A/m', < ! | rim(:,:,1),'mlon',1,nmlonp1,'mlat',1,nmlat,0) < ! call addfld('RIM2','K_mlam^DT','A/m', < ! | rim(:,:,2),'mlon',1,nmlonp1,'mlat',1,nmlat,0) --- > ! call addfsech_ij('ZIGM11',' ',' ',zigm11,1,nmlonp1,1,nmlat) > ! call addfsech_ij('ZIGMC' ,' ',' ',zigmc ,1,nmlonp1,1,nmlat) > ! call addfsech_ij('ZIGM2' ,' ',' ',zigm2 ,1,nmlonp1,1,nmlat) > ! call addfsech_ij('ZIGM22',' ',' ',zigm22,1,nmlonp1,1,nmlat) > ! call addfsech_ij('RIM1' ,' ',' ',rim(:,:,1),1,nmlonp1,1,nmlat) > ! call addfsech_ij('RIM2' ,' ',' ',rim(:,:,2),1,nmlonp1,1,nmlat) 602c689,690 < if (debug) write(6,"('dynamo call stencmd: isolve=',i3)") isolve --- > if (debug) write(6,"('dynamo call stencmd: isolve=',i3)..')") > | isolve 681d768 < #if defined(INTERCOMM) || defined(CISMAH) 683c770 < ! Convert LFM geographic potential to geomagnetic coordinates --- > ! At this point, phihm is heelis, weimer, or amie (see advance.F) 685,692c772 < call cism_pot2mag < c do jj=1,nmlat < c do i=1,nmlonp1 < c write(6,*)phihm(i,jj),i,jj < c enddo < c enddo < #endif < ! --- > ! If not amie: 704c784,838 < if(.not.mod_heelis) then ! original heelis --- > if (iamie <= 0) then > if(.not.mod_heelis) then ! original heelis > ncc = 1 > nmaglon = nmlon0 > nmaglat = nmlat0 > do n=1,5 > if (isolve==2) then > call stenmd(nmaglon,nmaglat,cee(ncc),phihm(1,nmlat0), > | pfrac) > else > call stenmod(nmaglon,nmaglat,cee(ncc),phihm(1,nmlat0), > | pfrac) > endif > ncc = ncc+9*nmaglon*nmaglat > if (n==1) ncc = ncc+nmaglon*nmaglat ! rhs is in 10th slot > nmaglon = (nmaglon+1)/2 > nmaglat = (nmaglat+1)/2 > enddo ! n=1,5 > endif > ! > ! If amie, then break phihm into symmetric (phisym) and asymmetric (phiasym) > ! parts. phihm(nmlonp1,nmlat), phisym(nmlonp1,nmlat0), phyasym(nmlonp1,nmlat) > ! > else ! is amie > phiasym = 0. > do i=1,nmlonp1 > phisym(i,1) = phihm(i,nmlat0) > phiasym(i,nmlat0) = 0. > phi_add = 0. > ! Modification for penetration E-field - G. Lu, 2/19/2008 > if (iyear==2004 .and. modeltime(1)==314 .and. > | modeltime(2) > 19 .and. pcp_nh_amie > 200.e3) then > do j=1,nmlat0-1 > if (colatc(i,nmlat0-j+1) < crit(2)) jfit = j > enddo > phi_add = 0.5*phisym(i,nmlat0-jfit+1) > if(i==58) write(6,"('Dynamo: Penetration E-field: istep', > | i5,' jfit = ',i2,' phi_add = ',f10.2)") > | istep,jfit,phi_add > ! if(i==58) write(6,"('Dynamo: phisym = ',/,(6f10.2))") > ! | phisym(i,1:nmlat0) > endif > do j=1,nmlat0-1 > jj = nmlat+1-j > j0 = nmlat0-j+1 > phisym(i,j0) = 0.5*(phihm(i,j)+phihm(i,jj)) > phiasym(i,j) = 0.5*(phihm(i,j)+phihm(i,jj))-phihm(i,j) > phiasym(i,jj) = 0.5*(phihm(i,j)+phihm(i,jj))-phihm(i,jj) > if (j >= jfit) then > phisym(i,j) = phisym(i,j)+phi_add > endif > enddo ! j=1,nmlat0-1 > enddo ! i=1,nmlonp1 > ! > ! Modify stencils of symmetric part of amie potential: 710c844,845 < call stenmd(nmaglon,nmaglat,cee(ncc),phihm(1,nmlat0),pfrac) --- > call stenmd(nmaglon,nmaglat,cee(ncc),phisym(1,1), > | pfrac) 712c847,848 < call stenmod(nmaglon,nmaglat,cee(ncc),phihm(1,nmlat0),pfrac) --- > call stenmod(nmaglon,nmaglat,cee(ncc),phisym(1,1), > | pfrac) 719c855,858 < endif --- > if(istep==1) write(6,"('Dynamo: colatc = ',/,(6f10.2))") > | colatc(58,1:nmlat0)*rtd > if(istep==1) write(6,"('Dynamo: phisym = ',/,(6f10.2))") > | phisym(58,1:nmlat0) 720a860,872 > ! End of modification > ! p=0 from pole to crit1, p=1 from crit2 to equator: > do i=1,nmlonp1 > do j=1,nmlat0-1 > jj = nmlat+1-j > j0 = nmlat0-j+1 > phiasym(i,j) = phiasym(i,j) *(1.-pfrac(i,j0)) > phiasym(i,jj) = phiasym(i,jj)*(1.-pfrac(i,j0)) > enddo ! j=1,nmlat0-1 > enddo ! i=1,nmlonp1 > endif ! iamie > > ! 758,759c910 < ! for weimer - heelis (is hemispherical symmetric-> correction would be not < ! necessary): --- > ! for weimer - heelis (is hemispherical symmetric): 772,786c923,937 < fac = 1.0 < if(mod_heelis) fac = 0. ! modified heelis < do j=1,nmlat0 ! SH < jn = nmlat - j + 1 < jp = nmlat0 - j + 1 < do i=1,nmlonp1 < phim(i,j)=rim(i,j,1)+fac*(1.-pfrac(i,jp))*(phihm(i,j)- < | phihm(i,jn)) < enddo ! i=1,nmlonp1 < enddo ! j=1,nmlat0 < do j=nmlat0+1,nmlat ! NH < do i=1,nmlonp1 < phim(i,j) = rim(i,j,1) < enddo ! i=1,nmlonp1 < enddo ! j=1,nmlat --- > if (iamie <= 0) then > if(.not.mod_heelis) fac = 0. ! modified heelis > do j=1,nmlat0 ! SH > jn = nmlat - j + 1 > jp = nmlat0 - j + 1 > do i=1,nmlonp1 > phim(i,j)=rim(i,j,1)+fac*(1.-pfrac(i,jp))*(phihm(i,j)- > | phihm(i,jn)) > enddo ! i=1,nmlonp1 > enddo ! j=1,nmlat0 > do j=nmlat0+1,nmlat ! NH > do i=1,nmlonp1 > phim(i,j) = rim(i,j,1) > enddo ! i=1,nmlonp1 > enddo ! j=1,nmlat 787a939,947 > ! Amie (fractional partitioning was done above): > else ! amie > do j=1,nmlat > do i=1,nmlonp1 > phim(i,j) = rim(i,j,1)-phiasym(i,j) > enddo ! i=1,nmlonp1 > enddo ! j=1,nmlat > endif > ! 789,794c949,951 < ! if (potential_model == 'WEIMER01') then < ! call addfld('PHIHM2D','2D WEIMER01 ELECTRIC POTENTIAL', < ! | 'V', phihm,'mlon',1,nmlonp1,'mlat',1,nmlat,0) < ! elseif (potential_model == 'WEIMER05') then < ! call addfld('PHIHM2D','2D WEIMER05 ELECTRIC POTENTIAL', < ! | 'V', phihm,'mlon',1,nmlonp1,'mlat',1,nmlat,0) --- > ! if (potential_model == 'WEIMER') then > ! call addfsech_ij('PHIHM2D','2D WEIMER01 ELECTRIC POTENTIAL', > ! | 'VOLTS', phihm,1,nmlonp1,1,nmlat) 796,797c953,954 < ! call addfld('PHIHM2D','2D HEELIS ELECTRIC POTENTIAL', < ! | 'V',phihm,'mlon',1,nmlonp1,'mlat',1,nmlat,0) --- > ! call addfsech_ij('PHIHM2D','2D HEELIS ELECTRIC POTENTIAL', > ! | 'VOLTS', phihm,1,nmlonp1,1,nmlat) 799,800c956,957 < ! call addfld('PHIHM2D','2D ELECTRIC POTENTIAL', < ! | 'V',phihm,'mlon',1,nmlonp1,'mlat',1,nmlat,0) --- > ! call addfsech_ij('PHIHM2D','2D ZERO ELECTRIC POTENTIAL', > ! | 'VOLTS', phihm,1,nmlonp1,1,nmlat) 804,805c961,962 < ! call addfld('PHIM2D','2D ELECTRIC POTENTIAL','VOLTS',phim, < ! | 'mlon',1,nmlonp1,'mlat',1,nmlat,0) --- > call addfsech_ij('PHIM2D','2D ELECTRIC POTENTIAL','VOLTS', > | phim,1,nmlonp1,1,nmlat) 821d977 < ! Note nmlev = nlevp1, so 1:nmlev cannot be used in the addfld call. 824,825c980,981 < ! call addfld('PHIM3D','El.Poten','V', < ! | phim3d(:,j,1:nlevp1),'mlon',1,nmlonp1,'imlev',1,nlevp1,j) --- > ! call addfsech_ik('PHIM3D','ELECTRIC POTENTIAL (MAG)','VOLTS', > ! | phim3d(:,j,:),1,nmlonp1,nmlev,nmlev-1,j) 854,855c1010,1017 < ! dynpot(nlonp1,0:nlatp1,nlevp1), ! 3d electric potential geographic < ! dynpot_diag(nlonp4,nlat,nlevp1) ! for addfld --- > ! do j=1,nlat > ! call addfsech_ik('DYNPOT',' ',' ',dynpot(:,j,:), > ! | 1,nlonp1,nlevp1,nlevp1-1,j) > ! call addfsech_ik('JE13D_GEO','je13d_geo','A/m^2', > ! | je13d_geo(:,j,:),1,nlonp1,nlevp1,nlevp1,j) > ! call addfsech_ik('JE23D_GEO','je23d_geo','A/m^2', > ! | je23d_geo(:,j,:),1,nlonp1,nlevp1,nlevp1,j) > ! enddo ! j=1,nlat 857,873d1018 < ! do j=1,nlat < ! dynpot_diag(:,:,:) = spval < ! dynpot_diag(3:nlonp2,j,:) = dynpot(1:nlon,j,:) ! 3,74 <= 1,72 < ! dynpot_diag(1:2,j,:) = dynpot_diag(nlonp1:nlonp2,j,:) ! 1,2 <= 73,74 < ! dynpot_diag(nlonp4-1:nlonp4,j,:) = dynpot_diag(3:4,j,:) ! 75,76 <= 3,4 < ! call addfld('DYNPOT','elec. potential (geo)','V', < ! | dynpot_diag(:,j,:),'lon',1,nlonp4,'ilev',1,nlevp1,j) < ! < ! je13d_diag(nlonp4,nlat,nlevp1), ! 3d je1 geographic for addfld < ! je13d_diag(:,:,:) = spval < ! je13d_diag(3:nlonp2,j,:) = je13d_geo(1:nlon,j,:) ! 3,74 <= 1,72 < ! je13d_diag(1:2,j,:) = je13d_diag(nlonp1:nlonp2,j,:) ! 1,2 <= 73,74 < ! je13d_diag(nlonp4-1:nlonp4,j,:) = je13d_diag(3:4,j,:) ! 75,76 <= 3,4 < ! call addfld('JE13D','J_e1(p,g)','A/m^2', < ! | je13d_diag(:,j,:),'lon',1,nlonp4,'lev',1,nlevp1,j) < ! enddo ! j=1,nlat < ! 884,893c1029,1039 < ! real,dimension(nlonp4,nlat) :: phih_diag < ! < ! do j=1,nlat < ! phih_diag(3:nlonp4-2,j) = phih(1:nlon,j) < ! phih_diag(1:2,j) = phih_diag(nlon+1:nlon+2,j) < ! phih_diag(nlon+3:nlon+4,j) = phih_diag(3:4,j) < ! enddo < ! call addfld('PHIH2D','elec. potential (geo)','V', < ! | phih,'lon',1,nlonp4,'lat',1,nlat,0) < ! --- > ! Save 2d potential on geographic grid: > ! if (potential_model == 'WEIMER') then > ! call addfsech_ij('PHIH2D','2D WEIMER01 POTENTIAL (GEOG)','VOLTS' > ! | ,phih,1,nlonp1,1,nlat) > ! elseif (potential_model == 'HEELIS') then > ! call addfsech_ij('PHIH2D','2D HEELIS POTENTIAL (GEOG)','VOLTS', > ! | phih,1,nlonp1,1,nlat) > ! else > ! call addfsech_ij('PHIH2D','2D ZERO POTENTIAL (GEOG)','VOLTS', > ! | phih,1,nlonp1,1,nlat) > ! endif 896a1043,1045 > ! BOP > ! !IROUTINE: transf > ! !INTERFACE: 898,906c1047 < ! < ! -maps the geographic fields to the geomagnetic coordinate < ! system < ! - call the fieldline integration routine to calculate the < ! conductances as well as the height integrated current density for the < ! right hand side < ! - include the boundary condition at the equator < ! - transformation from lam_m to lam_0 (regular grid) < ! --- > ! !USES: 919a1061,1075 > ! !RETURN VALUE: > ! !PARAMETERS: > ! !DESCRIPTION: -maps the geographic fields to the geomagnetic coordinate > ! system > ! - call the fieldline integration routine to calculate the > ! conductances as well as the height integrated current density for the > ! right hand side > ! - include the boundary condition at the equator > ! - transformation from lam_m to lam_0 (regular grid) > ! > ! !REVISION HISTORY: > ! 05.02.04 > ! > ! EOP > ! 1313,1315c1469,1476 < ! real,dimension(nmlonp1,-2:nlev) :: ! J(mag.pres,gravity) mag. grid < ! je1_pg, ! J(gravity) < ! je2_pg ! J(mag.pres) --- > ! call addfsech_ik('je1_pg' ,'je1_pg','A/cm^2',je1_pg, > ! | 1,nmlonp1,nmlev,nmlev-1,j) > ! call addfsech_ik('je2_pg' ,'je2_pg','A/cm^2',je2_pg, > ! | 1,nmlonp1,nmlev,nmlev-1,j) > ! call addfsech_ik('SIGMA1M' ,' ',' ',sigma_pedm, > ! | 1,nmlonp1,nmlev,nmlev-1,j) > ! call addfsech_ik('SIGMA2M' ,' ',' ',sigma_hallm, > ! | 1,nmlonp1,nmlev,nmlev-1,j) 1317,1325d1477 < ! call addfld('je1_pg' ,'je1_pg','A/cm^2',je1_pg(:,1:nmlev), < ! | 'mlon',1,nmlonp1,'mlev',1,nmlev,j) < ! call addfld('je2_pg' ,'je2_pg','A/cm^2',je2_pg(:,1:nmlev), < ! | 'mlon',1,nmlonp1,'mlev',1,nmlev,j) < ! call addfld('SIGMA1M','sig_ped','S/m',sigma_pedm(:,1:nmlev), < ! | 'mlon',1,nmlonp1,'mlev',1,nmlev,j) < ! call addfld('SIGMA2M','sig_hall','S/m',sigma_hallm(:,1:nmlev), < ! | 'mlon',1,nmlonp1,'mlev',1,nmlev,j) < ! 1351d1502 < je2oD_pg3d(i,j,k) = je2_pg(i,k) 1364,1365c1515 < je1oD_pg3d(nmlonp1,j,:)= je1oD_pg3d(1,j,:) < je2oD_pg3d(nmlonp1,j,:)= je2oD_pg3d(1,j,:) --- > je1oD_pg3d(nmlonp1,j,:)= je1oD_pg3d(1,j,:) 1378d1527 < je2oD_pg3d(i,j,nlevp1) = je2_pg(i,nlev) 1382a1532 > 1384a1535 > 1455d1605 < je2oD_pg3d(i,j,k) = je2_pg(i,k) ! gravity + mag.pressure 1474d1623 < je2oD_pg3d(nmlonp1,j,:) = je2oD_pg3d(1,j,:) ! gravity + mag.pressure 1507,1509d1655 < #if defined(INTERCOMM) || defined(CISMAH) < zigm1(i,j) = .06 *(zigm1(i,j-1) + zigm1(i,j+1)) ! cism < #endif 1577,1579d1722 < #if defined(INTERCOMM) || defined(CISMAH) < zigm1 (nmlonp1,j) = zigm1 (1,j) ! cism < #endif 1624,1629d1766 < #if defined(INTERCOMM) || defined(CISMAH) < zigm1(1, 1) = (4.*sddot(nmlon,unitvm,zigm1(1, 2))- ! cism < 1 sddot(nmlon,unitvm,zigm1(1, 3)))/(3.*float(nmlon)) < zigm1(1,nmlat) = (4.*sddot(nmlon,unitvm,zigm1(1,nmlat-1))- ! cism < 1 sddot(nmlon,unitvm,zigm1(1,nmlat-2)))/(3.*float(nmlon)) < #endif 1645,1648d1781 < #if defined(INTERCOMM) || defined(CISMAH) < zigm1(i, 1) = zigm1(1, 1) ! cism < zigm1(i, nmlat) = zigm1(1, nmlat) ! cism < #endif 1669,1671d1801 < #if defined(INTERCOMM) || defined(CISMAH) < zigm1 (nmlonp1,j) = zigm1 (1,j) ! cism < #endif 1682c1812,1815 < ! real,dimension(nmlonp1,nmlat,-2:nlevp1) :: zpotenm3d --- > do j=1,nmlat > call addfsech_ik('ZMAG','ZMAG','CM',zpotenm3d(:,j,:), > | 1,nmlonp1,nmlev,nmlev,j) > enddo ! j=1,nmlat 1684,1688d1816 < do j=1,nmlat < call addfld('ZMAG','GEOPOTENTIAL HEIGHT (MAGNETIC)','CM', < | zpotenm3d(:,j,:),'mlon',1,nmlonp1,'imlev',1,nimlevp1,j) < enddo ! j=1,nmlat < ! 1690a1819,1821 > ! BOP > ! !IROUTINE: fieldline_integrals > ! !INTERFACE: 1692,1706c1823 < ! < ! Perform approximated field line integration at geomagnetic grid < ! zigm11 is int[sig_p*d_1^2/D] ds, i.e. Sigma_(phi phi)/abs(sin Im) < ! zigm22 is int[sig_p*d_2^2/D] ds, i.e. Sigma_(lam lam)*abs(sin Im) < ! zigmc is int[sig_p*d_1*d_2/D] ds, i.e. Sigma_c < ! zigm2 is int[sigma_h] ds, i.e. Sigma_h < #if defined(INTERCOMM) || defined(CISMAH) < ! zigm1 is int[sigma_p] ds, i.e. Sigma_p !CISM < #endif < ! < ! rim1 [A/m] is int[(sigma_h-sigma_p*d_1*d_2/D)u_e1 + sigma_p*d_1^2/D u_e2] *A(h_r)* < ! B_e3 ds, i.e. K_(m phi)^D/abs(sin Im) < ! rim2 [A/m] is -/- int[(sigma_h+sigma_p*d_1*d_2/D)u_e2 - sigma_p*d_2^2/D u_e1] *A(h_r)* < ! B_e3 ds, i.e. +/- K_(m lam)^D < ! --- > ! !USES: 1710a1828,1830 > ! > ! !RETURN VALUE: > ! !ARGUMENTS: 1711a1832,1838 > ! !PARAMETERS: > ! !DESCRIPTION: > ! Perform approximated field line integration at geomagnetic grid > ! zigm11 is int[sig_p*d_1^2/D] ds, i.e. Sigma_(phi phi)/abs(sin Im) > ! zigm22 is int[sig_p*d_2^2/D] ds, i.e. Sigma_(lam lam)*abs(sin Im) > ! zigmc is int[sig_p*d_1*d_2/D] ds, i.e. Sigma_c > ! zigm2 is int[sigma_h] ds, i.e. Sigma_h 1712a1840,1849 > ! rim1 [A/m] is int[(sigma_h-sigma_p*d_1*d_2/D)u_e1 + sigma_p*d_1^2/D u_e2] *A(h_r)* > ! B_e3 ds, i.e. K_(m phi)^D/abs(sin Im) > ! rim2 [A/m] is -/- int[(sigma_h+sigma_p*d_1*d_2/D)u_e2 - sigma_p*d_2^2/D u_e1] *A(h_r)* > ! B_e3 ds, i.e. +/- K_(m lam)^D > ! > ! !REVISION HISTORY: > ! 08.02.04 > ! > ! EOP > ! 1770,1772d1906 < #if defined(INTERCOMM) || defined(CISMAH) < zigm1 (i,latm) = 0. ! CISM < #endif 1833,1835d1966 < #if defined(INTERCOMM) || defined(CISMAH) < zigm1(i,latm) = zigm1(i,latm) + sig1*rtramrm(i,k)*htfunc(i,k) ! CISM < #endif 1882,1884d2012 < #if defined(INTERCOMM) || defined(CISMAH) < zigm1(i,latm) = 1.e-2*zigm1(i,latm)*aam(i) ! CISM < #endif 1890a2019,2021 > ! BOP > ! !IROUTINE: rhspde > ! !INTERFACE: 1891a2023,2024 > ! !USES: > use cons_module,only: pi_dyn,dlatm,dlonm,r0 1892a2026,2028 > ! !RETURN VALUE: > ! !PARAMETERS: > ! !DESCRIPTION: 1897c2033,2036 < use cons_module,only: pi_dyn,dlatm,dlonm,r0 --- > ! !REVISION HISTORY: > ! 05.02.16 > ! > ! EOP 1995a2135,2137 > ! BOP > ! !IROUTINE: clearce > ! !INTERFACE: 1997a2140,2141 > ! !USES: > ! !DESCRIPTION: 2002a2147 > ! !PARAMETERS: 2003a2149 > ! !RETURN VALUE: 2005a2152,2156 > ! !REVISION HISTORY: > ! 05.03.8 > ! > ! EOP > ! 2025a2177,2179 > ! BOP > ! !IROUTINE: stencil > ! !INTERFACE: 2027a2182,2183 > ! !USES: > ! !DESCRIPTION: 2030a2187 > ! !PARAMETERS: 2036a2194,2195 > ! > ! !RETURN VALUE: 2039a2199,2203 > ! !REVISION HISTORY: > ! 05.03.8 > ! > ! EOP > ! 2060a2225,2227 > ! BOP > ! !IROUTINE: stencmd > ! !INTERFACE: 2062a2230,2231 > ! !USES: > ! !DESCRIPTION: 2066c2235 < ! Args: --- > ! !ARGUMENTS: 2072a2242,2243 > ! > ! !RETURN VALUE: 2075a2247,2251 > ! !REVISION HISTORY: > ! 18.02.05 > ! > ! EOP > ! 2106a2283,2285 > ! BOP > ! !IROUTINE: htrpex > ! !INTERFACE: 2109,2110c2288,2292 < ! Copy coefficients into array and extend array over 16 grid points < ! for the wrap around points on the 5 different grid levels. --- > ! !USES: > ! !DESCRIPTION: > ! copy coefficients into array and > ! extend array over 16 grid points for the wrap around points > ! on the 5 different grid levels. 2113c2295 < ! Args: --- > ! !ARGUMENTS: 2116a2299,2303 > ! !REVISION HISTORY: > ! 18.02.05 > ! > ! EOP > ! 2140a2328,2330 > ! BOP > ! !IROUTINE: cnm > ! !INTERFACE: 2142a2333,2334 > ! !USES: > ! !DESCRIPTION: 2153c2345 < ! Args: --- > ! !ARGUMENTS: 2157a2350,2351 > > ! !RETURN VALUE: 2161a2356,2360 > ! !REVISION HISTORY: > ! 18.02.05 > ! > ! EOP > ! 2279a2479,2481 > ! BOP > ! !IROUTINE: cnmmod > ! !INTERFACE: 2281a2484,2485 > ! !USES: > ! !DESCRIPTION: 2294c2498 < ! Args: --- > ! !ARGUMENTS: 2298a2503 > ! !RETURN VALUE: 2302a2508,2512 > ! !REVISION HISTORY: > ! 18.02.05 > ! > ! EOP > ! 2470a2681,2683 > ! BOP > ! !IROUTINE: divide > ! !INTERFACE: 2472a2686,2687 > ! !USES: > ! !DESCRIPTION: 2474a2690 > ! !ARGUMENTS: 2478a2695 > ! !RETURN VALUE: 2480a2698,2703 > ! !REVISION HISTORY: > ! 21.02.05 > ! > ! > ! EOP > ! 2495a2719,2721 > ! BOP > ! !IROUTINE: edges > ! !INTERFACE: 2497a2724,2725 > ! !USES: > ! !DESCRIPTION: 2500a2729 > ! !ARGUMENTS: 2501a2731 > ! !RETURN VALUE: 2503a2734,2738 > ! !REVISION HISTORY: > ! 21.02.05 > ! > ! EOP > ! 2516a2752,2754 > ! BOP > ! !IROUTINE: stenmod > ! !INTERFACE: 2519a2758,2760 > ! !USES: > ! > ! !DESCRIPTION: 2530a2772 > ! !PARAMETERS: 2534a2777 > ! !RETURN VALUE: 2535a2779,2782 > ! !REVISION HISTORY: > ! 05.03.10 > ! > ! EOP 2571a2819 > 2573a2822,2824 > ! BOP > ! !IROUTINE: stenmd > ! !INTERFACE: 2574a2826 > ! !USES: 2576a2829 > ! !DESCRIPTION: 2588a2842 > ! !PARAMETERS: 2592a2847 > ! !RETURN VALUE: 2593a2849,2852 > ! !REVISION HISTORY: > ! 05.03.8 > ! > ! EOP 2651a2911,2913 > ! BOP > ! !IROUTINE: ceee > ! !INTERFACE: 2652a2915 > ! !USES: 2653a2917 > ! !DESCRIPTION: 2656a2921 > ! !PARAMETERS: 2658a2924 > ! !RETURN VALUE: 2660a2927,2931 > ! !REVISION HISTORY: > ! 05.02.16 > ! > ! EOP > ! 2672a2944,2946 > ! BOP > ! !IROUTINE: threed > ! !INTERFACE: 2673a2948,2949 > ! > ! !USES: 2675,2680c2951,2952 < | rcos0s,re,dt1dts,dt0dts < use fields_module,only: phim3d, < | emphi3d, ! 3d eastward electric field magnetic < | emlam3d, ! 3d equatorw. electric field magnetic < | emz3d ! 3d upward (?) electric field magnetic < use init_module,only: istep ! for debug --- > | rcos0s,re,dt1dts > use fields_module,only: phim3d ! phim3d(nmlonp1,nmlat,-2:nlevp1) 2681a2954 > ! !DESCRIPTION: 2687a2961,2965 > > ! !ARGUMENTS: > ! !RETURN VALUE: > ! !REVISION HISTORY: > ! 07.03.05 2689,2693c2967 < ! calculates the electric field (used in subroutine efield) < ! R E_phi = -1/(cos lam_m) d Phi/ d phi_m < ! R E_lam = d Phi/ d lam_m < ! E_z = d Phi/ d zp < ! with R the Erath radius --- > ! EOP 2701d2974 < real,dimension(nmlonp1,nmlat) :: ephi,elam 2715d2987 < ephi(i,j) = ed1(i,j)*(r0*1.e-2) 2720,2721d2991 < ephi(1,j) = ed1(1,j)*(r0*1.e-2) < ephi(nmlonp1,j) = ed1(nmlonp1,j)*(r0*1.e-2) 2730d2999 < elam(i,j) = -(phim(i,j+1)-phim(i,j-1))/(2.*dlatm)*dt0dts(j) 2739d3007 < elam(i,j) = -(phim(i,j+1)-phim(i,j-1))/(2.*dlatm)*dt0dts(j) 2759,2766d3026 < ephi(i,1) = .25*(ephi(i,2) - ephi(ip2f,2) + < | elam(ip1f,2) - elam(ip3f,2)) < ephi(i,nmlat) = .25*(ephi(i,nmlat-1) - ephi(ip2f,nmlat-1) + < | elam(ip1f,nmlat-1) - elam(ip3f,nmlat-1)) < elam(i,1) = .25*(elam(i,2) - elam(ip2f,2) - < | ephi(ip1f,2) + ephi(ip3f,2)) < elam(i,nmlat) = .25*(elam(i,nmlat-1) - elam(ip2f,nmlat-1) - < | ephi(ip1f,nmlat-1) + ephi(ip3f,nmlat-1)) 2769c3029 < ed2(i,nmlath) = (4.*phim(i,nmlath+1)-phim(i,nmlath+2) --- > ed2(i,nmlath) = (4.*phim(i,nmlath+1)-phim(i,nmlath+2) 2771c3031 < ed2(i,nmlath+1) = (4.*phim(i,nmlath+2)-phim(i,nmlath+3) --- > ed2(i,nmlath+1) = (4.*phim(i,nmlath+2)-phim(i,nmlath+3) 2773c3033 < ed2(i,nmlath-1) = (4.*phim(i,nmlath-2)-phim(i,nmlath-3) --- > ed2(i,nmlath-1) = (4.*phim(i,nmlath-2)-phim(i,nmlath-3) 2775,2776d3034 < elam(i,nmlath) = (4.*phim(i,nmlath+1)-phim(i,nmlath+2) < | -3.*phim(i,nmlath))/(2.*dlatm) 2777a3036,3041 > > call addfsech_ij('ED1','2D ELECTRIC FIELD (ed1)','VOLTS/M', > | ed1,1,nmlonp1,1,nmlat) > call addfsech_ij('ED2','2D ELECTRIC FIELD (ed2)','VOLTS/M', > | ed2,1,nmlonp1,1,nmlat) > 2786a3051 > ! write(6,"('Going to height loop >>>')") 2791a3057,3058 > ! write(6,"('Inside height loop: k,j,cosltm = ',2i4,f9.3)") > ! | k,j,cosltm 2813c3080 < jslot(i) = int(qslot(i)) --- > jslot(i) = qslot(i) 2829,2836d3095 < ! < emphi3d(i,j,k) = (1.-qslot(i))* < | ephi(islot(i),jslot(i))+qslot(i)* < | ephi(islot(i),jslot(i)+1) < ! < emlam3d(i,j,k) = (1.-qslot(i))* < | elam(islot(i),jslot(i))+qslot(i)* < | elam(islot(i),jslot(i)+1) 2853,2857d3111 < ! < emphi3d(i,1,k) = ephi(i,1) < emphi3d(i,nmlat,k) = ephi(i,nmlat) < emlam3d(i,1,k) = elam(i,1) < emlam3d(i,nmlat,k) = elam(i,nmlat) 2860,2867d3113 < ! < do k=2,nlevp1-1 < do j=1,nmlat < do i=1,nmlon < emz3d(i,j,k) = -(phim3d(i,j,k+1)-phim3d(i,j,k-1)) < enddo ! i=1,nmlon < enddo ! j=2,nmlat-1 < enddo ! k=1,nlevp1 2869,2876d3114 < do k=-1,nlev < do j=1,nmlat < do i=1,nmlon < emz3d(i,j,k) = -(phim3d(i,j,k+1)-phim3d(i,j,k-1)) < enddo ! i=1,nmlon < enddo ! j=2,nmlat-1 < enddo ! k=1,nlevp1 < ! 2878c3116 < do k=-2,nlevp1 --- > do k=1,nlevp1 2883,2885d3120 < emphi3d(nmlonp1,j,k)= emphi3d(1,j,k) < emlam3d(nmlonp1,j,k)= emlam3d(1,j,k) < emz3d(nmlonp1,j,k) = emz3d(1,j,k) 2890,2900d3124 < ! From fields.F: < ! Electric potential on geographic and magnetic grids: < ! real :: < ! | dynpot(nlonp1,0:nlatp1,nlevp1), ! 3d electric potential geographic < ! | phim3d(nmlonp1,nmlat,nlevp1), ! 3d electric potential magnetic < ! | emphi3d(nmlonp1,nmlat,nlevp1), ! 3d eastward electric field magnetic < ! | emlam3d(nmlonp1,nmlat,nlevp1), ! 3d equatorw. electric field magnetic < ! | emz3d(nmlonp1,nmlat,nlevp1) ! 3d upward (?) electric field magnetic < ! Local: < ! real,dimension(nmlonp1,nmlat,-2:nlevp1) :: zpotenm3d < ! 2902,2915c3126,3131 < ! call addfld('EMPHI3D','R E_mphi','[V/m*m]', < ! | emphi3d(:,j,:),'mlon',1,nmlonp1,'imlev',1,nmlevp1,j) < ! call addfld('EMLAM3D','R E_mlam','[V/m*m]', < ! | emlam3d(:,j,:),'mlon',1,nmlonp1,'imlev',1,nmlevp1,j) < ! call addfld('EMZ3D','E_mZ','[V/m*m]', < ! | emz3d(:,j,:),'mlon',1,nmlonp1,'imlev',1,nmlevp1,j) < ! call addfld('ED1M3D','ed_1 (magn.)','[V/m]', < ! | ed13d(:,j,:),'mlon',1,nmlonp1,'imlev',1,nmlevp1,j) < ! call addfld('ED2M3D' ,'ed_2 (magn.)','[V/m]', < ! | ed23d(:,j,:),'mlon',1,nmlonp1,'imlev',1,nmlevp1,j) < ! call addfld('PHIM3D','El.Poten','V', < ! | phim3d(:,j,:),'mlon',1,nmlonp1,'imlev',1,nmlevp1,j) < ! call addfld('ZPOTEN3D','ZPOTEN3D','[cm]', < ! | zpotenm3d(:,j,:),'mlon',1,nmlonp1,'imlev',1,nmlevp1,j) --- > ! call addfsech_ik('ED1M3D' ,'ed_1 (magn.)','[V/m]', > ! | ed13d(:,j,:),1,nmlonp1,nmlev,nmlev,j) > ! call addfsech_ik('ED2M3D' ,'ed_2 (magn.)','[V/m]', > ! | ed23d(:,j,:),1,nmlonp1,nmlev,nmlev,j) > ! call addfsech_ik('ZPOTEN3D','ZPOTEN3D','[cm]', > ! | zpotenm3d(:,j,:),1,nmlonp1,nmlev,nmlev,j) 2919a3136,3138 > ! BOP > ! !IROUTINE: mag2geo > ! !INTERFACE: 2922c3141,3142 < ! --- > ! !USES: > ! !DESCRIPTION: 2926c3146 < ! Args: --- > ! !PARAMETERS: 2929a3150 > ! !RETURN VALUE: 2931a3153,3157 > ! !REVISION HISTORY: > ! 05.03.11 > ! > ! EOP > ! 2945a3172,3174 > ! BOP > ! !IROUTINE: geo2mag > ! !INTERFACE: 2947a3177 > ! !USES: 2948a3179 > ! !DESCRIPTION: 2952c3183 < ! Args: --- > ! !PARAMETERS: 2955a3187 > ! !RETURN VALUE: 2957a3190,3194 > ! !REVISION HISTORY: > ! 05.03.8 > ! > ! EOP > ! 3107,3108d3343 < #if defined(INTERCOMM) || defined(CISMAH) < !FIXME: cism_ucurrent should go in the "cism_coupling" module... 3110,3111c3345,3347 < ! IROUTINE: cism_ucurrent < ! INTERFACE: --- > ! !IROUTINE: transf_dyn0 > ! !INTERFACE: > subroutine transf_dyn0 3113,3149c3349,3361 < subroutine cism_ucurrent < ! < ! DESCRIPTION: < ! < ! This subroutine calculate height-integrated neutral wind generated < ! field-aligned current (dynamo) to be passed to the M-I coupler to < ! solve electric potential. This subroutine is based on the subroutine < ! 'nosocoef' in 'current.F' written by Astrid Maute. < ! The height-integrated neutral wind field-alined current is calculated in a < ! Quisi-Dipole Coordinate that is defined in detail in Richmond (1995). This < ! coordinate system removes the 1/|sinI_m| factor in the partial differential < ! equation for the electric potential in the Modified Apex Coordinate system. < ! 1/|sinI_m| is not defined at magnetic equator in the Modified Apex < ! Coordinate system, but is well defined in the Quisi-Dipole Coordinate system < ! (I still need to see how this works). < ! The neutral dynamo currents are already calculted in subroutine < ! 'fieldline-integrals' in the 'dynamo.F' as a global variable < ! 'rim(nmlonp1,nmlat,2)'. Subroutine 'rshpde' has the formula to calculate < ! height-integrated neutral wind current, but the current there is the sum < ! of two hemispheres. We want a global distribution of this current for the M-I < ! coupler. Thus the code here is an expanded version of that in "rhspde", but a < ! stripped version of "nosocoef". 'nosocoef' also calculates other < ! coefficients (lhs) for the potential equation to obtain total field-aligned currents < ! including both magnetosphere and thermosphere originated currents. We only need < ! thermospheric originated currents for the CISM M-I coupler. < ! < ! This subroutine is called by subroutine 'dynamo' after 'call transfer' < ! in 'dynamo.F' < ! ---------- Wenbin Wang 09/20/05 < ! USES < ! < use cons_module,only: dlonm,dlatm,pi,r0 < < ! < ! PARAMETERS: < ! RETURN VALUE: nsrhs(nmlonp1,nmlat) ! defined as a global variable above < ! --- > ! !USES: > use cons_module,only: h0,r0 > use magfield_module,only: > | zb, ! (nlonp1,0:nlatp1) > | ig, ! (nmlonp1,nmlat) geog lon at each geomag grid point > | jg, ! (nmlonp1,nmlat) geog lat at each geomag grid point > | wt ! (4,nmlonp1,nmlat) interpolation weights > ! > ! !RETURN VALUE: > ! !PARAMETERS: > ! !DESCRIPTION: > ! am_11/03 used only if dynamo = 0 > ! need zpoten3d in magnetic coordinates for subroutine threed 3151c3363,3364 < ! --- > ! 05.03.8 > ! 3154,3155d3366 < ! Calculate height-integrated field-aligned neutral wind currents for both hemisphere < ! 3156a3368,3369 > integer :: i,ii,k,kk,j,jj,lat,n > real :: z0 3158,3160c3371,3373 < real :: cs(nmlat) < real :: dfac < integer :: j,je,jj,i,n --- > ! Fields to be transformed to geomagnetic space (formerly in transmag.h): > ! (these will be input to the geographic to magnetic transformation). > real,dimension(nlonp1,0:nlatp1,-2:nlevp1) :: zz 3162c3375 < ! Externals: --- > real,dimension(nlonp4,nlevp1) :: zz_plt 3163a3377 > ! External: 3166c3380,3382 < ! Calculate coefficients for dynamo pde for both hemisphere --- > ! Set constants: > ! z0 is lowest level for start of field line integration set in h0 > ! (h0 in cons module) 3169c3385,3391 < ! Clear arrays --- > ! Pack inputs from 3->nlon+3 to 1->nlon+1, as in tgcm15 (end of sub lamdas): > do lat=1,nlat > do i=1,nlon+1 > ii = i+2 > zpoten(i,lat,:) = zpoten(ii,lat,:) > enddo ! i=1,nlonp4-3 > enddo ! lat=1,nlat 3171c3393 < nsrhs(:,:) = 0.0 --- > z0 = h0 3173c3395,3407 < ! Calculate magnetic latitude cosin array --- > ! Calculate quantities to be transformed to geomagnetic space: > do k=1,nlev > do j=1,nlat > do i=1,nlonp1 > zz(i,j,k) = zpoten(i,j,k) > enddo ! i=1,nlonp1 > enddo ! j=1,nlat > enddo ! k=1,nlev > do j=1,nlat > do i=1,nlonp1 > zz(i,j,nlevp1) = zpoten(i,j,nlevp1) > enddo ! i=1,nlonp1 > enddo ! j=1,nlat 3175,3177c3409,3411 < do j = 1,nmlat ! -pi/2 to pi/2 < cs(j) = cos(-pi/2.+(j-1)*dlatm) < enddo --- > ! Extend fields down to 90 km inserting 3 extra levels. > ! Set three equally spaced levels for Z, take U, V, and W > ! to be constant, and extrapolate sigmas exponentially. 3179c3413,3419 < ! Calculate right hand side of pde from rim(1) and rim(2) --- > do k=0,-2,-1 > do j=1,nlat > do i=1,nlonp1 > zz(i,j,k) = z0+float(k+2)*(zz(i,j,1)-z0)/3. > enddo ! i=1,nlonp1 > enddo ! j=1,nlat > enddo ! k=0,-2,-1 3181,3182c3421,3428 < do j = 2,nmlath-1 ! 2,48 south pole-1 to equator-1 < jj = j+nmlath-1 ! 50,96 equator+1 to north pole-1 --- > ! Values at poles: > do k=-2,nlev > zz(1,0,k) = > | (9.*sddot(nlon,unitv,zz(1,1,k))- > | sddot(nlon,unitv,zz(1,2,k)))/(8.*float(nlon)) > zz(1,nlatp1,k) = > | (9.*sddot(nlon,unitv,zz(1,nlat ,k))- > | sddot(nlon,unitv,zz(1,nlat-1,k)))/(8.*float(nlon)) 3184c3430,3435 < ! Differentiate rim(1) w.r.t lamda --- > ! Extend in longitude: > do i = 2,nlon > zz(i,0,k) = zz(1,0,k) > zz(i,nlatp1,k) = zz(1,nlatp1,k) > enddo ! i = 2,nlon > enddo ! k=-2,nlev 3186,3191c3437,3444 < do i = 2,nmlon-1 < nsrhs(i,j) = 1.0/(dlonm*cs(j))* < | 0.5*(rim(i+1,j,1)-rim(i-1,j,1)) < nsrhs(i,jj) = 1.0/(dlonm*cs(jj))* < | 0.5*(rim(i+1,jj,1)-rim(i-1,jj,1)) < enddo --- > ! Values at the poles: > zz(1,0,nlevp1)= (9.*sddot(nlon,unitv,zz(1,1,nlevp1))- > | sddot(nlon,unitv,zz(1,2,nlevp1)))/ > | (8.*float(nlon)) > zz(1,nlatp1,nlevp1) = (9.* > | sddot(nlon,unitv,zz(1,nlat,nlevp1))- > | sddot(nlon,unitv,zz(1,nlat-1,nlevp1)))/ > | (8.*float(nlon)) 3193c3446,3450 < ! Values at longitudinal boundaries --- > ! Extend in longitude: > do i = 2,nlon > zz(i,0,nlevp1) = zz(1,0,nlevp1) > zz(i,nlatp1,nlevp1)= zz(1,nlatp1,nlevp1) > enddo ! i = 2,nlon 3195,3203c3452,3458 < nsrhs(1,j) = 1.0/(dlonm*cs(j))* < | 0.5*(rim(2,j,1)-rim(nmlon,j,1)) < nsrhs(1,jj) = 1.0/(dlonm*cs(jj))* < | 0.5*(rim(2,jj,1)-rim(nmlon,jj,1)) < nsrhs(nmlon,j) = 1.0/(dlonm*cs(j))* < | 0.5*(rim(1,j,1)-rim(nmlon-1,j,1)) < nsrhs(nmlon,jj) = 1.0/(dlonm*cs(jj))* < | 0.5*(rim(1,jj,1)-rim(nmlon-1,jj,1)) < enddo --- > ! Periodic points: > do j = 0,nlatp1 > do k = -2,nlev > zz(nlonp1,j,k) = zz(1,j,k) > enddo ! k = -2,nlev > zz(nlonp1,j,nlevp1)= zz(1,j,nlevp1) > enddo ! j = 0,nlatp1 3205c3460,3461 < ! Differentiate rim(2) w.r.t theta0 --- > ! Transform needed fields to geomagnetic coordinate system, one latitude > ! at a time. 3207,3215c3463,3464 < do j = 2,nmlath-1 ! 2,48 south pole -1 to equator-1 "negative sigh" < jj = j+nmlath-1 ! 50,96 equator+1 to north pole-1 < do i = 1,nmlon < nsrhs(i,j) = nsrhs(i,j) - 1.0/(dlatm*cs(j))*0.5* < | (rim(i,j+1,2)*cs(j+1)-rim(i,j-1,2)*cs(j-1)) < nsrhs(i,jj) = nsrhs(i,jj) + 1.0/(dlatm*cs(jj))*0.5* < | (rim(i,jj+1,2)*cs(jj+1)-rim(i,jj-1,2)*cs(jj-1)) < enddo < enddo --- > ! subroutine geo2mag(fmag,fgeo,long,latg,wght,nlonp1_geo,nlonp1_mag, > !| nlon_mag,nlat_mag,lat) 3217c3466,3481 < ! Calculate value at the poles by averaging over i:nmlon --- > ! Magnetic latitude loop: > maglat_loop: do j=2,nmlat-1 > do k=-2,nlevp1 > call geo2mag(zpotenm(1,k),zz(1,0,k),ig,jg,wt,nlonp1, > | nmlonp1,nmlon,nmlat,j) > enddo ! k=-2,nlevp1 > ! Without calculation of k_(q,lam) > do i=1,nmlon > do k=-2,nlev > if (zpotenm(i,k) < z0) zpotenm(i,k) = z0 > zpotenm3d(i,j,k) = zpotenm(i,k) > enddo ! k=-2,nlev > if (zpotenm(i,nlevp1) < z0) zpotenm(i,nlevp1) = z0 > zpotenm3d(i,j,nlevp1) = zpotenm(i,nlevp1) > enddo ! i=1,nmlon > enddo maglat_loop ! j=2,nmlat-1 Main magnetic latitude loop 3219,3222c3483,3491 < nsrhs(1,nmlat) = -2./float(nmlon)* < | sddot(nmlon,unitvm,rim(1,nmlat-1,2))/cs(nmlat-1) < nsrhs(1,1) = -2./float(nmlon)* < | sddot(nmlon,unitvm,rim(1,2,2))/cs(2) --- > ! Polar values for Z: > do k=-2,nlevp1 > zpotenm3d(1,1,k) = > | (4.*sddot(nmlon,unitvm,zpotenm3d(1,2,k))- > | sddot(nmlon,unitvm,zpotenm3d(1,3,k)))/(3.*float(nmlon)) > zpotenm3d(1,nmlat,k) = > | (4.*sddot(nmlon,unitvm,zpotenm3d(1,nmlat-1,k))- > | sddot(nmlon,unitvm,zpotenm3d(1,nmlat-2,k)))/ > | (3.*float(nmlon)) 3224c3493,3497 < ! Extend over longitude --- > ! Extend Z over longitude: > do i=1,nmlon > zpotenm3d(i,1,k) = zpotenm3d(1,1,k) > zpotenm3d(i,nmlat,k) = zpotenm3d(1,nmlat,k) > enddo ! i=1,nmlon 3226,3227c3499,3503 < nsrhs(:,nmlat) = nsrhs(1,nmlat) < nsrhs(:,1) = nsrhs(1,1) --- > ! Periodic points: > do j=1,nmlat > zpotenm3d(nmlonp1,j,k) = zpotenm3d(1,j,k) > enddo ! j=1,nmlat > enddo ! k=-2,nlevp1 3229c3505,3510 < ! Calculate equator values --- > ! Save 3d potential on magnetic grid to secondary history: > ! PLEASE DO NOT COMMENT THIS OUT -- ZMAG is a mandatory mag field for sech > do j=1,nmlat > call addfsech_ik('ZMAG','ZMAG','CM',zpotenm3d(:,j,:), > | 1,nmlonp1,nmlev,nmlev,j) > enddo ! j=1,nmlat 3231,3235c3512,3526 < je = nmlath < i = 1 < nsrhs(i,je) = 0.5/dlonm*(rim(i+1,je,1)-rim(nmlon,je,1)) < nsrhs(i,je) = nsrhs(i,je) + 1./dlatm*(cs(je)* < | rim(i,je,2)+ cs(je+1)*rim(i,je+1,2)) --- > end subroutine transf_dyn0 > !----------------------------------------------------------------------- > ! BOP > ! !IROUTINE: prep_dynamo_dyn0 > ! !INTERFACE: > subroutine prep_dynamo_dyn0(z,lev0,lev1,lon0,lon1,lat0,lat1) > ! > ! !USES: > use cons_module,only: gask,grav > ! > ! !DESCRIPTION: > ! am_11/03: if dynamo = 0 need zpoten3d for subroutine threed > ! Prepare geographic-grid fields for input to the dynamo, and gather them > ! to the root task. This is executed by all tasks, and is called from > ! advance before the dynamo itself (which is executed by master task only). 3237,3241c3528,3529 < do i = 2,nmlon-1 < nsrhs(i,je) = 0.5/dlonm*(rim(i+1,je,1)-rim(i-1,je,1)) < nsrhs(i,je) = nsrhs(i,je) + 1./dlatm*(cs(je)* < | rim(i,je,2)+ cs(je+1)*rim(i,je+1,2)) < enddo --- > ! !PARAMETERS: > integer :: lev0,lev1,lon0,lon1,lat0,lat1 3243,3246c3531,3539 < i = nmlon < nsrhs(i,je) = 0.5/dlonm*(rim(1,je,1)-rim(i-1,je,1)) < nsrhs(i,je) = nsrhs(i,je) + 1./dlatm*(cs(je)* < | rim(i,je,2)+ cs(je+1)*rim(i,je+1,2)) --- > ! Input fields at task subdomains. These are from current (not updated) > ! fields (itp): > real,dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2),intent(in):: > | z ! geopotential height > ! > ! !REVISION HISTORY: > ! 05.03.8 > ! > ! EOP 3248c3541,3543 < ! Periodic points --- > ! Local: > integer :: k,i,lat,nk,lonbeg,lonend > real :: fmin,fmax 3250c3545,3549 < nsrhs(nmlonp1,:) = nsrhs(1,:) --- > nk = lev1-lev0+1 > lonbeg = lon0 > if (lon0==1) lonbeg = 3 > lonend = lon1 > if (lon1==nlonp4) lonend = nlonp4-1 3252c3551,3556 < ! Scale rhs by refernce radius (R_E + H0) in meters dfac = r0*1e-2 --- > ! Define subdomain part of dynamo input fields (geographic): > ! Also transform from (k,i,lat) to (i,lat,k). The latter is used > ! in the dynamo code, whereas the former is used in the rest > ! of the model. > ! (In earlier versions, this was in lamdas, where 1-73 <= 3-75. > ! Here, 3-75 <= 3-75) 3254,3255c3558,3564 < dfac = r0*1.0e-2 < nsrhs(:,:) = -1.*nsrhs(:,:)/dfac --- > do lat=lat0,lat1 > do i=lonbeg,lonend > do k=lev0,lev1-1 > zpoten (i,lat,k) = z (k,i,lat) > enddo ! k=lev0,lev1 > zpoten(i,lat,lev1) = z(lev1,i,lat) > enddo ! i=lon0,lon1 3257c3566,3573 < end subroutine cism_ucurrent --- > enddo ! lat=lat0,lat1 > > #ifdef MPI > ! > ! Gather dynamo input fields to the root task, defining module data > ! above at the global domain on the root task: > ! > call mp_dynamo_gather 3258a3575 > end subroutine prep_dynamo_dyn0 ======================================================================== >>> WARNING: Cannot find source file /fis/hao/tgcm/tiegcm1.92/src/dyndiag.F ======================================================================== Diff of /fis/hao/tgcm/tiegcm1.92/src/elden.F and /ptmp/foster/ganglu_tiegcm_amie/modsrc2/elden.F 3c3 < | nplus,n2p,nop,o2p,electrons,lev0,lev1,lon0,lon1,lat) --- > | z,nplus,n2p,nop,o2p,electrons,lev0,lev1,lon0,lon1,lat) 5,8d4 < ! This software is part of the NCAR TIE-GCM. Use is governed by the < ! Open Source Academic Research License Agreement contained in the file < ! tiegcmlicense.txt. < ! 11a8 > use params_module,only: nlevp1 17c14 < use addfld_module,only: addfld --- > use dyndiag_module,only: tec_sec,tec 35c32,33 < | xiop2d ! from oplus --- > | xiop2d, ! from oplus > | z ! geopotenital height 46c44,45 < integer :: k,i,i0,i1 --- > integer :: k,i > integer ::i0,i1,nk,nkm1 ! for addfsech 53c52 < --- > ! 55d53 < i0 = lon0 ; i1 = lon1 57,78c55,60 < ! call addfld('TN_ELD' ,' ',' ',tn (:,i0:i1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('BAR_ELD',' ',' ',barm (:,i0:i1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('OP_ELD' ,' ',' ',op (:,i0:i1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('OP1_ELD',' ',' ',op_upd(:,i0:i1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('O2_ELD' ,' ',' ',o2 (:,i0:i1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('O1_ELD' ,' ',' ',o1 (:,i0:i1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('N2D_ELD',' ',' ',n2d (:,i0:i1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('NO_ELD' ,' ',' ',no (:,i0:i1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('N4S_ELD',' ',' ',n4s (:,i0:i1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('XIOP2P' ,' ',' ',xiop2p(:,i0:i1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('XIOP2D' ,' ',' ',xiop2d(:,i0:i1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! Convenience ints for addfsech calls: > i0 = lon0 > i1 = lon1 > nk = lev1-lev0+1 > nkm1 = nk-1 > 79a62,74 > ! Bad OP1_ELD > ! call addfsech('TN_ELD' ,' ',' ',tn (:,i0:i1),i0,i1,nk,nkm1,lat) > ! call addfsech('BAR_ELD',' ',' ',barm (:,i0:i1),i0,i1,nk,nkm1,lat) > ! call addfsech('OP_ELD' ,' ',' ',op (:,i0:i1),i0,i1,nk,nkm1,lat) > ! call addfsech('OP1_ELD',' ',' ',op_upd(:,i0:i1),i0,i1,nk,nkm1,lat) > ! call addfsech('O2_ELD' ,' ',' ',o2 (:,i0:i1),i0,i1,nk,nkm1,lat) > ! call addfsech('O1_ELD' ,' ',' ',o1 (:,i0:i1),i0,i1,nk,nkm1,lat) > ! call addfsech('N2D_ELD',' ',' ',n2d (:,i0:i1),i0,i1,nk,nkm1,lat) > ! call addfsech('NO_ELD' ,' ',' ',no (:,i0:i1),i0,i1,nk,nkm1,lat) > ! call addfsech('N4S_ELD',' ',' ',n4s (:,i0:i1),i0,i1,nk,nkm1,lat) > ! call addfsech('XIOP2P' ,' ',' ',xiop2p(:,i0:i1),i0,i1,nk,nkm1,lat) > ! call addfsech('XIOP2D' ,' ',' ',xiop2d(:,i0:i1),i0,i1,nk,nkm1,lat) > ! 164,184c159,172 < ! call addfld('XNMBARM' ,' ',' ',xnmbarm, < ! | 'lev',lev0,lev1,'lon',i0,i1,lat) < ! call addfld('NPLUS' ,' ',' ',nplus(:,i0:i1), < ! | 'lev',lev0,lev1,'lon',i0,i1,lat) < ! call addfld('A_COEF' ,' ',' ',a,'lev',lev0,lev1,'lon',i0,i1,lat) < ! call addfld('B_COEF' ,' ',' ',b,'lev',lev0,lev1,'lon',i0,i1,lat) < ! call addfld('C_COEF' ,' ',' ',c,'lev',lev0,lev1,'lon',i0,i1,lat) < ! call addfld('D_COEF' ,' ',' ',d,'lev',lev0,lev1,'lon',i0,i1,lat) < ! call addfld('E_COEF' ,' ',' ',e,'lev',lev0,lev1,'lon',i0,i1,lat) < ! call addfld('FG_COEF' ,' ',' ',fg,'lev',lev0,lev1,'lon',i0,i1,lat) < ! call addfld('H_COEF' ,' ',' ',h,'lev',lev0,lev1,'lon',i0,i1,lat) < ! call addfld('A0' ,' ',' ',a0(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',i0,i1,lat) < ! call addfld('A1' ,' ',' ',a1(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',i0,i1,lat) < ! call addfld('A2' ,' ',' ',a2(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',i0,i1,lat) < ! call addfld('A3' ,' ',' ',a3(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',i0,i1,lat) < ! call addfld('A4' ,' ',' ',a4(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',i0,i1,lat) --- > ! call addfsech('XNMBARM' ,' ',' ',xnmbarm,i0,i1,nk,nkm1,lat) > ! call addfsech('NPLUS' ,' ',' ',nplus(:,i0:i1),i0,i1,nk,nkm1,lat) > ! call addfsech('A_COEF' ,' ',' ',a ,i0,i1,nk,nkm1,lat) > ! call addfsech('B_COEF' ,' ',' ',b ,i0,i1,nk,nkm1,lat) > ! call addfsech('C_COEF' ,' ',' ',c ,i0,i1,nk,nkm1,lat) > ! call addfsech('D_COEF' ,' ',' ',d ,i0,i1,nk,nkm1,lat) > ! call addfsech('E_COEF' ,' ',' ',e ,i0,i1,nk,nkm1,lat) > ! call addfsech('FG_COEF' ,' ',' ',fg ,i0,i1,nk,nkm1,lat) > ! call addfsech('H_COEF' ,' ',' ',h ,i0,i1,nk,nkm1,lat) > call addfsech('A0' ,' ',' ',a0 ,i0,i1,nk,nkm1,lat) > call addfsech('A1' ,' ',' ',a1 ,i0,i1,nk,nkm1,lat) > call addfsech('A2' ,' ',' ',a2 ,i0,i1,nk,nkm1,lat) > call addfsech('A3' ,' ',' ',a3 ,i0,i1,nk,nkm1,lat) > call addfsech('A4' ,' ',' ',a4 ,i0,i1,nk,nkm1,lat) 190c178 < ! call addfld('ROOT',' ',' ',root,'lev',lev0,lev1,'lon',i0,i1,lat) --- > call addfsech('ROOT',' ',' ',root,i0,i1,nk,nkm1,lat) 192,194d179 < ! 1/24/08 btf, maute: Minimum Ne is replaced by new values for flux < ! parameter al in qinite.F < ! 197,201c182,188 < ! do i=lon0,lon1 < ! do k=lev0,lev1-1 < ! if (root(k,i) < 3.1e3) root(k,i) = 3.1e3 < ! enddo < ! enddo --- > do i=lon0,lon1 > do k=lev0,lev1-1 > if (root(k,i) < 3.1e3) root(k,i) = 3.1e3 > ! if (root(k,i) < 1.0e3) root(k,i) = 1.0e3 > enddo > enddo > call addfsech('ROOT2',' ',' ',root,i0,i1,nk,nkm1,lat) 207,209c194 < if (root(k,i) < 1.) root(k,i) = 1.0 ! insure positive Ne from solver < ! in case there is a problem < n2p(k,i) = d(k,i)/(e(k,i)+ra3(k,i,lat)*root(k,i)) --- > n2p(k,i) = d(k,i)/(e(k,i)+ra3(k,i,lat)*root(k,i)) 222,229c207,212 < ! call addfld('NPLUSb' ,' ',' ',nplus(:,i0:i1), < ! | 'lev',lev0,lev1,'lon',i0,i1,lat) < ! call addfld('N2P_ELD',' ',' ',n2p (:,i0:i1), < ! | 'lev',lev0,lev1,'lon',i0,i1,lat) < ! call addfld('O2P_ELD',' ',' ',o2p (:,i0:i1), < ! | 'lev',lev0,lev1,'lon',i0,i1,lat) < ! call addfld('NOP_ELD',' ',' ',nop (:,i0:i1), < ! | 'lev',lev0,lev1,'lon',i0,i1,lat) --- > ! Small diffs in O2P reported as "global diffs" in tgcmproc, but > ! not seen in any plots. > ! call addfsech('NPLUSb' ,' ',' ',nplus(:,i0:i1),i0,i1,nk,nkm1,lat) > call addfsech('N2P',' ',' ',n2p (:,i0:i1),i0,i1,nk,nkm1,lat) > ! call addfsech('O2P_ELD',' ',' ',o2p (:,i0:i1),i0,i1,nk,nkm1,lat) > ! call addfsech('NOP_ELD',' ',' ',nop (:,i0:i1),i0,i1,nk,nkm1,lat) 240a224,233 > ! > C Get ht integral of electron density and save in tec of /sight/ > tec(:,lat) = 0. > do i=lon0,lon1 > do k=lev0,lev1-1 > tec_sec(i,lat,k) = electrons(k,i) > tec(i,lat) = tec(i,lat) +(z(k+1,i)-z(k,i))*electrons(k,i) > enddo > tec_sec(i,lat,nlevp1) = tec(i,lat) > enddo 242,243c235,236 < ! call addfld('NE_ELDEN',' ',' ',electrons(:,i0:i1), < ! | 'lev',lev0,lev1,'lon',i0,i1,lat) --- > call addfsech('NE_ELDEN',' ',' ',electrons(:,i0:i1), > | i0,i1,nk,nk,lat) 248d240 < use addfld_module,only: addfld 265c257 < integer :: k,i,nlevs,i0,i1 --- > integer :: k,i,nlevs 270d261 < i0 = lon0 ; i1 = lon1 320,323c311,314 < ! call addfld('W1' ,' ',' ',w1,'lev',lev0,lev1,'lon',i0,i1,lat) < ! call addfld('W2' ,' ',' ',w2,'lev',lev0,lev1,'lon',i0,i1,lat) < ! call addfld('W3' ,' ',' ',w3,'lev',lev0,lev1,'lon',i0,i1,lat) < ! call addfld('VQROOT',' ',' ',root,'lev',lev0,lev1,'lon',i0,i1,lat) --- > ! call addfsech('W1' ,' ',' ',w1,lon0,lon1,nlevs,nlevs-1,lat) > ! call addfsech('W2' ,' ',' ',w2,lon0,lon1,nlevs,nlevs-1,lat) > ! call addfsech('W3' ,' ',' ',w3,lon0,lon1,nlevs,nlevs-1,lat) > ! call addfsech('VQROOT',' ',' ',root,lon0,lon1,nlevs,nlevs-1,lat) ======================================================================== >>> WARNING: Cannot find source file /fis/hao/tgcm/tiegcm1.92/src/extraoutput.F ======================================================================== Diff of /fis/hao/tgcm/tiegcm1.92/src/heelis.F and /ptmp/foster/ganglu_tiegcm_amie/modsrc2/heelis.F 4,7d3 < ! This software is part of the NCAR TIE-GCM. Use is governed by the < ! Open Source Academic Research License Agreement contained in the file < ! tiegcmlicense.txt. < ! 11c7,8 < use dynamo_module,only: nmlat0,pfrac,phihm --- > use params_module,only: nmlat,nmlonp1,nmlon,nmlonp1 > use dynamo_module,only: nmlat0,pfrac,phihm,colatc 45d41 < use params_module,only: nmlonp1 52a49,54 > ! Args: > ! integer,intent(in) :: nmlat0,nmlonp1 > ! real,intent(out) :: pfrac(nmlonp1,nmlat0) > > ! real,dimension(nmlonp1,nmlat0) :: colatc > ! 56d57 < real,dimension(nmlonp1,nmlat0) :: colatc 100d100 < use params_module,only: nmlat,nmlon,nmlonp1 ======================================================================== Diff of /fis/hao/tgcm/tiegcm1.92/src/init.F and /ptmp/foster/ganglu_tiegcm_amie/modsrc2/init.F 3,7d2 < ! < ! This software is part of the NCAR TIE-GCM. Use is governed by the < ! Open Source Academic Research License Agreement contained in the file < ! tiegcmlicense.txt. < ! 9,10c4 < | glon1,dlon,glat1,dlat,nlev,zmbot,dlev,zibot,zmbot, < | nmlev,nmlevp1,nimlev,nimlevp1 --- > | nmlev,glon1,dlon,glat1,dlat,nlev,plev1,dlev 15,18c9,10 < real :: glon(nlon),glat(nlat),zpmid(nlevp1),zpint(nlevp1) < real :: gmlon(nmlonp1),gmlat(nmlat), < | zpmag_mid(nmlevp1),zpmag_int(nimlevp1) < ! | zpmag_mid(nmlev),zpmag_int(nimlev) --- > real :: glon(nlon),glat(nlat),plev(nlevp1) > real :: gmlon(nmlonp1),gmlat(nmlat),pmlev(nmlev) 40,43c32,39 < integer :: igswm_mi_di ! 0/1 flag for GSWM data diurnal tide < integer :: igswm_mi_sdi ! 0/1 flag for GSWM data semidiurnal tide < integer :: igswm_nm_di ! 0/1 flag for GSWM data nonmigrating diurnal tide < integer :: igswm_nm_sdi ! 0/1 flag for GSWM data nonmigrating semidiurnal tide --- > ! getgpi flag must go here rather than in gpi_mod to avoid circular > ! module dependency with nchist_mod and init_mod. > ! > integer :: igetgpi ! 0/1 flag for GPI data (see gpi_ncfile > integer :: igetgswmdi ! 0/1 flag for GSWM data diurnal tide > integer :: igetgswmsdi ! 0/1 flag for GSWM data semidiurnal tide > integer :: igetgswmnmdi ! 0/1 flag for GSWM data nonmigrating diurnal tide > integer :: igetgswmnmsdi ! 0/1 flag for GSWM data nonmigrating semidiurnal tide 74,80c70,76 < use input_module,only: start,step,secflds, < | start_year,start_day,calendar_advance,gpi_ncfile, < | gswm_mi_di_ncfile, < | gswm_mi_sdi_ncfile,gswm_nm_di_ncfile,gswm_nm_sdi_ncfile, < | mxhist_prim,mxhist_sech,output,secout,mkhvols,source_start, < | see_ncfile < use hist_module,only: hist_init,isechist,nstep,nhist_total, --- > use input_module,only: start,step,secflds,secfmag,secfmagphr, > | start_year,start_day,calendar_advance,gpi_ncfile,gswm_di_ncfile, > | gswm_sdi_ncfile,gswm_nmdi_ncfile,gswm_nmsdi_ncfile, > | mxhist_prim,mxhist_sech,output,secout,mkhvols,nmc,source_start, > | sd_ncfile > use hist_module,only: hist_init,isechist,nfsech_geo,nfsech_mag, > | nfsech_geo2d,nfsech_mag2d,nfsech_magphr,nstep,nhist_total, 82,84c78,80 < | nfiles_sech,nfsech < use fields_module,only: init_4d,init_3d,init_lbc,init_fsech, < | fsechist --- > | nfiles_sech > use fields_module,only: set_fsech,init_4d,init_3d, > | fsech,fsechmag,fsech2d,fsechmag2d,fsechmagphr2d 157,160c153,158 < ! GSWM integer flags. 11/2/05 btf: these have been taken off < ! the histories (replaced by the 4 file names, see input.F < ! and nchist.F) < ! --- > ! Set GPI flag: > igetgpi = 0 > if (len_trim(gpi_ncfile) > 0) igetgpi = 1 > if (igetgpi > 0) > | write(6,"(' gpi_ncfile = ',a)") trim(gpi_ncfile) > ! 162,165c160,163 < igswm_mi_di = 0 < if (len_trim(gswm_mi_di_ncfile) > 0) igswm_mi_di = 1 < if (igswm_mi_di > 0) < | write(6,"(' gswm_mi_di_ncfile = ',a)") trim(gswm_mi_di_ncfile) --- > igetgswmdi = 0 > if (len_trim(gswm_di_ncfile) > 0) igetgswmdi = 1 > if (igetgswmdi > 0) > | write(6,"(' gswm_di_ncfile = ',a)") trim(gswm_di_ncfile) 167,170c165,168 < igswm_mi_sdi = 0 < if (len_trim(gswm_mi_sdi_ncfile) > 0) igswm_mi_sdi = 1 < if (igswm_mi_sdi > 0) < | write(6,"(' gswm_mi_sdi_ncfile = ',a)")trim(gswm_mi_sdi_ncfile) --- > igetgswmsdi = 0 > if (len_trim(gswm_sdi_ncfile) > 0) igetgswmsdi = 1 > if (igetgswmsdi > 0) > | write(6,"(' gswm_sdi_ncfile = ',a)") trim(gswm_sdi_ncfile) 172,175c170,173 < igswm_nm_di = 0 < if (len_trim(gswm_nm_di_ncfile) > 0) igswm_nm_di = 1 < if (igswm_nm_di > 0) < | write(6,"(' gswm_nm_di_ncfile = ',a)") trim(gswm_nm_di_ncfile) --- > igetgswmnmdi = 0 > if (len_trim(gswm_nmdi_ncfile) > 0) igetgswmnmdi = 1 > if (igetgswmnmdi > 0) > | write(6,"(' gswm_nmdi_ncfile = ',a)") trim(gswm_nmdi_ncfile) 177,181c175,179 < igswm_nm_sdi = 0 < if (len_trim(gswm_nm_sdi_ncfile) > 0) igswm_nm_sdi = 1 < if (igswm_nm_sdi > 0) < | write(6,"(' gswm_nm_sdi_ncfile = ',a)") < | trim(gswm_nm_sdi_ncfile) --- > igetgswmnmsdi = 0 > if (len_trim(gswm_nmsdi_ncfile) > 0) igetgswmnmsdi = 1 > if (igetgswmnmsdi > 0) > | write(6,"(' gswm_nmsdi_ncfile = ',a)") > | trim(gswm_nmsdi_ncfile) 185,186c183,185 < if (igswm_mi_di>0 .or. igswm_mi_sdi>0 .or. < | igswm_nm_di>0 .or. igswm_nm_sdi>0) igetgswm = 1 --- > if (igetgswmdi>0 .or. igetgswmsdi>0 .or. > | igetgswmnmdi>0 .or. igetgswmnmsdi>0) igetgswm = 1 > 195c194 < ! Initialize amie, and get amie file if necessary: --- > ! Read amie data files if necessary: 196a196,207 > ! if (len_trim(aurora_proton) > 0) then > ! write(6,"('Reading AURORA PROTON file ',a)") trim(aurora_proton) > ! call rdproton > ! endif > ! if (len_trim(amienh) > 0) then > ! write(6,"('Reading AMIENH file ',a)") trim(amienh) > ! call rdamie_nh > ! endif > ! if (len_trim(amiesh) > 0) then > ! write(6,"('Reading AMIESH file ',a)") trim(amiesh) > ! call rdamie_sh > ! endif 199c210 < if (len_trim(see_ncfile) > 0) then --- > if (len_trim(sd_ncfile) > 0) then 220c231,233 < if (isechist > 0) call init_fsech ! fields.F --- > if (isechist > 0) then > call set_fsech > endif 222,224d234 < ! Allocate lbc for t,u,v: < call init_lbc(lon0,lon1,lat0,lat1) < ! 237,239c247,248 < do i=1,nlevp1 < zpmid(i) = zmbot+(i-1)*dlev ! midpoint levels < zpint(i) = zibot+(i-1)*dlev ! interface levels --- > do i=1,nlev > plev(i) = plev1+(i-1)*dlev 242,251d250 < ! Define magnetic zp grid: < ! For 97 km boundary, zpmag starts 3 zp levels below geographic fields < ! (at dzp=0.5, this is -8.5 instead of -7.0) < ! zpmag_mid(nmlevp1), zpmag_int(nimlevp1) < ! do i=1,nmlev < do i=1,nmlevp1 < zpmag_mid(i) = zmbot-(3.*dlev)+(i-1)*dlev ! midpoint levels < zpmag_int(i) = zpmag_mid(i)-0.5*dlev < enddo < ! 262c261,264 < write(6,"(' igswm_mi_di = ',i6,4x, --- > write(6,"(' igetgpi = ',i6,4x, > | '(If > 0, geophysical indices database will be used.)')") > | igetgpi > write(6,"(' igetgswmdi = ',i6,4x, 264,265c266,267 < | igswm_mi_di < write(6,"(' igswm_mi_sdi= ',i6,4x, --- > | igetgswmdi > write(6,"(' igetgswmsdi= ',i6,4x, 267,268c269,270 < | igswm_mi_sdi < write(6,"(' igswm_nm_di= ',i6,4x, --- > | igetgswmsdi > write(6,"(' igetgswmnmdi= ',i6,4x, 270,271c272,273 < | ' be used.)')") igswm_nm_di < write(6,"(' igswm_nm_sdi= ',i6,4x, --- > | ' be used.)')") igetgswmnmdi > write(6,"(' igetgswmnmsdi= ',i6,4x, 273,281c275 < | ' be used.)')") igswm_nm_sdi < write(6,"(' nlev = ',i6,4x, < | '(Number of levels (midpoints and interfaces))')") nlev < write(6,"(/,' zpmid (midpoint levels) = ',/,(10f7.3))") zpmid < write(6,"(/,' zpint (interface levels) = ',/,(10f7.3))") zpint < write(6,"(/,' nmlevp1=',i4,' zpmag_mid (mag midpoint levels) = ' < | ,/,(10f7.3))") nmlevp1,zpmag_mid < write(6,"(/,' nmlevp1=',i4,' zpmag_int (mag interface levels) = ' < | ,/,(10f7.3))") nmlevp1,zpmag_int --- > | ' be used.)')") igetgswmnmsdi 282a277,284 > ! ncep/nmc are in time-gcm only: > ! write(6,"(' ncep = ',i6,4x, > ! | '(If > 0, use NCEP Z and TN 10 mb lower boundaries.')") > ! | ncep > ! write(6,"(' nmc = ',i6,4x, > ! | '(If > 0, use NMC Z and TN 10 mb lower boundaries.')") > ! | nmc > ! 319,323c321,370 < write(6,"(' nfsech = ',i5,2x, < | '(Number of requested secondary history fields)')") nfsech < do i=1,nfsech < write(6,"(' secondary history field ',i3,': ',a)") < | i,fsechist(i)%short_name --- > write(6,"(' nfsech_geo = ',i5,2x, > | '(Number of secondary history fields on geographic grid)')") > | nfsech_geo > write(6,"(' nfsech_mag = ',i5,2x, > | '(Number of secondary history fields on magnetic grid)')") > | nfsech_mag > write(6,"(' nfsech_geo2d = ',i5,2x, > | '(Number of secondary history fields on geographic ', > | '2d grid)')")nfsech_geo2d > write(6,"(' nfsech_mag2d = ',i5,2x, > | '(Number of secondary history fields on magnetic 2d grid)')") > | nfsech_mag2d > write(6,"(' nfsech_magphr = ',i5,2x, > | '(Number of secondary history fields on magnetoshere grid)')") > | nfsech_magphr > ! > ! Report secondary history fields: > write(6,"(/,'Secondary history fields on geographic grid ', > | ' (number of fields =',i3,'):')") nfsech_geo > do i=1,nfsech_geo > if (len_trim(fsech(i)%long_name)>0) then > write(6,"(' Field ',a,' (',a,')')") > | fsech(i)%short_name(1:8),trim(fsech(i)%long_name) > else > write(6,"(' Field ',a)") fsech(i)%short_name(1:8) > endif > enddo > write(6,"(/,'Secondary history fields on magnetic ', > | 'grid (number of fields =',i3,'):')") nfsech_mag > do i=1,nfsech_mag > write(6,"(' Mag field ',a,' (diagnostic)')") > | fsechmag(i)%short_name > enddo > write(6,"(/,'Secondary history fields on geographic 2d grid ', > | ' (number of fields =',i3,'):')") nfsech_geo2d > do i=1,nfsech_geo2d > write(6,"(' Field ',a,' (diagnostic)')") > | fsech2d(i)%short_name > enddo > write(6,"(/,'Secondary history fields on magnetic ', > | '2d grid (number of fields =',i3,'):')") nfsech_mag2d > do i=1,nfsech_mag2d > write(6,"(' Mag 2d field ',a,' (diagnostic)')") > | fsechmag2d(i)%short_name > enddo > write(6,"(/,'Secondary history fields on magnetospheric ', > | '2d grid (number of fields =',i3,'):')") nfsech_magphr > do i=1,nfsech_magphr > write(6,"(' Magphr field ',a,' (diagnostic)')") > | fsechmagphr2d(i)%short_name ======================================================================== Diff of /fis/hao/tgcm/tiegcm1.92/src/inp_read.F and /ptmp/foster/ganglu_tiegcm_amie/modsrc2/inp_read.F 4,7d3 < ! This software is part of the NCAR TIE-GCM. Use is governed by the < ! Open Source Academic Research License Agreement contained in the file < ! tiegcmlicense.txt. < ! ======================================================================== Diff of /fis/hao/tgcm/tiegcm1.92/src/input.F and /ptmp/foster/ganglu_tiegcm_amie/modsrc2/input.F 3,7d2 < ! < ! This software is part of the NCAR TIE-GCM. Use is governed by the < ! Open Source Academic Research License Agreement contained in the file < ! tiegcmlicense.txt. < ! 19a15,21 > ! The model may reference either the module variables or the input_type > ! structure inp (e.g., inp%label, inp%f107, etc). Both methods > ! use "use input_module" statements, e.g.: > ! use input_module ! include entire module > ! use input_module,only: f107,f107a ! include only solar fluxes > ! use input_module,only: inp ! include input_type structure > ! 28,29c30,32 < ! 5. Add to stdout print in inp_print < ! 6. Validate values read in appropriate routine (e.g., inp_hist, etc) --- > ! 5. Define tgcm_type components in inp_deftyp (from module variables) > ! 6. Add to stdout print in inp_print > ! 7. Validate values read in appropriate routine (e.g., inp_hist, etc) 40c43,45 < | amievol ! file or mss path of amie data file (optional) --- > | amiesh, ! file or mss path of amie SH data file (optional) > | amienh, ! file or mss path of amie NH data file (optional) > | seeflux ! file or mss path of SEE photon data file (optional) 54a60 > | iuivi, ! ion drifts in momentum flag (replaced by dynamo flag) 56c62,63 < | tideann, ! 0/1 flag for annual tide (deprecated as of May 2008) --- > | nmc, ! flag to use NMC boundary conditions 0/1 > | tideann, ! 0/1 flag for annual tide 57a65,68 > | iamie, ! 0/1 flag for AMIE data (not in namelist read) > | amie_ibkg, ! 0/1/2 flag for read real, 1st, or 24-hr averaged data > | iseeflux, > | magphr, ! 0/1 flag for magnetosphere 60a72,73 > | mag(2,2), ! lat,lon of south,north magnetic poles > ! (this is vestigal -- can be removed) 66,69d78 < | colfac ! collision factor < ! < ! Input parameters that can be either constant or time-dependent: < real :: 72c81,82 < | bximf, ! BX component of IMF --- > | power_time(4,mxind_time), ! time-dependent hemispheric power input > | ctpoten_time(4,mxind_time), ! time-dependent cross tail potential input 74c84 < | bzimf, ! BZ component of IMF in nT --- > | bzimf, ! Bz component of IMF in nT 77,103c87,91 < | al ! AL lower magnetic auroral activity index in nT < real,dimension(4,mxind_time) :: power_time,ctpoten_time, < | bximf_time,byimf_time,bzimf_time,swvel_time,swden_time,al_time < integer :: < | ntimes_ctpoten,ntimes_power,ntimes_bximf,ntimes_byimf, < | ntimes_bzimf,ntimes_swden,ntimes_swvel,ntimes_al < logical :: aluse ! logical to use AL in Weimer 2001 model or not < ! < ! Parameters as read from namelist: < real :: rd_power,rd_ctpoten,rd_f107,rd_f107a,rd_bximf,rd_byimf, < | rd_bzimf,rd_swvel,rd_swden < ! < ! If indices_interp==1, time-dependent indices (power_time, ctpoten_time, etc) < ! will be interpolated to model time, otherwise they will change only < ! when the given values change. This has no effect on indices given as constants. < ! < integer :: indices_interp=1 < ! < ! Import data file names: < integer,parameter :: mxlen_filename=80 < character(len=mxlen_filename) :: < ! < ! 4/2/08 btf: Introducing Weimer 2005 model (wei05sc.F). < ! Retain ability to call either the 2001 or 2005 weimer models < ! for now, to facilitate comparison runs, so potential_model < ! can be either WEIMER01 or WEIMER05. < ! --- > | AL, ! AL lower magnetic auroral activity index in nT > ! if present, ALUSE=true; if absent, AL=-20, ALUSE=false > | colfac ! collision factor > logical :: aluse ! logical to use AL in Weimer model or not > character(len=80) :: 107,121c95,101 < | weimer_ncfile, ! path to netcdf weimer01 coefficients file < | wei05sc_ncfile, ! path to netcdf data files for weimer05 model < | gpi_ncfile, ! mss path or file path to netcdf gpi data file < | ncep_ncfile, ! ncep data file (time-gcm only) < | see_ncfile, ! mss path or file path to netcdf SEE flux data file < | imf_ncfile, ! mss path or disk file path to netcdf IMF data file < | gswm_mi_di_ncfile, ! gswm migrating diurnal data file < | gswm_mi_sdi_ncfile, ! gswm migrating semi-diurnal data file < | gswm_nm_di_ncfile, ! gswm non-migrating diurnal data file < | gswm_nm_sdi_ncfile ! gswm non-migrating semi-diurnal data file < < ! integer,parameter :: ngpivars = 4 < ! real :: gpi_vars(ngpivars) ! f107,f107a,power,ctpoten < ! character(len=16) :: < ! | gpi_names(ngpivars) ! names of gpi_vars --- > | weimer_ncfile, ! mss path or file path to netcdf weimer coef file > ! see comments in weimer_mod.f > | weimer_ncfiledef, ! default path to weimer coef data file > ! hrindices_ncfile NOT MADE YET! 11/15/02: > | hrindices_ncfile, ! mss path or file path to netcdf hourly geophysical > ! data indices file. see comments in hrindices_mod.f > | hrindices_ncfiledef, ! default path to hrly indices data file 122a103,119 > | gpi_ncfile, ! mss path or file path to netcdf gpi data file > | sd_ncfile, ! mss path or file path to netcdf SEE flux data file > | gswm_di_ncfile, ! gswm migrating diurnal data file > | gswm_sdi_ncfile, ! gswm migrating semi-diurnal data file > | gswm_nmdi_ncfile, ! gswm non-migrating diurnal data file > | gswm_nmsdi_ncfile, ! gswm non-migrating semi-diurnal data file > ! > ! Non-input gpi variables: > | gpi_ncfiledef ! default path to gpi data file > integer,parameter :: ngpivars = 4 > real :: gpi_vars(ngpivars) ! f107,f107a,power,ctpoten > character(len=16) :: > | gpi_names(ngpivars) ! names of gpi_vars > integer :: > | ntimes_ctpoten, ! number of times provided in ctpoten_time > | ntimes_power ! number of times provided in power_time > ! 142c139,143 < | secflds(mxfsech) ! secondary history output fields --- > | secflds(mxfsech), ! secondary history output fields > | secfmag(mxfsech), ! secondary output fields on magnetic grid > | secfgeo2d(mxfsech), ! secondary output fields on geographic 2d grid > | secfmag2d(mxfsech), ! secondary output fields on magnetic 2d grid > | secfmagphr(mxfsech) ! secondary output fields on magnetospheric 2d grid 149a151,202 > ! Define input structure type: > ! (Use same names as variables above) > ! > ! Model-wide input: > type input_type > character(len=80) :: > | label, tempdir, magvol, amiesh,amienh, gpi_ncfile, > | gswm_di_ncfile, gswm_sdi_ncfile, gswm_nmdi_ncfile, > | gswm_nmsdi_ncfile, potential_model, weimer_ncfile, > | hrindices_ncfile,seeflux > integer :: > | step,start_day,start_year,calendar_advance, > | dispose, difhor, iuivi, dynamo, nmc, tideann, aurora, magphr, > | ntask_lat,ntask_lon, iamie,amie_ibkg > real :: > | mag(2,2), tide(10),tide2(2),tide3m3(2), > | f107,f107a, power,ctpoten,byimf,colfac,bzimf,swvel,swden,al, > | power_time(4,mxind_time),ctpoten_time(4,mxind_time) > ! > ! Primary histories: > character(len=80) :: > | source, > | output(mxhvols) > integer :: > | source_start(3), > | start(3,mxseries), > | stop(3,mxseries), > | hist(3,mxseries), > | save(3,mxseries), > | mxhist_prim, > | msreten > ! > ! Secondary histories: > character(len=80) :: secsource ! (for mhd model) > character(len=80) :: secout(mxhvols) > character(len=16) :: secflds(mxfsech) > character(len=16) :: secfmag(mxfsech) > character(len=16) :: secfgeo2d(mxfsech) > character(len=16) :: secfmag2d(mxfsech) > character(len=16) :: secfmagphr(mxfsech) > integer :: > | secstart(3,mxseries), > | secstop(3,mxseries), > | sechist(3,mxseries), > | secsave(3,mxseries), > | mxhist_sech > end type input_type > ! > ! inp is module variable of type input_type: > ! (is defined from namelist input vars) > type(input_type) :: inp > ! 152c205 < | label,tempdir,magvol,amievol,date,calday,step,dispose, --- > | label,tempdir,magvol,date,calday,step,dispose, 155,162c208,215 < | potential_model,difhor,dynamo,tide,tide2,tide3m3, < | f107,f107a,power,ctpoten,bximf,byimf,bzimf,swvel,swden,al, < | colfac,tideann,aurora,gpi_ncfile,gswm_mi_di_ncfile, < | gswm_mi_sdi_ncfile,gswm_nm_di_ncfile,gswm_nm_sdi_ncfile, < | mxhist_prim,mxhist_sech,msreten,ntask_lat,ntask_lon, < | start_day,start_year,calendar_advance,see_ncfile, < | ctpoten_time,power_time,bximf_time,byimf_time,bzimf_time, < | swden_time,swvel_time,al_time,indices_interp,imf_ncfile --- > | secfmag,secfgeo2d,secfmag2d,secfmagphr,potential_model, > | mag,difhor,iuivi,dynamo,nmc,tide,tide2,tide3m3,f107,f107a, > | power,ctpoten,byimf,bzimf,swvel,swden,al,colfac,tideann,aurora, > | magphr,gpi_ncfile,gswm_di_ncfile,gswm_sdi_ncfile, > | gswm_nmdi_ncfile,gswm_nmsdi_ncfile,mxhist_prim,mxhist_sech, > | msreten,ntask_lat,ntask_lon,start_day,start_year, > | calendar_advance,sd_ncfile,ctpoten_time,power_time, > | amiesh,amienh,amie_ibkg,seeflux 165c218 < character(len=16) :: secflds_mandatory(6) = --- > character(len=16) :: secflds_mandatory(4) = 169,171c222,224 < | 'Z ', < | 'ZG ', ! see sub calczg in addiag.F < | 'ZMAG '/) ! see sub transf in dynamo.F --- > | 'Z '/) > character(len=16) :: secfmag_mandatory(1) = > | (/'ZMAG '/) 172a226 > ! 198a253,255 > ! Define type(input_typ) inp from validated inputs: > call inp_deftyp > ! 211c268,270 < amievol = ' ' --- > amiesh = ' ' > amienh = ' ' > seeflux = ' ' 213,215c272,279 < gpi_ncfile = ' ' ! user input gpi file path < ncep_ncfile = ' ' ! (time-gcm only) < see_ncfile = ' ' ! solar flux data (see module in soldata.F) --- > gpi_ncfile = ' ' ! user input gpi file path > gpi_ncfiledef = ' ' ! default gpi file path > ! write(gpi_ncfiledef,"('/TGCM/data/gpi_1979-2000.nc')") > ! write(gpi_ncfiledef,"('/TGCM/data/gpi_1979001-2001031.nc')") > ! write(gpi_ncfiledef,"('/TGCM/data/gpi_1979001-2002181.nc')") > write(gpi_ncfiledef,"('/TGCM/data/gpi_1979001-2002365.nc')") > gpi_vars(:) = spval > sd_ncfile = ' ' ! solar flux data (see module in soldata.F) 217,219c281,283 < imf_ncfile = ' ' ! user input imf data file, used to drive weimer < write(weimer_ncfile ,"('$TGCMDATA/weimer2001_coeffs.nc')") < write(wei05sc_ncfile,"('$TGCMDATA/wei05sc.nc')") --- > weimer_ncfile = ' ' ! user input weimer coef file path > weimer_ncfiledef = ' ' ! default weimer coef file path > write(weimer_ncfiledef,"('/TGCM/data/weimer2001_coeffs.nc')") 221,224c285,294 < gswm_mi_di_ncfile = ' ' ! diurnal tide: user input gswm file path < gswm_mi_sdi_ncfile= ' ' ! semidiurnal tide: user input gswm file path < gswm_nm_di_ncfile= ' ' ! nonmigrating diurnal tide: user input gswm file path < gswm_nm_sdi_ncfile= ' ' ! nonmigrating semidiurnal tide: user input gswm file path ! --- > hrindices_ncfile = ' ' ! user input hrly indices data file path > hrindices_ncfiledef = ' ' ! default hrly indices data file path > ! write(hrindices_ncfiledef, > ! | "('/TGCM/data/hrindices_1988001-2002181.nc')") > ! > gswm_di_ncfile = ' ' ! diurnal tide: user input gswm file path > gswm_sdi_ncfile= ' ' ! semidiurnal tide: user input gswm file path > gswm_nmdi_ncfile= ' ' ! nonmigrating diurnal tide: user input gswm file path > gswm_nmsdi_ncfile= ' ' ! nonmigrating semidiurnal tide: user input gswm file path > ! 233a304 > mag(:,:)= spval 234a306 > iuivi = ispval 235a308 > nmc = 0 ! default is no nmc boundaries 240a314,317 > iseeflux = 0 ! will be set 1 if amienh or amiesh files are given > iamie = 0 ! will be set 1 if amienh or amiesh files are given > amie_ibkg = 0 ! default is read in real time amie data > magphr = ispval 243,244d319 < colfac = spval < 249c324,325 < bximf = spval --- > power_time(:,:) = spval > ctpoten_time(:,:) = spval 255,263c331 < < power_time(:,:) = spval < ctpoten_time(:,:) = spval < bximf_time(:,:) = spval < byimf_time(:,:) = spval < bzimf_time(:,:) = spval < swden_time(:,:) = spval < swvel_time(:,:) = spval < al_time(:,:) = spval --- > colfac = spval 279a348,351 > secfmag(:) = ' ' > secfgeo2d(:) = ' ' > secfmag2d(:) = ' ' > secfmagphr(:) = ' ' 297a370,371 > ! Set temporary directory (settmpdir is in util.F): > ! 307,311c381,387 < ! 4/08: tempdir is deprecated: < if (len_trim(tempdir) > 0) then < write(6,"('>>> WARNING input: namelist read parameter ', < | '''TEMPDIR'' is deprecated. The value ',a,' will be ', < | 'ignored.')") trim(tempdir) --- > ! If tempdir is same as execution directory (cwd), turn off tempdir: > if (trim(tempdir)=='.'.or.trim(tempdir)==trim(cwd)) then > write(6,"(/,'NOTE: Temporary scratch directory tempdir (', > | a,')')") trim(cwd) > write(6,"(' is same as execution directory -- will', > | ' use only cwd.')") > tempdir = ' ' 312a389 > write(6,"('input: tempdir = ',a)") trim(tempdir) 393,402c470,479 < ! n = len_trim(magvol) < ! if (n <= 0) then < ! write(6,"('Input: did not read value for MAGVOL', < ! | ' (magnetic field data file)')") < ! write(magvol,"('/TGCM/data/magfield.nc')") < ! write(6,"(' Will use default MAGVOL = ',a)") magvol < ! else < ! write(6,"('Input: will use magnetic data file ',a)") < ! | trim(magvol) < ! endif --- > n = len_trim(magvol) > if (n <= 0) then > write(6,"('Input: did not read value for MAGVOL', > | ' (magnetic field data file)')") > write(magvol,"('/TGCM/data/magfield.nc')") > write(6,"(' Will use default MAGVOL = ',a)") magvol > else > write(6,"('Input: will use magnetic data file ',a)") > | trim(magvol) > endif 403a481,493 > ! NMC boundaries for T and Z are not supported in tiegcm: > ! If nmc boundaries are not used, zero out znmc and tnmc. > ! 5/01: eliminating nmc.h. > ! > ! if (nmc > 0) then > ! write(6,"(/,'>>> INPUT: NMC boundaries not supported ', > ! | 'in model ',a,/)") trim(tgcm_version) > ! call shutdown('NMC') > ! else > ! znmc = 0. > ! tnmc = 0. > ! endif > ! 432,439c522,534 < ! Tide3m3 not in tiegcm: < if (any(tide3m3(:) /= spval)) then < if (any(tide3m3(:) > 0.)) then < write(6,"('>>> INPUT: tide3m3=',2f8.2)") tide3m3 < write(6,"('2-day wave not available in tiegcm.')") < write(6,"('Please remove TIDE3M3 from the namelist ', < | 'read file.')") < call shutdown('TIDE3M3') --- > ! Tide3m3 (in time-gcm only, not in tiegcm): > n = size(tide3m3)-count(tide3m3==spval) > if (n > 0) then > if (tgcm_name /= "time-gcm") then > write(6,"(/,'>>> INPUT: there is no 2-day wave in ',a)") > | trim(tgcm_name) > write(6,"( ' (tide3m3 is ignored)')") > else > if (n /= 2) then > write(6,"(/,'>>> INPUT: need 2 real values for TIDE3M3')") > write(6,"(' (amplitude and phase of 2-day wave)')") > call shutdown('TIDE3M3') > endif 441a537,542 > if (n <= 0 .and. tgcm_name=="time-gcm") then > write(6,"(/,'>>> WARNING INPUT: did not read input parameter', > | 'TIDE3M3 -- am setting TIDE3M3 = 0. (no 2-day wave)')") > tide3m3(:) = 0. > endif > if (any(tide3m3==spval)) tide3m3(:) = 0. 444,450c545,549 < ! 5/1/08 btf: Annual tide is removed from versions later than 1-83: < ! < if (tideann /= 0 .and. tideann /= ispval) then < write(6,"(/,'>>> INPUT: TIDEANN=',i3)") tideann < write(6,"('Annual tide is no longer available in ', < | 'tiegcm versions later than v1-83.',/,' Please ', < | 'remove TIDEANN from the namelist read file.')") --- > if (tideann==ispval) then > tideann = 1 ! default is on > elseif (tideann /= 0 .and. tideann /= 1) then > write(6,"(/,'>>> INPUT: TIDEANN must be either 0 or 1:', > | ' tideann=',i5)") tideann 459a559,564 > ! Magnetospheric flag: > if (magphr==ispval) then > write(6,"(/,'Input: setting default MAGPHR = 0')") > magphr = 0 > endif > ! 489,490c594,597 < ! ncep data file: < if (len_trim(ncep_ncfile) > 0) call expand_path(ncep_ncfile) --- > ! Geophysical indices (s.a., /ingpi/ in ingpi.h) > ! Note: as of 2/99, requiring only 1 value for each, i.e., not > ! yet allowing time-dependent multiple valued input and > ! not yet using sub getgpi to get indices from mss database. 491a599,781 > ! Daily f10.7 cm flux: > if (f107 /= spval .and. f107 <= 0.) then > write(6,"(/,'>>> INPUT: f107 must be positive: f107=', > | e12.4)") f107 > call shutdown('F107') > endif > ! c(61) is replaced by f107 from input_mod. > ! c(61) = f107 ! this may get reset later by getgpi or tail > ! > ! 80-day mean f10.7 flux: > if (f107a /= spval .and. f107a <= 0.) then > write(6,"(/,'>>> INPUT: f107a must be positive: f107a=', > | e12.4)") f107a > call shutdown('F107A') > endif > ! > ! There are 3 input options for ctpoten and power: > ! 1) Constants are provided by the user (ctpoten, power) > ! 2) Time series are provided by the user (ctpoten_time, power_time) > ! 3) GPI database (neither constans nor time series were provided) > ! > ! Cannot provide both constant and time series: > if (ctpoten /= spval .and. any(ctpoten_time /= spval)) then > write(6,"(/,'>>> INPUT: you cannot provide both a constant', > | '(CTPOTEN) and a time-series (CTPOTEN_TIME) for cross-', > | 'tail potential.')") > call shutdown('CTPOTEN') > endif > if (power /= spval .and. any(power_time /= spval)) then > write(6,"(/,'>>> INPUT: you cannot provide both a constant', > | ' (POWER) and a time-series (POWER_TIME) for hemispheric', > | ' power.')") > call shutdown('POWER') > endif > ! > ! Validate cross-tail potential constant, if provided: > if (ctpoten /= spval .and. ctpoten <= 0.) then > write(6,"(/,'>>> INPUT: ctpoten must be positive: ctpoten=', > | e12.4)") ctpoten > call shutdown('CTPOTEN') > endif > ! > ! Validate hemispheric power constant, if provided: > if (power /= spval .and. power <= 0.) then > write(6,"(/,'>>> INPUT: power must be positive: power=', > | e12.4)") power > call shutdown('POWER') > endif > ! > ! Validate times and values in user-provided time series for > ! crosstail potential and hemispheric power: > call validate_indices_time(ctpoten_time,ntimes_ctpoten, > | 'CTPOTEN_TIME') > call validate_indices_time(power_time,ntimes_power, > | 'POWER_TIME') > ! > ! gpi_names and gpi_vars must be in the same order: > gpi_names(1) = "f107 " > gpi_names(2) = "f107a " > gpi_names(3) = "power " > gpi_names(4) = "ctpoten " > ! > gpi_vars(1) = f107 > gpi_vars(2) = f107a > gpi_vars(3) = power > gpi_vars(4) = ctpoten > if (any(power_time /= spval)) gpi_vars(3) = 0. ! dummy non-spval > if (any(ctpoten_time /= spval)) gpi_vars(4) = 0. ! dummy non-spval > ! > ! User did NOT provide one or more gpi_vars, meaning user wants > ! to use GPI database for those missing indices. In this case, > ! if the user provided gpi_ncfile, use it, otherwise use the > ! default file gpi_ncfiledef. > ! (If the user DID provide some of these indices, then those values > ! will be used for those indices) > ! > if (any(gpi_vars==spval)) then > write(6,"(/,'Input: The following GPI inputs were NOT ', > | 'provided by the user:')") > do i=1,ngpivars > if (gpi_vars(i)==spval) write(6,"(4x,a)",advance='no') > | trim(gpi_names(i)) > enddo > write(6,"(/,4x,'The GPI database will be used to provide ', > | 'values for these indices.')") > if (len_trim(gpi_ncfile)==0) then > write(6,"(4x,'Since gpi data file GPI_NCFILE was also NOT', > | ' provided,',/,4x,'I will use the default GPI_NCFILE: ', > | a)") trim(gpi_ncfiledef) > gpi_ncfile = gpi_ncfiledef > else > write(6,"(4x,'Will use user-provided path to GPI data', > | ' GPI_NCFILE = ',a)") trim(gpi_ncfile) > endif > ! > ! Model must advance in calendar time for GPI database to be used: > ! (see calday verification above) > ! > ! if (calday==0) then > if (calendar_advance <= 0) then > write(6,"(/,'>>> INPUT: Model must advance in calendar', > | ' time if GPI database is to be used.')") > write(6,"(' To make a GPI run, you must set ', > | 'CALENDAR_ADVANCE = 1')") > call shutdown('GPI') > endif > ! > ! User provided *all* gpi_vars: > ! In this case, use the provided values. If user the also provided a > ! gpi_ncfile, then stop with error message. > ! > else > write(6,"(/,'Input: User provided all gpi input ', > | 'variables:')") > do i=1,ngpivars > if ((trim(gpi_names(i))=="ctpoten".and.ntimes_ctpoten > 0).or. > | (trim(gpi_names(i))=="ctpoten".and.ntimes_ctpoten > 0)) then > write(6,"(' ',a,' = (time series)')") gpi_names(i) > else > write(6,"(' ',a,' = ',f10.2)") gpi_names(i),gpi_vars(i) > endif > enddo > if (len_trim(gpi_ncfile) > 0) then > write(6,"(/,'>>> INPUT: User provided all gpi input but', > | ' ALSO provided gpi data file path:',/, > | ' GPI_NCFILE = ',a)") trim(gpi_ncfile) > write(6,"(' If you want to use the provided gpi values ', > | 'please do NOT provide GPI_NCFILE.')") > write(6,"(' If you want to make a GPI run (i.e., use GPI', > | ' data file), please comment out',/,4x,'(i.e., do NOT ', > | 'provide) those gpi vars you want to get from ',/,4x, > | 'the GPI database.',/)") > call shutdown('GPI_NCFILE') > endif > endif > ! > ! Check to see if have hrindices_ncfile (when avail! 11/15/02) > ! > ! Check electric potential model: > if (potential_model == 'WEIMER') then > > ! 5/7/04 btf: Weimer is not working. Setmodel01 in weimer01.F produces > ! NaNs for Coef(). (coefficients read from netcdf file appear > ! to be ok) > ! > write(6,"('>>> Potential_model WEIMER is not available -- ', > | 'sub setmodel01 in weimer01.F produces NaNs for coeffs.')") > call shutdown('weimer') > ! > ! write (6,"(4x,'Will use the Weimer 2001 electric potential', > ! | ' model')") > ! if (len_trim(weimer_ncfile)==0) then > ! write(6,"(4x,'Since Weimer coef data file WEIMER_NCFILE was ', > ! | 'NOT provided,',/,4x,'I will use the default ', > ! | 'WEIMER_NCFILE: ',a)") trim(weimer_ncfiledef) > ! weimer_ncfile = weimer_ncfiledef > ! else > ! write(6,"(4x,'Will use user-provided path to Weimer coefs', > ! | ' Weimer_NCFILE = ',a)") trim(weimer_ncfile) > ! endif > > elseif (potential_model == 'HEELIS') then > write (6,"(4x,'Will use the Heelis param electric potential', > | ' model')") > elseif (potential_model == 'NONE') then > write (6,"(4x,'Will use NONE (ie zero) electric potential', > | ' model')") > endif > if (len_trim(potential_model)==0) then > write (6,"(4x,'Will use default Heelis elecric potential', > | ' model')") > potential_model='HEELIS' > endif > ! > ! BY component of solar IMF magnetic field: > if (byimf==spval) then > write(6,"(/,'>>> INPUT: need 1 value for byimf', > | ' e.g.: BYIMF=0.')") > write(6,"('NOTE: multiple (time-dependent) values for CTPOTEN', > | ' not yet supported')") > call shutdown('BYIMF') > endif > ! 493c783,786 < if (len_trim(see_ncfile) > 0) call expand_path(see_ncfile) --- > if (len_trim(sd_ncfile) > 0) then > write(6,"('INPUT: will read SEE flux data file ',a)") > | trim(sd_ncfile) > endif 495,503c788,800 < ! GSWM data files: < if (len_trim(gswm_mi_di_ncfile) > 0) < | call expand_path(gswm_mi_di_ncfile) < if (len_trim(gswm_mi_sdi_ncfile) > 0) < | call expand_path(gswm_mi_sdi_ncfile) < if (len_trim(gswm_nm_di_ncfile) > 0) < | call expand_path(gswm_nm_di_ncfile) < if (len_trim(gswm_nm_sdi_ncfile) > 0) < | call expand_path(gswm_nm_sdi_ncfile) --- > ! Limits on By NOT necessary for Weimer (or for NONE) > if (potential_model == 'HEELIS') then > if (byimf > 7.) then > write(6,"(/,'>>> INPUT: byimf too big (must be <= 7.):', > | ' byimf=',e12.4)") byimf > call shutdown('BYIMF') > endif > if (byimf < -11.) then > write(6,"(/,'>>> INPUT: byimf too small (must be >= -11.):', > | ' byimf=',e12.4)") byimf > call shutdown('BYIMF') > endif > endif 504a802,830 > ! Bz component of solar IMF magnetic field: > if (bzimf==spval) then > write(6,"('Input: Using default BZIMF=0.')") > bzimf = 0. > endif > ! > ! Solar wind velocity: > if (swvel==spval) then > write(6,"('Input: Using default SWVEL=400 km/s')") > swvel = 400. > endif > ! > ! Solar wind density: > if (swden==spval) then > write(6,"('Input: Using default SWDEN=4 #/cm3')") > swden = 4. > endif > ! > ! AL, lower auroral magnetic activity index: > if (AL==spval) then > write(6,"('Input: Using default AL=-20., ALUSE=FALSE')") > al = -20. > aluse = .false. > else > write(6,"('Input: AL provided, setting ALUSE=TRUE')") > write(6,"(' AL = ',e12.4)") al > aluse = .true. > endif > ! 510a837,849 > ! iuivi and dynamo flags: > ! iuivi is no longer used -- is replaced by dynamo flag: > if (iuivi /= ispval) then > write(6,"(/,'Input: IUIVI flag is no longer used.')") > write(6,"('Please use DYNAMO flag to turn dynamo on or off.')") > write(6,"('If DYNAMO=0, then dynamo is NOT called, and ', > | 'electric potential and ion drifts will be zero.')") > write(6,"('If DYNAMO=1, then dynamo IS called, and ', > | 'electric potential and ion drifts are calculated.')") > write(6,"('Default is DYNAMO=1')") > call shutdown('IUIVI') > endif > ! 512c851,852 < ! 6/11/08 btf: remove dynamo==0 option --- > ! dynamo <= 0 -> no dynamo (dynamo routines are not called, poten==0) > ! dynamo > 0 -> "new" dynamo (dynamo module in dynamo.F) 518,522c858,862 < write(6,"(/,'>>> Input: dynamo=',i3,': no-dynamo is no ', < | 'longer an option.')") dynamo < write(6,"('Please set DYNAMO=1, or remove DYNAMO ', < | 'from the namelist input file.')") dynamo < call shutdown('DYNAMO=0') --- > write(6,"('Input: dynamo=',i3,' --> dynamo will NOT be ', > | 'called.')") dynamo > else > write(6,"('Input: dynamo=',i3,' --> new dynamo will be ', > | 'called.')") dynamo 526,535c866,867 < ! Save certain params as originally read by namelist read: < rd_ctpoten = ctpoten < rd_power = power < rd_f107 = f107 < rd_f107a = f107a < rd_bximf = bximf < rd_byimf = byimf < rd_bzimf = bzimf < rd_swvel = swvel < rd_swden = swden --- > ! Set iamie flag to 1 if user has provided either amiesh or amienh > ! data files: 537,539c869,873 < ! Sub check_solar validates combinations of potential_model, gpi_ncfile, < ! imf_ncfile, and power,ctpoten,f107,f107a,bximf,byimf,bzimf,swden,swvel, < ! and their time-dependent equivalents. --- > if (len_trim(amiesh) + len_trim(amienh) > 0) then > write(6,"('Will read AMIE data inputs')") > iamie = 1 > potential_model = 'AMIE' > endif 541c875,884 < call check_solar --- > ! Read TIME-SEE flux data > ! gl - 3/05/2005 > ! > n = len_trim(seeflux) > if (n > 0) then > write(6,"('Read SEE flux Data as inputs')") > iseeflux = 1 > else > write(6,"('input: iseeflux=',i3)") iseeflux > endif 609c952,953 < | nsec_hist (mxseries),nsec_save(mxseries) --- > | nsec_hist (mxseries),nsec_save(mxseries), > | nsec_index,nsec0 675a1020 > ! if (calday /= 0) then 890,892d1234 < ! Expand any env vars embedded in path to source file: < if (nsrc > 0) call expand_path(source) < ! 923a1266,1320 > ! Validate that times given by ctpoten_time and/or power_time are > ! within start and stop times (the times themselves were validated > ! in inp_model). Note user must provide a value for each start time. > ! > if (ntimes_ctpoten > 0) then > ! > ! Must provide first ctpoten_time(:,1) same as START time. > nsec0 = mtime_to_nsec(int(ctpoten_time(1:3,1))) > if (nsec0 /= nsec_start(1)) then > write(6,"(/,'>>> INPUT: Please provide first CTPOTEN_TIME', > | ' time equal to first START time.')") > call shutdown('starting ctpoten_time') > endif > ! > ! All ctpoten times must be within start and stop times: > do i=1,ntimes_ctpoten > nsec_index = mtime_to_nsec(int(ctpoten_time(1:3,i))) > if (nsec_index < nsec_start(1) .or. > | nsec_index > nsec_stop(1)) then > write(6,"(/,'>>> INPUT: CTPOTEN_TIME ',3i4,' is outside ', > | 'model START/STOP times: START=',3i4,' STOP=',3i4)") > | int(ctpoten_time(1:3,i)),start(:,1),stop(:,1) > call shutdown('ctpoten_time') > endif > enddo > ! > ! Init: > ctpoten = ctpoten_time(4,1) > endif ! ntimes_ctpoten > if (ntimes_power > 0) then > ! > ! Must provide first power_time(:,1) same as START time. > nsec0 = mtime_to_nsec(int(power_time(1:3,1))) > if (nsec0 /= nsec_start(1)) then > write(6,"(/,'>>> INPUT: Please provide first POWER_TIME', > | ' time equal to first START time.')") > call shutdown('starting power_time') > endif > ! > ! All power times must be within start and stop times: > do i=1,ntimes_power > nsec_index = mtime_to_nsec(int(power_time(1:3,i))) > if (nsec_index < nsec_start(1) .or. > | nsec_index > nsec_stop(1)) then > write(6,"(/,'>>> INPUT: POWER_TIME ',3i4,' is outside ', > | 'model START/STOP times: START=',3i4,' STOP=',3i4)") > | int(power_time(1:3,i)),start(:,1),stop(:,1) > call shutdown('power_time') > endif > enddo > ! > ! Init: > power = power_time(4,1) > endif ! ntimes_power > ! 937,945d1333 < ! Expand any env vars imbedded in output: < do i=1,mxhvols < if (len_trim(output(i)) > 0) then < call expand_path(output(i)) < ! write(6,"('Input: Expanded output file ',a,' to ',/,' ',a)") < ! | trim(hvols(i)),trim(output(i)) < endif < enddo < ! 1023c1411,1415 < | size(secflds) -count(len_trim(secflds)==0) --- > | size(secflds) -count(len_trim(secflds)==0) + > | size(secfmag) -count(len_trim(secfmag)==0) + > | size(secfgeo2d) -count(len_trim(secfgeo2d)==0)+ > | size(secfmag2d) -count(len_trim(secfmag2d)==0)+ > | size(secfmagphr)-count(len_trim(secfmagphr)==0) 1038,1047d1429 < ! < ! Expand any env vars imbedded in secout: < do i=1,mxhvols < if (len_trim(secout(i)) > 0) then < call expand_path(secout(i)) < write(6,"('Input: Expanded secout file ',a,' to ',/,' ',a)") < | trim(hvols(i)),trim(secout(i)) < endif < enddo < ! 1397a1780,1919 > ! > ! Secondary history fields on the magnetic grid: > nflds_sech = count(len_trim(secfmag) > 0) > ! > ! Pack names so no blank names occur from 1->nflds_sech > call packstr(secfmag,mxfsech,nonblank) > if (nonblank /= nflds_sech) then > write(6,"('>>> WARNING: Input after packstr(secfmag): ', > | 'nonblank /= nflds_sech: nonblank=',i3,' nflds_sech=',i3)") > | nonblank,nflds_sech > write(6,"('secfmag(mxfsech=',i3,')=')") mxfsech > do i=1,mxfsech > write(6,"('secfmag(',i2,')=',a)") i,secfmag(i) > enddo > endif > ! > ! Check for dups of secfmag field names: > if (nflds_sech > 0) then > ch80 = ' ' > do i=1,nflds_sech > ch80 = secfmag(i) > secfmag(i) = 'dummy' > if (any(secfmag==ch80)) then > write(6,"(/,'>>> INPUT: Duplicate SECFMAG field names = ', > | a,/)") trim(ch80) > call shutdown('SECFMAG') > endif > secfmag(i) = ch80 > enddo > endif > ! > ! Add mandatory 3d magnetic fields to secondary history: > do i=1,size(secfmag_mandatory) > write(6,"('i=',i3,' Mandatory secfmag field ',a)") > | i,trim(secfmag_mandatory(i)) > found = .false. > if (nflds_sech > 0) then > do ii=1,nflds_sech > if (trim(secfmag(ii))==trim(secfmag_mandatory(i))) then > found = .true. > endif > enddo > endif > if (.not.found) then > write(6,"('Input: adding mandatory mag field ',a, > | ' to secondary history.')") > nflds_sech = nflds_sech+1 > secfmag(nflds_sech) = secfmag_mandatory(i) > endif > enddo > ! > ! Secondary history fields on the geographic 2d grid: > nflds_sech = count(len_trim(secfgeo2d) > 0) > ! > ! Pack names so no blank names occur from 1->nflds_sech > call packstr(secfgeo2d,mxfsech,nonblank) > if (nonblank /= nflds_sech) then > write(6,"('>>> WARNING: Input after packstr(secfgeo2d): ', > | 'nonblank /= nflds_sech: nonblank=',i3,' nflds_sech=',i3)") > | nonblank,nflds_sech > write(6,"('secgeo2d(mxfsech=',i3,')=')") mxfsech > do i=1,mxfsech > write(6,"('secfgeo2d(',i2,')=',a)") i,secfgeo2d(i) > enddo > endif > ! > ! Check for dups of secfgeo2d field names: > if (nflds_sech > 0) then > ch80 = ' ' > do i=1,nflds_sech > ch80 = secfgeo2d(i) > secfgeo2d(i) = 'dummy' > if (any(secfgeo2d==ch80)) then > write(6,"(/,'>>> INPUT: Duplicate SECFGEO2D field names = ', > | a,/)") trim(ch80) > call shutdown('SECFGEO2D') > endif > secfgeo2d(i) = ch80 > enddo > endif > ! > ! Secondary history fields on the magnetic 2d grid: > nflds_sech = count(len_trim(secfmag2d) > 0) > ! > ! Pack names so no blank names occur from 1->nflds_sech > call packstr(secfmag2d,mxfsech,nonblank) > if (nonblank /= nflds_sech) then > write(6,"('>>> WARNING: Input after packstr(secfmag2d): ', > | 'nonblank /= nflds_sech: nonblank=',i3,' nflds_sech=',i3)") > | nonblank,nflds_sech > write(6,"('secfmag2d(mxfsech=',i3,')=')") mxfsech > do i=1,mxfsech > write(6,"('secfmag2d(',i2,')=',a)") i,secfmag2d(i) > enddo > endif > ! > ! Check for dups of secfmag 2d field names: > if (nflds_sech > 0) then > ch80 = ' ' > do i=1,nflds_sech > ch80 = secfmag2d(i) > secfmag2d(i) = 'dummy' > if (any(secfmag2d==ch80)) then > write(6,"(/,'>>> INPUT: Duplicate SECFMAG2D field names = ', > | a,/)") trim(ch80) > call shutdown('SECFMAG2D') > endif > secfmag2d(i) = ch80 > enddo > endif > ! > ! Secondary history fields on the magnetospheric grid: > nflds_sech = count(len_trim(secfmagphr) > 0) > ! > ! Pack names so no blank names occur from 1->nflds_sech > call packstr(secfmagphr,mxfsech,nonblank) > if (nonblank /= nflds_sech) then > write(6,"('>>> WARNING: Input after packstr(secfmagphr): ', > | 'nonblank /= nflds_sech: nonblank=',i3,' nflds_sech=',i3)") > | nonblank,nflds_sech > write(6,"('secfmagphr(mxfsech=',i3,')=')") mxfsech > do i=1,mxfsech > write(6,"('secfmagphr(',i2,')=',a)") i,secfmagphr(i) > enddo > endif > ! > ! Check for dups of secfmagphr field names: > if (nflds_sech > 0) then > ch80 = ' ' > do i=1,nflds_sech > ch80 = secfmagphr(i) > secfmagphr(i) = 'dummy' > if (any(secfmagphr==ch80)) then > write(6,"(/,'>>> INPUT: Duplicate SECFMAGPHR field > | names',' = ', a,/)") trim(ch80) > call shutdown('SECFMAGPHR') > endif > secfmagphr(i) = ch80 > enddo > endif 1399a1922,1991 > subroutine inp_deftyp > ! > ! Define inp (type(input_type)) from validated namelist input > ! module variables: > ! > inp%label = label > inp%tempdir = tempdir > inp%magvol = magvol > inp%potential_model = potential_model > inp%hrindices_ncfile = hrindices_ncfile > inp%weimer_ncfile = weimer_ncfile > inp%gpi_ncfile = gpi_ncfile > inp%gswm_di_ncfile = gswm_di_ncfile > inp%gswm_sdi_ncfile = gswm_sdi_ncfile > inp%gswm_nmdi_ncfile = gswm_nmdi_ncfile > inp%gswm_nmsdi_ncfile= gswm_nmsdi_ncfile > inp%start_day = start_day > inp%start_year = start_year > inp%calendar_advance = calendar_advance > inp%step = step > inp%dispose = dispose > inp%ntask_lon = ntask_lon > inp%ntask_lat = ntask_lat > inp%mag = mag > inp%difhor = difhor > inp%iuivi = iuivi > inp%dynamo = dynamo > inp%nmc = nmc > inp%tide(:) = tide(:) > inp%tide2(:)= tide2(:) > inp%tide3m3(:) = tide3m3(:) > inp%tideann = tideann > inp%aurora = aurora > inp%f107 = f107 > inp%f107a = f107a > inp%power = power > inp%ctpoten = ctpoten > inp%power_time(:,:) = power_time(:,:) > inp%ctpoten_time(:,:) = ctpoten_time(:,:) > inp%byimf = byimf > inp%bzimf = bzimf > inp%swvel = swvel > inp%swden = swden > inp%AL = AL > inp%colfac = colfac > ! > inp%source = source > inp%output = output > inp%source_start = source_start > inp%start = start > inp%stop = stop > inp%hist = hist > inp%save = save > inp%mxhist_prim = mxhist_prim > inp%msreten = msreten > ! > inp%secsource= secsource > inp%secout = secout > inp%secstart = secstart > inp%secstop = secstop > inp%sechist = sechist > inp%secsave = secsave > inp%secflds = secflds > inp%secfmag = secfmag > inp%secfgeo2d= secfgeo2d > inp%secfmag2d= secfmag2d > inp%secfmagphr = secfmagphr > inp%mxhist_sech = mxhist_sech > end subroutine inp_deftyp > !------------------------------------------------------------------- 1415c2007 < | ' current run)')") trim(label) --- > | ' current run)')") trim(inp%label) 1418c2010 < | trim(tempdir) --- > | trim(inp%tempdir) 1422,1433c2014,2023 < | trim(magvol) < < write(6,"(' High-lat electric potential model: ', < | 'potential_model = ',a)") trim(potential_model) < if (trim(potential_model)=='WEIMER01') < | write(6,"(' weimer coefs: weimer_ncfile = ',a)") < | trim(weimer_ncfile) < if (trim(potential_model)=='WEIMER'.or. < | trim(potential_model)=='WEIMER05') < | write(6,"(' weimer coefs: wei05sc_ncfile = ',a)") < | trim(wei05sc_ncfile) < --- > | trim(inp%magvol) > if (len_trim(potential_model) > 0) > | write(6,"(' high-lat electric potential model: ', > | 'potential_model = ',a)") trim(potential_model) > if (len_trim(hrindices_ncfile) > 0) > | write(6,"(' hrly indices: hrindices_ncfile = ',a)") > | trim(hrindices_ncfile) > if (len_trim(weimer_ncfile) > 0) > | write(6,"(' weimer coefs: weimer_ncfile = ',a)") > | trim(weimer_ncfile) 1436,1456c2026,2039 < if (len_trim(see_ncfile) > 0) < | write(6,"(' SEE data: see_ncfile = ',a)") trim(see_ncfile) < if (len_trim(imf_ncfile) > 0) < | write(6,"(' imf run: imf_ncfile = ',a)") trim(imf_ncfile) < < if (len_trim(gswm_mi_di_ncfile) > 0) < | write(6,"(' gswm migrating diurnal file: ', < | 'gswm_mi_di_ncfile = ',a)") trim(gswm_mi_di_ncfile) < if (len_trim(gswm_mi_sdi_ncfile) > 0) < | write(6,"(' gswm migrating semi-diurnal file: ', < | 'gswm_mi_sdi_ncfile = ',a)") trim(gswm_mi_sdi_ncfile) < if (len_trim(gswm_nm_di_ncfile) > 0) < | write(6,"(' gswm non-migrating diurnal file: ', < | 'gswm_nm_di_ncfile = ',a)") trim(gswm_nm_di_ncfile) < if (len_trim(gswm_nm_sdi_ncfile) > 0) < | write(6,"(' gswm non-migrating semi-diurnal file: ', < | 'gswm_nm_sdi_ncfile = ',a)") trim(gswm_nm_sdi_ncfile) < < if (len_trim(amievol) > 0) < | write(6,"(' amievol = ',a,/,4x, < | '(file or mss path containing amie data)')") trim(amievol) --- > if (len_trim(sd_ncfile) > 0) > | write(6,"(' SEE run: sd_ncfile = ',a)") trim(sd_ncfile) > if (len_trim(gswm_di_ncfile) > 0) > | write(6,"(' gswm run diurnal tides: gswm_di_ncfile = ',a)") > | trim(gswm_di_ncfile) > if (len_trim(gswm_sdi_ncfile) > 0) > | write(6,"(' gswm run semidiurnal tides: gswm_sdi_ncfile = ' > | ,a)") trim(gswm_sdi_ncfile) > if (len_trim(gswm_nmdi_ncfile) > 0) > | write(6,"(' gswm run nonmigrating diurnal tides: ', > | 'gswm_nmdi_ncfile = ',a)") trim(gswm_nmdi_ncfile) > if (len_trim(gswm_nmsdi_ncfile) > 0) > | write(6,"(' gswm run nonmigrating semidiurnal tides: ', > | 'gswm_nmsdi_ncfile = ',a)") trim(gswm_nmsdi_ncfile) 1458c2041 < | start_year --- > | inp%start_year 1460,1461c2043,2044 < | start_day < if (calendar_advance /= 0) then --- > | inp%start_day > if (inp%calendar_advance /= 0) then 1464c2047 < | calendar_advance --- > | inp%calendar_advance 1467c2050 < | 'advanced in calendar time)')") calendar_advance --- > | 'advanced in calendar time)')") inp%calendar_advance 1471c2054 < | i4)") step --- > | i4)") inp%step 1473c2056 < | dispose --- > | inp%dispose 1484c2067 < if (len_trim(source) > 0) then --- > if (len_trim(inp%source) > 0) then 1486c2069 < | ' containing source history)')") trim(source) --- > | ' containing source history)')") trim(inp%source) 1489c2072 < | source_start --- > | inp%source_start 1494,1495c2077,2078 < | (trim(output(i)),i=1,n) < n = (size(start)-count(start==ispval))/3 --- > | (trim(inp%output(i)),i=1,n) > n = (size(inp%start)-count(inp%start==ispval))/3 1497,1498c2080,2081 < | /,4(4x,i3,',',i2,',',i2))") (start(:,i),i=1,n) < n = (size(stop)-count(stop==ispval))/3 --- > | /,4(4x,i3,',',i2,',',i2))") (inp%start(:,i),i=1,n) > n = (size(inp%stop)-count(inp%stop==ispval))/3 1500,1501c2083,2084 < | /,4(4x,i3,',',i2,',',i2))") (stop(:,i),i=1,n) < n = (size(hist)-count(hist==ispval))/3 --- > | /,4(4x,i3,',',i2,',',i2))") (inp%stop(:,i),i=1,n) > n = (size(inp%hist)-count(inp%hist==ispval))/3 1503,1504c2086,2087 < | /,4(4x,i3,',',i2,',',i2))") (hist(:,i),i=1,n) < n = (size(save)-count(save==ispval))/3 --- > | /,4(4x,i3,',',i2,',',i2))") (inp%hist(:,i),i=1,n) > n = (size(inp%save)-count(inp%save==ispval))/3 1506c2089 < | /,4(4x,i3,',',i2,',',i2))") (save(:,i),i=1,n) --- > | /,4(4x,i3,',',i2,',',i2))") (inp%save(:,i),i=1,n) 1508c2091 < | i3)") mxhist_prim --- > | i3)") inp%mxhist_prim 1510c2093 < | i5)") msreten --- > | i5)") inp%msreten 1513c2096 < if (len_trim(secsource) > 0) then --- > if (len_trim(inp%secsource) > 0) then 1515c2098 < | ' containing secsource history)')") trim(secsource) --- > | ' containing secsource history)')") trim(inp%secsource) 1518c2101 < | source_start --- > | inp%source_start 1524,1525c2107,2108 < | (trim(secout(i)),i=1,n) < n = (size(secstart)-count(secstart==ispval))/3 --- > | (trim(inp%secout(i)),i=1,n) > n = (size(inp%secstart)-count(inp%secstart==ispval))/3 1528,1529c2111,2112 < | /,4(4x,i3,',',i2,',',i2))") (secstart(:,i),i=1,n) < n = (size(secstop)-count(secstop==ispval))/3 --- > | /,4(4x,i3,',',i2,',',i2))") (inp%secstart(:,i),i=1,n) > n = (size(inp%secstop)-count(inp%secstop==ispval))/3 1532,1533c2115,2116 < | /,4(4x,i3,',',i2,',',i2))") (secstop(:,i),i=1,n) < n = (size(sechist)-count(sechist==ispval))/3 --- > | /,4(4x,i3,',',i2,',',i2))") (inp%secstop(:,i),i=1,n) > n = (size(inp%sechist)-count(inp%sechist==ispval))/3 1537,1538c2120,2121 < | (sechist(:,i),i=1,n) < n = (size(secsave)-count(secsave==ispval))/3 --- > | (inp%sechist(:,i),i=1,n) > n = (size(inp%secsave)-count(inp%secsave==ispval))/3 1542,1543c2125,2126 < | (secsave(:,i),i=1,n) < n = (size(secflds)-count(len_trim(secflds)==0)) --- > | (inp%secsave(:,i),i=1,n) > n = (size(inp%secflds)-count(len_trim(inp%secflds)==0)) 1546c2129,2145 < | ' =',/,(4x,5a12))") (secflds(i),i=1,n) --- > | ' =',/,(4x,5a12))") (inp%secflds(i),i=1,n) > n = (size(inp%secfmag)-count(len_trim(inp%secfmag)==0)) > if (n > 0) > | write(6,"(' secfmag (secondary history fields on magnetic ', > | 'grid) =',/,(4x,5a12))") (inp%secfmag(i),i=1,n) > n = (size(inp%secfgeo2d)-count(len_trim(inp%secfgeo2d)==0)) > if (n > 0) > | write(6,"(' secfgeo2d (secondary history fields on geo. ', > | '2d grid) =',/,(4x,5a12))") (inp%secfgeo2d(i),i=1,n) > n = (size(inp%secfmag2d)-count(len_trim(inp%secfmag2d)==0)) > if (n > 0) > | write(6,"(' secfmag2d (secondary history fields on magnetic ', > | '2d grid) =',/,(4x,5a12))") (inp%secfmag2d(i),i=1,n) > n = (size(inp%secfmagphr)-count(len_trim(inp%secfmagphr)==0)) > if (n > 0) > | write(6,"('secfmagphr (secondary history fields on magnetphr', > | 'grid) =',/,(4x,5a12))") (inp%secfmagphr(i),i=1,n) 1548c2147 < | i3)") mxhist_sech --- > | i3)") inp%mxhist_sech 1550a2150,2151 > write(6,"(' mag (lat,lon of south,north magnetic poles) =', > | /,4x,4f8.2)") inp%mag 1552c2153,2168 < | difhor --- > | inp%difhor > ! > ! iuivi flag is replaced by dynamo flag: > ! write(6,"(' iuivi = ',i2,' (ion drifts momentum flag)')") > ! | inp%iuivi > if (inp%dynamo <= 0) then > write(6,"(' dynamo = ',i2,' (dynamo will NOT be calculated)')") > | inp%dynamo > write(6,"(14x, > | '(electric potential and ion drifts will be zero')") > else > write(6,"(' dynamo = ',i2,' (dynamo will be calculated)')") > | inp%dynamo > endif > write(6,"(' nmc = ',i2,' (flag for NMC boundary', > | ' conditions)')") inp%nmc 1554c2170 < | /,4x,5e8.1,5f6.2)") tide --- > | /,4x,5e8.1,5f6.2)") inp%tide 1556,1562c2172,2179 < | /,4x,e8.1,f6.2)") tide2 < ! write(6,"(' tide3m3 (amplitude and phase of 2-day wave)=', < ! | /,4x,e8.1,f6.2)") tide3m3 < ! write(6,"(' tideann = ',i2,' (0/1 flag for annual tides)')") < ! | tideann < write(6,"(' aurora = ',i2,' (0/1 flag for aurora)')") aurora < write(6,"(' colfac = ',f9.3,' (collision factor)')") colfac --- > | /,4x,e8.1,f6.2)") inp%tide2 > write(6,"(' tide3m3 (amplitude and phase of 2-day wave)=', > | /,4x,e8.1,f6.2)") inp%tide3m3 > write(6,"(' tideann = ',i2,' (0/1 flag for annual tides)')") > | inp%tideann > write(6,"(' aurora = ',i2,' (0/1 flag for aurora)')") inp%aurora > write(6,"(' magphr = ',i2,' (0/1 flag for magnetosphere)')") > | inp%magphr 1564,1577c2181,2183 < write(6,"('If any of the following are spval (',e12.4,'),', < | ' they will be calculated',/,'during the simulation on a per ', < | 'timestep basis:')") spval < write(6,"(' power = ',e12.4,' (Hemispheric Power)')") power < write(6,"(' ctpoten= ',e12.4,' (Cross-cap potential)')") ctpoten < write(6,"(' f107 = ',e12.4,' (F10.7 solar flux)')") f107 < write(6,"(' f107a = ',e12.4,' (81-day ave F10.7 flux)')") f107 < write(6,"(' bximf = ',e12.4,' (BX component of IMF)')") bximf < write(6,"(' byimf = ',e12.4,' (BY component of IMF)')") byimf < write(6,"(' bzimf = ',e12.4,' (Bz component of IMF)')") bzimf < write(6,"(' swvel = ',e12.4,' (solar wind velocity)')") swvel < write(6,"(' swden = ',e12.4,' (solar wind density)')") swden < ! write(6,"(' al = ',e12.4,' (AL, lower auroral mag index)')") < ! | al --- > ! If any of f107,f107a,power,ctpoten are spval, this means GPI database > ! will be used for those indices, otherwise will use user-provided > ! values: 1578a2185,2239 > if (f107 /= spval) then > write(6,"(' f107 = ',f9.3,' (daily 10.7 cm solar flux)')") > | inp%f107 > elseif (len_trim(gpi_ncfile) > 0) then > write(6,"(' f107 not provided:', > | ' will use gpi data file ',a)") trim(gpi_ncfile) > endif > ! > if (f107a /= spval) then > write(6,"(' f107a = ',f9.3,' (81-day ave 10.7 cm solar', > | ' flux)')") inp%f107a > elseif (len_trim(gpi_ncfile) > 0) then > write(6,"(' f107a not provided:', > | ' will use gpi data file ',a)") trim(gpi_ncfile) > endif > ! > if (power /= spval) then > if (ntimes_power==0) then > write(6,"(' power = ',f9.3,' (hemispheric power (gw)')") > | inp%power > else > write(6,"(' power = ',f9.3,' (hemispheric power (gw)', > | ' (user provided time series)')") inp%power > endif > elseif (len_trim(gpi_ncfile) > 0) then > write(6,"(' power not provided:', > | ' will use gpi data file ',a)") trim(gpi_ncfile) > endif > ! > if (ctpoten /= spval) then > if (ntimes_ctpoten==0) then > write(6,"(' ctpoten = ',f9.3,' (cross-cap potential ', > | '(volts)')") inp%ctpoten > else > write(6,"(' ctpoten = ',f9.3,' (cross-cap potential ', > | '(volts) (user provided time series)')") inp%ctpoten > endif > elseif (len_trim(gpi_ncfile) > 0) then > write(6,"(' ctpoten not provided:', > | ' will use gpi data file ',a)") trim(gpi_ncfile) > endif > ! > write(6,"(' byimf = ',f9.3,' (BY component of IMF)')") > | inp%byimf > write(6,"(' bzimf = ',f9.3,' (Bz component of IMF)')") > | inp%bzimf > write(6,"(' swvel = ',f9.3,' (solar wind velocity)')") > | inp%swvel > write(6,"(' swden = ',f9.3,' (solar wind density)')") > | inp%swden > write(6,"(' AL = ',f9.3,' (AL, lower auroral mag index)')") > | inp%AL > write(6,"(' colfac = ',f9.3,' (collision factor)')") > | inp%colfac > ! 1582c2243 < !----------------------------------------------------------------------- --- > !------------------------------------------------------------------- 1645c2306 < subroutine validate_timedep(constant,timedep,mxtimes,ntimes,name) --- > subroutine validate_indices_time(rindex,ntimes,name) 1647c2308,2309 < ! Validate times and values in user provided time series. --- > ! Validate user provided time series for solar index "name". Rindex will > ! be either ctpoten_time or power_time, from namelist input. 1650,1651c2312 < real,intent(in) :: constant,timedep(4,mxtimes) < integer,intent(in) :: mxtimes --- > real,intent(in) :: rindex(4,mxind_time) 1657c2318 < integer(kind=8) :: nsec,nsec0,nsec1,nsec_start,nsec_stop --- > integer(kind=8) :: nsec0,nsec1 1664c2325 < if (any(timedep /= spval)) then --- > if (any(rindex /= spval)) then 1668c2329 < do i=1,mxtimes --- > do i=1,mxind_time 1670c2331 < if (timedep(ii,i) /= spval) n = n+1 --- > if (rindex(ii,i) /= spval) n = n+1 1676c2337 < call shutdown('validate_timedep') --- > call shutdown('validate_indices_time') 1678,1680c2339,2347 < do i=1,mxtimes < if (any(timedep(:,i) /= spval)) then < call validate_mtime(int(timedep(1:3,i)),mxday,name) --- > do i=1,mxind_time > if (any(rindex(:,i) /= spval)) then > call validate_mtime(int(rindex(1:3,i)),mxday,name) > if (rindex(4,i) <= 0.) then > write(6,"(/,'>>> INPUT: ',a,' values must be ', > | 'positive: i=',i3,' rindex(4,i)=',e12.4)") > | name,i,rindex(4,i) > call shutdown('validate_indices_time') > endif 1683,1685c2350 < enddo ! i=1,mxtimes < nsec_start = mtime_to_nsec(start(:,1)) ! model start time < nsec_stop = mtime_to_nsec(stop(:,1)) ! model stop time --- > enddo ! i=1,mxind_time 1687,1708d2351 < ! First time must be model start time: < if (ntimes > 0) then < nsec = mtime_to_nsec(int(timedep(1:3,1))) < if (nsec /= nsec_start) then < write(6,"(/,'>>> INPUT: Please provide first value of ',a, < | ' at model START time.')") trim(name) < call shutdown('validate_timedep') < endif < ! < ! All times must be between START and STOP times: < do i=1,ntimes < nsec = mtime_to_nsec(int(timedep(1:3,i))) < if (nsec < nsec_start .or. < | nsec > nsec_stop) then < write(6,"(/,'>>> INPUT: ',a,' time ',3i4,' is outside ', < | 'model START/STOP times: START=',3i4,' STOP=',3i4)") < | trim(name),int(timedep(1:3,i)),start(:,1),stop(:,1) < call shutdown('validate_timedep') < endif < enddo < endif ! ntimes > 0 < ! 1712c2355 < nsec0 = mtime_to_nsec(int(timedep(1:3,1))) --- > nsec0 = mtime_to_nsec(int(rindex(1:3,1))) 1714c2357 < nsec1 = mtime_to_nsec(int(timedep(1:3,i))) --- > nsec1 = mtime_to_nsec(int(rindex(1:3,i))) 1718,1719c2361,2362 < | ' time previous to i.')") name,i,int(timedep(1:3,i)) < call shutdown('validate_timedep') --- > | ' time previous to i.')") name,i,int(rindex(1:3,i)) > call shutdown('validate_indices_time') 1724,2006c2367,2368 < endif ! any(timedep /= spval) < ! < ! User cannot provide both a constant and time-dependent values: < if (ntimes > 0 .and. constant /= spval) then < write(6,"('>>> INPUT: Please provide either constant or ', < | 'time-dependent values for ',a,' (not both)')") trim(name) < write(6,"(a,'=',e12.4,' ',a,'_time=',/,(6e12.4))") < | trim(name),constant,trim(name),timedep(4,:) < call shutdown('validate_timedep') < endif < end subroutine validate_timedep < !----------------------------------------------------------------------- < subroutine check_solar < ! < ! Validate combinations of potential_model, gpi_ncfile, imf_ncfile, and < ! power,ctpoten,f107,f107a,bximf,byimf,bzimf,swden,swvel, and their < ! time-dependent equivalents. < ! < ! The rules for these namelist read parameters are as follows: < ! 1. Potential_model must be 'HEELIS','WEIMER','WEIMER01','WEIMER05', or 'NONE' < ! (if 'WEIMER', then the 2005 model will be called) < ! (if potential_model is not provided, it defaults to 'HEELIS') < ! 2. gpi_ncfile data file can be provided only with Heelis potential model. < ! (data file has 3-hourly Kp and daily f107,f107a) < ! 3. imf_ncfile data file can be provided only with Weimer potential model. < ! (data file has hourly bx,by,bz,swvel,swden,kp, and daily f107,f107a) < ! 4. User cannot provide both gpi_ncfile and imf_ncfile in a single run. < ! 5. User can provide the following parameters as either constants or < ! time-dependent values: ctpoten,power,bximf,byimf,bzimf,swden,swvel < ! (time-dependent keywords are xxxx_time, e.g., ctpoten_time) < ! Time-dependent namelist f107,f107a are not yet available. < ! Valid ranges for user-provided parameters are not enforced. < ! < ! If (potential_model == 'HEELIS') then < ! [user does not need to provide bx,by,bz,swvel,swden] < ! if (gpi_ncfile is NOT provided) then < ! [user must provide hp,cp,f107,f107a] < ! elseif (gpi_ncfile is provided) then < ! [user must NOT provide at least one of hp,cp,f107,f107a] < ! [parameters not provided will be taken or calculated from the data] < ! endif < ! Endif < ! < ! If (potential_model == 'WEIMER') then < ! [user is not allowed to provide ctpoten (derived from Weimer potential)] < ! [if user does not provide power, it will be calculated from bz,swvel] < ! if (imf_ncfile is NOT provided) then < ! [user must provide bximf,byimf,bzimf,swden,swvel,f107,f107a] < ! elseif (imf_ncfile is provided) then < ! [user must NOT provide at least one of bx,by,bz,swden,swvel,f107,f107a] < ! [parameters not provided will be taken from the data] < ! endif < ! Endif < ! < ! If time-dependent values are given, sub validate_timedep validates < ! the times, and returns ntimes_xxxx. If only constants are given, < ! it returns ntimes_xxxx == 0 < ! < call validate_timedep(ctpoten,ctpoten_time,mxind_time, < | ntimes_ctpoten,'ctpoten') < call validate_timedep(power,power_time,mxind_time, < | ntimes_power,'power') < call validate_timedep(byimf,byimf_time,mxind_time, < | ntimes_byimf,'byimf') < call validate_timedep(bzimf,bzimf_time,mxind_time, < | ntimes_bzimf,'bzimf') < call validate_timedep(swden,swden_time,mxind_time, < | ntimes_swden,'swden') < call validate_timedep(swvel,swvel_time,mxind_time, < | ntimes_swvel,'swvel') < call validate_timedep(al,al_time,mxind_time, < | ntimes_al,'al') < aluse = .true. < if (al == spval) aluse = .false. < ! < ! Check electric potential model: < ! 4/08 btf: Add wiemer05 option < ! 4/25/08 btf: default potential_model is still heelis: < ! < if (len_trim(potential_model)==0) then < write (6,"(4x,'Will use default Heelis elecric potential', < | ' model')") < potential_model='HEELIS' < endif < select case (trim(potential_model)) < case('WEIMER01') < write(6,"('Will use the Weimer 2001 potential model')") < call expand_path(weimer_ncfile) ! coeffs file < write(6,"('weimer_ncfile=',a)") trim(weimer_ncfile) < case('WEIMER05') < write(6,"('Will use the Weimer 2005 potential model')") < call expand_path(wei05sc_ncfile) ! coeffs file < write(6,"(' wei05sc_ncfile=',a)") trim(wei05sc_ncfile) < case('WEIMER') < write(6,"('Will use the Weimer 2005 potential model')") < call expand_path(wei05sc_ncfile) ! coeffs file < write(6,"('wei05sc_ncfile=',a)") trim(wei05sc_ncfile) < case('HEELIS') < write (6,"('Will use the Heelis potential model')") < case('NONE') < write(6,"('Will NOT use an empirical potential model')") < write(6,"('High-lat convection will be zero.)')") < case default < write(6,"(/,'>>> INPUT: unknown potential_model: ',a)") < | trim(potential_model) < write(6,"('potential_model can be one of the following:')") < write(6,"('''HEELIS''',',','''WEIMER01''',',', < | '''WEIMER05''',',','''WEIMER''',',','''NONE''')") < call shutdown('POTENTIAL_MODEL') < end select < ! < ! Cannot specify both imf and gpi data in same run: < if (len_trim(gpi_ncfile) > 0.and.len_trim(imf_ncfile) > 0) then < write(6,"(/,'>>> INPUT: User cannot request both GPI ', < | '(gpi_ncfile) and IMF (imf_ncfile) data runs.')") < call shutdown('GPI and IMF not allowed') < endif < ! < ! Check parameters needed for Heelis potential model: < if (trim(potential_model)=='HEELIS') then < ! < ! IMF data not allowed with Heelis potential model: < if (len_trim(imf_ncfile) > 0) then < write(6,"(/,'>>> INPUT: IMF data runs (imf_ncfile) can', < | ' be requested only with WEIMER potential model.')") < call shutdown('IMF with HEELIS') < endif < ! < ! 12/3/08 btf: User may set BY to test BY effect on Heelis (see aurora.F) < ! < if (byimf == spval) then < write(6,"('Note input: Setting BY to 0 with HEELIS ', < | 'potential model.')") < byimf = 0. < endif < ! < ! Heelis non-gpi run: user must provide power,ctpoten,f107,f107a: < ! Later, an alternative would be for the user to provide IMF data < ! then use empirical calculation to get power, etc from the IMF. < ! Note: namelist time-dependent f107 is not available. < ! < if (len_trim(gpi_ncfile)==0) then < if (power==spval.and.ntimes_power==0) then < write(6,"(/,'>>> INPUT: POWER or POWER_TIME must be ', < | 'provided for non-GPI run with Heelis potential model.')") < call shutdown('POWER') < endif < if (ctpoten==spval.and.ntimes_ctpoten==0) then < write(6,"(/,'>>> INPUT: CTPOTEN or CTPOTEN_TIME must be ', < | 'provided for non-GPI run with Heelis potential model.')") < call shutdown('CTPOTEN') < endif < if (f107==spval) then < write(6,"(/,'>>> INPUT: F107 must be provided for non-GPI', < | ' run with Heelis potential model.')") < call shutdown('F107') < endif < if (f107a==spval) then < write(6,"(/,'>>> INPUT: F107a must be provided for non-GPI', < | ' run with Heelis potential model.')") < call shutdown('F107a') < endif < ! < ! Heelis gpi run: < ! < else ! gpi run < ! < ! At least one of the gpi params must NOT be provided: < ! (i.e., at least one parameter will come from the gpi data file) < ! < if ((power /= spval.or.ntimes_power > 0).and. < | (ctpoten/= spval.or.ntimes_ctpoten > 0).and. < | (f107 /= spval.and.f107a /= spval)) then < write(6,"(/,'>>> INPUT: At least one of power, ctpoten,', < | ' f107 or f107a must NOT be provided for a gpi run.')") < call shutdown('GPI params') < endif < < endif ! gpi data run < endif ! heelis potential model < ! < ! Check parameters needed for Weimer potential model: < ! < if (potential_model(1:6)=='WEIMER') then < ! < ! GPI data not allowed with Weimer potential model: < if (len_trim(gpi_ncfile) > 0) then < write(6,"(/,'>>> INPUT: GPI data runs (gpi_ncfile) can', < | ' be requested only with HEELIS potential model.')") < call shutdown('GPI with WEIMER') < endif < ! < ! ctpoten cannot be provided by the user, since it will be < ! calculated from the Weimer potential: < if (ctpoten /= spval .or. ntimes_ctpoten > 0) then < write(6,"(/,'>>> INPUT: Cannot provide CTPOTEN with', < | ' Weimer potential model')") < write(6,"('(ctpoten is calculated from the Weimer', < | ' electric potential)')") < call shutdown('ctpoten and Weimer') < endif < ! < ! Weimer non-imf data run: < if (len_trim(imf_ncfile)==0) then < ! < ! User must provide bx,by,bz,swden,swvel,f107,f107a for non-IMF data run: < ! (if power is not provided, it will be calculated from bzimf,swvel) < ! < if ((bximf==spval.and.ntimes_bximf==0).or. < | (byimf==spval.and.ntimes_byimf==0).or. < | (bzimf==spval.and.ntimes_bzimf==0)) then < write(6,"(/,'>>> INPUT: bximf, byimf, and bzimf must be ', < | 'provided for non-IMF run with Weimer potential model.')") < call shutdown('IMF params') < endif < if ((swden==spval.and.ntimes_swden==0).or. < | (swvel==spval.and.ntimes_swvel==0)) then < write(6,"(/,'>>> INPUT: swvel and swden must be provided', < | ' for non-IMF run with Weimer potential model.')") < call shutdown('IMF params') < endif < if (f107==spval.and.f107a==spval) then < write(6,"(/,'>>> INPUT: f107 and f107a must be provided', < | ' for non-IMF run with Weimer potential model.')") < call shutdown('f107,f107a params') < endif < ! < ! Weimer IMF data run: < else ! imf data run < ! < ! At least one of the imf params must NOT be provided: < ! (i.e., at least one parameter will come from the imf data file) < ! < if ((bximf /= spval.or.ntimes_bximf > 0).and. < | (byimf /= spval.or.ntimes_byimf > 0).and. < | (bzimf /= spval.or.ntimes_bzimf > 0).and. < | (swvel /= spval.or.ntimes_swvel > 0).and. < | (swden /= spval.or.ntimes_swden > 0)) then < write(6,"(/,'>>> INPUT: At least one of bximf,byimf,', < | 'bzimf,swvel or swden must NOT be provided for an ', < | 'imf run.')") < write(6,"('(i.e., at least one parameter must come', < | ' from the imf data file)')") < call shutdown('IMF params') < endif < < endif ! imf run < endif ! weimer potential model < ! < ! Calendar must be advanced if using gpi or imf data: < if (len_trim(gpi_ncfile) > 0) then < if (calendar_advance <= 0) then < write(6,"(/,'>>> INPUT: Model must advance in calendar', < | ' time if GPI database is to be used.')") < write(6,"(' To make a GPI run, you must set ', < | 'CALENDAR_ADVANCE = 1')") < call shutdown('calendar_advance') < endif < endif < if (len_trim(imf_ncfile) > 0) then < if (calendar_advance <= 0) then < write(6,"(/,'>>> INPUT: Model must advance in calendar', < | ' time if IMF database is to be used.')") < write(6,"(' To make an IMF run, you must set ', < | 'CALENDAR_ADVANCE = 1')") < call shutdown('calendar_advance') < endif < endif < ! < ! Report to stdout for debug: < ! write(6,"(/,'check_solar returning:')") < ! write(6,"('potential_model=',a)") trim(potential_model) < ! if (len_trim(gpi_ncfile) > 0) < ! | write(6,"('gpi_ncfile=',a)") trim(gpi_ncfile) < ! if (len_trim(imf_ncfile) > 0) < ! | write(6,"('imf_ncfile=',a)") trim(imf_ncfile) < ! write(6,"('power=',e12.4,' ctpoten=',e12.4)") power,ctpoten < ! write(6,"('f107 =',e12.4,' f107a =',e12.4)") f107,f107a < ! write(6,"('bximf=',e12.4,' byimf =',e12.4,' bzimf=',e12.4)") < ! | bximf,byimf,bzimf < ! write(6,"('swden=',e12.4,' swvel =',e12.4)") swden,swvel < < end subroutine check_solar --- > endif ! ctpoten_time > end subroutine validate_indices_time ======================================================================== Diff of /fis/hao/tgcm/tiegcm1.92/src/lamdas.F and /ptmp/foster/ganglu_tiegcm_amie/modsrc2/lamdas.F 5,8d4 < ! This software is part of the NCAR TIE-GCM. Use is governed by the < ! Open Source Academic Research License Agreement contained in the file < ! tiegcmlicense.txt. < ! 20d15 < use addfld_module,only: addfld 47c42,43 < integer :: k,i,l,lonbeg,lonend,i0,i1 --- > integer :: k,i,l,nlevs,lonbeg,lonend > integer ::i0,i1,nk,nkm1 ! for addfsech 99a96,98 > ! Convenience ints for addfsech calls: > i0 = lon0 ; i1 = lon1 ; nk = lev1-lev0+1 ; nkm1 = nk-1; nlevs = nk > 102,108c101,103 < i0 = lon0 ; i1 = lon1 < ! call addfld('O2P_LAM',' ',' ',o2p(:,i0:i1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('OP_LAM' ,' ',' ',op (:,i0:i1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('NOP_LAM',' ',' ',nop(:,i0:i1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('O2P_LAM',' ',' ',o2p(:,i0:i1),i0,i1,nk,nkm1,lat) > ! call addfsech('OP_LAM' ,' ',' ',op (:,i0:i1),i0,i1,nk,nkm1,lat) > ! call addfsech('NOP_LAM',' ',' ',nop(:,i0:i1),i0,i1,nk,nkm1,lat) 202,207c197,199 < ! call addfld('O2_CM3',' ',' ',o2_cm3, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('O_CM3' ,' ',' ',o1_cm3, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('N2_CM3',' ',' ',n2_cm3, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('O2_CM3',' ',' ',o2_cm3,i0,i1,nk,nkm1,lat) > ! call addfsech('O_CM3' ,' ',' ',o1_cm3 ,i0,i1,nk,nkm1,lat) > ! call addfsech('N2_CM3',' ',' ',n2_cm3,i0,i1,nk,nkm1,lat) 238a231,233 > > enddo ! k=lev0,lev1-1 > enddo ! i=lon0,lon1 240a236 > ! 247c243 < rnu_ne(k,i) = rnu_ne(k,i)*4. --- > ! rnu_ne = rnu_ne*4. 249,252c245,248 < ! write(6,"('lamdas: lat=',i3,' k=',i3,' i=',i3,' te=', < ! | e12.4,' n2=',e12.4,' o2=',e12.4,' o1=',e12.4,' omega_e_inv=' < ! | ,e12.4,' rnu_ne=',e12.4)") lat,k,i,te(k,i),n2_cm3(k,i), < ! | o2_cm3(k,i),o1_cm3(k,i),omega_e_inv(i),rnu_ne(k,i) --- > ! call addfsech('RNU_O2P',' ',' ',rnu_o2p,i0,i1,nk,nkm1,lat) > ! call addfsech('RNU_OP' ,' ',' ',rnu_op ,i0,i1,nk,nkm1,lat) > ! call addfsech('RNU_NOP',' ',' ',rnu_nop,i0,i1,nk,nkm1,lat) > ! call addfsech('RNU_NE' ,' ',' ',rnu_ne ,i0,i1,nk,nkm1,lat) 254,264d249 < enddo ! k=lev0,lev1-1 < enddo ! i=lon0,lon1 < < ! call addfld('RNU_O2P',' ',' ',rnu_o2p, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('RNU_OP' ,' ',' ',rnu_op , < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('RNU_NOP',' ',' ',rnu_nop, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('RNU_NE' ,' ',' ',rnu_ne , < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) 294,299c279,284 < ! call addfld('ELECDEN' ,' ',' ',ne, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('SIGPEDin',' ',' ',sigma_ped(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('SIGHALin',' ',' ',sigma_hall(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > call addfsech('ELECDEN' ,' ',' ',ne ,i0,i1,nk,nkm1,lat) > ! call addfsech('OP' ,' ',' ',op ,i0,i1,nk,nkm1,lat) > ! call addfsech('O2P' ,' ',' ',o2p ,i0,i1,nk,nkm1,lat) > ! call addfsech('NOP' ,' ',' ',nop ,i0,i1,nk,nkm1,lat) > ! call addfsech('SIGMAPED',' ',' ',sigma_ped ,i0,i1,nk,nkm1,lat) > ! call addfsech('SIGMAHAL',' ',' ',sigma_hall,i0,i1,nk,nkm1,lat) 345,356c330,335 < ! call addfld('LAMDA1',' ',' ',lamda1, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('LAMDA2',' ',' ',lamda2, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('LXXNOROT',' ',' ',lxxnorot, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('LYYNOROT',' ',' ',lyynorot, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('LXYNOROT',' ',' ',lxynorot, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('LYXNOROT',' ',' ',lyxnorot, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('LAMDA1',' ',' ',lamda1,i0,i1,nk,nk,lat) > ! call addfsech('LAMDA2',' ',' ',lamda2,i0,i1,nk,nk,lat) > ! call addfsech('LXXNOROT',' ',' ',lxxnorot,i0,i1,nk,nk,lat) > ! call addfsech('LYYNOROT',' ',' ',lyynorot,i0,i1,nk,nk,lat) > ! call addfsech('LXYNOROT',' ',' ',lxynorot,i0,i1,nk,nk,lat) > ! call addfsech('LYXNOROT',' ',' ',lyxnorot,i0,i1,nk,nk,lat) 372,379c351,355 < ! call addfld('LXX','LXX','Hz',lxx(:,i0:i1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('LYY','LYY','Hz',lyy(:,i0:i1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('LXY','LXY','Hz',lxy(:,i0:i1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('LYX','LYX','Hz',lyx(:,i0:i1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > call addfsech('LXX','LXX','Hz',lxx(:,i0:i1),i0,i1,nk,nk,lat) > call addfsech('LYY','LYY','Hz',lyy(:,i0:i1),i0,i1,nk,nk,lat) > call addfsech('LXY','LXY','Hz',lxy(:,i0:i1),i0,i1,nk,nk,lat) > call addfsech('LYX','LYX','Hz',lyx(:,i0:i1),i0,i1,nk,nk,lat) > call addfsech('LAMDA1','LAMDA1 ','Hz',lamda1,i0,i1,nk,nk,lat) 394,399c370,373 < ! call addfld('SIGMAPED' ,'SIGMAPED','S/m ', < ! | ped_out(lev0:lev1-1,i0:i1), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('SIGMAHAL','SIGMAHAL','S/m ', < ! | hall_out(lev0:lev1-1,i0:i1), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('SIGMAPED' ,'SIGMAPED','S/m ',ped_out (:,i0:i1), > ! | i0,i1,nk,nkm1,lat) > ! call addfsech('SIGMAHAL','SIGMAHAL','S/m ',hall_out(:,i0:i1), > ! | i0,i1,nk,nkm1,lat) ======================================================================== Diff of /fis/hao/tgcm/tiegcm1.92/src/magfield.F and /ptmp/foster/ganglu_tiegcm_amie/modsrc2/magfield.F 4,7d3 < ! This software is part of the NCAR TIE-GCM. Use is governed by the < ! Open Source Academic Research License Agreement contained in the file < ! tiegcmlicense.txt. < ! 23c19 < use input_module,only: magvol --- > use input_module,only: tempdir,magvol 124c120 < subroutine magfield --- > subroutine magfield(dynamo) 129a126,128 > ! Args: > integer,intent(in) :: dynamo > ! 133a133,160 > ! Get and read magnetic data file. > ! 2/00: using new netcdf mag file (see ~foster/tgcm/mkmag) > ! 9/00: In new getms, if MPI, only master proc actually acquires mspath. > ! For systems without ncar mss (MSS==0), MAGVOL given in user input file > ! should be a local file name, e.g., MAGVOL='TGCM.data.magfield.nc' > > ! btf 1/14/05: Removing calls to acquire and read magvol, since apex coord > ! code is always called if DYNAMO=1. (i.e., there is no > ! "old dynamo", and the "new dynamo" always uses apex code. > ! > #if (MSS == 0) > dskfile = magvol > call get_diskfile(dskfile,' ') > #else > dskfile = ' ' > call getfile(magvol,dskfile) > #endif > ! > ! If dynamo==1, then dynamo will be called. The dynamo uses > ! apxparm (apex.F), so nc_rdmag is not necessary in this case. > ! > if (dynamo <= 0) then > call nc_rdmag(dskfile) > else > write(6,"('magfield: nc_rdmag not called because dynamo=', > | i2)") dynamo > endif > ! 135c162 < call dynpotmag --- > if (dynamo > 0) call dynpotmag 138,139c165,173 < #include < subroutine magdyn --- > subroutine nc_rdmag(dskfile) > ! > ! Read netcdf magnetic data file. > ! The mss data file (magvol) is set from input according to current > ! horizontal resolution. Currently (1/02) there are 2 such files: > ! /TGCM/data/magdat.nc for 5.0 degree resolution, and > ! /TGCM/data/magdat_2.5h.nc for 2.5 degree resolution. > ! These files are generated by code in hao /home/tgcm/mkmag, using > ! the apex parm code (s.a. Roy Barnes). 140a175,181 > ! The "original" cray-blocked file for 5 degrees was > ! /ECRIDLEY/ECR90/ECRMG6 (s.a. code in ~foster/tgcm/mkmag) > ! > implicit none > ! Args: > character(len=*),intent(in) :: dskfile > ! 142,143c183,196 < ! real,parameter :: sin10=0.17 ! should be equal to dipmin < real :: cos10 --- > integer :: istat,ncid,j > integer :: ids1(1),ids2(2),ids3(3),ids4(4) > integer :: id_nlat,id_nlonp1,id_nlatp2,id_dim2,id_dim3, > | id_nmlonp1,id_nmlat,id_dim4 > integer :: idv_alatm,idv_alonm,idv_xb,idv_yb,idv_zb,idv_bmod, > | idv_dmlat,idv_rjac,idv_av,idv_p,idv_rmag11,idv_rmagc,idv_rmag2, > | idv_rmag22,idv_rjacd,idv_im,idv_jm > integer :: idv_ig,idv_jg,idv_wt,idv_dim,idv_djm > integer :: idv_cslatm,idv_snlatm,idv_cslonm,idv_snlonm,idv_cslatg, > | idv_snlatg,idv_cslong,idv_snlong > integer :: start_1d(1),count_1d(1),start_2d(2),count_2d(2), > | start_3d(3),count_3d(3),start_4d(4),count_4d(4) > character(len=8) :: dimname > real :: fmin,fmax 145c198,200 < ! sin10 should be the same as dipmin (see cons.F) --- > write(6,"(/,72('-'))") > write(6,"('nc_rdmag: Read magnetic field data file ',a, > | /,10x,' (mss file ',a,')')") trim(dskfile),trim(magvol) 147,153c202,211 < #if (NLAT==36 && NLON==72) < real,parameter :: sin10=0.17 ! 5.0 deg horizontal resolution < #elif (NLAT==72 && NLON==144) < real,parameter :: sin10=0.24 ! 2.5 deg horizontal resolution < #else < UNKNOWN NLAT,NLON ! compilation will stop here if unknown res < #endif --- > ! Open the netcdf dataset: > call nc_open(ncid,dskfile,'OLD','READ') > if (ncid <= 0) then > write(6,"(/,'>>> nc_rdmag: error opening netcdf mag data ', > | 'file ',a)") trim(dskfile) > call shutdown('nc_rdmag') > ! else > ! write(6,"('nc_rdmag: opened netcdf mag data file ',a, > ! | ' ncid=',i8)") trim(dskfile),ncid > endif 154a213,442 > ! Check dimensions: > call checkdim(ncid,"nlat" ,nlat) > call checkdim(ncid,"nlonp1" ,nlonp1) > call checkdim(ncid,"nlatp2" ,nlatp1+1) > ! call checkdim(ncid,"nmlonp1",nmlonp1) > call checkdim(ncid,"nmlon" ,nmlonp1) > call checkdim(ncid,"nmlat" ,nmlat) > ! > ! Read variables for fieldz.h: > ! 2-d doubles (nlonp1,0:nlatp1): > start_2d(:) = 1 > count_2d(1) = nlonp1 > count_2d(2) = nlatp2 > call rd2dfld(ncid,'ALATM ',idv_alatm ,start_2d,count_2d,alatm ) > call rd2dfld(ncid,'ALONM ',idv_alonm ,start_2d,count_2d,alonm ) > call rd2dfld(ncid,'XB ',idv_xb ,start_2d,count_2d,xb ) > call rd2dfld(ncid,'YB ',idv_yb ,start_2d,count_2d,yb ) > call rd2dfld(ncid,'ZB ',idv_zb ,start_2d,count_2d,zb ) > call rd2dfld(ncid,'BMOD ',idv_bmod ,start_2d,count_2d,bmod ) > call rd2dfld(ncid,'DMLAT ',idv_dmlat ,start_2d,count_2d,dmlat ) > call rd2dfld(ncid,'P ',idv_p ,start_2d,count_2d,p ) > call rd2dfld(ncid,'RMAG11',idv_rmag11,start_2d,count_2d,rmag11) > call rd2dfld(ncid,'RMAGC ',idv_rmagc ,start_2d,count_2d,rmagc ) > call rd2dfld(ncid,'RMAG2 ',idv_rmag2 ,start_2d,count_2d,rmag2 ) > call rd2dfld(ncid,'RMAG22',idv_rmag22,start_2d,count_2d,rmag22) > call rd2dfld(ncid,'RJACD ',idv_rjacd ,start_2d,count_2d,rjacd ) > ! > ! RJAC(nlonp1,0:nlatp1,2,2): > start_4d(:) = 1 > count_4d(1) = nlonp1 > count_4d(2) = nlatp2 > count_4d(3:4) = 2 > istat = nf_inq_varid(ncid,'RJAC',idv_rjac) > istat = nf_get_vara_double(ncid,idv_rjac,start_4d,count_4d,rjac) > if (istat /= NF_NOERR) call handle_ncerr(istat, > | 'Error return from nf_get_vara_double for rjac') > call fminmax(rjac,nlonp1*nlatp2*2*2,fmin,fmax) > write(6,"(' RJAC min,max=',2e12.4)") fmin,fmax > ! > ! AV(nlonp1,0:nlatp1,3,2): > start_4d(:) = 1 > count_4d(1) = nlonp1 > count_4d(2) = nlatp2 > count_4d(3) = 3 > count_4d(4) = 2 > istat = nf_inq_varid(ncid,'AV',idv_av) > istat = nf_get_vara_double(ncid,idv_av,start_4d,count_4d,av) > if (istat /= NF_NOERR) call handle_ncerr(istat, > | 'Error return from nf_get_vara_double for av') > call fminmax(av,nlonp1*nlatp2*3*2,fmin,fmax) > write(6,"(' AV min,max=',2e12.4)") fmin,fmax > ! > ! Read variables to module data: > ! > ! IG(nmlonp1,nmlat) > start_2d(:) = 1 > count_2d(1) = nmlonp1 > count_2d(2) = nmlat > istat = nf_inq_varid(ncid,'IG',idv_ig) > istat = nf_get_vara_int(ncid,idv_ig,start_2d,count_2d,ig) > if (istat /= NF_NOERR) call handle_ncerr(istat, > | 'Error return from nf_get_vara_int for ig') > ! > ! JG(nmlonp1,nmlat) > count_2d(1) = nmlonp1 > count_2d(2) = nmlat > istat = nf_inq_varid(ncid,'JG',idv_jg) > istat = nf_get_vara_int(ncid,idv_jg,start_2d,count_2d,jg) > if (istat /= NF_NOERR) call handle_ncerr(istat, > | 'Error return from nf_get_vara_int for jg') > ! > ! IM(nlonp1,0:nlatp1): > count_2d(1) = nlonp1 > count_2d(2) = nlatp2 > istat = nf_inq_varid(ncid,'IM',idv_im) > istat = nf_get_vara_int(ncid,idv_im,start_2d,count_2d,im) > if (istat /= NF_NOERR) call handle_ncerr(istat, > | 'Error return from nf_get_vara_int for im') > ! > ! JM(nlonp1,0:nlatp1): > istat = nf_inq_varid(ncid,'JM',idv_jm) > istat = nf_get_vara_int(ncid,idv_jm,start_2d,count_2d,jm) > if (istat /= NF_NOERR) call handle_ncerr(istat, > | 'Error return from nf_get_vara_int for jm') > ! > ! WT(4,nmlonp1,nmlat): > start_3d(:) = 1 > count_3d(1) = 4 > count_3d(2) = nmlonp1 > count_3d(3) = nmlat > istat = nf_inq_varid(ncid,'WT',idv_wt) > istat = nf_get_vara_double(ncid,idv_wt,start_3d,count_3d,wt) > if (istat /= NF_NOERR) call handle_ncerr(istat, > | 'Error return from nf_get_vara_double for wt') > call fminmax(wt,4*nmlonp1*nmlat,fmin,fmax) > write(6,"(' WT min,max=',2e12.4)") fmin,fmax > ! > ! DIM and DJM(nlonp1,0:nlatp1): > start_2d(:) = 1 > count_2d(1) = nlonp1 > count_2d(2) = nlatp2 > call rd2dfld(ncid,'DIM ',idv_dim ,start_2d,count_2d,dim ) > call rd2dfld(ncid,'DJM ',idv_djm ,start_2d,count_2d,djm ) > ! > ! cslatm, snlatm, cslonm, snlonm: > start_2d(:) = 1 > count_2d(1) = nlonp1 > count_2d(2) = nlat > call rd2dfld(ncid,'CSLATM ',idv_cslatm ,start_2d,count_2d,cslatm) > call rd2dfld(ncid,'SNLATM ',idv_snlatm ,start_2d,count_2d,snlatm) > call rd2dfld(ncid,'CSLONM ',idv_cslonm ,start_2d,count_2d,cslonm) > call rd2dfld(ncid,'SNLONM ',idv_snlonm ,start_2d,count_2d,snlonm) > ! > ! CSLATG(nlat): > start_1d(:) = 1 > count_1d(1) = nlat > istat = nf_inq_varid(ncid,'CSLATG',idv_cslatg) > istat = nf_get_vara_double(ncid,idv_cslatg,start_1d,count_1d, > | cslatg) > if (istat /= NF_NOERR) call handle_ncerr(istat, > | 'Error return from nf_get_vara_double for cslatg') > call fminmax(cslatg,nlat,fmin,fmax) > write(6,"(' CSLATG min,max=',2e12.4)") fmin,fmax > ! > ! SNLATG(nlat): > istat = nf_inq_varid(ncid,'SNLATG',idv_snlatg) > istat = nf_get_vara_double(ncid,idv_snlatg,start_1d,count_1d, > | snlatg) > if (istat /= NF_NOERR) call handle_ncerr(istat, > | 'Error return from nf_get_vara_double for snlatg') > call fminmax(snlatg,nlat,fmin,fmax) > write(6,"(' SNLATG min,max=',2e12.4)") fmin,fmax > ! > ! CSLONG(nlonp1): > count_1d(1) = nlonp1 > istat = nf_inq_varid(ncid,'CSLONG',idv_cslong) > istat = nf_get_vara_double(ncid,idv_cslong,start_1d,count_1d, > | cslong) > if (istat /= NF_NOERR) call handle_ncerr(istat, > | 'Error return from nf_get_vara_double for cslong') > call fminmax(cslong,nlonp1,fmin,fmax) > write(6,"(' CSLONG min,max=',2e12.4)") fmin,fmax > ! > ! SNLONG(nlonp1): > istat = nf_inq_varid(ncid,'SNLONG',idv_snlong) > istat = nf_get_vara_double(ncid,idv_cslong,start_1d,count_1d, > | snlong) > if (istat /= NF_NOERR) call handle_ncerr(istat, > | 'Error return from nf_get_vara_double for snlong') > call fminmax(snlong,nlonp1,fmin,fmax) > write(6,"(' SNLONG min,max=',2e12.4)") fmin,fmax > ! > ! Close the dataset: > call nc_close(ncid) > write(6,"('Completed read of magnetic field data file.')") > write(6,"(72('-'),/)") > end subroutine nc_rdmag > !------------------------------------------------------------------- > subroutine checkdim(ncid,dimname,iparam) > ! > ! Get length of dimension "dimname". If this length is not equal > ! to iparam, stop with error message. > ! > implicit none > ! > ! Args: > integer,intent(in) :: ncid,iparam > character(len=*),intent(in) :: dimname > ! > ! Local: > integer :: istat,iddim,len > character(len=80) :: char80 > ! > ! Get dim id: > istat = nf_inq_dimid(ncid,dimname,iddim) > if (istat /= NF_NOERR) then > write(char80,"('nc_rdmag: error getting dim id for ', > | a)") dimname > call handle_ncerr(istat,char80) > endif > ! > ! Get dim length: > istat = nf_inq_dimlen(ncid,iddim,len) > if (istat /= NF_NOERR) then > write(char80,"('nc_rdmag: error getting length of ', > | 'dimension ',a)") dimname > call handle_ncerr(istat,char80) > endif > ! > ! Compare with iparam: > if (len /= iparam) then > write(6,"(/,'>>> nc_rdmag: unexpected length for ', > | 'dimension ',a)") dimname > write(6,"(' length read = ',i3,' should be = ',i3)") > | len,iparam > call shutdown('nc_rdmag') > endif > end subroutine checkdim > !------------------------------------------------------------------- > subroutine rd2dfld(ncid,name,idvout,start_2d,count_2d,var) > implicit none > ! > ! Read 2-d double array from ncid to var: > ! > ! Args: > integer,intent(in) :: ncid,start_2d(2),count_2d(2) > character(len=*),intent(in) :: name > integer,intent(out) :: idvout > real,intent(out) :: var(count_2d(1),count_2d(2)) > ! > ! Local: > integer :: istat > character(len=80) :: char80 > real :: fmin,fmax > ! > istat = nf_inq_varid(ncid,name,idvout) > istat = nf_get_vara_double(ncid,idvout,start_2d,count_2d,var) > write(char80,"('Error return from nf_get_vara_double for var', > | a)") name > if (istat /= NF_NOERR) call handle_ncerr(istat,char80) > ! call fminmax(var,count_2d(1)*count_2d(2),fmin,fmax) > ! write(6,"('rd2dfld: ',a,' fmin,max=',2e12.4)") name,fmin,fmax > end subroutine rd2dfld > !----------------------------------------------------------------------- > subroutine magdyn > ! > ! Local: > real,parameter :: sin10=0.17 ! should be equal to dipmin > real :: cos10 > ! 268a557,574 > ! do j=1,nlat > ! do k=1,nlevp1 > ! write(6,"('dynpotmag: j=',i2,' k=',i2,' dynpot(:,j,k)=',/, > ! | (6e12.4))") j,k,dynpot(:,j,k) > ! enddo > ! enddo > ! > ! Sub geo2mag input dynpot is transformed to magnetic grid in phim3d output. > ! subroutine geo2mag(fmag,fgeo,long,latg,wght,nlonp1_geo,nlonp1_mag, > ! | nlon_mag,nlat_mag,lat) > ! > ! do k=1,nlevp1 > ! do j=1,nmlat > ! call geo2mag(phim3d(1,j,k),dynpot(1,0,k),ig,jg,wt,nlonp1, > ! | nmlonp1,nmlon,nmlat,j) > ! enddo ! j=1,nmlat > ! enddo ! k=1,nlevp1 > ! 294,298c600,629 < do k=1,nlevp1 < do j=1,nmlat < phim3d(nmlonp1,j,k) = phim3d(1,j,k) < enddo ! j=1,nmlat < enddo ! k=1,nlevp1 --- > ! do k=1,nlevp1 > ! do j=1,nmlat > ! phim3d(nmlonp1,j,k) = phim3d(1,j,k) > ! enddo ! j=1,nmlat > ! enddo ! k=1,nlevp1 > ! > ! Save to secondary history from root task: > ! addfsech will not work because this routine is called once per run, > ! so write to stdout. > ! > ! if (mytid==0) then > ! do j=0,nlatp1 > ! call addfsech_ik('DYNPOT_0',' ',' ',dynpot(:,j,:), > ! | 1,nlonp1,nlevp1,nlevp1-1,j) > ! > ! dynpot(nlonp1,0:nlatp1,nlevp1), ! 3d electric potential geographic > ! call fminmax(dynpot(:,j,:),nlonp1*nlevp1,fmin,fmax) > ! write(6,"('dynpotmag: j=',i3,' dynpot min,max=',2e12.4)") > ! | j,fmin,fmax > ! enddo ! j=1,nlat > ! do j=1,nmlat > ! call addfsech_ik('PHIM3D_0',' ',' ',phim3d(:,j,:), > ! | 1,nmlonp1,nmlev,nmlev-1,j) > ! > ! | phim3d(nmlonp1,nmlat,-2:nlevp1) ! 3d electric potential magnetic > ! call fminmax(phim3d(:,j,:),nmlonp1*nmlev,fmin,fmax) > ! write(6,"('dynpotmag: j=',i3,' phim3d min,max=',2e12.4)") > ! | j,fmin,fmax > ! enddo ! j=1,nmlat > ! endif 338a670,699 > !----------------------------------------------------------------------- > ! subroutine geo2mag(fmag,fgeo,long,latg,wght,nlonp1_geo,nlonp1_mag, > ! | nlon_mag,nlat_mag,lat) > ! > ! Transform field fgeo on geographic grid to geomagnetic grid using > ! indices long,latg and weights wght. Return field fmag on magnetic grid. > ! This routine is similiar to sub geo2mag in dynamo.F. > ! > ! Args: > ! integer,intent(in) :: nlonp1_geo,nlonp1_mag,nlon_mag,nlat_mag,lat > ! integer,dimension(nlonp1_mag,nlat_mag),intent(in) :: long,latg > ! real,intent(in) :: fgeo(nlonp1_geo,*),wght(4,nlonp1_mag,nlat_mag) > ! real,intent(out) :: fmag(nlonp1_mag,*) > ! integer,intent(in) :: iprint > ! > ! Local: > ! integer :: i > ! > ! do i=1,nlon_mag > ! fmag(i,1) = > ! | fgeo(long(i,lat) ,latg(i,lat) )*wght(1,i,lat)+ > ! | fgeo(long(i,lat)+1,latg(i,lat) )*wght(2,i,lat)+ > ! | fgeo(long(i,lat)+1,latg(i,lat)+1)*wght(3,i,lat)+ > ! | fgeo(long(i,lat) ,latg(i,lat)+1)*wght(4,i,lat) > ! if (iprint > 0) write(6,"('geo2mag: i=',i3,' lat=',i3,' long=', > ! | i3,' latg=',i3,' wght=',4e12.4,' fgeo=',e12.4,' fmag=', > ! | e12.4)") i,lat,long(i,lat),latg(i,lat),wght(:,i,lat), > ! | fgeo(long(i,lat),latg(i,lat)),fmag(i,1) > ! enddo > ! end subroutine geo2mag ======================================================================== Diff of /fis/hao/tgcm/tiegcm1.92/src/nchist.F and /ptmp/foster/ganglu_tiegcm_amie/modsrc2/nchist.F 3,12c3,4 < ! < ! This software is part of the NCAR TIE-GCM. Use is governed by the < ! Open Source Academic Research License Agreement contained in the file < ! tiegcmlicense.txt. < ! < ! Module to create, read and write netcdf history files: < ! < use params_module,only: nlon,nlev,nmlev,nimlev,nmlevp1,nimlevp1, < | nlat,nlevp1,spval,nlonp4,nlonp2,nmlonp1,nmlat,nmlon,zmbot,zmtop, < | zibot,zitop,mxfsech --- > use params_module,only: nlon,nlev,nmlev,nlat,nlevp1,spval,nlonp4, > | nlonp1,nmlonp1,nmlat,nmlon,nmagphrlon,nmagphrlat 14,22c6,7 < | fsechist,itc,itp,fields_4d,fields_3d,fields_2d,poten,foutput, < | tlbc,ulbc,vlbc,tlbc_glb,ulbc_glb,vlbc_glb, < | tlbc_nm,ulbc_nm,vlbc_nm,tlbc_nm_glb,ulbc_nm_glb,vlbc_nm_glb, < | nf3d,fzg < use input_module,only: mxlen_filename, < | gswm_mi_di_ncfile, gswm_mi_sdi_ncfile, < | gswm_nm_di_ncfile, gswm_nm_sdi_ncfile < use init_module,only: glon,glat,zpmid,zpint,gmlon,gmlat,istep, < | start_mtime,zpmag_mid,zpmag_int --- > | fsech,fsechmag,fsech2d,fsechmag2d,fsechmagphr2d, > | itc,itp,fields_4d,fields_3d,fields_2d,poten,foutput 24a10,11 > ! Module to create, read and write netcdf history files: > ! 33,37c20,23 < | id_mtimedim, ! dimension id for model time (3) < | id_lon,id_lat, ! horizontal dimension ids < | id_lev,id_ilev, ! vertical dimension ids (midpoints,interfaces) < | id_mlon,id_mlat, ! horizontal dimension ids for magnetic grid < | id_mlev,id_imlev, ! vertical dimension ids for magnetic grid --- > | id_mtime, ! dimension id for model time (3) > | id_lon,id_lat,id_lev, ! dimension ids for 3d model grid > | id_mlon,id_mlat,id_mlev, ! dimension ids for 3d magnetic grid > | id_magphrlon,id_magphrlat, ! dimension ids for 2d magnetosphere grid 42,44c28 < | id_datelen, ! length of date and time < | id_filelen, ! max length of a file name < | ids1(1),ids2(2),ids3(3),ids4(4),! vectors of dim id's --- > | ids1(1),ids2(2),ids3(3),ids4(4), ! vectors of dim id's 54,67c38,47 < | idv_time,idv_mtime,idv_ut,idv_calendar_adv, < | idv_lon,idv_lat,idv_lev,idv_ilev, < | idv_lbc,idv_tlbc,idv_ulbc,idv_vlbc, < | idv_tlbc_nm,idv_ulbc_nm,idv_vlbc_nm, < | idv_mlon,idv_mlat,idv_mlev,idv_imlev,idv_p0_model, < | idv_step,idv_iter,idv_year,idv_day,idv_p0,idv_grav, < | idv_zg,idv_hpower,idv_ctpoten,idv_bximf,idv_byimf,idv_bzimf, < | idv_colfac,idv_swden,idv_swvel,idv_al, < | idv_gswm_mi_di_ncfile,idv_gswm_mi_sdi_ncfile, < | idv_gswm_nm_di_ncfile,idv_gswm_nm_sdi_ncfile, < | idv_see_ncfile,idv_gpi_ncfile,idv_ncep_ncfile, < | idv_f107d,idv_f107a,idv_imf_ncfile,idv_mag,idv_dtide, < | idv_sdtide,idv_f4d(nf4d),idv_e1,idv_e2,idv_h1,idv_h2,idv_alfac, < | idv_ec,idv_alfad,idv_ed,idv_writedate --- > | idv_time,idv_mtime,idv_ut, ! variable id's > | idv_lon,idv_lat,idv_lev, > | idv_mlon,idv_mlat,idv_mlev, > | idv_magphrlon,idv_magphrlat, > | idv_step,idv_iter,idv_year,idv_day,idv_p0, > | idv_hpower,idv_ctpoten,idv_byimf,idv_colfac,idv_ncep, > | idv_gpi,idv_gswmdi,idv_gswmsdi,idv_gswmnmdi,idv_gswmnmsdi, > | idv_f107d,idv_f107a, > | idv_mag,idv_dtide,idv_sdtide,idv_nflds,idv_f4d(nf4d), > | idv_alfa30,idv_e30,idv_ed2,idv_alfad2 69d48 < integer :: idv_fsech(mxfsech) 72c51,52 < ! history. --- > ! history. Sub check_nans (util.F) will be called from subs wrf4d, wrf3d, > ! wrf2d, and rdf4d. This sub works only on IBM-AIX. 75c55 < logical :: check_nan = .true. --- > logical :: check_nan = .false. 147c127 < !----------------------------------------------------------------------- --- > !------------------------------------------------------------------- 175c155 < use hist_module,only: sh,hist_initype,hist_print,nsource, --- > use hist_module,only: h,hist_initype,hist_print,nsource, 176a157,158 > use init_module,only: istep,start_mtime,glon,glat,plev, > | gmlon,gmlat,pmlev 186,188c168,169 < integer,parameter :: mxvars=100 ! max # 4d vars < integer :: istat,id_time,id_mtimedim,mtime_read(3),ntimes, < | i,ix,istart2(2),icount2(2),j,i4dims(4) --- > integer :: istat,id_time,id_mtime,mtime_read(3),ntimes, > | i,ix,istart2(2),icount2(2),j,irdf4d(nf4d_hist) 192,194c173 < character(len=80) :: varnames(mxvars)=' ' < real :: scalar,var1(1),var22(2,2),var2(2),var10(10),varlbc < real,dimension(nlevp1) :: zpmid_rd,zpint_rd --- > real :: scalar,var1(1),var22(2,2),var2(2),var10(10) 196,202d174 < integer,parameter :: mxf4d=100 < character(len=16) :: f4dnames(mxf4d) ! list of 4d fields read < logical :: found < ! < ! External: < logical,external :: arrayeq ! util.F < ! 251c223 < call hist_initype(sh,istep) ! initialize history structure --- > call hist_initype(h,istep) ! initialize history structure 254,256c226,228 < sh%ihist = itime < sh%modeltime(1:3) = mtime < sh%modeltime(4) = 0 --- > h%ihist = itime > h%modeltime(1:3) = mtime > h%modeltime(4) = 0 259,265c231,235 < istat = nf_get_att_text(ncid,NF_GLOBAL,"label",sh%label) < istat = nf_get_att_text(ncid,NF_GLOBAL,"create_date", < | sh%create_date) < istat = nf_get_att_text(ncid,NF_GLOBAL,"logname",sh%logname) < istat = nf_get_att_text(ncid,NF_GLOBAL,"host",sh%host) < istat = nf_get_att_text(ncid,NF_GLOBAL,"system",sh%system) < istat = nf_get_att_text(ncid,NF_GLOBAL,"model_name",sh%model_name) --- > istat = nf_get_att_text(ncid,NF_GLOBAL,"rundate",h%rundate) > istat = nf_get_att_text(ncid,NF_GLOBAL,"logname",h%logname) > istat = nf_get_att_text(ncid,NF_GLOBAL,"host",h%host) > istat = nf_get_att_text(ncid,NF_GLOBAL,"system",h%system) > istat = nf_get_att_text(ncid,NF_GLOBAL,"model_name",h%model_name) 267,273c237,241 < | sh%model_version) < istat = nf_get_att_int(ncid,NF_GLOBAL,"source_mtime", < | sh%source_mtime) < istat = nf_get_att_text(ncid,NF_GLOBAL,"initial_file", < | sh%initial_file) < if (istat /= NF_NOERR) ! was not on "old" histories < | sh%initial_file = ' ' --- > | h%model_version) > istat = nf_get_att_text(ncid,NF_GLOBAL,"mss_path",h%mss_path) > istat = nf_get_att_text(ncid,NF_GLOBAL,"mss_source",h%mss_source) > istat = nf_get_att_text(ncid,NF_GLOBAL,"mss_secsource", > | h%mss_secsource) 275,276c243,245 < ! History_type is either "primary" or "secondary": < istat=nf_get_att_text(ncid,NF_GLOBAL,"history_type",sh%hist_type) --- > ! If this is a continuation run, read initial time from the history. > ! Otherwise (this is an initial run) the initial time was set to the > ! model start time by hist_initype. 278,290c247,263 < ! Check for tuv_lbc_intop (lbc of t,u,v stored in top slot) < ! tuv_lbc_intop == 0 --> new history (tuv lbc *not* stored in top slot) < ! tuv_lbc_intop == 1 --> old history (tuv lbc *is* stored in top slot) < ! If tuv_lbc_intop global attribute is not on the file, assume < ! "old" history, i.e., tuv_lbc_intop==1: < ! < istat=nf_get_att_int(ncid,NF_GLOBAL,"tuv_lbc_intop", < | sh%tuv_lbc_intop) < if (istat /= NF_NOERR) then ! old hist < write(6,"('nc_rdhist: did not find tuv_lbc_intop in source', < | ' history ',a,' --> assuming tuv_lbc_intop==1')") < | trim(diskfile) < sh%tuv_lbc_intop = 1 --- > if (nsource <= 0) then > istat=nf_get_att_int(ncid,NF_GLOBAL,"initial_year", > | h%initial_year) > if (istat /= NF_NOERR) istat=nf_get_att_int(ncid,NF_GLOBAL, > | "start_year" ,h%initial_year) > > istat=nf_get_att_int(ncid,NF_GLOBAL,"initial_day",h%initial_day) > if (istat /= NF_NOERR) istat=nf_get_att_int(ncid,NF_GLOBAL, > | "start_day" ,h%initial_day) > > istat=nf_get_att_int(ncid,NF_GLOBAL,"initial_mtime", > | h%initial_mtime) > if (istat /= NF_NOERR) istat=nf_get_att_int(ncid,NF_GLOBAL, > | "start_mtime",h%initial_mtime) > > istat=nf_get_att_int(ncid,NF_GLOBAL,"source_mtime", > | h%source_mtime) 292a266,268 > ! History_type is either "primary" or "secondary": > istat = nf_get_att_text(ncid,NF_GLOBAL,"history_type",h%type) > ! 309c285 < sh%nlon = len --- > h%nlon = len 318c294 < sh%nlat = len --- > h%nlat = len 326,330c302,303 < write(6,"(/,'>>> FATAL: source history vertical dimension', < | ' does not match model levels dimension.')") < write(6,"(/,'nc_rdhist: length of lev dimension', < | ' on source history is less than model parameter ', < | 'nlevp1.')") --- > write(6,"(/,'>>> nc_rdhist: length of lev dimension', > | ' of history read is less than model parameter nlevp1.')") 347c320 < sh%nlev = len --- > h%nlev = len 354,358d326 < if (istat /= NF_NOERR) then < write(6,"('>>> nc_rdhist: error ', < | 'inquiring about var: i=',i4,' nvars=',i4)") i,nvars < call handle_ncerr(istat,'inquiring about a var') < endif 368,369d335 < ! < ! New hist: lev(lev) is midpoints 371,440c337,339 < if (sh%tuv_lbc_intop <= 0) then ! new hist (lev is midpoints) < istat = nf_get_var_double(ncid,i,zpmid_rd) < if (istat /= NF_NOERR) < | call handle_ncerr(istat,'reading zpmid (new history)') < < ! write(6,"('nc_rdhist sh%nlev=',i3,': read zpmid from new', < ! | ' hist: zpmid_rd=',/,(10f7.3))") sh%nlev,zpmid_rd < < if (.not.arrayeq(zpmid,zpmid_rd,nlevp1)) then < write(6,"(/,'>>> nc_rdhist: zpmid_rd (as read from new', < | ' history) is not equal to model zpmid')") < write(6,"('nlevp1=',i3,' zpmid_rd=',/,(10f7.3))") < | nlevp1,zpmid_rd < write(6,"('nlevp1=',i3,' zpmid =',/,(10f7.3))") < | nlevp1,zpmid < call shutdown('zpmid') < endif < ! < ! Old hist lev(lev) is interfaces: < else ! old hist (lev is interfaces) < istat = nf_get_var_double(ncid,i,zpint_rd) < if (istat /= NF_NOERR) < | call handle_ncerr(istat,'reading zpint (old history)') < < ! write(6,"('nc_rdhist sh%nlev=',i3,': read zpint from old', < ! | ' hist: zpint_rd=',/,(10f7.3))") sh%nlev,zpint_rd < < if (.not.arrayeq(zpint,zpint_rd,nlevp1)) then < write(6,"(/,'>>> nc_rdhist: zpint_rd (as read from old', < | ' history) is not equal to model zpint')") < write(6,"('nlevp1=',i3,' zpint_rd=',/,(10f7.3))") < | nlevp1,zpint_rd < write(6,"('nlevp1=',i3,' zpint =',/,(10f7.3))") < | nlevp1,zpint < call shutdown('zpint') < endif < endif < ! < ! ilev(ilev) interface levels are on new histories, or histories written < ! by mksrc.ncl (i.e., new lbc from old histories): < case('ilev') < if (sh%tuv_lbc_intop <= 0) then ! new hist (lev is midpoints) < istat = nf_get_var_double(ncid,i,zpint_rd) < if (istat /= NF_NOERR) < | call handle_ncerr(istat,'reading zpint (new history)') < if (.not.arrayeq(zpint,zpint_rd,nlevp1)) then < write(6,"(/,'>>> nc_rdhist: zpint_rd (as read from new', < | ' history) is not equal to model zpint')") < write(6,"('nlevp1=',i3,' zpint_rd=',/,(10f7.3))") < | nlevp1,zpint_rd < write(6,"('nlevp1=',i3,' zpint =',/,(10f7.3))") < | nlevp1,zpint < call shutdown('zpint') < endif < else ! old hist ilev interfaces (probably written by mksrc.ncl) < istat = nf_get_var_double(ncid,i,zpint_rd) < if (istat /= NF_NOERR) < | call handle_ncerr(istat,'reading zpint (old history)') < if (.not.arrayeq(zpint,zpint_rd,nlevp1)) then < write(6,"(/,'>>> nc_rdhist: zpint_rd (as read from new', < | ' history) is not equal to model zpint')") < write(6,"('nlevp1=',i3,' zpint_rd=',/,(10f7.3))") < | nlevp1,zpint_rd < write(6,"('nlevp1=',i3,' zpint =',/,(10f7.3))") < | nlevp1,zpint < call shutdown('zpint') < endif < endif < ! < ! Magnetic coordinates: --- > istat = nf_get_var_double(ncid,i,plev) > if (istat /= NF_NOERR) > | call handle_ncerr(istat,'reading plev') 449,460c348,351 < case('mlev') ! mag midpoints < ! istat = nf_get_var_double(ncid,i,zpmag) ! zpmag is in init module < ! if (istat /= NF_NOERR) < ! | call handle_ncerr(istat,'reading zpmag') < ! write(6,"('nc_rdhist: read zpmag=',/,(8f8.2))") zpmag < < case('imlev') ! mag interfaces < ! istat = nf_get_var_double(ncid,i,zpimag) ! zpimag is in init module < ! if (istat /= NF_NOERR) < ! | call handle_ncerr(istat,'reading zpimag') < ! < ! Time: --- > case('mlev') > istat = nf_get_var_double(ncid,i,pmlev) > if (istat /= NF_NOERR) > | call handle_ncerr(istat,'reading pmlev') 465,478c356 < sh%time = scalar < ! < ! If this is a continuation run, read initial times < ! (If an initial run, initial times were set by sub hist_initype (hist.F)) < ! < if (nsource <= 0) then < istat=nf_get_att_int(ncid,i,"initial_year", < | sh%initial_year) < istat=nf_get_att_int(ncid,i,"initial_day", < | sh%initial_day) < istat=nf_get_att_int(ncid,i,"initial_mtime", < | sh%initial_mtime) < endif < ! --- > h%time = scalar 484c362 < sh%year = iscalar --- > h%year = iscalar 489c367 < sh%day = iscalar --- > h%day = iscalar 494c372 < sh%iter = iscalar --- > h%iter = iscalar 499c377,382 < sh%ut = scalar --- > h%ut = scalar > case('mag') > istat = nf_get_var_double(ncid,i,var22) > if (istat /= NF_NOERR) > | call handle_ncerr(istat,'reading mag') > h%mag(:,:) = var22(:,:) 502c385 < istart2(2) = sh%ihist --- > istart2(2) = h%ihist 508c391 < sh%dtide(:) = var2(:) --- > h%dtide(:) = var2(:) 511c394 < istart2(2) = sh%ihist --- > istart2(2) = h%ihist 517c400 < sh%sdtide(:) = var10(:) --- > h%sdtide(:) = var10(:) 522c405 < sh%f107d = scalar --- > h%f107d = scalar 527c410 < sh%f107a = scalar --- > h%f107a = scalar 532c415 < sh%hpower = scalar --- > h%hpower = scalar 537,542c420 < sh%ctpoten = scalar < case('bximf') < istat = nf_get_var1_double(ncid,i,itime,scalar) < if (istat /= NF_NOERR) < | call handle_ncerr(istat,'reading bximf') < sh%bximf = scalar --- > h%ctpoten = scalar 547,548c425,426 < sh%byimf = scalar < case('bzimf') --- > h%byimf = scalar > case('colfac') 551,553c429,431 < | call handle_ncerr(istat,'reading bzimf') < sh%bzimf = scalar < case('swvel') --- > | call handle_ncerr(istat,'reading colfac') > h%colfac = scalar > case('alfa30') 556,558c434,436 < | call handle_ncerr(istat,'reading swvel') < sh%swvel = scalar < case('swden') --- > | call handle_ncerr(istat,'reading alfa30') > h%alfa30 = scalar > case('e30') 561,563c439,441 < | call handle_ncerr(istat,'reading swden') < sh%swden = scalar < case('al') --- > | call handle_ncerr(istat,'reading e30') > h%e30 = scalar > case('ed2') 566,568c444,446 < | call handle_ncerr(istat,'reading al') < sh%al = scalar < case('colfac') --- > | call handle_ncerr(istat,'reading ed2') > h%ed2 = scalar > case('alfad2') 571,607c449,450 < | call handle_ncerr(istat,'reading colfac') < sh%colfac = scalar < case('e1') < istat = nf_get_var1_double(ncid,i,itime,scalar) < if (istat /= NF_NOERR) call handle_ncerr(istat,'reading e1') < sh%e1 = scalar < case('e2') < istat = nf_get_var1_double(ncid,i,itime,scalar) < if (istat /= NF_NOERR) call handle_ncerr(istat,'reading e2') < sh%e2 = scalar < case('h1') < istat = nf_get_var1_double(ncid,i,itime,scalar) < if (istat /= NF_NOERR) call handle_ncerr(istat,'reading h1') < sh%h1 = scalar < case('h2') < istat = nf_get_var1_double(ncid,i,itime,scalar) < if (istat /= NF_NOERR) call handle_ncerr(istat,'reading h2') < sh%h2 = scalar < case('ec') < istat = nf_get_var1_double(ncid,i,itime,scalar) < if (istat /= NF_NOERR) call handle_ncerr(istat,'reading ec') < sh%ec = scalar < case('ed') < istat = nf_get_var1_double(ncid,i,itime,scalar) < if (istat /= NF_NOERR) call handle_ncerr(istat,'reading ed') < sh%ed = scalar < case('alfac') < istat = nf_get_var1_double(ncid,i,itime,scalar) < if (istat /= NF_NOERR) < | call handle_ncerr(istat,'reading alfac') < sh%alfac = scalar < case('alfad') < istat = nf_get_var1_double(ncid,i,itime,scalar) < if (istat /= NF_NOERR) < | call handle_ncerr(istat,'reading alfad') < sh%alfad = scalar < --- > | call handle_ncerr(istat,'reading alfad2') > h%alfad2 = scalar 612,622c455 < sh%p0 = var1(1) < case('p0_model') < istat = nf_get_var_double(ncid,i,var1) < if (istat /= NF_NOERR) < | call handle_ncerr(istat,'reading p0_model') < sh%p0_model = var1(1) < case('grav') < istat = nf_get_var_double(ncid,i,var1) < if (istat /= NF_NOERR) < | call handle_ncerr(istat,'reading grav') < sh%grav = var1(1) --- > h%p0 = var1(1) 627,636c460,468 < sh%step = iscalar < ! < ! GPI data file: gpi_ncfile(time,filelen), where filelen=mxlen_filename < case('gpi_ncfile') < start_2d(1) = 1 < start_2d(2) = sh%ihist < count_2d(1) = mxlen_filename < count_2d(2) = 1 < istat = nf_get_vara_text(ncid,i,start_2d,count_2d, < | sh%gpi_ncfile) --- > h%step = iscalar > case('nflds') > istat = nf_get_var_int(ncid,i,iscalar) > if (istat /= NF_NOERR) > | call handle_ncerr(istat,'reading nflds') > h%nflds = iscalar > ! ncep is time-gcm only, but leave here for time being.. > case('ncep') ! time-gcm only > istat = nf_get_var1_int(ncid,i,itime,iscalar) 638,688c470,473 < | call handle_ncerr(istat,'reading gpi_ncfile') < if (len_trim(sh%gpi_ncfile)==0) sh%gpi_ncfile='[none]' < ! < ! NCEP data file: ncep_ncfile(time,filelen), where filelen=mxlen_filename < ! (ncep files used only by timegcm -- will always be '[none]' for tiegcm) < case('ncep_ncfile') ! new histories < start_2d(1) = 1 < start_2d(2) = sh%ihist < count_2d(1) = mxlen_filename < count_2d(2) = 1 < istat = nf_get_vara_text(ncid,i,start_2d,count_2d, < | sh%ncep_ncfile) < if (istat /= NF_NOERR) < | call handle_ncerr(istat,'reading ncep_ncfile') < if (len_trim(sh%ncep_ncfile)==0) sh%ncep_ncfile='[none]' < ! < ! SEE data file: see_ncfile(time,filelen), where filelen=mxlen_filename < case('see_ncfile') ! new histories < start_2d(1) = 1 < start_2d(2) = sh%ihist < count_2d(1) = mxlen_filename < count_2d(2) = 1 < istat = nf_get_vara_text(ncid,i,start_2d,count_2d, < | sh%see_ncfile) < if (istat /= NF_NOERR) < | call handle_ncerr(istat,'reading see_ncfile') < if (len_trim(sh%see_ncfile)==0) sh%see_ncfile='[none]' < ! < ! IMF data file: imf_ncfile(time,filelen), where filelen=mxlen_filename < case('imf_ncfile') ! new histories < start_2d(1) = 1 < start_2d(2) = sh%ihist < count_2d(1) = mxlen_filename < count_2d(2) = 1 < istat = nf_get_vara_text(ncid,i,start_2d,count_2d, < | sh%imf_ncfile) < if (istat /= NF_NOERR) < | call handle_ncerr(istat,'reading imf_ncfile') < if (len_trim(sh%imf_ncfile)==0) sh%imf_ncfile='[none]' < ! < ! GSWM data files (from namelist input): < ! character(len=mxlen_filename) :: < ! gswm_mi_di_ncfile, ! GSWM migrating diurnal data file < ! gswm_mi_sdi_ncfile,! GSWM migrating semi-diurnal data file < ! gswm_nm_di_ncfile, ! GSWM non-migrating diurnal data file < ! gswm_nm_sdi_ncfile,! GSWM non-migrating semi-diurnal data file < ! < ! gswm_mi_di_ncfile: < case('gswm_mi_di_ncfile') < istat = nf_get_vara_text(ncid,i,start_2d,count_2d, < | sh%gswm_mi_di_ncfile) --- > | call handle_ncerr(istat,'reading ncep') > h%ncep = iscalar > case('gpi') > istat = nf_get_var1_int(ncid,i,itime,iscalar) 690,695c475,478 < | call handle_ncerr(istat,'reading gswm_mi_di_ncfile') < ! < ! gswm_mi_sdi_ncfile: < case('gswm_mi_sdi_ncfile') < istat = nf_get_vara_text(ncid,i,start_2d,count_2d, < | sh%gswm_mi_sdi_ncfile) --- > | call handle_ncerr(istat,'reading gpi') > h%gpi = iscalar > case('gswmdi') > istat = nf_get_var1_int(ncid,i,itime,iscalar) 697,702c480,483 < | call handle_ncerr(istat,'reading gswm_mi_sdi_ncfile') < ! < ! gswm_nm_di_ncfile: < case('gswm_nm_di_ncfile') < istat = nf_get_vara_text(ncid,i,start_2d,count_2d, < | sh%gswm_nm_di_ncfile) --- > | call handle_ncerr(istat,'reading gswmdi') > h%gswmdi = iscalar > case('gswmsdi') > istat = nf_get_var1_int(ncid,i,itime,iscalar) 704c485,497 < | call handle_ncerr(istat,'reading gswm_nm_di_ncfile') --- > | call handle_ncerr(istat,'reading gswmsdi') > h%gswmsdi = iscalar > > case('gswmnmdi') > istat = nf_get_var1_int(ncid,i,itime,iscalar) > if (istat /= NF_NOERR) > | call handle_ncerr(istat,'reading gswmnmdi') > h%gswmnmdi = iscalar > case('gswmnmsdi') > istat = nf_get_var1_int(ncid,i,itime,iscalar) > if (istat /= NF_NOERR) > | call handle_ncerr(istat,'reading gswmnmsdi') > h%gswmnmsdi = iscalar 706,709c499,501 < ! gswm_nm_sdi_ncfile: < case('gswm_nm_sdi_ncfile') < istat = nf_get_vara_text(ncid,i,start_2d,count_2d, < | sh%gswm_nm_sdi_ncfile) --- > ! Check for gswm names prior to tiegcm1.8: > case('gswmnmidi') ! histories prior to tiegcm1.8 > istat = nf_get_var1_int(ncid,i,itime,iscalar) 711,712c503,509 < | call handle_ncerr(istat,'reading gswm_nm_sdi_ncfile') < --- > | call handle_ncerr(istat,'reading gswmnmidi') > h%gswmnmdi = iscalar > case('gswmnmisdi') ! histories prior to tiegcm1.8 > istat = nf_get_var1_int(ncid,i,itime,iscalar) > if (istat /= NF_NOERR) > | call handle_ncerr(istat,'reading gswmnmisdi') > h%gswmnmsdi = iscalar 713a511 > 715,747c513 < ! < ! Interface level of lower boundary (scalar coord for TLBC,ULBC,VLBC): < case('LBC') < istat = nf_get_var1_double(ncid,i,itime,varlbc) < if (istat /= NF_NOERR) < | call handle_ncerr(istat,'reading LBC') < if (varlbc /= zibot) then < write(6,"(/,'>>> WARNING nc_rdhist read LBC: varlbc=', < | f8.2,' but should equal zibot=',f8.2)") varlbc,zibot < else < sh%lbc = varlbc < write(6,"('Read LBC from source history: i=',i3, < | ' sh%lbc=',f8.2)") i,sh%lbc < endif < ! < ! Read lbc's for t,u,v. See fields.F. These will exist on source history < ! only if sh%tuv_lbc_intop==0, i.e., "new histories"). Read into global < ! arrays, then store subdomains. < ! < case('TLBC') < call rdlbc(ncid,i,tlbc,varname,itime) < case('ULBC') < call rdlbc(ncid,i,ulbc,varname,itime) < case('VLBC') < call rdlbc(ncid,i,vlbc,varname,itime) < case('TLBC_NM') < call rdlbc(ncid,i,tlbc_nm,varname,itime) < case('ULBC_NM') < call rdlbc(ncid,i,ulbc_nm,varname,itime) < case('VLBC_NM') < call rdlbc(ncid,i,vlbc_nm,varname,itime) < ! < ! Check for variable name in 4-d fields: --- > 751a518 > irdf4d(j) = 1 753,754d519 < sh%nflds = sh%nflds+1 < varnames(sh%nflds) = varname 757,770d521 < ! < ! 10/27/05 btf: This conditional covers "W" from old histories. < ! (var name "W" has been changed to "OMEGA" on the new histories) < ! < elseif (varname=='W') then < do j=1,nf4d_hist < if (f4d(j)%short_name=='OMEGA') then < call rdf4d(ncid,varname,itime,j) < sh%nflds = sh%nflds+1 < varnames(sh%nflds) = varname < endif < enddo < ! < ! Variable is unknown to the model: 772c523 < write(6,"('Note nc_rdhist: unused variable: ',a)") --- > write(6,"('Note nc_rdhist: unknown variable: ',a)") 776a528,529 > h%zptop = plev(nlevp1) > h%zpbot = plev(1) 778,797d530 < sh%zmtop = zmtop < sh%zmbot = zmbot < sh%zitop = zitop < sh%zibot = zibot < if (associated(sh%fnames)) deallocate(sh%fnames) < if (sh%nflds > 0) then < allocate(sh%fnames(sh%nflds),stat=ier) < if (ier /= 0) then < write(6,"('>>> nc_rdhist: error allocating sh%fnames with ', < | ' sh%nflds=',i4)") sh%nflds < call shutdown('source hist nflds') < endif < else < write(6,"('>>> sh%nflds=',i4)") sh%nflds < call shutdown('sh%nflds') < endif < do i=1,sh%nflds < sh%fnames(i) = varnames(i) < enddo < ! 799c532 < call hist_print(sh,'READ',diskfile) --- > call hist_print(h,'READ',diskfile) 803,879d535 < subroutine rdlbc(ncid,idv,flbc,vname,itime) < ! < ! Read global TLBC, ULBC, or VLBC from current history, and transfer to < ! subdomains tlbc, ulbc, or vlbc (fields.F). < ! < use mpi_module,only: lon0,lon1,lat0,lat1 < use fields_module,only: lond0,lond1,latd0,latd1 < ! Routine to add fields to secondary histories: < use addfld_module,only: addfld < implicit none < ! < ! Args: < integer,intent(in) :: ncid,idv,itime < character(len=*),intent(in) :: vname < real,intent(out) :: flbc(lond0:lond1,latd0:latd1) < ! < ! Local: < integer :: istat,i,j,lonbeg,lonend < real,dimension(nlon,nlat) :: glbc ! lbc at global domain < character(len=80) :: char80 < ! < start_3d(1:2) = 1 < start_3d(3) = itime < count_3d(1) = nlon < count_3d(2) = nlat < count_3d(3) = 1 < ! < ! Read global domain into local glbc: < istat = nf_get_vara_double(ncid,idv,start_3d,count_3d,glbc) < if (istat /= NF_NOERR) then < write(char80,"('Error reading ',a,' ncid=',i3)") < | trim(vname),ncid < call handle_ncerr(istat,trim(char80)) < endif < ! < ! Store subdomain in flbc (actual arg is tlbc, ulbc, or vlbc): < lonbeg = lon0 < if (lon0==1) lonbeg = 3 < lonend = lon1 < if (lon1==nlonp4) lonend = lon1-2 < do j=lat0,lat1 < do i=lonbeg,lonend < flbc(i,j) = glbc(i-2,j) < enddo < enddo < < #ifndef MPI < ! Periodic points for non-MPI runs: < flbc(1:2,:) = flbc(nlonp4-3:nlonp4-2,:) < flbc(nlonp4-1:nlonp4,:) = flbc(3:4,:) < #endif < < write(6,"('Read ',a,' subdomain from source history: min,max=', < | 2f8.2)") trim(vname), minval(flbc(lon0:lon1,lat0:lat1)), < | maxval(flbc(lon0:lon1,lat0:lat1)) < < ! if (trim(vname)=='TLBC') then < ! do i=lon0,lon1 < ! write(6,"('rdlbc: i=',i3,' lat0,1=',2i3,' tlbc(i,lat0:lat1)=', < ! | /,(6e12.4))") i,lat0,lat1,tlbc(i,lat0:lat1) < ! enddo ! j=lat0,lat1 < ! endif < ! if (trim(vname)=='ULBC') then < ! do i=lon0,lon1 < ! write(6,"('rdlbc: i=',i3,' lat0,1=',2i3,' ulbc(i,lat0:lat1)=', < ! | /,(6e12.4))") i,lat0,lat1,ulbc(i,lat0:lat1) < ! enddo ! j=lat0,lat1 < ! endif < ! if (trim(vname)=='VLBC') then < ! do i=lon0,lon1 < ! write(6,"('rdlbc: i=',i3,' lat0,1=',2i3,' vlbc(i,lat0:lat1)=', < ! | /,(6e12.4))") i,lat0,lat1,vlbc(i,lat0:lat1) < ! enddo ! j=lat0,lat1 < ! endif < < end subroutine rdlbc < !----------------------------------------------------------------------- 888c544,545 < use hist_module,only: sh --- > use hist_module,only: h > use init_module,only: glat 897c554 < | iscalar,idimsizes(4),nx,nxk,lonbeg,lonend,nnans,nanfatal --- > | iscalar,idimsizes(4),nx,nxk,lonbeg,lonend,nnans 903a561,566 > ! Fields whose lower boundary condition is stored in the top > ! pressure slot (k==nlev==nlevp1) (see dt.F and duv.F in model): > character(len=shortname_len) :: names_lbc_intop(6) = > | (/'TN ','UN ','VN ', > | 'TN_NM ','UN_NM ','VN_NM '/) > ! 922,923c585 < if (idimsizes(1) /= nlon .or. idimsizes(2) /= nlat .or. < | idimsizes(3) /= nlevp1) then --- > if (idimsizes(1) /= nlon .or. idimsizes(2) /= nlat) then 925,929c587,589 < | ' for field ',a)") trim(rdname) < write(6,"(' idimsizes(1:3)=',3i4,' but should be ', < | 'nlon,nlat,nlevp1=',3i4)") idimsizes(1:3),nlon,nlat, < | nlevp1 < call shutdown('source history coordinate dimensions') --- > | ' for prognostic ',a)") trim(rdname) > write(6,"(' idimsizes(1:2)=',2i4,' but should be ', > | 'nlon,nlat=',2i4)") idimsizes(1:2),nlon,nlat 931d590 < endif 932a592,601 > ! Error if number of levels in source history is less than number > ! of levels in model run (not an error if number of levels in source > ! history is greater than nlevp1). > ! > if (idimsizes(3) < nlevp1) then > write(6,"(/,'>>> WARNING rdf4d: bad idimsizes(3)=', > | i4,' nlevp1=',i4,' field ',a)") idimsizes(3),nlevp1, > | trim(rdname) > endif > endif 955c624 < ! Read field into local f3drd: --- > ! Read field into data component of field structure: 974d642 < nanfatal = 0 ! reading nans from source history is non-fatal 976,977c644 < | call check_nans(f3drd,nlon,nlat,nlevp1,name(1:8),nnans,0,0.,1, < | nanfatal) --- > | call check_nans(f3drd,nlon,nlat,nlevp1,name(1:8),nnans,0,0.,1,0) 983a651,657 > > ! call fminmax(f3drd(lonbeg-2:lonend-2,lat0:lat1,:), > ! | nlevp1*((lonend-2)-(lonbeg-2)+1)*(lat1-lat0+1),fmin,fmax) > ! write(6,"('rdf4d: lonbeg,end=',2i3,' lat0,1=',2i3, > ! | ' f3drd min,max=',2e12.4)") lonbeg,lonend,lat0,lat1,fmin,fmax > > ii = 1 992a667 > ii = ii+1 994a670,676 > > call fminmax(f4d(ix)%data(:,lonbeg:lonend,lat0:lat1,itp), > | nlevp1*(lonend-lonbeg+1)*(lat1-lat0+1),fmin,fmax) > > ! write(6,"('lonbeg,lonend=',2i3)") lonbeg,lonend > write(6,"('Read field ',a,' 3d min,max=',2e12.4)") > | f4d(ix)%short_name,fmin,fmax 996,1000c678,679 < ! Define t,u,v lbc subdomains from top slot if tuv_lbc_intop==1: < ! If tuv_lbc_intop==0, these arrays were read by nc_rdhist. < ! These arrays are in fields.F, allocated by sub init_lbc as < ! (lond0:lond1,latd0:latd1) < ! --- > ! Do periodic points later, when all fields can be loaded into > ! mpi messages, e.g., after call nc_rdhist, see rdsource.F 1002,1055c681,689 < if (sh%tuv_lbc_intop > 0) then ! (is "old" history) < select case(trim(name)) < case('TN') < do j=lat0,lat1 < tlbc(:,j) = f4d(ix)%data(nlevp1,:,j,itp) < enddo ! j=lat0,lat1 < write(6,"('rdf4d: tlbc from top slot min,max=',2f10.2)") < | minval(tlbc(lon0:lon1,lat0:lat1)), < | maxval(tlbc(lon0:lon1,lat0:lat1)) < f4d(ix)%data(nlevp1,:,:,itp) = spval ! top slot is now missing data < case('UN') < do j=lat0,lat1 < ulbc(:,j) = f4d(ix)%data(nlevp1,:,j,itp) < enddo < write(6,"('rdf4d: ulbc from top slot min,max=',2f10.2)") < | minval(ulbc(lon0:lon1,lat0:lat1)), < | maxval(ulbc(lon0:lon1,lat0:lat1)) < f4d(ix)%data(nlevp1,:,:,itp) = spval ! top slot is now missing data < case('VN') < do j=lat0,lat1 < vlbc(:,j) = f4d(ix)%data(nlevp1,:,j,itp) < enddo < write(6,"('rdf4d: vlbc from top slot min,max=',2f10.2)") < | minval(vlbc(lon0:lon1,lat0:lat1)), < | maxval(vlbc(lon0:lon1,lat0:lat1)) < f4d(ix)%data(nlevp1,:,:,itp) = spval ! top slot is now missing data < < case('TN_NM') < do j=lat0,lat1 < tlbc_nm(:,j) = f4d(ix)%data(nlevp1,:,j,itp) < enddo ! j=lat0,lat1 < write(6,"('rdf4d: tlbc_nm from top slot min,max=',2f10.2)") < | minval(tlbc_nm(lon0:lon1,lat0:lat1)), < | maxval(tlbc_nm(lon0:lon1,lat0:lat1)) < f4d(ix)%data(nlevp1,:,:,itp) = spval ! top slot is now missing data < case('UN_NM') < do j=lat0,lat1 < ulbc_nm(:,j) = f4d(ix)%data(nlevp1,:,j,itp) < enddo < write(6,"('rdf4d: ulbc_nm from top slot min,max=',2f10.2)") < | minval(ulbc_nm(lon0:lon1,lat0:lat1)), < | maxval(ulbc_nm(lon0:lon1,lat0:lat1)) < f4d(ix)%data(nlevp1,:,:,itp) = spval ! top slot is now missing data < case('VN_NM') < do j=lat0,lat1 < vlbc_nm(:,j) = f4d(ix)%data(nlevp1,:,j,itp) < enddo < write(6,"('rdf4d: vlbc_nm from top slot min,max=',2f10.2)") < | minval(vlbc_nm(lon0:lon1,lat0:lat1)), < | maxval(vlbc_nm(lon0:lon1,lat0:lat1)) < f4d(ix)%data(nlevp1,:,:,itp) = spval ! top slot is now missing data < case default ! do nothing if not one of these fields < end select ! case(trim(name)) < endif ! if (sh%tuv_lbc_intop > 0) --- > ! Periodic points for data(k,i,j): > ! f4d(ix)%data(:,1 ,1:nlat,itp) = ! 1 <- nlon+1 (73) > ! | f4d(ix)%data(:,nlon+1,1:nlat,itp) > ! f4d(ix)%data(:,2 ,1:nlat,itp) = ! 2 <- nlon+2 (74) > ! | f4d(ix)%data(:,nlon+2,1:nlat,itp) > ! f4d(ix)%data(:,nlon+3,1:nlat,itp) = ! nlon+3 (75) <- 3 > ! | f4d(ix)%data(:,3 ,1:nlat,itp) > ! f4d(ix)%data(:,nlon+4,1:nlat,itp) = ! nlon+4 (76) <- 4 > ! | f4d(ix)%data(:,4 ,1:nlat,itp) 1057c691 < ! Report to stdout: --- > 1059,1062c693,696 < call fminmaxspv(f4d(ix)%data(:,lonbeg:lonend,lat0:lat1,itp), < | nlevp1*(lonend-lonbeg+1)*(lat1-lat0+1),fmin,fmax,spval) < write(6,"('Read field ',a,' 3d subdomain min,max=',2e12.4)") < | f4d(ix)%short_name,fmin,fmax --- > ! If number of levels in source history (h%nlev) is > number of > ! levels in model (nlevp1), then store t,u,v bottom boundaries in > ! top slot (nlevp1). This is important esp for u,v, so that the > ! model tuvbnd.F will calculate u,v bottom boundaries correctly. 1063a698,737 > if (h%nlev > nlevp1 .and. any(names_lbc_intop==name)) then > write(6,"('rdf4d: nlevp1=',i3,' h%nlev=',i3,' field=', > | a,' -- storing bottom boundary in top level.')") > | nlevp1,h%nlev,trim(name) > ! data(k,i,j): > f4d(ix)%data(nlevp1,:,1:nlat,itp) = > | f4d(ix)%data(1 ,:,1:nlat,itp) > endif > ! > ! New models (tiegcmxx or timegcmxx) do not store bottom boundary > ! of t,u,v in top slot. If reading an "old" model history (tgcmxx), > ! put top slot into bottom boundary: > ! if (h%model_version(1:4) == 'tgcm'.and.any(names_lbc_intop==name)) > ! | then > !! f4d(ix)%data(:,1 ,1:nlat,itp) = > !! | f4d(ix)%data(:,nlevp1,1:nlat,itp) > ! f4d(ix)%data(1 ,:,1:nlat,itp) = > ! | f4d(ix)%data(nlevp1,:,1:nlat,itp) > ! endif > ! > ! In old cray-blocked histories, NOPNM was not defined at the > ! top level. Define it here with spval for compatability with > ! old sources (s.a., read_oldsrc). This is not strictly necessary, > ! but is convenient for debug and comparisons between old and new > ! histories with fminmax, etc. > ! > ! if (trim(name)=='OP_NM') then > ! f4d(ix)%data(nlevp1,:,1:nlat,itp) = spval > ! endif > > ! call fminmax(f4d(ix)%data(:,lon0:lon1,lat0:lat1,itp), > ! | nlevp1*(lon1-lon0+1)*(lat1-lat0+1),fmin,fmax) > ! write(6,"('Read field ',a,' 3d min,max=',2e12.4)") > ! | f4d(ix)%short_name,fmin,fmax > ! > ! In earlier versions, full-domain dynpot was defined here from poten. > ! In this version, subdomains of poten are read from the source history > ! by this routine, then mp_dynpot is called (from readsource) to define > ! dynpot at the full domain for each task. > ! 1078,1080c752,755 < use hist_module,only: h,sh,nsource,nsecsource < use cons_module,only: pi < use input_module,only: potential_model,ncep_ncfile --- > use hist_module,only: h,nsource,nsecsource > use init_module,only: glon,glat,plev,gmlon,gmlat,pmlev > use cons_module,only: pi,ylatmagphr,ylonmagphr > use input_module,only: potential_model,sd_ncfile 1087c762 < integer :: i,ii,istat,idum,ivar1(1),imo,ida,startmtime(4) --- > integer :: i,istat,idum,ivar1(1),imo,ida,startmtime(4) 1090,1091c765 < character(len=24) :: create_date,create_time < real :: var1(1),rdays,rmins --- > real :: var1(1),rmins 1095c769 < ! CDL notation. Mag fields will be (time,[mlev or imlev],mlat,mlon): --- > ! CDL notation. Mag fields will be (time,mlev,mlat,mlon): 1108,1110c782,783 < ! < ! Midpoint levels dimension "lev"=nlevp1: < istat = nf_def_dim(ncid,"lev",nlevp1,id_lev) ! midpoint levels dimension --- > ! istat = nf_def_dim(ncid,"lev",nlev,id_lev) > istat = nf_def_dim(ncid,"lev",nlevp1,id_lev) 1112c785 < | 'Error defining midpoint levels dimension') --- > | 'Error defining levels dimension') 1114,1118d786 < ! Interface levels dimension "ilev"=nlevp1: < istat = nf_def_dim(ncid,"ilev",nlevp1,id_ilev) ! interface levels dimension < if (istat /= NF_NOERR) call handle_ncerr(istat, < | 'Error defining interface levels dimension') < ! 1126,1130c794 < ! < ! Mag midpoint levels dimension: < ! 11/07 btf: mlev should be nmlev, not nmlevp1 (?) < < istat = nf_def_dim(ncid,"mlev",nmlevp1,id_mlev) --- > istat = nf_def_dim(ncid,"mlev",nlevp1+3,id_mlev) 1132c796 < | 'Error defining magnetic midpoints levels dimension') --- > | 'Error defining magnetic levels dimension') 1134,1137c798,799 < ! Mag interface levels dimension: < ! 11/07 btf: imlev should be nimlev, not nmlevp1 (?) < < istat = nf_def_dim(ncid,"imlev",nimlevp1,id_imlev) --- > ! am_09/02 magnetosphere grid dimensions: > istat = nf_def_dim(ncid,"magphrlon",nmagphrlon,id_magphrlon) 1139,1140c801,802 < | 'Error defining magnetic interface levels dimension') < istat = nf_def_dim(ncid,"mtimedim",3,id_mtimedim) --- > | 'Error defining magnetosphere longitude dimension') > istat = nf_def_dim(ncid,"magphrlat",nmagphrlat,id_magphrlat) 1141a804,807 > | 'Error defining magnetosphere latitude dimension') > ! > istat = nf_def_dim(ncid,"mtime",3,id_mtime) > if (istat /= NF_NOERR) call handle_ncerr(istat, 1158,1167d823 < ! String length of date and time: < istat = nf_def_dim(ncid,"datelen",len(h%write_date),id_datelen) < if (istat /= NF_NOERR) call handle_ncerr(istat, < + 'Error defining datelen dimension') < ! < ! String length of file names (mxlen_filename is parameter in input.F): < istat = nf_def_dim(ncid,"filelen",mxlen_filename,id_filelen) < if (istat /= NF_NOERR) call handle_ncerr(istat, < + 'Error defining filelen dimension') < ! 1170,1193d825 < ! Time (coordinate variable time(time)). This is days since < ! the initial run's start time. The units string is: yyyy-m-d, < ! where yyyy is the year, m is month, and d is day of the source < ! start time. < ! < ids1(1) = id_time ! for 1d time-unlimited vars < istat = nf_def_var(ncid,"time",NF_DOUBLE,1,ids1,idv_time) < if (istat /= NF_NOERR) call handle_ncerr(istat, < + 'Error defining time dimension variable') < startmtime(1:3) = sh%initial_mtime(1:3) ; startmtime(4) = 0 < ! rdays = mtime_to_datestr(sh%initial_year,startmtime,imo,ida, < ! | char80) < rmins = mtime_to_datestr(sh%initial_year,startmtime,imo,ida, < | char80) < istat = nf_put_att_text(ncid,idv_time,"long_name",4,"time") < istat = nf_put_att_text(ncid,idv_time,"units",len_trim(char80), < | trim(char80)) < istat = nf_put_att_int(ncid,idv_time,"initial_year",NF_INT,1, < | h%initial_year) < istat = nf_put_att_int(ncid,idv_time,"initial_day",NF_INT,1, < | h%initial_day) < istat = nf_put_att_int(ncid,idv_time,"initial_mtime",NF_INT,3, < | h%initial_mtime) < ! 1222c854 < ! Midpoint levels coordinate variable lev(lev): --- > ! Vertical levels (log pressure) (coordinate variable lev(lev)): 1226,1228c858,859 < | 'Error defining midpoint levels coordinate variable lev(lev)') < ! long name of lev coord var: < write(char80,"('midpoint levels')") --- > + 'Error defining levels dimension variable') > write(char80,"('log pressure levels')") 1230c861 < | len_trim(char80),trim(char80)) --- > + len_trim(char80),trim(char80)) 1232,1235c863,864 < |'Error defining long_name of midpoint levels coordinate variable') < ! short name = ln(p0/p) < istat = nf_put_att_text(ncid,idv_lev,"short_name", < | 8,"ln(p0/p)") --- > + 'Error defining long_name of levels dimension variable') > istat = nf_put_att_text(ncid,idv_lev,"units",8,'ln(p0/p)') 1237,1263c866 < | 'Error defining short_name of midpoint levels coord var') < ! lev coord var is unitless: < istat = nf_put_att_text(ncid,idv_lev,"units",0," ") < if (istat /= NF_NOERR) call handle_ncerr(istat, < | 'Error defining units of midpoint levels coord var') < ! positive='up' < istat = nf_put_att_text(ncid,idv_lev,"positive",2,'up') < if (istat /= NF_NOERR) call handle_ncerr(istat, < | 'Error defining positive attribute of midpoint levels coord var') < ! standard name of midpoints lev coord var: < write(char80,"('atmosphere_ln_pressure_coordinate')") < istat = nf_put_att_text(ncid,idv_lev,"standard_name", < | len_trim(char80),trim(char80)) < if (istat /= NF_NOERR) call handle_ncerr(istat, < | 'Error defining standard_name of midpoint levels coord var') < ! formula terms for midpoints lev coord var: < write(char80,"('p0: p0 lev: lev')") < istat = nf_put_att_text(ncid,idv_lev,"formula_terms", < | len_trim(char80),trim(char80)) < if (istat /= NF_NOERR) call handle_ncerr(istat, < | 'Error defining formula terms of midpoint levels coord var') < ! formula to obtain pressure from midpoint lev: < write(char80,"('p(k) = p0 * exp(-lev(k))')") < istat = nf_put_att_text(ncid,idv_lev,"formula", < | len_trim(char80),trim(char80)) < if (istat /= NF_NOERR) call handle_ncerr(istat, < | 'Error defining formula for midpoint levels coord var') --- > + 'Error defining units of levels dimension variable') 1265,1307d867 < ! Interface levels coordinate array: < ids1(1) = id_ilev < istat = nf_def_var(ncid,"ilev",NF_DOUBLE,1,ids1,idv_ilev) < if (istat /= NF_NOERR) call handle_ncerr(istat, < | 'Error defining interface levels coordinate variable ilev(ilev)') < ! long name of ilev coord var: < write(char80,"('interface levels')") < istat = nf_put_att_text(ncid,idv_ilev,"long_name", < | len_trim(char80),trim(char80)) < if (istat /= NF_NOERR) call handle_ncerr(istat, < |'Error defining long_name of interface levels coordinate var') < ! short name = ln(p0/p) < istat = nf_put_att_text(ncid,idv_ilev,"short_name", < | 8,"ln(p0/p)") < if (istat /= NF_NOERR) call handle_ncerr(istat, < | 'Error defining short_name of interface levels coord var') < ! ilev coord var is unitless: < istat = nf_put_att_text(ncid,idv_ilev,"units",0," ") < if (istat /= NF_NOERR) call handle_ncerr(istat, < | 'Error defining units of interface levels coord var') < ! positive='up' < istat = nf_put_att_text(ncid,idv_ilev,"positive",2,'up') < if (istat /= NF_NOERR) call handle_ncerr(istat, < |'Error defining positive attribute of interface levels coord var') < ! standard name of interface ilev coord var: < write(char80,"('atmosphere_ln_pressure_coordinate')") < istat = nf_put_att_text(ncid,idv_ilev,"standard_name", < | len_trim(char80),trim(char80)) < if (istat /= NF_NOERR) call handle_ncerr(istat, < | 'Error defining standard_name of interface levels coord var') < ! formula terms for interface ilev coord var: < write(char80,"('p0: p0 lev: ilev')") < istat = nf_put_att_text(ncid,idv_ilev,"formula_terms", < | len_trim(char80),trim(char80)) < if (istat /= NF_NOERR) call handle_ncerr(istat, < | 'Error defining formula terms of interface levels coord var') < ! formula to obtain pressure from interface ilev: < write(char80,"('p(k) = p0 * exp(-ilev(k))')") < istat = nf_put_att_text(ncid,idv_ilev,"formula", < | len_trim(char80),trim(char80)) < if (istat /= NF_NOERR) call handle_ncerr(istat, < | 'Error defining formula for interface levels coord var') < ! 1318c878 < istat = nf_put_att_text(ncid,idv_mlon,"units",12,'degrees_east') --- > istat = nf_put_att_text(ncid,idv_lon,"units",12,'degrees_east') 1336c896 < ! Magnetic midpoint coordinate variable mlev(mlev)): --- > ! Magnetic levels (log pressure) (coordinate variable mlev(mlev)): 1340,1342c900,901 < + 'Error defining magnetic levels coord variable mlev') < ! long name of mlev: < write(char80,"('magnetic midpoint levels')") --- > + 'Error defining magnetic levels dimension variable') > write(char80,"('log pressure levels (magnetic grid)')") 1346,1349c905,906 < + 'Error defining long_name of mlev coordinate variable') < ! short name = ln(p0/p) < istat = nf_put_att_text(ncid,idv_mlev,"short_name", < | 8,"ln(p0/p)") --- > + 'Error defining long_name of mag levels dimension variable') > istat = nf_put_att_text(ncid,idv_mlev,"units",8,'ln(p0/p)') 1351,1353c908,912 < | 'Error defining short_name of mlev levels coord var') < ! units of mlev (unitless): < istat = nf_put_att_text(ncid,idv_mlev,"units",0," ") --- > + 'Error defining units of magnetic levels dimension variable') > ! > ! Magnetospheric longitude (deg) (coordinate variable magphrlon(magphrlon)): > ids1(1) = id_magphrlon > istat = nf_def_var(ncid,"maglon",NF_DOUBLE,1,ids1,idv_magphrlon) 1355,1357c914,917 < + 'Error defining units of mlev coordinate variable') < ! positive attribute of mlev: < istat = nf_put_att_text(ncid,idv_mlev,"positive",2,'up') --- > + 'Error defining magnetospheric longitude dimension variable') > write(char80,"('magnetospheric longitude (-west, +east)')") > istat = nf_put_att_text(ncid,idv_magphrlon,"long_name", > + len_trim(char80),trim(char80)) 1359,1363c919,920 < + 'Error defining positive attribute for mlev coord var') < ! standard_name of mlev: < write(char80,"('atmosphere_ln_pressure_coordinate')") < istat = nf_put_att_text(ncid,idv_mlev,"standard_name", < | len_trim(char80),trim(char80)) --- > + 'Error defining long_name of magnetospheric long. dim. var.') > istat = nf_put_att_text(ncid,idv_magphrlon,"units",7,'degrees') 1365,1377c922 < + 'Error defining standard_name attribute for mlev coord var') < ! formula terms for mlev: < write(char80,"('p0: p0 lev: mlev')") < istat = nf_put_att_text(ncid,idv_mlev,"formula_terms", < | len_trim(char80),trim(char80)) < if (istat /= NF_NOERR) call handle_ncerr(istat, < | 'Error defining formula terms of mlev coord var') < ! formula to obtain pressure from mlev: < write(char80,"('p(k) = p0 * exp(-mlev(k))')") < istat = nf_put_att_text(ncid,idv_mlev,"formula", < | len_trim(char80),trim(char80)) < if (istat /= NF_NOERR) call handle_ncerr(istat, < | 'Error defining formula for mlev coord var') --- > + 'Error defining units of magnetospheric longitude dim. var.') 1379,1381c924,927 < ! Magnetic interface coordinate variable imlev(imlev)): < ids1(1) = id_imlev < istat = nf_def_var(ncid,"imlev",NF_DOUBLE,1,ids1,idv_imlev) --- > ! Magnetospheric latitude (deg) (coordinate variable magphrlat(magphrlat)): > ids1(1) = id_magphrlat > istat = nf_def_var(ncid,"magphrlat",NF_DOUBLE,1,ids1, > | idv_magphrlat) 1383,1386c929,931 < + 'Error defining magnetic levels coord variable imlev') < ! long name of imlev: < write(char80,"('magnetic interface levels')") < istat = nf_put_att_text(ncid,idv_imlev,"long_name", --- > + 'Error defining magnetospheric latitude dimension variable') > write(char80,"('magnetospheric latitude (-south, +north)')") > istat = nf_put_att_text(ncid,idv_magphrlat,"long_name", 1389,1392c934,935 < + 'Error defining long_name of imlev coordinate variable') < ! short name = ln(p0/p) < istat = nf_put_att_text(ncid,idv_imlev,"short_name", < | 8,"ln(p0/p)") --- > + 'Error defining long_name of magnetospheric latitude dim. var.') > istat = nf_put_att_text(ncid,idv_magphrlat,"units",7,'degrees') 1394,1420c937 < | 'Error defining short_name of imlev levels coord var') < ! units of imlev (unitless): < istat = nf_put_att_text(ncid,idv_imlev,"units",0," ") < if (istat /= NF_NOERR) call handle_ncerr(istat, < + 'Error defining units of imlev coordinate variable') < ! positive attribute of imlev: < istat = nf_put_att_text(ncid,idv_imlev,"positive",2,'up') < if (istat /= NF_NOERR) call handle_ncerr(istat, < + 'Error defining positive attribute for imlev coord var') < ! standard_name of imlev: < write(char80,"('atmosphere_ln_pressure_coordinate')") < istat = nf_put_att_text(ncid,idv_imlev,"standard_name", < | len_trim(char80),trim(char80)) < if (istat /= NF_NOERR) call handle_ncerr(istat, < + 'Error defining standard_name attribute for imlev coord var') < ! formula terms for imlev: < write(char80,"('p0: p0 lev: imlev')") < istat = nf_put_att_text(ncid,idv_imlev,"formula_terms", < | len_trim(char80),trim(char80)) < if (istat /= NF_NOERR) call handle_ncerr(istat, < | 'Error defining formula terms of imlev coord var') < ! formula to obtain pressure from imlev: < write(char80,"('p(k) = p0 * exp(-imlev(k))')") < istat = nf_put_att_text(ncid,idv_imlev,"formula", < | len_trim(char80),trim(char80)) < if (istat /= NF_NOERR) call handle_ncerr(istat, < | 'Error defining formula for imlev coord var') --- > + 'Error defining units of magnetospheric latitude dim. var.') 1424a942,960 > ! Time (coordinate variable time(time)). This is minutes since > ! the run's source history start time. The units string is: yyyy-m-d, > ! where yyyy is the year, m is month, and d is day of the source > ! start time. > ! > istat = nf_def_var(ncid,"time",NF_DOUBLE,1,ids1,idv_time) > if (istat /= NF_NOERR) call handle_ncerr(istat, > + 'Error defining time dimension variable') > startmtime(1) = h%initial_day > startmtime(2:3) = h%initial_mtime(2:3) ; startmtime(4) = 0 > rmins = mtime_to_datestr(h%initial_year,startmtime,imo,ida,char80) > istat = nf_put_att_text(ncid,idv_time,"long_name",4,"time") > if (istat /= NF_NOERR) call handle_ncerr(istat, > + 'Error defining long_name of time dimension variable') > istat = nf_put_att_text(ncid,idv_time,"units",len_trim(char80), > | trim(char80)) > if (istat /= NF_NOERR) call handle_ncerr(istat, > + 'Error defining units of time dimension variable') > ! 1428c964 < | sh%initial_year) --- > | h%initial_year) 1430c966 < | sh%initial_day) --- > | h%initial_day) 1432c968 < | sh%initial_mtime) --- > | h%initial_mtime) 1438c974 < ! (id_mtimedim) (day,hour,minute), and time is the unlimited dimension --- > ! (id_mtime) (day,hour,minute), and time is the unlimited dimension 1441c977 < ids2(1) = id_mtimedim --- > ids2(1) = id_mtime 1474,1497d1009 < ! Calendar advance: < istat = nf_def_var(ncid,"calendar_advance",NF_INT,1,ids1, < | idv_calendar_adv) < if (istat /= NF_NOERR) call handle_ncerr(istat, < | 'Error defining integer calendar advance variable') < write(char80,"('calendar advance flag', < | ' (1 if advancing calendar time)')") < istat = nf_put_att_text(ncid,idv_calendar_adv,"long_name", < | len_trim(char80),trim(char80)) < if (istat /= NF_NOERR) call handle_ncerr(istat, < | 'Error defining long_name of calendar advance variable') < ! < ! Date each history was written: < ids2(1) = id_datelen < ids2(2) = id_time < istat= nf_def_var(ncid,"write_date",NF_CHAR,2,ids2,idv_writedate) < if (istat /= NF_NOERR) call handle_ncerr(istat, < + 'Error defining history write_date variable') < write(char80,"('Date and time each history was written')") < istat = nf_put_att_text(ncid,idv_writedate,"long_name", < | len_trim(char80),trim(char80)) < if (istat /= NF_NOERR) call handle_ncerr(istat, < + 'Error defining long_name of write_date') < ! 1525d1036 < ! 9/30/05: change units as suggested by John Caron (s.a. Udunits) 1527,1528c1038 < ! | "Daily 10.7 cm solar flux","W/m^2Hz*1.e-22") < | "Daily 10.7 cm solar flux","1.e-22 kg.s-4") --- > | "Daily 10.7 cm solar flux","W/m^2Hz*1.e-22") 1530,1531c1040 < ! | "81-day average 10.7 cm solar flux","W/m^2Hz*1.e-22") < | "81-day average 10.7 cm solar flux","1.e-22 kg.s-4") --- > | "81-day average 10.7 cm solar flux","W/m^2Hz*1.e-22") 1535c1044 < | "Hemispheric power","gw") --- > | "Hemispheric power","Gw") 1539c1048 < | "Cross-tail potential","volts") --- > | "Cross-tail potential","Volts") 1541,1543c1050 < ! BX,BY,BZ: < call defvar_time_dbl(ncid,"bximf",ids1,idv_bximf, < | "BX component of IMF","nT") --- > ! Byimf: 1545,1547c1052 < | "BY component of IMF","nT") < call defvar_time_dbl(ncid,"bzimf",ids1,idv_bzimf, < | "BZ component of IMF","nT") --- > | "BY component of IMF"," ") 1549,1558d1053 < ! swvel,swden: < call defvar_time_dbl(ncid,"swvel",ids1,idv_swvel, < | "Solar wind velocity","km/s") < call defvar_time_dbl(ncid,"swden",ids1,idv_swden, < | "Solar wind density","cm3") < ! < ! al: < call defvar_time_dbl(ncid,"al",ids1,idv_al, < | "Lower magnetic auroral activity index","nT") < ! 1570c1065 < write(char80,"('amplitude and phase of diurnal tide mode (1,1)')") --- > write(char80,"('amplitude and phase of diurnal tide')") 1582c1077 < write(char80,"('amplitudes and phases of semi-diurnal tide')") --- > write(char80,"('amplitude and phase of semi-diurnal tide')") 1588,1591c1083,1093 < ! Define ncep data file (used by timegcm only): < call define_ncfile(ncid,"ncep_ncfile",idv_ncep_ncfile, < | "long_name","ncep data file", < | "data","10 mb lower boundary for TN and Z") --- > ! 1/31/01: Adding ncep flag: > ! Is time-gcm only, but add it anyway for processors. > istat = nf_def_var(ncid,"ncep",NF_INT,1,ids1,idv_ncep) > if (istat /= NF_NOERR) call handle_ncerr(istat, > + 'Error defining ncep variable') > write(char80, > | "('NCEP/NMC flag (1 if using ncep boundaries for t and z)')") > istat = nf_put_att_text(ncid,idv_ncep,"long_name", > | len_trim(char80),trim(char80)) > if (istat /= NF_NOERR) call handle_ncerr(istat, > + 'Error defining long_name of ncep variable') 1593,1596c1095,1105 < ! Define gpi data file: < call define_ncfile(ncid,"gpi_ncfile",idv_gpi_ncfile, < | "long_name","GeoPhysical Indices data file", < | "data","f107, f107a, ctpoten, power") --- > ! 2/08/01: Adding gpi flag: > istat = nf_def_var(ncid,"gpi",NF_INT,1,ids1,idv_gpi) > if (istat /= NF_NOERR) call handle_ncerr(istat, > + 'Error defining gpi variable') > write(char120, > | "('GPI flag (1 if using geophysical indices database for ', > | 'f107d, f107a, hpower, and ctpoten)')") > istat = nf_put_att_text(ncid,idv_gpi,"long_name", > | len_trim(char120),trim(char120)) > if (istat /= NF_NOERR) call handle_ncerr(istat, > + 'Error defining long_name of gpi variable') 1598,1601c1107,1117 < ! Define TIMED SEE data file: < call define_ncfile(ncid,"see_ncfile",idv_see_ncfile, < | "long_name","TIMED SEE data file", < | "data","Solar flux data") --- > ! 7/04/02: Adding gswmdi flag: > istat = nf_def_var(ncid,"gswmdi",NF_INT,1,ids1,idv_gswmdi) > if (istat /= NF_NOERR) call handle_ncerr(istat, > | 'Error defining gswm variable') > write(char120, > | "('GSWMDI flag (1 if using GSWM diurnal tides as boundary ', > | 'for Z,TN,UN,VN)')") > istat = nf_put_att_text(ncid,idv_gswmdi,"long_name", > | len_trim(char120),trim(char120)) > if (istat /= NF_NOERR) call handle_ncerr(istat, > | 'Error defining long_name of gswmdi variable') 1603,1606c1119,1129 < ! Define imf data file: < call define_ncfile(ncid,"imf_ncfile",idv_imf_ncfile, < | "long_name","IMF data file", < | "data","Bx,By,Bz,Swvel,Swden,Kp,f107,f107a") --- > ! 7/04/02: Adding gswmsdi flag: > istat = nf_def_var(ncid,"gswmsdi",NF_INT,1,ids1,idv_gswmsdi) > if (istat /= NF_NOERR) call handle_ncerr(istat, > | 'Error defining gswmsdi variable') > write(char120, > | "('GSWMSDI flag (1 if using GSWM semidiurnal tides as ', > | 'boundary for Z,TN,UN,VN)')") > istat = nf_put_att_text(ncid,idv_gswmsdi,"long_name", > | len_trim(char120),trim(char120)) > if (istat /= NF_NOERR) call handle_ncerr(istat, > | 'Error defining long_name of gswmsdi variable') 1608,1624c1131,1141 < ! Define gswm data files: < call define_ncfile(ncid,"gswm_mi_di_ncfile", < | idv_gswm_mi_di_ncfile, < | "long_name","GSWM migrating diurnal tides data file", < | "data","lower boundary perturbations for TN, UN, VN, and Z") < call define_ncfile(ncid,"gswm_mi_sdi_ncfile", < | idv_gswm_mi_sdi_ncfile, < | "long_name","GSWM migrating semi-diurnal tides data file", < | "data","lower boundary perturbations for TN, UN, VN, and Z") < call define_ncfile(ncid,"gswm_nm_di_ncfile", < | idv_gswm_nm_di_ncfile, < | "long_name","GSWM non-migrating diurnal tides data file", < | "data","lower boundary perturbations for TN, UN, VN, and Z") < call define_ncfile(ncid,"gswm_nm_sdi_ncfile", < | idv_gswm_nm_sdi_ncfile, < | "long_name","GSWM non-migrating semi-diurnal tides data file", < | "data","lower boundary perturbations for TN, UN, VN, and Z") --- > ! 7/18/02: Adding gswmnmdi flag: > istat = nf_def_var(ncid,"gswmnmdi",NF_INT,1,ids1,idv_gswmnmdi) > if (istat /= NF_NOERR) call handle_ncerr(istat, > | 'Error defining gswmnmdi variable') > write(char120, > | "('GSWMNMDI flag (1 if using GSWM nonmigrating diurnal ', > | 'tides as boundary for Z,TN,UN,VN)')") > istat = nf_put_att_text(ncid,idv_gswmnmdi,"long_name", > | len_trim(char120),trim(char120)) > if (istat /= NF_NOERR) call handle_ncerr(istat, > | 'Error defining long_name of gswmnmdi variable') 1626c1143,1153 < ! Auroral parameters (alfa30, e30, alfad2, ed2 are timegcm only) --- > ! 7/19/02: Adding gswmnmsdi flag: > istat=nf_def_var(ncid,"gswmnmsdi",NF_INT,1,ids1,idv_gswmnmsdi) > if (istat /= NF_NOERR) call handle_ncerr(istat, > | 'Error defining gswmnmsdi variable') > write(char120, > | "('GSWMNMSDI flag (1 if using GSWM nonmigrating semidiurnal ', > | 'tides as boundary for Z,TN,UN,VN)')") > istat = nf_put_att_text(ncid,idv_gswmnmsdi,"long_name", > | len_trim(char120),trim(char120)) > if (istat /= NF_NOERR) call handle_ncerr(istat, > | 'Error defining long_name of gswmnmsdi variable') 1627a1155,1156 > ! 2/14/01: Add auroral parameters (from input): > ! 1629,1631c1158,1160 < ! call defvar_time_dbl(ncid,"alfa30",ids1,idv_alfa30, < ! | "Characteristic energy of high-energy auroral electrons", < ! | "KeV") --- > call defvar_time_dbl(ncid,"alfa30",ids1,idv_alfa30, > | "Characteristic energy of high-energy auroral electrons", > | "KeV") 1634,1636c1163,1165 < ! call defvar_time_dbl(ncid,"e30",ids1,idv_e30, < ! | "Energy flux of high-energy auroral electrons", < ! | "ergs/cm2/s") --- > call defvar_time_dbl(ncid,"e30",ids1,idv_e30, > | "Energy flux of high-energy auroral electrons", > | "ergs/cm2/s") 1639,1641c1168,1170 < ! call defvar_time_dbl(ncid,"alfad2",ids1,idv_alfad2, < ! | "Characteristic energy of solar protons in the polar cap", < ! | "KeV") --- > call defvar_time_dbl(ncid,"alfad2",ids1,idv_alfad2, > | "Characteristic energy of solar protons in the polar cap", > | "KeV") 1644,1652c1173,1174 < ! call defvar_time_dbl(ncid,"ed2",ids1,idv_ed2, < ! | "Energy flux of solar protons in the polar cap", < ! | "ergs/cm2/s") < ! < ! 1/24/08 btf: Auroral parameters: < ! < ! e1: < call defvar_time_dbl(ncid,"e1",ids1,idv_e1, < | "Peak energy flux in noon sector of the aurora", --- > call defvar_time_dbl(ncid,"ed2",ids1,idv_ed2, > | "Energy flux of solar protons in the polar cap", 1654,1681d1175 < ! e2: < call defvar_time_dbl(ncid,"e2",ids1,idv_e2, < | "Peak energy flux in midnight sector of the aurora", < | "ergs/cm2/s") < ! h1: < call defvar_time_dbl(ncid,"h1",ids1,idv_h1, < | "Gaussian half-width of the noon auroral oval", < | "degrees") < ! h2: < call defvar_time_dbl(ncid,"h2",ids1,idv_h2, < | "Gaussian half-width of the midnight auroral oval", < | "degrees") < ! alfac: < call defvar_time_dbl(ncid,"alfac",ids1,idv_alfac, < | "Characteristic Maxwellian energy of polar cusp electrons", < | "keV") < ! ec: < call defvar_time_dbl(ncid,"ec",ids1,idv_ec, < | "Column energy input of polar cusp electrons", < | "ergs/cm**2/s") < ! alfad: < call defvar_time_dbl(ncid,"alfad",ids1,idv_alfad, < | "Characteristic Maxwellian energy of drizzle electrons", < | "keV") < ! ed: < call defvar_time_dbl(ncid,"ed",ids1,idv_ed, < | "Column energy input of drizzle electrons", < | "ergs/cm**2/s") 1682a1177,1178 > ! Time-independent "primary" variables: > ! 1699c1195 < ! Reference pressure used to convert ln(p0/p) to pressure (millibars (hPa)): --- > ! Standard pressure: 1704c1200 < | 18,"Reference pressure") ! for conversion of vertical coordinates --- > | 17,"Standard pressure") 1706,1715c1202,1203 < ! 4/26/06 btf: p0 units can be either hPa or millibars. Using the latter < ! now to be consistent w/ microbar units of p0_model < istat = nf_put_att_text(ncid,idv_p0,"units",9,"millibars") < ! istat = nf_put_att_text(ncid,idv_p0,"units",3,"hPA") < ! < ! Reference pressure used by the model (dynes/cm2): < ! p0_model units can be either dynes/cm2 or microbars. Using the latter < ! to be consistent w/ 1981 paper by Dickinson, Ridley, and Roble < ! < istat = nf_def_var(ncid,"p0_model",NF_DOUBLE,0,idum,idv_p0_model) --- > ! Number of fields (will be nf4d for primary histories): > istat = nf_def_var(ncid,"nflds",NF_INT,0,idum,idv_nflds) 1717,1720c1205,1207 < + 'Error defining variable p0') < char80 = ' ' < write(char80,"('Reference pressure (as used by the model)')") < istat = nf_put_att_text(ncid,idv_p0_model,"long_name", --- > + 'Error defining nflds variable') > write(char80,"('number of 3-d model fields')") > istat = nf_put_att_text(ncid,idv_nflds,"long_name", 1722,1726d1208 < istat = nf_put_att_text(ncid,idv_p0_model,"units",9,"microbars") < ! istat = nf_put_att_text(ncid,idv_p0_model,"units",9,"dynes/cm2") < ! < ! Gravity (constant used in the model, independent of height): < istat = nf_def_var(ncid,"grav",NF_DOUBLE,0,idum,idv_grav) 1728,1736c1210 < + 'Error defining variable grav') < istat = nf_put_att_text(ncid,idv_grav,"long_name", < | 26,"gravitational acceleration") < istat = nf_put_att_text(ncid,idv_grav,"units", < | 4,"cm/s") < write(char80,"('constant used in the model, independent of ', < | 'height')") < istat = nf_put_att_text(ncid,idv_grav,"info", < | len_trim(char80),trim(char80)) --- > + 'Error defining long_name attribute of variable nflds') 1739,1740c1213,1214 < if (h%hist_type(1:3)=='pri') then < do i=1,nf4d_hist --- > if (h%type(1:3)=='pri') then > do i=1,nf4d 1744,1746c1218,1221 < ! Define secondary history fields (geographic or magnetic): < elseif (h%hist_type(1:3)=='sec') then < call def_fsech(ncid) --- > ! Define secondary history fields (geographic, magnetic and magnetospheric): > elseif (h%type(1:3)=='sec') then > call defvar_sech(ncid,h%nfgeo,h%nfmag,h%nfgeo2d,h%nfmag2d, > | h%nfmagphr) 1748c1223 < write(6,"('>>> nc_define: unknown h%hist_type=',a)") h%hist_type --- > write(6,"('>>> nc_define: unknown h%type=',a)") h%type 1751,1770d1225 < ! Define lower boundaries of t,u,v (both secondary and primary): < call deflbc(ncid,"TLBC",idv_tlbc) < call deflbc(ncid,"ULBC",idv_ulbc) < call deflbc(ncid,"VLBC",idv_vlbc) < call deflbc(ncid,"TLBC_NM",idv_tlbc_nm) < call deflbc(ncid,"ULBC_NM",idv_ulbc_nm) < call deflbc(ncid,"VLBC_NM",idv_vlbc_nm) < ! < ! Define LBC: bottom interface level (scalar coord of TLBC,ULBC,VLBC): < istat = nf_def_var(ncid,"LBC",NF_DOUBLE,0,idum,idv_lbc) < if (istat /= NF_NOERR) call handle_ncerr(istat, < | 'Error defining var LBC') < write(char80, < | "('Interface level of t,u,v lower boundary condition')") < istat = nf_put_att_text(ncid,idv_lbc,"long_name", < | len_trim(char80),trim(char80)) < if (istat /= NF_NOERR) call handle_ncerr(istat, < | 'Error defining long_name attribute of variable LBC') < ! write(6,"('defined LBC: idv_lbc=',i3)") idv_lbc < ! 1773,1774c1228,1230 < ! CF Conventions: < istat = nf_put_att_text(ncid,NF_GLOBAL,"Conventions",6,"CF-1.0") --- > ! Run date and time: > istat = nf_put_att_text(ncid,NF_GLOBAL,"rundate", > + len_trim(h%rundate),trim(h%rundate)) 1777c1233 < | 'for Conventions global attribute')") --- > + 'for rundate global attribute')") 1781,1802d1236 < ! User-defined job comment (namelist parameter "label"): < if (len_trim(h%label) > 0) then < istat = nf_put_att_text(ncid,NF_GLOBAL,"label", < | len_trim(h%label),trim(h%label)) < if (istat /= NF_NOERR) then < write(char120,"('Error return from nf_put_att_text ', < | 'for label global attribute')") < call handle_ncerr(istat,char120) < endif < endif < < ! Create date and time: < call datetime(create_date,create_time) < h%create_date = trim(create_date)//' '//trim(create_time) < istat = nf_put_att_text(ncid,NF_GLOBAL,"create_date", < + len_trim(h%create_date),trim(h%create_date)) < if (istat /= NF_NOERR) then < write(char120,"('Error return from nf_put_att_text ', < + 'for create_date global attribute')") < call handle_ncerr(istat,char120) < endif < ! 1848d1281 < ! This is not written to new history files (see output_file below) 1850,1860c1283,1284 < ! istat = nf_put_att_text(ncid,NF_GLOBAL,"mss_path", < ! | len_trim(h%mss_path),trim(h%mss_path)) < ! if (istat /= NF_NOERR) then < ! write(char120,"('Error return from nf_put_att_text ', < ! | 'for mss_path global attribute')") < ! call handle_ncerr(istat,char120) < ! endif < ! < ! Output path (from namelist): < istat = nf_put_att_text(ncid,NF_GLOBAL,"output_file", < | len_trim(h%output_file),trim(h%output_file)) --- > istat = nf_put_att_text(ncid,NF_GLOBAL,"mss_path", > | len_trim(h%mss_path),trim(h%mss_path)) 1863c1287 < | 'for output_file global attribute')") --- > | 'for mss_path global attribute')") 1867,1869c1291,1302 < ! Primary or Secondary histories (h%hist_type): < istat = nf_put_att_text(ncid,NF_GLOBAL,"history_type", < | len_trim(h%hist_type),trim(h%hist_type)) --- > ! Primary or Secondary histories: > if (h%type(1:3)=='pri') then > istat = nf_put_att_text(ncid,NF_GLOBAL,"history_type", > | 7,'primary') > elseif (h%type(1:3)=='sec') then > istat = nf_put_att_text(ncid,NF_GLOBAL,"history_type", > | 9,'secondary') > else > write(6,"('>>> nc_define: unknown h%type=',a)") h%type > istat = nf_put_att_text(ncid,NF_GLOBAL,"history_type", > | 7,'unknown') > endif 1876,1885c1309 < ! Run type ('initial' or 'continuation') < istat = nf_put_att_text(ncid,NF_GLOBAL,"run_type", < | len_trim(h%run_type),trim(h%run_type)) < if (istat /= NF_NOERR) then < write(char120,"('nc_define: Error return from nf_put_att_text ', < | 'for run_type global attribute')") < call handle_ncerr(istat,char120) < endif < ! < ! Source history file (for this run, either initial or continuation): --- > ! Mss path to source history file: 1887,1888c1311,1312 < istat = nf_put_att_text(ncid,NF_GLOBAL,"source_file", < | len_trim(h%source_file)+10,trim(h%source_file)//' (initial)') --- > istat = nf_put_att_text(ncid,NF_GLOBAL,"mss_source", > | len_trim(h%mss_source)+10,trim(h%mss_source)//' (initial)') 1890,1892c1314,1316 < istat = nf_put_att_text(ncid,NF_GLOBAL,"source_file", < | len_trim(h%source_file)+15, < | trim(h%source_file)//' (continuation)') --- > istat = nf_put_att_text(ncid,NF_GLOBAL,"mss_source", > | len_trim(h%mss_source)+15, > | trim(h%mss_source)//' (continuation)') 1896c1320 < | 'for source_file global attribute')") --- > | 'for mss_source global attribute')") 1899,1902c1323 < ! < ! Source model time (will be same as start time for this run, < ! whether initial or continuation) < istat = nf_put_att_int(ncid,NF_GLOBAL,"source_mtime",NF_INT,3, --- > istat = nf_put_att_int(ncid,idv_time,"source_mtime",NF_INT,3, 1905,1906c1326,1327 < write(char120,"('Error return from nf_put_att_text ', < | 'for source_mtime global attribute')") --- > write(char120,"('Error return from nf_put_att_int ', > | 'for source_mtime=',3i4,' global attribute')") h%source_mtime 1910,1912c1331,1336 < ! Initial file (source file from the initial run) < istat = nf_put_att_text(ncid,NF_GLOBAL,"initial_file", < | len_trim(h%initial_file),trim(h%initial_file)) --- > ! Mss path to secsource history file (magnetospheric model only): > if (nsecsource > 0) then ! initial secsource file > istat = nf_put_att_text(ncid,NF_GLOBAL,"mss_secsource", > | len_trim(h%mss_secsource)+10,trim(h%mss_secsource)// > | ' (initial)') > endif 1915c1339 < | 'for initial_file global attribute')") --- > | 'for mss_secsource global attribute')") 1919c1343,1359 < ! Initial mtime (this is also an attribute of the time coord var) --- > ! Start date and time of initial run: > istat = nf_put_att_int(ncid,NF_GLOBAL,"initial_year",NF_INT,1, > | h%initial_year) > if (istat /= NF_NOERR) then > write(char120,"('Error return from nf_put_att_int ', > | 'for start_year global attribute: h%initial_year=',i4)") > | h%initial_year > call handle_ncerr(istat,char120) > endif > istat = nf_put_att_int(ncid,NF_GLOBAL,"initial_day",NF_INT,1, > | h%initial_day) > if (istat /= NF_NOERR) then > write(char120,"('Error return from nf_put_att_int ', > | 'for start_day global attribute: h%initial_day=',i4)") > | h%initial_day > call handle_ncerr(istat,char120) > endif 1923,1924c1363,1365 < write(char120,"('Error return from nf_put_att_text ', < | 'for initial_mtime global attribute')") --- > write(char120,"('Error return from nf_put_att_int ', > | 'for start_mtime global attribute: h%initial_mtime=',i4)") > | h%initial_mtime 1928,1933c1369,1372 < ! Method 1 for conversion from lev (ln(p0/p)) to pressure in hPa < ! (millibars), using p0: < ! < write(char80,"('p0*exp(-lev(k))')") < istat = nf_put_att_text(ncid,NF_GLOBAL,"lev_to_hPa_method1", < | len_trim(char80),trim(char80)) --- > ! Missing value: > var1(1) = spval > istat = nf_put_att_double(ncid,NF_GLOBAL,"missing_value", > | NF_DOUBLE,1,var1) 1935,1936c1374,1375 < write(char120,"('Error return from nf_put_att_text ', < | 'for lev_to_hPa_method1 global attribute')") --- > write(char120,"('Error return from nf_put_att_double ', > | 'for missing_value global attribute')") 1940,1944c1379,1381 < ! Method 2 for conversion from lev (ln(p0/p)) to pressure in hPa < ! (millibars), using p0_model: < ! < write(char80,"('p0_model*1.e-3*exp(-lev(k))')") < istat = nf_put_att_text(ncid,NF_GLOBAL,"lev_to_hPa_method2", --- > ! Conversion from lev (ln(p0/p)) to pressure mb: > write(char80,"('p0*e(-lev(k))*1.e-3')") > istat = nf_put_att_text(ncid,NF_GLOBAL,"lev_to_mb", 1948c1385 < | 'for lev_to_hPa_method2 global attribute')") --- > | 'for lev_to_mb global attribute')") 1971,1981d1407 < ! Missing_value (this can be used by procs if the field does not < ! have its own missing_value attribute) < var1(1) = spval < istat = nf_put_att_double(ncid,NF_GLOBAL,"missing_value", < | NF_DOUBLE,1,var1) < if (istat /= NF_NOERR) then < write(char120,"('Error return from ', < | 'nf_put_att_double for missing_value global attribute')") < call handle_ncerr(istat,char120) < endif < ! 1991,1995c1417,1424 < ! tuv_lbc_intop==0 (lbc of t,u,v are not stored in top k-slot) < ! (only "old" histories stored lbc of t,u,v in top slot) < ivar1(1) = h%tuv_lbc_intop ! see init in hist.F < istat = nf_put_att_int(ncid,NF_GLOBAL,"tuv_lbc_intop", < | NF_INT,1,ivar1) --- > ! TIMED SEE data file: > if (len_trim(sd_ncfile) > 0) then > istat = nf_put_att_text(ncid,NF_GLOBAL,"sd_ncfile", > | len_trim(sd_ncfile),trim(sd_ncfile)) > else > istat = nf_put_att_text(ncid,NF_GLOBAL,"sd_ncfile", > | 6,'[none]') > endif 1997,1998c1426,1428 < write(char120,"('Error return from nf_put_att_int ', < | 'for tuv_lbc_intop global attribute')") --- > write(char120,"('Error return from nf_put_att_text ', > | 'for sd_ncfile global attribute: sd_ncfile=',a)") > | trim(sd_ncfile) 2007c1437,1450 < ! Give values to coordinate variables: --- > ! Mag grid coordinates (consdyn.h) were set in init_consdyn (cons_mod.F) > ! (convert to degrees): > ! do i=1,nmlonp1 > ! gmlon(i) = ylonm(i)*rtdeg > ! enddo > ! do i=1,nmlat > ! gmlat(i) = ylatm(i)*rtdeg > ! enddo > ! do i=1,nlev > ! pmlev(i+3) = plev(i) > ! enddo > ! do i=3,1,-1 > ! pmlev(i) = pmlev(i+1)-dlev > ! enddo 2009c1452,1454 < ! Geographic horizontal: --- > ! Give values to dimension variables: > ! > ! Geographic: 2011,2012d1455 < if (istat /= NF_NOERR) < | call handle_ncerr(istat,'Error giving values to glon coord var') 2014,2015c1457,1462 < if (istat /= NF_NOERR) < | call handle_ncerr(istat,'Error giving values to glat coord var') --- > istat = nf_put_var_double(ncid,idv_lev,plev) > if (istat /= NF_NOERR) then > write(char120,"('Error return from nf_put_var_double ', > + ' to assign values to geographic dimension vars')") > call handle_ncerr(istat,char120) > endif 2017,2029d1463 < ! Vertical: < istat = nf_put_var_double(ncid,idv_lev,zpmid) ! midpoint levels < if (istat /= NF_NOERR) < | call handle_ncerr(istat,'Error giving values to zpmid coord var') < istat = nf_put_var_double(ncid,idv_ilev,zpint) ! interface levels < if (istat /= NF_NOERR) < | call handle_ncerr(istat,'Error giving values to zpint coord var') < ! < ! Bottom interface level LBC for t,u,v lbc: < istat = nf_put_var_double(ncid,idv_lbc,zibot) < if (istat /= NF_NOERR) < | call handle_ncerr(istat,'Error giving value to LBC scalar var') < ! 2033,2039c1467 < ! < ! 11/07 btf: mag midpoints are zpmag_mid(nmlev), and < ! mag interfaces are zpmag_int(nimlev) < ! (see init.F) < ! < istat = nf_put_var_double(ncid,idv_mlev,zpmag_mid) < istat = nf_put_var_double(ncid,idv_imlev,zpmag_int) --- > istat = nf_put_var_double(ncid,idv_mlev,pmlev) 2045,2054d1472 < < ! write(6,"('nc_define: mag midpoints zpmag_mid=',/,(8f8.2))") < ! | zpmag_mid < ! write(6,"('nc_define: mag interfaces zpmag_int=',/,(8f8.2))") < ! | zpmag_int < < end subroutine nc_define < !----------------------------------------------------------------------- < subroutine define_ncfile(ncid,name,idv,att1name,att1val, < | att2name,att2val) 2056,2075c1474,1476 < ! Args: < integer,intent(in) :: ncid < integer,intent(out) :: idv < character(len=*),intent(in) :: name,att1name,att1val, < | att2name,att2val < ! < ! Local: < integer :: istat,ids2(2) < character(len=120) :: char120 < ! < if (len_trim(name) <= 0) then < write(6,"('>>> define_ncfile: empty name! returning..')") < return < endif < ! < ids2(1) = id_filelen < ids2(2) = id_time < ! < ! Define time-dependent char variable: < istat= nf_def_var(ncid,name,NF_CHAR,2,ids2,idv) --- > ! Magnetospheric: > istat = nf_put_var_double(ncid,idv_magphrlon,ylonmagphr) > istat = nf_put_var_double(ncid,idv_magphrlat,ylatmagphr) 2077c1478,1479 < write(char120,"('Error defining file var ',a)") trim(name) --- > write(char120,"('Error return from nf_put_var_double ', > + ' to assign values to magnetospheric dimension vars')") 2080,2105c1482,1483 < ! < ! First attribute: < if (len_trim(att1name) > 0.and.len_trim(att1val) > 0) then < istat = nf_put_att_text(ncid,idv,att1name,len_trim(att1val), < | trim(att1val)) < if (istat /= NF_NOERR) then < write(char120,"('Error defining ',a,' attribute to var ', < | a,': attribute value=',a)") trim(name),trim(att1name), < | trim(att1val) < call handle_ncerr(istat,char120) < endif < endif < ! < ! Second attribute: < if (len_trim(att2name) > 0.and.len_trim(att2val) > 0) then < istat = nf_put_att_text(ncid,idv,att2name,len_trim(att2val), < | trim(att2val)) < if (istat /= NF_NOERR) then < write(char120,"('Error defining ',a,' attribute to var ', < | a,': attribute value=',a)") trim(name),trim(att2name), < | trim(att2val) < call handle_ncerr(istat,char120) < endif < endif < end subroutine define_ncfile < !----------------------------------------------------------------------- --- > end subroutine nc_define > !------------------------------------------------------------------- 2107a1486,1489 > > ! call defvar_time_dbl(ncid,"ut",ids1,idv_ut, > ! | "universal time (from model time hour and minute)", > ! | "hours") 2151c1533 < subroutine deflbc(ncid,vname,idv) --- > subroutine defvar_sech(ncid,nfgeo,nfmag,nfgeo2d,nfmag2d,nfmagphr) 2153,2154c1535,1536 < ! Define t, u, or v lbc on current history file. Return new varialbe < ! id in idv. (vname should be TLBC, ULBC, or VLBC) --- > ! Define secondary history fields on currently open ncid > ! (not data -- see wrf3d for data write) 2157,2159c1539,1545 < integer,intent(in) :: ncid < integer,intent(out) :: idv < character(len=*),intent(in) :: vname --- > integer,intent(in) :: > | ncid, ! netcdf file id > | nfgeo, ! number of fields on geographic grid > | nfmag, ! number of fields on magnetic grid > | nfgeo2d, ! number of fields on geographic grid 2d > | nfmag2d, ! number of fields on magnetic grid 2d > | nfmagphr ! number of fields on magnetospheric grid 2162,2226c1548 < integer :: istat,len < character(len=80) :: char80,units < ! < ids3(1) = id_lon < ids3(2) = id_lat < ids3(3) = id_time < ! < ! Define variable: < istat = nf_def_var(ncid,trim(vname),NF_DOUBLE,3,ids3,idv) < if (istat /= NF_NOERR) then < write(char80,"('Error defining 2-d var ',a)") trim(vname) < call handle_ncerr(istat,trim(char80)) < endif < ! < ! Long name attribute: < ! (Variable names ending in '_NM' are at previous time n-1) < ! < write(char80,"('Lower boundary condition of ',a,'N')") vname(1:1) < len = len_trim(vname) < if (vname(len-2:len)=='_NM') < | char80 = trim(char80)//' (TIME N-1)' < ! < istat = nf_put_att_text(ncid,idv,"long_name", < | len_trim(char80),trim(char80)) < if (istat /= NF_NOERR) then < write(char80,"('Error defining long_name attribute of ', < | 'variable ',a)") trim(vname) < call handle_ncerr(istat,trim(char80)) < endif < ! < ! Units attribute: < units = 'cm/s' < if (vname(1:1)=='T') units = 'K' < istat = nf_put_att_text(ncid,idv,"units",len_trim(units), < | trim(units)) < if (istat /= NF_NOERR) then < write(char80,"('Error defining units attribute of variable ', < | a)") trim(vname) < call handle_ncerr(istat,trim(char80)) < endif < ! < ! Coordinates attribute: < istat = nf_put_att_text(ncid,idv,"coordinates",3,'LBC') < if (istat /= NF_NOERR) then < write(char80,"('Error defining coordinates attribute of ', < | 'variable',a)") trim(vname) < call handle_ncerr(istat,trim(char80)) < endif < ! write(6,"('deflbc: defined var ',a,' idv=',i3)") trim(vname),idv < end subroutine deflbc < !----------------------------------------------------------------------- < subroutine def_fsech(ncid) < ! < ! Define secondary history fields (geo or mag, 2d+time or 3d+time): < ! < use fields_module,only: fsechist < use hist_module,only: nsech,isecout < use input_module,only: secout < implicit none < ! < ! Args: < integer,intent(in) :: ncid < ! < ! Local: < integer :: ix,istat,iprog,idimids(4),idv --- > integer :: i,ii,ier,istat,iprog 2228d1549 < real :: var1(1) 2231c1552 < integer,external :: strloc --- > integer,external :: strloc 2233,2236c1554,1561 < if (nsech==2) then < istat = nf_redef(ncid) ! put dataset in define mode < if (istat /= NF_NOERR) < | call handle_ncerr(istat,'error from nf_redef') --- > if (allocated(idv_sech)) deallocate(idv_sech) > allocate(idv_sech(nfgeo+nfmag+nfgeo2d+nfmag2d+nfmagphr),stat=ier) > if (ier /= 0) then > write(6,"(/,'>>> WARNING defvar_sech: ', > | 'error return from allocate for idv_sech: nfgeo=',i3, > | ' nfmag=',i3,' nfgeo2dr=',i3, > | ' nfmag2d=',i3,' nfmagphr=',i3,' ier=',i4)") > | nfgeo,nfmag,nfgeo2d,nfmag2d,nfmagphr,ier 2237a1563,1565 > if (nfgeo > 0) then > do i=1,nfgeo > iprog = strloc(f4d%short_name,size(f4d),fsech(i)%short_name) 2239,2246d1566 < ! Fields loop: < floop: do ix=1,mxfsech < if (len_trim(fsechist(ix)%short_name)==0) cycle floop < ! < ! Define prognostic only if this is 1st history on this file: < iprog=strloc(f4d%short_name,size(f4d),fsechist(ix)%short_name) < if (iprog > 0.and.nsech==1) then < ! 2248c1568,1569 < call defvar_f4d(ncid,f4d(iprog),idv_fsech(ix)) --- > if (iprog > 0) then > call defvar_f4d(ncid,f4d(iprog),idv_sech(i)) 2250,2308c1571,1573 < ! 10/27/05 btf: Assume user-requested 'W' refers to "old hist" W, i.e. OMEGA: < ! < elseif (nsech==1.and.fsechist(ix)%short_name=='W') then < write(6,"('Note: defining requested secondary history ', < | 'variable ''W'' as prognostic ''OMEGA''')") < iprog = strloc(f4d%short_name,size(f4d),'OMEGA') < call defvar_f4d(ncid,f4d(iprog),idv_fsech(ix)) < cycle floop < endif ! iprog and nsech < ! < ! Define diagostics only if not first timestep (because in that case, < ! diags have not yet been allocated by addfld): < if (istep==0.or.iprog > 0) cycle floop < ! < ! If data pointer is not associated, addfld was probably never called < ! for this field. In this case, do not define the field. (subs def_fsech < ! and wrfsech will also check this pointer, see nchist.F, and sub < ! mp_gather2root_fsech in mpi.F) < ! < if (.not.associated(fsechist(ix)%data)) then < write(6,"('>>> WARNING: Field ',a,' will not be defined', < | ' on secondary histories because',/,4x,'data was not ', < | 'allocated. (addfld was probably not called for this ', < | 'field)')") trim(fsechist(ix)%short_name) < cycle floop < endif < ! < ! Get dim id's for 3 dimensions (geo or mag): < if (fsechist(ix)%dimsizes(3) /= 0) then ! 3d var (lon,lat,lev,time) < istat=nf_inq_dimid(ncid,fsechist(ix)%dimnames(1),idimids(1)) < if (istat /= NF_NOERR) then < write(char80,"('def_fsech: Error getting id for dim ', < | a,' (1st of 3)')") trim(fsechist(ix)%dimnames(1)) < call handle_ncerr(istat,trim(char80)) < endif < istat=nf_inq_dimid(ncid,fsechist(ix)%dimnames(2),idimids(2)) < if (istat /= NF_NOERR) then < write(char80,"('def_fsech: Error getting id for dim ', < | a,' (2nd of 3)')") trim(fsechist(ix)%dimnames(2)) < call handle_ncerr(istat,trim(char80)) < endif < istat=nf_inq_dimid(ncid,fsechist(ix)%dimnames(3),idimids(3)) < if (istat /= NF_NOERR) then < write(char80,"('def_fsech: Error getting id for dim ', < | a,' (3rd of 3)')") trim(fsechist(ix)%dimnames(3)) < call handle_ncerr(istat,trim(char80)) < endif < idimids(4) = id_time < ! < ! Define 3d var (lon,lat,lev,time) < istat = nf_inq_varid(ncid,fsechist(ix)%short_name,idv) < if (istat /= NF_NOERR) then ! var has not been defined < istat = nf_def_var(ncid,fsechist(ix)%short_name,NF_DOUBLE, < | 4,idimids,idv_fsech(ix)) ! returns idv_fsech(ix) < if (istat /= NF_NOERR) then < write(char80,"('def_fsech: Error defining 3d field ',a)") < | trim(fsechist(ix)%short_name) < call handle_ncerr(istat,trim(char80)) < endif --- > ! Define secondary history field: > else > call defvar_f3d(ncid,fsech(i),idv_sech(i)) 2310,2369c1575,1601 < ! < ! Get dim id's for 2 dimensions (geo or mag): < else ! 2d var (lon,lat,time) < istat=nf_inq_dimid(ncid,fsechist(ix)%dimnames(1),idimids(1)) < if (istat /= NF_NOERR) then < write(char80,"('def_fsech: Error getting id for dim ', < | a,' (1st of 2)')") trim(fsechist(ix)%dimnames(1)) < call handle_ncerr(istat,trim(char80)) < endif < istat=nf_inq_dimid(ncid,fsechist(ix)%dimnames(2),idimids(2)) < if (istat /= NF_NOERR) then < write(char80,"('def_fsech: Error getting id for dim ', < | a,' (2nd of 2)')") trim(fsechist(ix)%dimnames(2)) < call handle_ncerr(istat,trim(char80)) < endif < idimids(3) = id_time < ! < ! Define 2d var (lon,lat,time) < istat = nf_inq_varid(ncid,fsechist(ix)%short_name,idv) < if (istat /= NF_NOERR) then ! var has not been defined < istat = nf_def_var(ncid,fsechist(ix)%short_name,NF_DOUBLE, < | 3,idimids(1:3),idv_fsech(ix)) ! returns idv_fsech(ix) < if (istat /= NF_NOERR) then < write(char80,"('def_fsech: Error defining 2d field ',a)") < | fsechist(ix)%short_name < call handle_ncerr(istat,trim(char80)) < endif < endif < endif ! 2d or 3d < < ! write(6,"('def_fsech: defined sech field ',a,': dimnames=', < ! | a,',',a,',',a,' dimsizes=',3i4)") fsechist(ix)%short_name, < ! | trim(fsechist(ix)%dimnames(1)),trim(fsechist(ix)%dimnames(2)), < ! | trim(fsechist(ix)%dimnames(3)),fsechist(ix)%dimsizes < ! < ! Attributes: < if (len_trim(fsechist(ix)%long_name) > 0) then < istat = nf_put_att_text(ncid,idv_fsech(ix),"long_name", < | len_trim(fsechist(ix)%long_name),trim(fsechist(ix)%long_name)) < endif < if (len_trim(fsechist(ix)%units) > 0) then < istat = nf_put_att_text(ncid,idv_fsech(ix),"units", < | len_trim(fsechist(ix)%units),trim(fsechist(ix)%units)) < endif < ! < ! Missing value: < var1(1) = spval < istat = nf_put_att_double(ncid,idv_fsech(ix),"missing_value", < | NF_DOUBLE,1,var1) < if (istat /= NF_NOERR) then < write(char80,"('def_fsech: Error return from ', < | 'nf_put_att_double for missing_value var attribute')") < call handle_ncerr(istat,char80) < endif < ! < ! End field loop: < enddo floop ! i=1,mxfsech < if (nsech==2) istat = nf_enddef(ncid) ! take out of define mode < end subroutine def_fsech < !----------------------------------------------------------------------- --- > enddo > endif > if (nfmag > 0) then > do i=1,nfmag > call defvar_f3d(ncid,fsechmag(i),idv_sech(nfgeo+i)) > enddo > endif > ! subroutine defvar_f2d(ncid,f,idvar) > if (nfgeo2d > 0) then > do i=1,nfgeo2d > call defvar_f2d(ncid,fsech2d(i),idv_sech(nfgeo+nfmag+i)) > enddo > endif > if (nfmag2d > 0) then > do i=1,nfmag2d > call defvar_f2d(ncid,fsechmag2d(i),idv_sech(nfgeo+nfmag+ > | nfgeo2d+i)) > enddo > endif > if (nfmagphr > 0) then > do i=1,nfmagphr > call defvar_f2d(ncid,fsechmagphr2d(i),idv_sech(nfgeo+nfmag+ > | nfgeo2d+nfmag2d+i)) > enddo > endif > end subroutine defvar_sech > !------------------------------------------------------------------- 2384d1615 < real :: var1(1) 2390,2391c1621 < idimids(3) = id_lev ! midpoints < if (f%vcoord(1:3)=='int') idimids(3) = id_ilev ! interfaces --- > idimids(3) = id_lev 2419,2421d1648 < ! 1/18/06 btf: Use f%units for densities) instead of "fraction" or "1", < ! and do not add alternate units. < ! 2429a1657,1659 > end subroutine defvar_f4d > !------------------------------------------------------------------- > subroutine defvar_f3d(ncid,f,idvar) 2431,2434c1661,1689 < ! 10/27/05 btf: Add former_name attribute to OMEGA to indicate it < ! was previously known as W: < if (f%short_name=='OMEGA') then < istat = nf_put_att_text(ncid,idvar,"former_name",1,"W") --- > ! Define a diagnostic variable (geographic and magnetic) > ! on the current netcdf history file: > ! > ! Args: > integer,intent(in) :: ncid > integer,intent(out) :: idvar > type(fields_3d),intent(inout) :: f > ! > ! Local: > integer :: istat,idimids(4),ndims > character(len=80) :: char80 > ! > if (.not.fakeflds) then > if (.not.f%magnetos.and..not.f%magnetic) then ! field is on geographic grid > ndims = 4 > idimids(1) = id_lon > idimids(2) = id_lat > idimids(3) = id_lev > idimids(4) = id_time > elseif (.not.f%magnetos) then ! field is on magnetic grid > ndims = 4 > idimids(1) = id_mlon > idimids(2) = id_mlat > idimids(3) = id_mlev > idimids(4) = id_time > endif > else > idimids(1:3) = id_fake > idimids(4) = id_time 2437,2440c1692,1693 < ! Add missing_value attribute: < var1(1) = spval < istat = nf_put_att_double(ncid,idvar,"missing_value", < | NF_DOUBLE,1,var1) --- > istat = nf_def_var(ncid,f%short_name,NF_DOUBLE,ndims, > | idimids,idvar) 2442,2444c1695,1700 < write(char160,"('defvar_f4d: Error return from ', < | 'nf_put_att_double for missing_value var attribute')") < call handle_ncerr(istat,char160) --- > write(char80,"('Error defining diagnostic field ',a)") > | f%short_name > call handle_ncerr(istat,trim(char80)) > ! else > ! write(6,"('defvar_f3d: defined diagnostic field ',a)") > ! | f%short_name 2446,2447c1702,1747 < end subroutine defvar_f4d < !----------------------------------------------------------------------- --- > end subroutine defvar_f3d > !------------------------------------------------------------------- > subroutine defvar_f2d(ncid,f,idvar) > ! > ! Define a diagnostic variable (geographic, magnetic or magnetosphere) > ! on the current netcdf history file: > ! > ! Args: > integer,intent(in) :: ncid > integer,intent(out) :: idvar > type(fields_2d),intent(inout) :: f > ! > ! Local: > integer :: istat,idimids(3),ndims > character(len=80) :: char80 > ! > if (.not.fakeflds) then > if (.not.f%magnetos.and..not.f%magnetic) then ! 2d geographic > idimids(1) = id_lon > idimids(2) = id_lat > elseif (.not.f%magnetos) then ! field is on magnetic 2d grid > idimids(1) = id_mlon > idimids(2) = id_mlat > else ! field is on magnetospheric 2d grid > idimids(1) = id_magphrlon > idimids(2) = id_magphrlat > endif > ndims = 3 > idimids(3) = id_time > else > idimids(1:2) = id_fake > idimids(3) = id_time > endif > ! > istat = nf_def_var(ncid,f%short_name,NF_DOUBLE,ndims, > | idimids,idvar) > if (istat /= NF_NOERR) then > write(char80,"('Error defining diagnostic field ',a)") > | f%short_name > call handle_ncerr(istat,trim(char80)) > ! else > ! write(6,"('defvar_f3d: defined diagnostic field ',a)") > ! | f%short_name > endif > end subroutine defvar_f2d > !------------------------------------------------------------------- 2452c1752 < use hist_module,only: sh,h,hist_print --- > use hist_module,only: h,hist_print 2460,2461c1760 < integer :: mins,istat,ivar1(1),i,j,iprog,imo,ida,mtimeinit(4), < | ivar2(2),ii --- > integer :: mins,istat,ivar1(1),i,j,iprog,imo,ida,mtimetmp(4) 2463d1761 < character(len=240) :: char240 2466c1764 < real :: var1(1),var22(2,2),var2(2),var10(10),rmins,rdays --- > real :: var1(1),var22(2,2),var2(2),var10(10),rmins,rmins1(1) 2472,2474c1770,1774 < ! Time: decimal days since start time of initial run: < ! h%initial_mtime was set by sub hist_initype (if initial run), < ! or was read from source history (if continuation run). --- > ! Total model time in minutes: > ! Normally time is current model time (mins) since start_day,mtime > ! (i.e., since start time of the initial run), however if model time > ! is earlier than initial start time, use time since start time of > ! current run. 2476,2487c1776,1790 < mtimeinit(1:3) = sh%initial_mtime(1:3) ; mtimeinit(4) = 0 < rmins = mtime_delta(mtimeinit,h%modeltime) < rdays = rmins/1440. < if (rmins < 0.) then < write(6,"(/,'>>> nc_wrhist: time from initial start must be', < | ' >= 0: mtimeinit=',3i4,' h%modeltime=',3i4,' delta (mins)=', < | f10.2)") mtimeinit(1:3),h%modeltime(1:3),rmins < call shutdown('delta time from init run') < else < ! write(6,"('nc_wrhist: mtimeinit=',3i4,' h%modeltime=',3i4, < ! | ' delta (mins)=',f10.2,' delta (days)=',f8.2)") < ! | mtimeinit(1:3),h%modeltime(1:3),rmins,rdays --- > mtimetmp(1) = h%initial_day > mtimetmp(2:3) = h%initial_mtime(2:3) ; mtimetmp(4) = 0 > rmins = mtime_delta(mtimetmp,h%modeltime) > if (rmins < 0.) then ! use time since start time of the run > if (h%type(1:3)=='pri') then > mtimetmp(1:3) = start(:,1) ; mtimetmp(4) = 0 > rmins = mtime_delta(mtimetmp,h%modeltime) > elseif (h%type(1:3)=='sec') then > mtimetmp(1:3) = secstart(:,1) ; mtimetmp(4) = 0 > rmins = mtime_delta(mtimetmp,h%modeltime) > else > write(6,"(/,'>>> WARNING nc_wrhist: unknown h%type=',a)") > | h%type > rmins = 0. > endif 2490,2492d1792 < ! 1/29/08 btf: Use minutes rather than days < ! (see time units "minutes since.." above) < ! istat = nf_put_var1_double(ncid,idv_time,h%ihist,rdays) 2495,2498c1795,1800 < write(char240,"('Error from nf_put_var1_double defining ', < | 'time at h%modeltime=',4i4,' mtimeinit=',3i4, < | ' delta (days)=',f8.2)") h%modeltime,mtimeinit(1:3),rdays < call handle_ncerr(istat,char240) --- > write(char120,"('Error from nf_put_var1_double defining ', > | 'time at h%modeltime=',4i4,' rmins=',e12.4, > | ' h%initial_mtime=',3i4,' start(:,1)=',3i4,' secstart(:,1)=', > | 3i4)") h%modeltime,rmins,h%initial_mtime,start(:,1), > | secstart(:,1) > call handle_ncerr(istat,char120) 2507,2517d1808 < ! < ! If model day is > 365, write actual day of year, i.e. day-365 < ! (e.g., if model day is 366, write model day 1 to the history) < ! < if (h%modeltime(1) > 365) then < write(6,"('Note: Changed model day from ',i4,' to ',i4, < | ' before writing to history file.')") < | h%modeltime(1), h%modeltime(1)-365 < h%modeltime(1) = h%modeltime(1)-365 < endif < ! 2548,2574d1838 < ! Calendar advance: < if (idv_calendar_adv <= 0) < | istat = nf_inq_varid(ncid,"calendar_advance",idv_calendar_adv) < istat = nf_put_var1_int(ncid,idv_calendar_adv,h%ihist, < | h%calendar_advance) < if (istat /= NF_NOERR) then < write(char120,"('Error from nf_put_var1_int defining ', < | 'calendar advance flag at h%ihist=',i3, < | ': h%calendar_advance=',i5)") h%ihist,h%calendar_advance < call handle_ncerr(istat,char120) < endif < ! < ! Date and time history was written: < if (idv_writedate <= 0) istat = nf_inq_varid(ncid,"write_date", < | idv_writedate) < start_2d(1) = 1 < start_2d(2) = h%ihist < count_2d(1) = len(h%write_date) < count_2d(2) = 1 < istat = nf_put_vara_text(ncid,idv_writedate,start_2d,count_2d, < | h%write_date) < if (istat /= NF_NOERR) then < write(char120,"('Error from nf_put_vara_text writing ', < | 'h%write_date=',a)") trim(h%write_date) < call handle_ncerr(istat,char120) < endif < ! 2587a1852,1856 > ! Magnetic pole coords: > if (idv_mag <= 0) istat = nf_inq_varid(ncid,"mag",idv_mag) > var22(:,:) = h%mag(:,:) > istat = nf_put_var_double(ncid,idv_mag,var22) > ! 2609,2611c1878,1886 < ! Update gpi_ncfile: < call update_ncfile(ncid,"gpi_ncfile",h%gpi_ncfile,idv_gpi_ncfile, < | h%ihist) --- > ! ncep/nmc flag: > ! time-gcm only, but leave it for processors. > if (idv_ncep <= 0) istat = nf_inq_varid(ncid,"ncep",idv_ncep) > istat = nf_put_var1_int(ncid,idv_ncep,h%ihist,h%ncep) > if (istat /= NF_NOERR) then > write(char120,"('Error from nf_put_var1_int defining ', > + 'ncep at h%ihist=',i3,': h%ncep=',i3)") h%ihist,h%ncep > call handle_ncerr(istat,char120) > endif 2613,2615c1888,1895 < ! Update ncep_ncfile: < call update_ncfile(ncid,"ncep_ncfile",h%ncep_ncfile, < | idv_ncep_ncfile,h%ihist) --- > ! gpi flag: > if (idv_gpi <= 0) istat = nf_inq_varid(ncid,"gpi",idv_gpi) > istat = nf_put_var1_int(ncid,idv_gpi,h%ihist,h%gpi) > if (istat /= NF_NOERR) then > write(char120,"('Error from nf_put_var1_int defining ', > + 'gpi at h%ihist=',i3,': h%gpi=',i3)") h%ihist,h%gpi > call handle_ncerr(istat,char120) > endif 2617,2619c1897,1935 < ! Update see_ncfile: < call update_ncfile(ncid,"see_ncfile",h%see_ncfile,idv_see_ncfile, < | h%ihist) --- > ! gswmdi flag for diurnal tides: > if (idv_gswmdi <= 0) istat = nf_inq_varid(ncid,"gswmdi", > | idv_gswmdi) > istat = nf_put_var1_int(ncid,idv_gswmdi,h%ihist,h%gswmdi) > if (istat /= NF_NOERR) then > write(char120,"('Error from nf_put_var1_int defining ', > | 'gswmdi at h%ihist=',i3,': h%gswmdi=',i3)") h%ihist,h%gswmdi > call handle_ncerr(istat,char120) > endif > ! gswmsdi flag for semidiurnal tides: > if (idv_gswmsdi <= 0) istat = nf_inq_varid(ncid,"gswmsdi", > | idv_gswmsdi) > istat = nf_put_var1_int(ncid,idv_gswmsdi,h%ihist,h%gswmsdi) > if (istat /= NF_NOERR) then > write(char120,"('Error from nf_put_var1_int defining ', > | 'gswmsdi at h%ihist=',i3,': h%gswmsdi=',i3)") h%ihist, > | h%gswmsdi > call handle_ncerr(istat,char120) > endif > ! gswmnmdi flag for nonmigrating diurnal tides: > if (idv_gswmnmdi <= 0) istat = nf_inq_varid(ncid,"gswmnmdi", > | idv_gswmnmdi) > istat = nf_put_var1_int(ncid,idv_gswmnmdi,h%ihist,h%gswmnmdi) > if (istat /= NF_NOERR) then > write(char120,"('Error from nf_put_var1_int defining ', > | 'gswmnmdi at h%ihist=',i3,': h%gswmnmdi=',i3)") h%ihist, > | h%gswmnmdi > call handle_ncerr(istat,char120) > endif > ! gswmnmsdi flag for nonmigrating semidiurnal tides: > if (idv_gswmnmsdi <= 0) istat = nf_inq_varid(ncid,"gswmnmsdi", > | idv_gswmnmsdi) > istat = nf_put_var1_int(ncid,idv_gswmnmsdi,h%ihist,h%gswmnmsdi) > if (istat /= NF_NOERR) then > write(char120,"('Error from nf_put_var1_int defining ', > | 'gswmnmsdi at h%ihist=',i3,': h%gswmnmsdi=',i3)") h%ihist, > | h%gswmnmsdi > call handle_ncerr(istat,char120) > endif 2621,2634d1936 < ! Update imf_ncfile: < call update_ncfile(ncid,"imf_ncfile",h%imf_ncfile,idv_imf_ncfile, < | h%ihist) < ! < ! Update gswm files: < call update_ncfile(ncid,"gswm_mi_di_ncfile",h%gswm_mi_di_ncfile, < | idv_gswm_mi_di_ncfile,h%ihist) < call update_ncfile(ncid,"gswm_mi_sdi_ncfile",h%gswm_mi_sdi_ncfile, < | idv_gswm_mi_sdi_ncfile,h%ihist) < call update_ncfile(ncid,"gswm_nm_di_ncfile",h%gswm_nm_di_ncfile, < | idv_gswm_nm_di_ncfile,h%ihist) < call update_ncfile(ncid,"gswm_nm_sdi_ncfile",h%gswm_nm_sdi_ncfile, < | idv_gswm_nm_sdi_ncfile,h%ihist) < ! 2653,2655c1955 < ! BX,BY,BZ imf: < if (idv_bximf <= 0) istat = nf_inq_varid(ncid,"bximf",idv_bximf) < istat = nf_put_var1_double(ncid,idv_bximf,h%ihist,h%bximf) --- > ! BY imf: 2658,2659d1957 < if (idv_bzimf <= 0) istat = nf_inq_varid(ncid,"bzimf",idv_bzimf) < istat = nf_put_var1_double(ncid,idv_bzimf,h%ihist,h%bzimf) 2661,2670d1958 < ! swvel,swden: < if (idv_swvel <= 0) istat = nf_inq_varid(ncid,"swvel",idv_swvel) < istat = nf_put_var1_double(ncid,idv_swvel,h%ihist,h%swvel) < if (idv_swden <= 0) istat = nf_inq_varid(ncid,"swden",idv_swden) < istat = nf_put_var1_double(ncid,idv_swden,h%ihist,h%swden) < ! < ! al: < if (idv_al <= 0) istat = nf_inq_varid(ncid,"swden",idv_al) < istat = nf_put_var1_double(ncid,idv_al,h%ihist,h%al) < ! 2675c1963 < --- > ! 2677,2679c1965,1967 < ! if (idv_alfa30 <= 0) istat = nf_inq_varid(ncid,"alfa30", < ! | idv_alfa30) < ! istat = nf_put_var1_double(ncid,idv_alfa30,h%ihist,h%alfa30) --- > if (idv_alfa30 <= 0) istat = nf_inq_varid(ncid,"alfa30", > | idv_alfa30) > istat = nf_put_var1_double(ncid,idv_alfa30,h%ihist,h%alfa30) 2682,2683c1970,1971 < ! if (idv_e30 <= 0) istat = nf_inq_varid(ncid,"e30",idv_e30) < ! istat = nf_put_var1_double(ncid,idv_e30,h%ihist,h%e30) --- > if (idv_e30 <= 0) istat = nf_inq_varid(ncid,"e30",idv_e30) > istat = nf_put_var1_double(ncid,idv_e30,h%ihist,h%e30) 2686,2688c1974,1976 < ! if (idv_alfad2 <= 0) istat = nf_inq_varid(ncid,"alfad2", < ! | idv_alfad2) < ! istat = nf_put_var1_double(ncid,idv_alfad2,h%ihist,h%alfad2) --- > if (idv_alfad2 <= 0) istat = nf_inq_varid(ncid,"alfad2", > | idv_alfad2) > istat = nf_put_var1_double(ncid,idv_alfad2,h%ihist,h%alfad2) 2691,2714c1979,1980 < ! if (idv_ed2 <= 0) istat = nf_inq_varid(ncid,"ed2",idv_ed2) < ! istat = nf_put_var1_double(ncid,idv_ed2,h%ihist,h%ed2) < < ! e1,e2: < if (idv_e1 <= 0) istat = nf_inq_varid(ncid,"e1",idv_e1) < istat = nf_put_var1_double(ncid,idv_e1,h%ihist,h%e1) < if (idv_e2 <= 0) istat = nf_inq_varid(ncid,"e2",idv_e2) < istat = nf_put_var1_double(ncid,idv_e2,h%ihist,h%e2) < ! h1,h2: < if (idv_h1 <= 0) istat = nf_inq_varid(ncid,"h1",idv_h1) < istat = nf_put_var1_double(ncid,idv_h1,h%ihist,h%h1) < if (idv_h2 <= 0) istat = nf_inq_varid(ncid,"h2",idv_h2) < istat = nf_put_var1_double(ncid,idv_h2,h%ihist,h%h2) < ! alfac,ec: < if (idv_alfac <= 0) istat = nf_inq_varid(ncid,"alfac",idv_alfac) < istat = nf_put_var1_double(ncid,idv_alfac,h%ihist,h%alfac) < if (idv_ec <= 0) istat = nf_inq_varid(ncid,"ec",idv_ec) < istat = nf_put_var1_double(ncid,idv_ec,h%ihist,h%ec) < ! alfad,ed: < if (idv_alfad <= 0) istat = nf_inq_varid(ncid,"alfad",idv_alfad) < istat = nf_put_var1_double(ncid,idv_alfad,h%ihist,h%alfad) < if (idv_ed <= 0) istat = nf_inq_varid(ncid,"ed",idv_ed) < istat = nf_put_var1_double(ncid,idv_ed,h%ihist,h%ed) < --- > if (idv_ed2 <= 0) istat = nf_inq_varid(ncid,"ed2",idv_ed2) > istat = nf_put_var1_double(ncid,idv_ed2,h%ihist,h%ed2) 2716,2717c1982 < ! Reference pressure used to convert ln(p0/p) to pressure (hPa): < ! (h%p0 was set in sub define_hist, output.F) --- > ! Standard pressure: 2721,2730d1985 < ! Reference pressure used by the model (microbars): < ! (h%p0_model was set in sub define_hist, output.F) < if (idv_p0_model <= 0) istat = nf_inq_varid(ncid,"p0_model", < | idv_p0_model) < istat = nf_put_var1_double(ncid,idv_p0_model,h%ihist,h%p0_model) < ! < ! Gravitational constant used in the model: < if (idv_grav <= 0) istat = nf_inq_varid(ncid,"grav",idv_grav) < istat = nf_put_var1_double(ncid,idv_grav,h%ihist,h%grav) < ! 2740,2774d1994 < ! Update run_type (initial or continuation): < istat = nf_redef(ncid) ! put dataset in define mode < < istat = nf_put_att_text(ncid,NF_GLOBAL,"run_type", < | len_trim(h%run_type),trim(h%run_type)) < if (istat /= NF_NOERR) then < write(char120,"('nc_wrhist: Error return from nf_put_att_text ', < | 'for run_type global attribute')") < call handle_ncerr(istat,char120) < endif < ! < ! Update source_file and source mtime: < if (h%run_type(1:4)=='init') then ! initial source file < istat = nf_put_att_text(ncid,NF_GLOBAL,"source_file", < | len_trim(h%source_file)+10,trim(h%source_file)//' (initial)') < elseif (h%run_type(1:4)=='cont') then ! continuation source file < istat = nf_put_att_text(ncid,NF_GLOBAL,"source_file", < | len_trim(h%source_file)+15, < | trim(h%source_file)//' (continuation)') < endif < if (istat /= NF_NOERR) then < write(char120,"('Error return from nf_put_att_text ', < | 'for source_file global attribute')") < call handle_ncerr(istat,char120) < endif < istat = nf_put_att_int(ncid,NF_GLOBAL,"source_mtime",NF_INT,3, < | h%source_mtime) < if (istat /= NF_NOERR) then < write(char120,"('Error return from nf_put_att_text ', < | 'for source_mtime global attribute')") < call handle_ncerr(istat,char120) < endif < < istat = nf_enddef(ncid) ! take out of define mode < ! 2783a2004,2013 > ! Number of fields (scalar): > if (idv_nflds <= 0) istat = nf_inq_varid(ncid,"nflds",idv_nflds) > ! istat = nf_put_var1_int(ncid,idv_nflds,h%ihist,h%nflds) > istat = nf_put_var_int(ncid,idv_nflds,h%nflds) > if (istat /= NF_NOERR) then > write(char120,"('Error from nf_put_var_int defining ', > + 'nflds: h%nflds=',i4)") h%nflds > call handle_ncerr(istat,char120) > endif > ! 2788,2790c2018 < idv_tlbc = 0 ; idv_ulbc = 0 ; idv_vlbc = 0 ! forces wrlbc to inquire < idv_tlbc_nm = 0 ; idv_ulbc_nm = 0 ; idv_vlbc_nm = 0 ! forces wrlbc to inquire < if (h%hist_type(1:3)=='pri') then --- > if (h%type(1:3)=='pri') then 2792a2021 > enddo 2794,2812d2022 < ! Write ZG after Z (zg was calculated by sub calczg in addiag.F, < ! then gathered to fzg by mp_gather2root_f3d): < ! 3/1/06 btf: do not write ZG to primary histories. < ! if (trim(f4d(i)%short_name)=='Z') < ! | call wrf3d(ncid,fzg,h%ihist,'ZG',idv_zg) < enddo ! i=1,nf4d_hist < ! < ! Update t,u,v lbc to primary history: < ! Global arrays t,u,vlbc_glb were gathered from subdomains for history < ! output by sub mp_gather2root_lbc (mpi.F). < ! < call wrlbc(ncid,"TLBC",tlbc_glb,h%ihist,idv_tlbc,'pri') < call wrlbc(ncid,"ULBC",ulbc_glb,h%ihist,idv_ulbc,'pri') < call wrlbc(ncid,"VLBC",vlbc_glb,h%ihist,idv_vlbc,'pri') < ! < call wrlbc(ncid,"TLBC_NM",tlbc_nm_glb,h%ihist,idv_tlbc_nm,'pri') < call wrlbc(ncid,"ULBC_NM",ulbc_nm_glb,h%ihist,idv_ulbc_nm,'pri') < call wrlbc(ncid,"VLBC_NM",vlbc_nm_glb,h%ihist,idv_vlbc_nm,'pri') < ! 2814,2815c2024,2028 < elseif (h%hist_type(1:3)=='sec') then < call wrfsech(ncid,h%ihist) ! write secondary prog and diag fields --- > ! If a prognostic field, write field from fg to the history > ! (sub wrf4d). > ! If a diagnostic field, write field from fsech%data > ! (fsech%data was init to spval by sub set_fsech. If istep > 0, > ! then fsech%data should have been defined by addfsech. 2817,2823c2030,2061 < ! Update t,u,v lbc to secondary history: < call wrlbc(ncid,"TLBC",tlbc_glb,h%ihist,idv_tlbc,'sec') < call wrlbc(ncid,"ULBC",ulbc_glb,h%ihist,idv_ulbc,'sec') < call wrlbc(ncid,"VLBC",vlbc_glb,h%ihist,idv_vlbc,'sec') < call wrlbc(ncid,"TLBC_NM",tlbc_nm_glb,h%ihist,idv_tlbc_nm,'sec') < call wrlbc(ncid,"ULBC_NM",ulbc_nm_glb,h%ihist,idv_ulbc_nm,'sec') < call wrlbc(ncid,"VLBC_NM",vlbc_nm_glb,h%ihist,idv_vlbc_nm,'sec') --- > elseif (h%type(1:3)=='sec') then > if (h%nfgeo > 0) then > do i=1,h%nfgeo ! geographic fields > iprog = strloc(f4d%short_name,nf4d,fsech(i)%short_name) > if (iprog > 0) then > call wrf4d(ncid,fsech(i)%short_name,h%ihist,fakeflds, > | iprog) > else > call wrf3d(ncid,fsech(i),h%ihist,fakeflds) > endif > enddo > endif > if (h%nfmag > 0) then > do i=1,h%nfmag ! magnetic fields > call wrf3d(ncid,fsechmag(i),h%ihist,fakeflds) > enddo > endif > if (h%nfgeo2d > 0) then > do i=1,h%nfgeo2d ! geographic 2d fields > call wrf2d(ncid,fsech2d(i),h%ihist,fakeflds) > enddo > endif > if (h%nfmag2d > 0) then > do i=1,h%nfmag2d ! magnetic 2d fields > call wrf2d(ncid,fsechmag2d(i),h%ihist,fakeflds) > enddo > endif > if (h%nfmagphr > 0) then > do i=1,h%nfmagphr ! magnetospheric 2d fields > call wrf2d(ncid,fsechmagphr2d(i),h%ihist,fakeflds) > enddo > endif 2825,2826c2063,2064 < write(6,"(/,'>>> WARNING nc_wrhist: unknown h%hist_type=',a)") < | h%hist_type --- > write(6,"(/,'>>> WARNING nc_wrhist: unknown h%type=',a)") > | h%type 2833,2834c2071,2072 < !----------------------------------------------------------------------- < subroutine wrfsech(ncid,itime) --- > !------------------------------------------------------------------- > subroutine wrf2d(ncid,f,itime,fake) 2836,2838c2074 < ! Write data values of secondary history fields to ncfile. < ! (fields were defined on the file by def_fsech) < ! Data was gathered to root task by mp_gather2root_sechist (nchist.F) --- > ! Write diagnostic field to current open history file: 2840,2842c2076,2080 < use fields_module,only: fsechist,shortname_len < use hist_module,only: nsech,h < implicit none --- > ! f%data should be allocated and defined. > ! If the model has taken at least one timestep (istep > 0), then > ! f%data should have been defined by user-called sub addfsech. > ! If istep==0, then f%data was init to spval by set_fsech at beginning > ! of run. 2843a2082,2083 > use init_module,only: istep > ! 2845a2086,2087 > type(fields_2d),intent(in) :: f > logical,intent(in) :: fake 2848c2090,2092 < integer :: ix,iprog,istat,idvar,iddims(4),itype,ndims,natts,i --- > integer :: k,i,j,istat,idvar,itype,ndims,iddims(2),natts, > | idimsizes(2),nnans > character(len=120) :: char120 2850c2094,2099 < real,allocatable :: f2d(:,:),f3d(:,:,:) --- > character(len=16) :: rdname > real :: f2dgeo(nlon,nlat), > | f2dmag(nmlonp1,nmlat), > | f2dmagphr(nmagphrlon,nmagphrlat) ! note i,j > real :: fmin,fmax > real :: fakevar(1,1) 2852,2870c2101,2108 < ! External: < integer,external :: strloc < ! < ! write(6,"('Enter wrfsech: nsech=',i3,' itime=',i3)") nsech,itime < floop: do ix=1,mxfsech < if (len_trim(fsechist(ix)%short_name)==0) cycle floop < ! < ! Write prognostic: < iprog=strloc(f4d%short_name,size(f4d),fsechist(ix)%short_name) < if (iprog > 0) then < call wrf4d(ncid,fsechist(ix)%short_name,h%ihist,fakeflds, < | iprog) < cycle floop < elseif (fsechist(ix)%short_name=='W') then < write(6,"('Note: defining requested secondary history ', < | 'variable ''W'' as prognostic ''OMEGA''')") < iprog = strloc(f4d%short_name,size(f4d),'OMEGA') < call wrf4d(ncid,'OMEGA',h%ihist,fakeflds,iprog) < cycle floop --- > ! Fake means 2d fields are dimensioned (1,1) for testing: > ! (see fakeflds in fields.F) > if (fake) then > istat = nf_inq_varid(ncid,f%short_name,idvar) > if (istat /= NF_NOERR) then > write(char120,"('wrf2d: Error getting id of field var ',a)") > | trim(f%short_name) > call handle_ncerr(istat,char120) 2871a2110,2123 > start_3d(1:2) = 1 > start_3d(3) = itime > count_3d(1) = 1 > count_3d(2) = 1 > count_3d(3) = 1 > fakevar(1,1) = 0. > istat = nf_put_vara_double(ncid,idvar,start_4d,count_4d,fakevar) > if (istat /= NF_NOERR) then > write(char120,"('Error return from nf_put_vara_double', > + ' for fake field var ',a,' itime=',i2)") f%short_name,itime > call handle_ncerr(istat,char120) > endif > return > endif 2873,2883c2125,2130 < ! Wrote diagnostic only if not first timestep: < if (istep==0) cycle floop < ! < ! If addfld was never called for this field, data will not be < ! allocated -- in this case, leave the field defined on the < ! history, but do not write data (netcdf will default to _Fillvalue) < ! < if (.not.associated(fsechist(ix)%data)) then < ! write(6,"('>>> WARNING: sechist field ',a,': data not', < ! | ' allocated.')") trim(fsechist(ix)%short_name) < cycle floop --- > if (istep > 0) then > if (any(f%data(:,:) /= spval)) then ! was defined > > else > write(6,"(/,'>>> WARNING wrf2d: field ',a,' apparently not ', > | 'defined by addfsech.')") trim(f%short_name) 2884a2132,2134 > else ! istep == 0 > > endif 2887,2892c2137,2142 < istat = nf_inq_varid(ncid,fsechist(ix)%short_name,idvar) < if (istat /= NF_NOERR) then < write(char80,"('wrfsech: Error getting var id of field ',a)") < | trim(fsechist(ix)%short_name) < call handle_ncerr(istat,char80) < endif --- > istat = nf_inq_varid(ncid,f%short_name,idvar) > if (istat /= NF_NOERR) then > write(char80,"('wrf2d: Error getting id of field var ',a)") > | trim(f%short_name) > call handle_ncerr(istat,char80) > endif 2894,2895c2144,2149 < ! 3d+time field: < if (fsechist(ix)%dimsizes(3) > 0) then --- > ! Get info about the field: > istat = nf_inq_var(ncid,idvar,rdname,itype,ndims,iddims,natts) > if (ndims /= 3) then > write(6,"(/,'>>> WARNING wrf2d: bad ndims=',i3, > | ' (every diagnostic should have 3 dimensions)')") ndims > endif 2897,2904c2151,2163 < ! Allocate and transfer to local 3d output array: < allocate(f3d(fsechist(ix)%dimsizes(1), < | fsechist(ix)%dimsizes(2), < | fsechist(ix)%dimsizes(3)),stat=istat) < if (istat /= 0) then < write(6,"(/,'>>> wrfsech: Error allocating f3d: ', < | 'dimsizes=',3i4)") fsechist(ix)%dimsizes < call shutdown('wrfsech') --- > ! Get info about dimensions: > do i=1,ndims > istat = nf_inq_dim(ncid,iddims(i),rdname,idimsizes(i)) > enddo > ! > ! Check dimension sizes: > if (.not.fakeflds) then > if (.not.f%magnetic.and..not.f%magnetos) then ! geographic grid > if (idimsizes(1) /= nlon .or. idimsizes(2) /= nlat) then > write(6,"(/,'>>> WARNING wrf2d: bad dimension sizes', > | ' for geographic 2d diagnostic field ',a)") trim(rdname) > write(6,"(' dim sizes=',2i4,' but should be ', > | 'nlon,nlat=',2i4)") idimsizes(1:2),nlon,nlat 2906c2165,2183 < f3d = fsechist(ix)%data --- > elseif (.not.f%magnetos) then ! magnetic grid > if (idimsizes(1) /= nmlonp1 .or. idimsizes(2) /= nmlat) then > write(6,"(/,'>>> WARNING wrf2d: bad dimension sizes', > | ' for magnetic 2d diagnostic field ',a)") trim(rdname) > write(6,"(' dim sizes=',2i4,' but should be ', > | 'nmlonp1,nmlat=',2i4)") idimsizes(1:2),nmlonp1,nmlat > endif > else ! magnetospheric grid > if (idimsizes(1) /= nmagphrlon .or. > | idimsizes(2) /= nmagphrlat) then > write(6,"(/,'>>> WARNING wrf2d: bad dimension sizes', > | ' for magnetospheric diagnostic field ',a)") trim(rdname) > write(6,"(' dim sizes=',2i4,' but should be ', > | 'nmagphrlon,nmagphrlat=',3i4)") idimsizes(1:2), > | nmagphrlon,nmagphrlat > endif > > endif > endif 2908,2912c2185,2191 < ! Write values for 3d+time var (lon,lat,lev,time) < start_4d(1:3) = 1 < start_4d(4) = itime < count_4d(2:3) = fsechist(ix)%dimsizes(2:3) < count_4d(4) = 1 --- > ! Define f2d from f%data (netcdf does not like the pointer f%data): > ! local: real :: f2dgeo(nlonp4,nlat) > ! local: real :: f2dmag(nmlonp1,nmlat) > ! local: real :: f2dmagphr(nmagphrlon,nmagphrlat) > ! field.F: allocate(fsech2d(i)%data(nlonp4,nlat)) > ! allocate(fsechmag2d(i)%data(nmlonp1,nmlat)) > ! allocate(fsechmagphr2d(i)%data(nmagphrlon,nmagphrlat)) 2914,2917c2193,2196 < ! Write 3d+time geo field: < ! (write only 3:nlonp2 to exclude periodic points): < if (fsechist(ix)%geo) then ! 3d geo < count_4d(1) = nlon --- > if (.not.f%magnetic.and..not.f%magnetos) then ! geographic grid > do i=1,nlon > f2dgeo(i,:) = f%data(i+2,:) ! 1->nlon <= 3->nlon+2 > enddo 2919,2928c2198,2206 < ! write(6,"('wrfsech: writing 3d sech field ',a,'(',a,'=',i3, < ! | ',',a,'=',i3,',',a,'=',i3,'): min,max=',2e12.4)") < ! | fsechist(ix)%short_name(1:10), < ! | trim(fsechist(ix)%dimnames(1)),fsechist(ix)%dimsizes(1), < ! | trim(fsechist(ix)%dimnames(2)),fsechist(ix)%dimsizes(2), < ! | trim(fsechist(ix)%dimnames(3)),fsechist(ix)%dimsizes(3), < ! | minval(f3d(3:nlonp2,:,:)),maxval(f3d(3:nlonp2,:,:)) < < istat = nf_put_vara_double(ncid,idvar,start_4d,count_4d, < | f3d(3:nlonp2,:,:)) --- > elseif (.not.f%magnetos) then ! magnetic grid > do i=1,nmlonp1 > f2dmag(i,:) = f%data(i,:) > enddo > else ! magnetospheric grid > do i=1,nmagphrlon > f2dmag(i,:) = f%data(i,:) > enddo > endif 2930,2949c2208,2251 < ! Write 3d+time mag field: < else ! 3d mag < count_4d(1) = nmlonp1 < < ! write(6,"('wrfsech: writing 3d sech mag field ',a,'(',a,'=', < ! | i3,' ',a,'=',i3,',',a,'=',i3,'): min,max=',2e12.4)") < ! | trim(fsechist(ix)%short_name), < ! | trim(fsechist(ix)%dimnames(1)),fsechist(ix)%dimsizes(1), < ! | trim(fsechist(ix)%dimnames(2)),fsechist(ix)%dimsizes(2), < ! | trim(fsechist(ix)%dimnames(3)),fsechist(ix)%dimsizes(3), < ! | minval(f3d),maxval(f3d) < < istat = nf_put_vara_double(ncid,idvar,start_4d,count_4d, < | f3d) < endif ! geo or mag < if (istat /= NF_NOERR) then < write(char80,"('wrfsech: Error writing 3d+time field ',a)") < | trim(fsechist(ix)%short_name) < call handle_ncerr(istat,char80) < endif --- > ! Write data to the file: > start_3d(1:2) = 1 > start_3d(3) = itime > count_3d(3) = 1 > if (.not.f%magnetic.and..not.f%magnetos) then ! geographic grid > count_3d(1) = nlon > count_3d(2) = nlat > istat = nf_put_vara_double(ncid,idvar,start_3d,count_3d,f2dgeo) > if (istat /= NF_NOERR) then > write(char80,"(/,'>>> wrf2d: error return from ', > | 'nf_put_vara_double for geo2d field var ',a,' itime=',i2)") > | trim(f%short_name),itime > call handle_ncerr(istat,char80) > endif > if (check_nan) > | call check_nans(f2dgeo,nlon,nlat,1,f%short_name,nnans, > | 0,0.,1,0) > elseif (.not.f%magnetos) then ! magnetic grid > count_3d(1) = nmlonp1 > count_3d(2) = nmlat > istat = nf_put_vara_double(ncid,idvar,start_3d,count_3d,f2dmag) > if (istat /= NF_NOERR) then > write(char80,"(/,'>>> wrf2d: error return from ', > | 'nf_put_vara_double for mag2d field var ',a,' itime=',i2)") > | trim(f%short_name),itime > call handle_ncerr(istat,char80) > endif > if (check_nan) > | call check_nans(f2dmag,nmlonp1,nmlat,1,f%short_name,nnans, > | 0,0.,1,0) > else ! magnetospheric grid > count_3d(1) = nmagphrlon > count_3d(2) = nmagphrlat > istat = nf_put_vara_double(ncid,idvar,start_3d,count_3d,f2dmag) > if (istat /= NF_NOERR) then > write(char80,"(/,'>>> wrf2d: error return from ', > | 'nf_put_vara_double for magphr2d field var ',a, > | ' itime=',i2)") > | trim(f%short_name),itime > call handle_ncerr(istat,char80) > endif > if (check_nan) call check_nans(f2dmag,nmagphrlon,nmagphrlat, > | 1,f%short_name,nnans,0,0.,1,0) > endif 2951,2952c2253,2255 < ! Write 2d+time var (lon,lat,time): < else --- > ! If model has executed one or more time steps, the long_name and > ! units of the diagnostic sech field may have been defined by the > ! user-called addfsech routine: 2954,2960c2257,2270 < ! Allocate and transfer to local 2d array: < allocate(f2d(fsechist(ix)%dimsizes(1), < | fsechist(ix)%dimsizes(2)),stat=istat) < if (istat /= 0) then < write(6,"(/,'>>> wrfsech: Error allocating f2d: ', < | 'dimsizes=',3i4)") fsechist(ix)%dimsizes(1:2) < call shutdown('wrfsech') --- > if (istep > 0) then > if (len_trim(f%long_name) > 0 .or. len_trim(f%units) > 0) then > istat = nf_redef(ncid) ! put dataset in define mode > if (istat /= NF_NOERR) call handle_ncerr(istat, > + 'Error return from nf_redef') > if (len_trim(f%long_name) > 0) then > istat = nf_put_att_text(ncid,idvar,"long_name", > | len_trim(f%long_name),f%long_name) > if (istat /= NF_NOERR) then > write(char80,"('Error defining long_name of diagnostic', > | ' variable ',a,': long_name = ',a)") > | trim(f%short_name),trim(f%long_name) > call handle_ncerr(istat,trim(char80)) > endif 2962c2272,2286 < f2d = fsechist(ix)%data(:,:,1) --- > if (len_trim(f%units) > 0) then > istat = nf_put_att_text(ncid,idvar,"units", > | len_trim(f%units),f%units) > if (istat /= NF_NOERR) then > write(char80,"('Error defining units of diagnostic', > | ' variable ',a,' units = ',a)") > | trim(f%short_name),trim(f%units) > call handle_ncerr(istat,trim(char80)) > endif > endif > istat = nf_enddef(ncid) ! end define mode > if (istat /= NF_NOERR) call handle_ncerr(istat, > | 'Error return from nf_enddef') > endif ! long_name or units defined > endif ! istep > 0 2964,2968c2288,2296 < ! Write values for 2d+time var (lon,lat,time) < start_3d(1:2) = 1 < start_3d(3) = itime < count_3d(2) = fsechist(ix)%dimsizes(2) < count_3d(3) = 1 --- > ! Write min,max of each field: > ! if (istep /= 0) then > ! call fminmaxspv(f3diag,nlon*nlat*nlev,fmin,fmax,spval) > ! write(6,"('wrf2d: Wrote field ',a,' istep=',i3, > ! | ' 3d min,max=',2e12.4)") f%short_name(1:8),istep,fmin,fmax > ! endif > end subroutine wrf2d > !------------------------------------------------------------------- > subroutine wrf3d(ncid,f,itime,fake) 2970,2983c2298 < ! Write 2d+time geo field: < ! (write only 3:nlonp2 to exclude periodic points): < if (fsechist(ix)%geo) then ! 2d geo < count_3d(1) = nlon < < ! write(6,"('wrfsech: writing 2d geo sech field ',a,'(',a,'=', < ! | i3,',',a,'=',i3,'): min,max=',2e12.4)") < ! | fsechist(ix)%short_name(1:10), < ! | trim(fsechist(ix)%dimnames(1)),fsechist(ix)%dimsizes(1), < ! | trim(fsechist(ix)%dimnames(2)),fsechist(ix)%dimsizes(2), < ! | minval(f2d(3:nlonp2,:)),maxval(f2d(3:nlonp2,:)) < < istat = nf_put_vara_double(ncid,idvar,start_3d,count_3d, < | f2d(3:nlonp2,:)) --- > ! Write diagnostic field to current open history file: 2985,3010c2300,2304 < ! Write 2d+time mag field: < else ! 2d mag < count_3d(1) = nmlonp1 < < ! write(6,"('wrfsech: writing 2d mag sech field ',a,'(',a,'=', < ! | i3,',',a,'=',i3,'): min,max=',2e12.4)") < ! | trim(fsechist(ix)%short_name), < ! | trim(fsechist(ix)%dimnames(1)),fsechist(ix)%dimsizes(1), < ! | trim(fsechist(ix)%dimnames(2)),fsechist(ix)%dimsizes(2), < ! | minval(f2d),maxval(f2d) < < istat = nf_put_vara_double(ncid,idvar,start_3d,count_3d, < | f2d) < endif < if (istat /= NF_NOERR) then < write(char80,"('wrfsech: Error writing 2d+time field ',a)") < | trim(fsechist(ix)%short_name) < call handle_ncerr(istat,char80) < endif < endif < if (allocated(f2d)) deallocate(f2d) < if (allocated(f3d)) deallocate(f3d) < enddo floop ! ix=1,mxfsech < end subroutine wrfsech < !----------------------------------------------------------------------- < subroutine update_ncfile(ncid,vname,ncfile,idv,ihist) --- > ! f%data should be allocated and defined. > ! If the model has taken at least one timestep (istep > 0), then > ! f%data should have been defined by user-called sub addfsech. > ! If istep==0, then f%data was init to spval by set_fsech at beginning > ! of run. 3012,3013c2306 < ! Update file text var vname for history ihist. < ! Value of the variable to write is ncfile. --- > use init_module,only: istep 3015,3016d2307 < implicit none < ! 3018,3020c2309,2311 < integer,intent(in) :: ncid,ihist < integer,intent(inout) :: idv < character(len=*),intent(in) :: vname,ncfile --- > integer,intent(in) :: ncid,itime > type(fields_3d),intent(in) :: f > logical,intent(in) :: fake 3023,3024c2314,2315 < integer :: istat,start(2),count(2) < character(len=len(ncfile)) :: file --- > integer :: k,i,j,istat,idvar,itype,ndims,iddims(4),natts, > | idimsizes(4),nnans 3025a2317,2321 > character(len=80) :: char80 > character(len=16) :: rdname > real :: f3diag(nlon,nlat,nlevp1),f3dmag(nmlonp1,nmlat,nmlev) ! note i,j,k > real :: fmin,fmax > real :: fakevar(1,1,1) 3027,3035c2323,2362 < if (idv <= 0) < | istat = nf_inq_varid(ncid,vname,idv) < start(1) = 1 < start(2) = ihist < count(2) = 1 < file = ncfile < if (len_trim(ncfile) <= 0) file = '[none]' < count(1) = len(ncfile) < istat = nf_put_vara_text(ncid,idv,start,count,file) --- > ! Fake means 3d fields are dimensioned (1,1,1) for testing: > ! (see fakeflds in flds_mod.f) > if (fake) then > istat = nf_inq_varid(ncid,f%short_name,idvar) > if (istat /= NF_NOERR) then > write(char120,"('wrf3d: Error getting id of field var ',a)") > | trim(f%short_name) > call handle_ncerr(istat,char120) > endif > start_4d(1:3) = 1 > start_4d(4) = itime > count_4d(1) = 1 > count_4d(2) = 1 > count_4d(3) = 1 > count_4d(4) = 1 > fakevar(1,1,1) = 0. > istat = nf_put_vara_double(ncid,idvar,start_4d,count_4d,fakevar) > if (istat /= NF_NOERR) then > write(char120,"('Error return from nf_put_vara_double', > + ' for fake field var ',a,' itime=',i2)") f%short_name,itime > call handle_ncerr(istat,char120) > endif > return > endif > ! > ! If the following flags are set, the any() statement can fail with NaNS. > ! FFLAGS= -qinitauto=7FF7FFFF -qfloat=nans -qflttrap=invalid:enable > ! -qsigtrap=xl__trcedump > ! > if (istep > 0) then > if (any(f%data(:,:,:) /= spval)) then ! was defined > > else > write(6,"(/,'>>> WARNING wrf3d: field ',a,' apparently not ', > | 'defined by addfsech.')") trim(f%short_name) > endif > endif > ! > ! Get field id: > istat = nf_inq_varid(ncid,f%short_name,idvar) 3037,3042c2364,2366 < write(char120,"('Error from nf_put_vara_text to update ncfile ', < | a)") trim(file) < call handle_ncerr(istat,char120) < else < ! write(6,"('Updated var ',a,' for ihist=',i3,' file=',a)") < ! | trim(vname),ihist,trim(file) --- > write(char80,"('wrf3d: Error getting id of field var ',a)") > | trim(f%short_name) > call handle_ncerr(istat,char80) 3043a2368,2397 > ! > ! Get info about the field: > istat = nf_inq_var(ncid,idvar,rdname,itype,ndims,iddims,natts) > if (ndims /= 4) then > write(6,"(/,'>>> WARNING wrf3d: bad ndims=',i3, > | ' (every diagnostic should have 4 dimensions)')") ndims > endif > ! > ! Get info about dimensions: > do i=1,ndims > istat = nf_inq_dim(ncid,iddims(i),rdname,idimsizes(i)) > enddo > ! > ! Check dimension sizes: > if (.not.fakeflds) then > if (.not.f%magnetic) then ! geographic grid > if (idimsizes(1) /= nlon .or. idimsizes(2) /= nlat) then > write(6,"(/,'>>> WARNING wrf3d: bad dimension sizes', > | ' for geographic diagnostic field ',a)") trim(rdname) > write(6,"(' dim sizes=',3i4,' but should be ', > | 'nlon,nlat,nlev=',3i4)") idimsizes(1:3),nlon,nlat,nlev > endif > else ! magnetic grid > if (idimsizes(1) /= nmlonp1 .or. idimsizes(2) /= nmlat) then > write(6,"(/,'>>> WARNING wrf3d: bad dimension sizes', > | ' for magnetic diagnostic field ',a)") trim(rdname) > write(6,"(' dim sizes=',3i4,' but should be ', > | 'nmlonp1,nmlat,nmlev=',3i4)") idimsizes(1:3),nmlonp1, > | nmlat,nmlev > endif 3045,3048c2399,2404 < end subroutine update_ncfile < !----------------------------------------------------------------------- < subroutine wrlbc(ncid,vname,flbc,itime,idv,type) < implicit none --- > endif > if (idimsizes(3) < nlev) then > write(6,"(/,'>>> WARNING wrf3d: dimsize(3) < nlev:', > | ' idimsizes(3)=',i4,' nlev=',i4)") idimsizes(3),nlev > endif > endif 3050,3053c2406 < ! Update global lbc of t,u,v (TLBC,ULBC,VLBC (lon,lat,time)) to < ! current history (may be primary or secondary history). < ! This is executed by master task only (subdomains were gathered < ! into flbc by mp_gather2root_lbc) --- > ! Define f3diag from f%data (netcdf does not like the pointer f%data): 3055,3059c2408,2427 < ! Args: < integer,intent(in) :: ncid,itime < integer,intent(inout) :: idv < character(len=*),intent(in) :: vname,type < real,intent(in) :: flbc(nlonp4,nlat) ! data to save on file --- > if (.not.f%magnetic) then ! geographic grid > do k=1,nlevp1 > do i=1,nlon > f3diag(i,:,k) = f%data(k,i+2,:) ! 1->nlon <= 3->nlon+2 > enddo > > ! if (itime==2) then > ! do j=1,nlat > ! write(6,"('wrf3d: j=',i3,' k=',i3,' itime=',i3,' f3diag=', > ! | /,(6e12.4))") j,k,itime,f3diag(:,j,k) > ! enddo > ! endif > > enddo > > ! call fminmax(f3diag(:,:,:),nlevp1*nlon*nlat,fmin,fmax) > ! write(6,"('wrf3d: mag field ',a,' fmin,max=',2e12.4)") > ! | f%short_name,fmin,fmax > > else ! magnetic grid 3061,3065c2429,2434 < ! Local: < integer :: istat,j < character(len=80) :: char80 < character(len=120) :: char120 < real :: fglb(nlon,nlat) ! local for write to history --- > ! Secondary history array: fsechmag(n)%data(nlevp1+3,nmlonp1,nmlat) > ! (see allocation in set_fsech in fields.F) > ! Local f3dmag(nmlonp1,nmlat,nmlev) ! note i,j,k > ! Note nmlev==nlevp1+3 for extra levels at bottom, see transf in dynamo.F. > ! (mag fields in dynamo are (nmlonp1,-2:nlev)) > ! Transform from (k,i,j) to (i,j,k) for secondary history. 3067,3071c2436,2441 < start_3d(1:2) = 1 < start_3d(3) = itime < count_3d(1) = nlon < count_3d(2) = nlat < count_3d(3) = 1 --- > do k=1,nmlev ! nmlev = nlevp1+3 > do i=1,nmlonp1 > f3dmag(i,:,k) = f%data(k,i,:) > enddo > enddo > endif 3073,3075c2443,2451 < ! idv may be 0 for primary continuation file: < if (idv <= 0) then < istat = nf_inq_varid(ncid,trim(vname),idv) --- > ! Write data to the file: > start_4d(1:3) = 1 > start_4d(4) = itime > count_4d(4) = 1 > if (.not.f%magnetic) then ! geographic grid > count_4d(1) = nlon > count_4d(2) = nlat > count_4d(3) = nlevp1 > istat = nf_put_vara_double(ncid,idvar,start_4d,count_4d,f3diag) 3077,3078c2453,2455 < write(char80,"('Error getting var id for ',a, < | ' (ncid=',i3,')')") trim(vname),ncid --- > write(char80,"(/,'>>> wrf3d: error return from ', > | 'nf_put_vara_double for geo field var ',a,' itime=',i2)") > | trim(f%short_name),itime 3080,3082d2456 < else < ! write(6,"('wrlbc: vname=',a,' idv=',i3,' (idv was 0 on ', < ! | 'input)')") trim(vname),idv 3084,3086c2458,2473 < else < ! write(6,"('wrlbc: vname=',a,' idv on input=',i3)") < ! | trim(vname),idv --- > if (check_nan) call check_nans(f3diag,nlon,nlat, > | nlevp1,f%short_name,nnans,0,0.,1,0) > > else ! magnetic grid > count_4d(1) = nmlonp1 > count_4d(2) = nmlat > count_4d(3) = nmlev > istat = nf_put_vara_double(ncid,idvar,start_4d,count_4d,f3dmag) > if (istat /= NF_NOERR) then > write(char80,"(/,'>>> wrf3d: error return from ', > | 'nf_put_vara_double for mag field var ',a,' itime=',i2)") > | trim(f%short_name),itime > call handle_ncerr(istat,char80) > endif > if (check_nan) call check_nans(f3dmag,nmlonp1,nmlat, > | nmlev,f%short_name,nnans,0,0.,1,0) 3089,3109c2476,2523 < fglb(:,:) = flbc(3:nlon+2,:) < istat = nf_put_vara_double(ncid,idv,start_3d,count_3d,fglb) < if (istat /= NF_NOERR) then < write(6,"('>>> wrlbc: error writing ',a,': itime=',i4, < | ' type=',a,' global (nlon,nlat) min,max=',2f8.2)") < | trim(vname),itime,trim(type),minval(fglb),maxval(fglb) < write(char80,"('Error return from nf_put_vara_double for ', < | 'var ',a,': itime=',i2,' type=',a)") trim(vname),itime, < | trim(type) < call handle_ncerr(istat,char80) < else < ! write(6,"('wrlbc: wrote ',a,': itime=',i4,' type=',a, < ! | ' global (nlon,nlat) min,max=',2f8.2)") trim(vname), < ! | itime,trim(type),minval(fglb),maxval(fglb) < endif < < ! if (trim(vname)=='TLBC') then < ! do j=1,nlat < ! write(6,"('wrlbc: j=',i3,' tlbc(:,j)=',/,(6e12.4))") < ! | j,fglb(:,j) < ! enddo --- > ! If model has executed one or more time steps, the long_name and > ! units of the diagnostic sech field may have been defined by the > ! user-called addfsech routine: > ! > if (istep > 0) then > if (len_trim(f%long_name) > 0 .or. len_trim(f%units) > 0) then > istat = nf_redef(ncid) ! put dataset in define mode > if (istat /= NF_NOERR) call handle_ncerr(istat, > | 'Error return from nf_redef') > if (len_trim(f%long_name) > 0) then > istat = nf_put_att_text(ncid,idvar,"long_name", > | len_trim(f%long_name),f%long_name) > if (istat /= NF_NOERR) then > write(char80,"('Error defining long_name of diagnostic', > | ' variable ',a,': long_name = ',a)") > | trim(f%short_name),trim(f%long_name) > call handle_ncerr(istat,trim(char80)) > endif > endif > if (len_trim(f%units) > 0) then > istat = nf_put_att_text(ncid,idvar,"units", > | len_trim(f%units),f%units) > if (istat /= NF_NOERR) then > write(char80,"('Error defining units of diagnostic', > | ' variable ',a,' units = ',a)") > | trim(f%short_name),trim(f%units) > call handle_ncerr(istat,trim(char80)) > endif > endif > istat = nf_enddef(ncid) ! end define mode > if (istat /= NF_NOERR) call handle_ncerr(istat, > | 'Error return from nf_enddef') > endif ! long_name or units defined > endif ! istep > 0 > ! > ! Write min,max of each field: > ! if (istep /= 0) then > ! if (.not.f%magnetic) then > ! call fminmaxspv(f3diag,nlon*nlat*nlev,fmin,fmax,spval) > ! write(6,"('wrf3d: Wrote geo field ',a,' istep=',i3, > ! | ' 3d min,max=',2e12.4)") > ! | f%short_name(1:8),istep,fmin,fmax > ! else > ! call fminmaxspv(f3diag,nlon*nlat*nlev,fmin,fmax,spval) > ! write(6,"('wrf3d: Wrote mag field ',a,' istep=',i3, > ! | ' 3d min,max=',2e12.4)") > ! | f%short_name(1:8),istep,fmin,fmax > ! endif 3111,3113c2525,2526 < < end subroutine wrlbc < !----------------------------------------------------------------------- --- > end subroutine wrf3d > !------------------------------------------------------------------- 3119a2533,2534 > use init_module,only: istep > use mpi_module,only: lon0,lon1,lat0,lat1 3151c2566 < write(char120,"('wrf4d: Error return from nf_put_vara_double', --- > write(char120,"('Error return from nf_put_vara_double', 3217,3218c2632 < ! nanfatal = 1 ! abort if nans are found (this is normal default) < nanfatal = 0 ! temporary: allow NaNs for debug --- > nanfatal = 1 ! abort if nans are found 3223,3278c2637 < !----------------------------------------------------------------------- < subroutine wrf3d(ncid,f,itime,name,idv) < ! < ! Write global 3d field type f(k,i,j) to current netcdf output history < ! file attached to ncid: < ! < ! Args: < integer,intent(in) :: ncid,itime,idv < real :: f(nlevp1,nlonp4,nlat) < character(len=*),intent(in) :: name < ! < ! Local: < integer :: nxk,k,i,j,istat,lonbeg,lonend,nnans,nanfatal < real :: f3d(nlon,nlat,nlevp1) ! note i,j,k for history < character(len=120) :: char120 < real :: fmin,fmax < ! < ! Transform from (k,i,j) to (i,j,k) for the history. < ! f3d(nlon,nlat,nlevp1) ! note i,j,k for history < ! < do j=1,nlat < do k=1,nlevp1 < f3d(:,j,k) = f(k,3:nlon+2,j) < enddo < enddo < ! < ! Put data onto netcdf file (this is where the majority of output < ! i/o happens). < ! < start_4d(1:3) = 1 < start_4d(4) = itime < count_4d(1) = nlon < count_4d(2) = nlat < count_4d(3) = nlevp1 < count_4d(4) = 1 < istat = nf_put_vara_double(ncid,idv,start_4d,count_4d,f3d) < if (istat /= NF_NOERR) then < write(char120,"('wrf3d: Error return from nf_put_vara_double', < + ' for field var ',a,' itime=',i2)") name,itime < call handle_ncerr(istat,char120) < endif < ! < ! Write min,max of each field if not echoing source history: < ! if (istep /= 0) then < ! call fminmaxspv(f3d,nlon*nlev*nlat,fmin,fmax,spval) < ! write(6,"('wrf3d: Wrote field ',a,' istep=',i3, < ! | ' 3d min,max=',2e12.4)") name,istep,fmin,fmax < ! endif < ! < ! Check for NaNs: < nanfatal = 1 ! abort if nans are found < if (check_nan) < | call check_nans(f3d,nlon,nlat,nlevp1,name,nnans, < | 0,0.,1,nanfatal) < end subroutine wrf3d < !----------------------------------------------------------------------- --- > !------------------------------------------------------------------- 3376c2735 < !----------------------------------------------------------------------- --- > !------------------------------------------------------------------- 3392c2751 < !----------------------------------------------------------------------- --- > !------------------------------------------------------------------- ======================================================================== Diff of /fis/hao/tgcm/tiegcm1.92/src/newton.F and /ptmp/foster/ganglu_tiegcm_amie/modsrc2/newton.F 5,8d4 < ! This software is part of the NCAR TIE-GCM. Use is governed by the < ! Open Source Academic Research License Agreement contained in the file < ! tiegcmlicense.txt. < ! 15d10 < use addfld_module,only: addfld 38a34 > integer :: nk,nkm1 ! for addfsech 94,103c90,101 < ! call addfld('XMCO2',' ',' ',xmco2(lev0:lev1-1,lon0:lon1), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('CO2_COOL',' ',' ',co2_cool(lev0:lev1-1,lon0:lon1), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('NO_COOL' ,' ',' ',no_cool(:,lon0:lon1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('COOL_IMP' ,' ',' ',cool_implicit(:,lon0:lon1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('COOL_EXP' ,' ',' ',cool_explicit(:,lon0:lon1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > nk = lev1-lev0+1 > nkm1 = nk-1 > ! call addfsech('XMCO2',' ',' ',xmco2(:,lon0:lon1), > ! | lon0,lon1,nk,nkm1,lat) > ! call addfsech('CO2_COOL',' ',' ',co2_cool(:,lon0:lon1), > ! | lon0,lon1,nk,nkm1,lat) > ! call addfsech('NO_COOL' ,' ',' ',no_cool(:,lon0:lon1), > ! | lon0,lon1,nk,nkm1,lat) > ! call addfsech('COOL_IMP' ,' ',' ',cool_implicit(:,lon0:lon1), > ! | lon0,lon1,nk,nkm1,lat) > call addfsech('COOL_EXP' ,' ',' ',cool_explicit(:,lon0:lon1), > | lon0,lon1,nk,nkm1,lat) 114d111 < use addfld_module,only: addfld 128a126 > integer :: nk,nkm1 ! for addfsech 196,199c194,199 < ! call addfld('COOLIMP' ,' ',' ',cool_implicit(:,lon0:lon1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('COOLEXP' ,' ',' ',cool_explicit(:,lon0:lon1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > nk = lev1-lev0+1 > nkm1 = nk-1 > ! call addfsech('COOL_IMP' ,' ',' ',cool_implicit(:,lon0:lon1), > ! | lon0,lon1,nk,nkm1,lat) > ! call addfsech('COOL_EXP' ,' ',' ',cool_explicit(:,lon0:lon1), > ! | lon0,lon1,nk,nkm1,lat) ======================================================================== Diff of /fis/hao/tgcm/tiegcm1.92/src/oplus.F and /ptmp/foster/ganglu_tiegcm_amie/modsrc2/oplus.F 3,7d2 < ! < ! This software is part of the NCAR TIE-GCM. Use is governed by the < ! Open Source Academic Research License Agreement contained in the file < ! tiegcmlicense.txt. < ! 10d4 < use addfld_module,only: addfld 18,22d11 < ! < ! 1/8/08 btf: add option to call filter() and/or filter2() for oplus. < ! Default for tiegcm is callfilt1=.false. and callfilt2=.true. < logical :: callfilt1=.false. ! if true, call filter() < logical :: callfilt2=.true. ! if true, call filter2() 35,37c24,26 < use cons_module,only: rmass_op,gask,grav,re,cs,dphi,dlamda, < | shapiro,dtx2inv,boltz,expz,rmassinv_o2,rmassinv_o1, < | rmassinv_n2,rmassinv_n2d,p0,dtsmooth,dtsmooth_div2,kut --- > use cons_module,only: set_wave_filter,rmass_op,gask,grav,re,cs, > | dphi,dlamda,shapiro,dtx2inv,boltz,expz,rmassinv_o2,rmassinv_o1, > | rmassinv_n2,rmassinv_n2d,p0,dtsmooth,dtsmooth_div2 77c66 < integer :: k,i,lonbeg,lonend,lat,ier,nlevs --- > integer :: k,i,nlevs,lonbeg,lonend,lat,ier 83a73,76 > integer,parameter :: kutt_5(36) = ! for 5 degree latitude resolution > | (/1,2,3,5,6,7,9,10,11,13,14,15,17,17,17,17,17,17,17,17,17,17,17, > | 17,15,14,13,11,10,9,7,6,5,3,2,1/) > integer :: kutt(nlat) ! see sub set_wave_filter, set for current resolution 98a92,93 > ! For diagnostics: > ! real,dimension(lev0:lev1,lon0:lon1) :: bx_ik,by_ik 109c104,106 < | optm1_smooth ! op at time n-1, with shapiro smoother (was s1) --- > | optm1_smooth,! op at time n-1, with shapiro smoother (was s1) > ! 8/28/06 btf: Jiuhou Lei mod: > | tr ! 0.5*(ti+tn) (s3-s7) 119c116,129 < nlevs = lev1-lev0+1 ! for bndlons calls --- > nlevs = lev1-lev0+1 > > ! real,dimension(lev0:lev1,lon0-2:lon1+2,lat0-2:lat1+2), > ! | intent(in) :: > ! | tn, te, ti, ! neutral, electron, and ion temperatures (deg K) > ! | o2, o1, ! o2, o mass mixing ratios > ! | n2d, ! n2d > ! | ne, ! electron density > ! | u,v,w, ! neutral wind velocities (zonal, meridional, omega) > ! | barm, ! mean molecular mass > ! | optm1, ! O+ at time n-1 > ! | op, ! O+ ion > ! | ui,vi,wi, ! zonal, meridional, and vertical ion velocities > ! | xnmbar ! p0*e(-z)*barm/kT 121,140c131,151 < ! do lat=lat0,lat1 < ! call addfld('TE_OP',' ',' ',te(lev0:lev1-1,lon0:lon1,lat), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('TI_OP',' ',' ',ti(lev0:lev1-1,lon0:lon1,lat), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('N2D_OP',' ',' ',n2d(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('NE_OP',' ',' ',ne(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('OPTM1',' ',' ',optm1(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('OP_OPLUS',' ',' ',op(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('UI_OP',' ',' ',ui(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('VI_OP',' ',' ',vi(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('WI_OP',' ',' ',wi(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! enddo ! lat=lat0,lat1 --- > do lat=lat0,lat1 > ! call addfsech('TE_OP',' ',' ',te(:,lon0:lon1,lat),lon0,lon1, > ! | nlevs,nlevs-1,lat) > ! call addfsech('TI_OP',' ',' ',ti(:,lon0:lon1,lat),lon0,lon1, > ! | nlevs,nlevs-1,lat) > ! call addfsech('N2D_OP',' ',' ',n2d(:,lon0:lon1,lat),lon0,lon1, > ! | nlevs,nlevs-1,lat) > ! call addfsech('NE_OP',' ',' ',ne(:,lon0:lon1,lat),lon0,lon1, > ! | nlevs,nlevs-1,lat) > ! call addfsech('OPTM1',' ',' ',optm1(:,lon0:lon1,lat),lon0,lon1, > ! | nlevs,nlevs-1,lat) > ! call addfsech('OP_OPLUS',' ',' ',op(:,lon0:lon1,lat),lon0,lon1, > ! | nlevs,nlevs-1,lat) > ! call addfsech('UI_OP',' ',' ',ui(:,lon0:lon1,lat),lon0,lon1, > ! | nlevs,nlevs-1,lat) > ! call addfsech('VI_OP',' ',' ',vi(:,lon0:lon1,lat),lon0,lon1, > ! | nlevs,nlevs-1,lat) > ! call addfsech('WI_OP',' ',' ',wi(:,lon0:lon1,lat),lon0,lon1, > ! | nlevs,nlevs-1,lat) > enddo ! lat=lat0,lat1 > 141a153,155 > ! Set kut for wave filtering according to dlat (2.5 or 5.0 degrees): > call set_wave_filter(36,kutt_5,nlat,kutt) > ! 165a180,183 > ! 8/28/06 btf: Add by Jiuhou Lei > tr(k,i,jm1) = 0.5*(tn(k,i,jm1)+ti(k,i,jm1)) > tr(k,i,lat ) = 0.5*(tn(k,i,lat )+ti(k,i,lat )) > tr(k,i,jp1) = 0.5*(tn(k,i,jp1)+ti(k,i,jp1)) 167a186,192 > > ! call addfsech('TPJM1',' ',' ',tpj(:,lon0:lon1,jm1),lon0,lon1,nlevs, > ! | nlevs-1,lat) > ! call addfsech('TP ',' ',' ',tpj(:,lon0:lon1,lat ),lon0,lon1,nlevs, > ! | nlevs-1,lat) > ! call addfsech('TPJP1',' ',' ',tpj(:,lon0:lon1,jp1),lon0,lon1,nlevs, > ! | nlevs-1,lat) 175c200 < | tpj(:,lon0:lon1,jm1),dj(:,lon0:lon1,jm1), --- > | tr(:,lon0:lon1,jm1),dj(:,lon0:lon1,jm1), 180c205 < | tpj(:,lon0:lon1,lat),dj(:,lon0:lon1,lat), --- > | tr(:,lon0:lon1,lat),dj(:,lon0:lon1,lat), 185c210 < | tpj(:,lon0:lon1,jp1),dj(:,lon0:lon1,jp1), --- > | tr(:,lon0:lon1,jp1),dj(:,lon0:lon1,jp1), 189,194c214,219 < ! call addfld('DJM1',' ',' ',dj(:,lon0:lon1,jm1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('DJ ',' ',' ',dj(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('DJP1',' ',' ',dj(:,lon0:lon1,jp1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('DJM1',' ',' ',djm1(:,lon0:lon1,jm1),lon0,lon1,nlevs, > ! | nlevs-1,lat) > ! call addfsech('DJ ',' ',' ',dj (:,lon0:lon1,lat),lon0,lon1,nlevs, > ! | nlevs-1,lat) > ! call addfsech('DJP1',' ',' ',djp1(:,lon0:lon1,jp1),lon0,lon1,nlevs, > ! | nlevs-1,lat) 217,222c242,247 < ! call addfld('HJM1',' ',' ',hj(lev0:lev1-1,:,jm1), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('HJ ',' ',' ',hj(lev0:lev1-1,:,lat), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('HJP1',' ',' ',hj(lev0:lev1-1,:,jp1), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('HJM1',' ',' ',hjm1(:,:,jm1),lon0,lon1, > ! | nlevs,nlevs-1,lat) > ! call addfsech('HJ ',' ',' ',hj (:,:,lat ),lon0,lon1, > ! | nlevs,nlevs-1,lat) > ! call addfsech('HJP1',' ',' ',hjp1(:,:,jp1),lon0,lon1, > ! | nlevs,nlevs-1,lat) 246,251c271,276 < ! call addfld('BVEL_JM1',' ',' ',bvel(lev0:lev1-1,lon0:lon1,jm1), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('BVEL_J' ,' ',' ',bvel(lev0:lev1-1,lon0:lon1,j0), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('BVEL_JP1',' ',' ',bvel(lev0:lev1-1,lon0:lon1,jp1), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('BVEL_JM1',' ',' ',bvel(:,lon0:lon1,jm1), > ! | lon0,lon1,nlevs,nlevs-1,lat) > ! call addfsech('BVEL_J' ,' ',' ',bvel(:,lon0:lon1,j0), > ! | lon0,lon1,nlevs,nlevs-1,lat) > ! call addfsech('BVEL_JP1',' ',' ',bvel(:,lon0:lon1,jp1), > ! | lon0,lon1,nlevs,nlevs-1,lat) 269,274c294,299 < ! call addfld('DIFFJM1',' ',' ',diffj(:,lon0:lon1,jm1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('DIFFJ ',' ',' ',diffj(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('DIFFJP1',' ',' ',diffj(:,lon0:lon1,jp1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('DIFFJM1',' ',' ',diffj(:,lon0:lon1,jm1), > ! | lon0,lon1,nlevs,nlevs-1,lat) > ! call addfsech('DIFFJ ',' ',' ',diffj(:,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs-1,lat) > ! call addfsech('DIFFJP1',' ',' ',diffj(:,lon0:lon1,jp1), > ! | lon0,lon1,nlevs,nlevs-1,lat) 293,302c318,327 < ! call addfld('TPJM2',' ',' ',tpj(lev0:lev1-1,lon0:lon1,jm2), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('TPJM1',' ',' ',tpj(lev0:lev1-1,lon0:lon1,jm1), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('TP ',' ',' ',tpj(lev0:lev1-1,lon0:lon1,lat), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('TPJP1',' ',' ',tpj(lev0:lev1-1,lon0:lon1,jp1), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('TPJP2',' ',' ',tpj(lev0:lev1-1,lon0:lon1,jp2), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('TPJM2',' ',' ',tpj(:,lon0:lon1,jm2), > ! | lon0,lon1,nlevs,nlevs-1,lat) > ! call addfsech('TPJM1',' ',' ',tpj(:,lon0:lon1,jm1), > ! | lon0,lon1,nlevs,nlevs-1,lat) > ! call addfsech('TP ',' ',' ',tpj(:,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs-1,lat) > ! call addfsech('TPJP1',' ',' ',tpj(:,lon0:lon1,jp1), > ! | lon0,lon1,nlevs,nlevs-1,lat) > ! call addfsech('TPJP2',' ',' ',tpj(:,lon0:lon1,jp2), > ! | lon0,lon1,nlevs,nlevs-1,lat) 365,366c390,392 < ! call addfld('BDOTDH',' ',' ',bdotdh_op(lev0:lev1-1,lon0:lon1,lat), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('BDOTDH',' ',' ',bdotdh_op(:,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs-1,lat) > 432,439c458,466 < ! call addfld('BDOT_DIF',' ',' ',bdotdh_diff(lev0:lev1-1,lon0:lon1, < ! | lat),'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('BDOT_JM1',' ',' ',bdotdh_opj(lev0:lev1-1,lon0:lon1, < ! | jm1),'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('BDOT_J' ,' ',' ',bdotdh_opj(lev0:lev1-1,lon0:lon1, < ! | lat),'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('BDOT_JP1',' ',' ',bdotdh_opj(lev0:lev1-1,lon0:lon1, < ! | jp1),'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('BDOT_DIF',' ',' ',bdotdh_diff(:,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs-1,lat) > ! call addfsech('BDOT_JM1',' ',' ',bdotdh_opj(:,lon0:lon1,jm1), > ! | lon0,lon1,nlevs,nlevs-1,lat) > ! call addfsech('BDOT_J' ,' ',' ',bdotdh_opj(:,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs-1,lat) > ! call addfsech('BDOT_JP1',' ',' ',bdotdh_opj(:,lon0:lon1,jp1), > ! | lon0,lon1,nlevs,nlevs-1,lat) > 447,448c474,476 < ! call addfld('BDZDVB',' ',' ',bdzdvb_op(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('BDZDVB',' ',' ',bdzdvb_op,lon0,lon1,nlevs, > ! | nlevs-1,lat) > 455a484,487 > > ! bx_ik(:,i) = bx(i,lat) > ! by_ik(:,i) = by(i,lat) > 458,468c490,500 < ! call addfld('EXPLIC0',' ',' ',explicit(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('BX',' ',' ',bx(lon0:lon1,:), < ! | 'lon',lon0,lon1,'lat',lat,lat,0) < ! call addfld('BY',' ',' ',by(lon0:lon1,:), < ! | 'lon',lon0,lon1,'lat',lat,lat,0) < ! call addfld('UI_VEL',' ',' ',ui(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('VI_VEL',' ',' ',vi(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < --- > ! call addfsech('EXPLIC0',' ',' ',explicit,lon0,lon1,nlevs,nlevs-1, > ! | lat) > ! call addfsech('BX',' ',' ',bx_ik(:,lon0:lon1), > ! | lon0,lon1,nlevs,nlevs-1,lat) > ! call addfsech('BY',' ',' ',by_ik(:,lon0:lon1), > ! | lon0,lon1,nlevs,nlevs-1,lat) > ! call addfsech('UI_VEL',' ',' ',ui(:,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs-1,lat) > ! call addfsech('VI_VEL',' ',' ',vi(:,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs-1,lat) > ! 494,495c526,529 < ! call addfld('EXPLIC1',' ',' ',explicit(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! > ! Some very small diffs at couple of grid points, probably from BY: > ! call addfsech('EXPLIC1',' ',' ',explicit,lon0,lon1,nlevs,nlevs-1, > ! | lat) 507,508c541,544 < ! call addfld('HDZ',' ',' ',hdz(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > > ! call addfsech('HDZ',' ',' ',hdz,lon0,lon1,nlevs,nlevs-1,lat) > ! call addfsech('TP' ,' ',' ',tp ,lon0,lon1,nlevs, > ! | nlevs-1,lat) 533,536c569,570 < ! call addfld('TPHDZ1',' ',' ',tphdz1, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('TPHDZ0',' ',' ',tphdz0, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('TPHDZ1',' ',' ',tphdz1,lon0,lon1,nlevs,nlevs,lat) ! s13 > ! call addfsech('TPHDZ0',' ',' ',tphdz0,lon0,lon1,nlevs,nlevs,lat) ! s12 546,547c580,582 < ! call addfld('DJINT' ,' ',' ',djint, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > > ! call addfsech('DJINT' ,' ',' ',djint ,lon0,lon1,nlevs, > ! | nlevs-1,lat) 566,567c601,603 < ! call addfld('DIVBZ' ,' ',' ',divbz(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > > ! call addfsech('DIVBZ' ,' ',' ',divbz ,lon0,lon1,nlevs,nlevs-1, > ! | lat) 579,582c615,618 < ! call addfld('HDZMBZ' ,' ',' ',hdzmbz(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('HDZPBZ' ,' ',' ',hdzpbz(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('HDZMBZ' ,' ',' ',hdzmbz,lon0,lon1,nlevs, > ! | nlevs-1,lat) ! s10 > ! call addfsech('HDZPBZ' ,' ',' ',hdzpbz,lon0,lon1,nlevs, > ! | nlevs-1,lat) ! s9 598,602c634,638 < ! call addfld('OPTM1_SM' ,' ',' ', < ! | optm1_smooth(lev0:lev1-1,lon0:lon1,lat), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('EXPLIC2' ,' ',' ',explicit(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('OPTM1_SM' ,' ',' ',optm1_smooth(:,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs-1,lat) > ! call addfsech('EXPLIC2' ,' ',' ',explicit,lon0,lon1,nlevs, > ! | nlevs-1,lat) > 614,619c650,656 < ! call addfld('P_COEFF0',' ',' ',p_coeff(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('Q_COEFF0',' ',' ',q_coeff(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('R_COEFF0',' ',' ',r_coeff(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('P_COEFF0',' ',' ',p_coeff,lon0,lon1,nlevs, > ! | nlevs-1,lat) > ! call addfsech('Q_COEFF0',' ',' ',q_coeff,lon0,lon1,nlevs, > ! | nlevs-1,lat) > ! call addfsech('R_COEFF0',' ',' ',r_coeff,lon0,lon1,nlevs, > ! | nlevs-1,lat) > 628,629c665,667 < ! call addfld('BDOTU' ,' ',' ',bdotu(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > > ! call addfsech('BDOTU' ,' ',' ',bdotu,lon0,lon1,nlevs, > ! | nlevs-1,lat) 644,649c682,687 < ! call addfld('P_COEFF1',' ',' ',p_coeff(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('Q_COEFF1',' ',' ',q_coeff(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('R_COEFF1',' ',' ',r_coeff(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('P_COEFF1',' ',' ',p_coeff,lon0,lon1,nlevs, > ! | nlevs-1,lat) > ! call addfsech('Q_COEFF1',' ',' ',q_coeff,lon0,lon1,nlevs, > ! | nlevs-1,lat) > ! call addfsech('R_COEFF1',' ',' ',r_coeff,lon0,lon1,nlevs, > ! | nlevs-1,lat) 687,694c725,732 < ! call addfld('EXPLIC3',' ',' ',explicit(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('P_COEFF2',' ',' ',p_coeff(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('Q_COEFF2',' ',' ',q_coeff(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('R_COEFF2',' ',' ',r_coeff(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('EXPLIC3',' ',' ',explicit,lon0,lon1,nlevs, > ! | nlevs-1,lat) > ! call addfsech('P_COEFF2',' ',' ',p_coeff,lon0,lon1,nlevs, > ! | nlevs-1,lat) > ! call addfsech('Q_COEFF2',' ',' ',q_coeff,lon0,lon1,nlevs, > ! | nlevs-1,lat) > ! call addfsech('R_COEFF2',' ',' ',r_coeff,lon0,lon1,nlevs, > ! | nlevs-1,lat) 696,703c734,743 < ! call addfld('QOP2P_OP',' ',' ',qop2p(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QOP2D_OP',' ',' ',qop2d(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('RK20',' ',' ',rk20(lev0:lev1-1,lon0:lon1,lat), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('RK25',' ',' ',rk25(lev0:lev1-1,lon0:lon1,lat), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('QOP2P_OP',' ',' ',qop2p(:,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs-1,lat) > ! call addfsech('QOP2D_OP',' ',' ',qop2d(:,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs-1,lat) > ! call addfsech('RK20',' ',' ',rk20(:,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs-1,lat) > ! call addfsech('RK25',' ',' ',rk25(:,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs-1,lat) > ! call addfsech('NE_OP',' ',' ',ne(:,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs-1,lat) 734,753c774,794 < ! call addfld('XIOP2P',' ',' ',xiop2p(lev0:lev1,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('XIOP2D',' ',' ',xiop2d(lev0:lev1,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('OP_LOSS',' ',' ',op_loss(lev0:lev1-1,lon0:lon1), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('OP_QOP',' ',' ',qop(lev0:lev1,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('OP_NE' ,' ',' ',ne(lev0:lev1,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('OP_O1' ,' ',' ',o1(lev0:lev1,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('OP_TN' ,' ',' ',tn(lev0:lev1,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('OP_BARM' ,' ',' ',barm(lev0:lev1,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('OP_RK19' ,' ',' ',rk19(lev0:lev1-1,lon0:lon1,lat), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('OP_RK25' ,' ',' ',rk25(lev0:lev1-1,lon0:lon1,lat), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('XIOP2P',' ',' ',xiop2p(lev0:lev1,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('XIOP2D',' ',' ',xiop2d(lev0:lev1,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('OP_LOSS',' ',' ',op_loss(lev0:lev1,lon0:lon1), > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('OP_QOP',' ',' ',qop(lev0:lev1,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('OP_NE' ,' ',' ',ne(lev0:lev1,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('OP_O1' ,' ',' ',o1(lev0:lev1,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('OP_TN' ,' ',' ',tn(lev0:lev1,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('OP_BARM' ,' ',' ',barm(lev0:lev1,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('OP_RK19' ,' ',' ',rk19(lev0:lev1,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('OP_RK25' ,' ',' ',rk25(lev0:lev1,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) > 767,768c808,811 < ! call addfld('EXPLIC4',' ',' ',explicit(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > > ! call addfsech('EXPLIC4',' ',' ',explicit,lon0,lon1,nlevs,nlevs-1, > ! | lat) > 778,785c821,828 < ! call addfld('P_COEFF',' ',' ',p_coeff(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('Q_COEFF',' ',' ',q_coeff(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('R_COEFF',' ',' ',r_coeff(lev0:lev1-2,:), < ! | 'lev',lev0,lev1-2,'lon',lon0,lon1,lat) < ! call addfld('EXPLIC5',' ',' ',explicit(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('P_COEFF',' ',' ',p_coeff,lon0,lon1,nlevs,nlevs-1, > ! | lat) > ! call addfsech('Q_COEFF',' ',' ',q_coeff,lon0,lon1,nlevs,nlevs-1, > ! | lat) > ! call addfsech('R_COEFF',' ',' ',r_coeff,lon0,lon1,nlevs,nlevs-1, > ! | lat) > ! call addfsech('EXPLIC5',' ',' ',explicit,lon0,lon1,nlevs,nlevs-1, > ! | lat) 795,796c838,839 < ! call addfld('OP_SOLV',' ',' ',opout(lev0:lev1-1,lon0:lon1,lat), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('OP_SOLV',' ',' ',opout(:,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs-1,lat) 806c849 < | lev0,lev1,lon0,lon1,lat0,lat1,kut) --- > | lev0,lev1,lon0,lon1,lat0,lat1,kutt) 813,814c856,858 < ! call addfld('OP_FILT',' ',' ',opout(lev0:lev1-1,lon0:lon1,lat), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! Very small "diamond diffs" with tgcm15: > ! call addfsech('OP_FILT',' ',' ',opout(:,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs-1,lat) 841a886,895 > ! Very small "diamond diffs" with tgcm15: > ! (This may be related to small diffs in mag field bx,by,bz and/or small > ! diffs in ion velocities, esp WI. This may also be related to use of > ! -lmass in tiegcm1, which is not used in tgcm15, e.g. see pi_dyn) > ! > ! call addfsech('OPOUT',' ',' ',opout(:,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('OPTM1',' ',' ',optm1out(:,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) > ! 855,858c909,912 < ! call addfld('OPOUT',' ',' ',opout(lev0:lev1-1,lon0:lon1,lat), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('OPOUTM1',' ',' ',optm1out(lev0:lev1-1,lon0:lon1, < ! | lat),'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('OPOUT',' ',' ',opout(:,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('OPTM1',' ',' ',optm1out(:,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) 874a929,930 > use init_module, only: iday > use input_module, only: f107 882,885c938,941 < real,parameter :: < | phid = 2.0e8, < | phin = -2.0e8, < | ppolar = 0. --- > ! real,parameter :: > ! | phid = 2.0e8, > ! | phin = -2.0e8, > ! | ppolar = 0. 888a945 > real :: phin,phid,an,bn,ad,bd,rday,f107r,sinday,ppolar 889a947,973 > ! O+ flux set for Sep. 2005 event > phid = 4.0e8 > phin = -2.0e8 > ppolar = 1.0e8 > ! Change made by Roble for Charley Barth > ! phid = -1.0e8 > ! phin = -1.0e8 > ! ppolar = -1.0e8 > ! 8/28/06 btf: Jiuhou mods: > f107r=(f107-80.)/120. > an=-0.5e8-f107r*0.7e8; ad= 1.0e8+f107r*1.0e8 > ! Incease the dayside upflow - G. Lu 12/20/2006 > ! an=-0.5e8-f107r*0.7e8; ad= 8.0e8+f107r*1.0e8 > bn=-0.5e8-f107r*0.8e8; bd=-2.5e7-f107r*2.5e7 > rday=(iday-171.25)*pi/365 > ! > ! day/night flux change with season > ! > ! sinday=(1.-sin(pi*(abs(rday)-pi/8.)/(pi/4.))) > ! if (abs(rday)-pi/4.>=0.) then > ! phid = ad + 0.1e8*sinday > ! phin = an - 0.1e8*sinday*(120.-f107)/40. > ! else > ! phid = ad+bd*sinday > ! phin = an+bn*sinday > ! endif > ! 895a980 > ! if (abs(rlatm(i,lat))-pi/12.>=0.) then 898a984 > ! a(i)=.5*(1.+sin(pi*(abs(rlatm(i,lat))-pi/24.)/(pi/12.))) 969c1055,1056 < ans(k,i) = 1.42E17*boltz*t(k,i)/(p0*expz(k)*.5*(rms(k,i)+ --- > ! 8/28/06 btf: Jiuhou mods to values of constants: > ans(k,i) = 1.48E17*boltz*t(k,i)/(p0*expz(k)*.5*(rms(k,i)+ 971,972c1058,1059 < | alog10(tp(k,i)))**2*colfac+18.6*(1.-ps1(k,i)-ps2(k,i))* < | rmassinv_n2+18.1*ps1(k,i)*rmassinv_o2)) --- > | alog10(tp(k,i)))**2*colfac+19.5*(1.-ps1(k,i)-ps2(k,i))* > | rmassinv_n2+19.1*ps1(k,i)*rmassinv_o2)) 1087c1174 < use filter_module,only: filter,filter2 --- > use filter_module,only: filter2 1130a1218 > if (kut(j) >= nlon/2) cycle latscan 1138,1145c1226 < ! call filter and/or filter2 according to module logicals callfilt1,callfilt2: < ! < ! If requested, call filter2(), as in composition comp_major and minor: < if (callfilt2) call filter2(op_ik,lev0,lev1,j) < ! < ! If requested, call filter(), as in dt,duv,etc: < ! < if (callfilt1) call filter(op_ik,lev0,lev1,kut(j),j) --- > call filter2(op_ik,lev0,lev1,kut(j),j) ======================================================================== Diff of /fis/hao/tgcm/tiegcm1.92/src/qinite.F and /ptmp/foster/ganglu_tiegcm_amie/modsrc2/qinite.F 5,8d4 < ! This software is part of the NCAR TIE-GCM. Use is governed by the < ! Open Source Academic Research License Agreement contained in the file < ! tiegcmlicense.txt. < ! 50c46,48 < real,parameter :: al(3) = (/5.E4, 5.E3, 5.E3/) --- > ! real,parameter :: al(3) = (/5.E4, 5.E3, 5.E3/) > ! Change to higher values for nighttime ionization - from A. Maute Feb. 2008 > real,parameter :: al(3) = (/1.5E7, 1.5E6, 1.5E6/) 83,85d80 < do i=lon0,lon1 !!! temporal fix CISM < if(n2i(k,i)<=0.)n2i(k,i)=1.e-5 !!! temporal fix CISM < enddo !!! temporal fix CISM 111c106 < ! call addfsech('QBO1',' ',' ',qbo1,lon0,lon1,nlevs,nlevs,lat) --- > call addfsech('QBO1',' ',' ',qbo1,lon0,lon1,nlevs,nlevs,lat) 144,145c139,140 < ! call addfsech('QOP' ,' ',' ',qop (lev0:lev1,lon0:lon1,lat), < ! | lon0,lon1,nlevs,nlevs,lat) --- > call addfsech('QNITE_QOP' ,' ',' ',qop (lev0:lev1,lon0:lon1,lat), > | lon0,lon1,nlevs,nlevs,lat) ======================================================================== Diff of /fis/hao/tgcm/tiegcm1.92/src/qjoule.F and /ptmp/foster/ganglu_tiegcm_amie/modsrc2/qjoule.F 5,8d4 < ! This software is part of the NCAR TIE-GCM. Use is governed by the < ! Open Source Academic Research License Agreement contained in the file < ! tiegcmlicense.txt. < ! 24a21 > ! 30c27 < use addfld_module,only: addfld --- > ! 51c48 < integer :: k,i --- > integer :: k,i,nlevs 56a54,62 > nlevs = lev1-lev0+1 > > ! call addfsech('QJI_UI',' ',' ',ui(:,lon0:lon1), > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('QJI_VI',' ',' ',vi(:,lon0:lon1), > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('QJI_LAM1',' ',' ',lam1(:,lon0:lon1), > ! | lon0,lon1,nlevs,nlevs,lat) > ! 90,91c96,97 < ! call addfld('QJI_TI','QJI_TI ',' ',qji_ti(lev0:lev1-1,lon0:lon1), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > call addfsech('QJI_TI','QJI_TI ',' ',qji_ti(:,lon0:lon1), > | lon0,lon1,nlevs,nlevs-1,lat) 114c120 < use addfld_module,only: addfld --- > ! 130c136 < integer :: k,i --- > integer :: k,i,nlevs 132a139,146 > integer :: iuivi=1 > > nlevs = lev1-lev0+1 > ! > ! iuivi used to be an input flag, but has been replaced by the dynamo > ! input flag. iuivi is set locally here, so ui,vi are always used in > ! joule heating calculation. But if dynamo==0 (no dynamo), then ui,vi > ! will be zero, resulting in the same result as if iuivi==0. 136a151,177 > if (iuivi==0) then ! never executed, assuming local iuivi==1. > do i=lon0,lon1 > do k=lev0,lev1-1 > scheight(k,i) = gask*tn(k,i)/ > | (.5*(barm(k,i)+barm(k+1,i))*grav) > vel_zonal(k,i) = -un(k,i) ! s2 > vel_merid(k,i) = -vn(k,i) ! s3 > vel_vert(k,i) = -0.5*scheight(i,k)*(w(k,i)+w(k+1,i)) > enddo ! k=lev0,lev1-1 > enddo ! i=lon0,lon1 > else > do i=lon0,lon1 > do k=lev0,lev1-1 > scheight(k,i) = gask*tn(k,i)/ > | (.5*(barm(k,i)+barm(k+1,i))*grav) > vel_zonal(k,i) = .5*(ui(k,i)+ui(k+1,i))-un(k,i) ! s2 > vel_merid(k,i) = .5*(vi(k,i)+vi(k+1,i))-vn(k,i) ! s3 > vel_vert(k,i) = .5*(wi(k,i)+wi(k+1,i)-scheight(k,i)* > | ( w(k,i)-w(k+1,i)) ) > enddo ! k=lev0,lev1-1 > enddo ! i=lon0,lon1 > endif > ! > ! S4(I,1) = .5*(S2(I,1)**2*(F(I,NLXXK)+F(I,NLXXK+1))+S2(I,1)* > ! 1 S3(I,1)*(F(I,NLXYK)+F(I,NLXYK+1)-F(I,NLYXK)-F(I,NLYXK+1))+ > ! 2 S3(I,1)**2*(F(I,NLYYK)+F(I,NLYYK+1))) > 139,148d179 < scheight(k,i) = gask*tn(k,i)/ < | (.5*(barm(k,i)+barm(k+1,i))*grav) < vel_zonal(k,i) = .5*(ui(k,i)+ui(k+1,i))-un(k,i) ! s2 < vel_merid(k,i) = .5*(vi(k,i)+vi(k+1,i))-vn(k,i) ! s3 < vel_vert(k,i) = .5*(wi(k,i)+wi(k+1,i)-scheight(k,i)* < | ( w(k,i)-w(k+1,i)) ) < enddo ! k=lev0,lev1-1 < enddo ! i=lon0,lon1 < do i=lon0,lon1 < do k=lev0,lev1-1 153a185,186 > > nlevs = lev1-lev0+1 155,171c188,206 < ! call addfld('QJI_UN','QJI_UN','cm/s',un(:,lon0:lon1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QJI_VN','QJI_VN','cm/s',vn(:,lon0:lon1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QJI_W','QJI_W','cm/s',vn(:,lon0:lon1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QJI_UI','QJI_UI','cm/s',ui(:,lon0:lon1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QJI_VI','QJI_VI','cm/s',vi(:,lon0:lon1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QJI_WI','QJI_WI','cm/s',wi(:,lon0:lon1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QJI_LAM1','QJI_LAM','1/s',lam1(:,lon0:lon1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QJI_TN','QJI_TN','ergs/s/g', < ! | qji_tn(lev0:lev1-1,lon0:lon1), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! xlf8.1 bug: QJI_LXX has spike at geog pole in 2nd time step > ! (tgcm15 does not) > ! > call addfsech('QJI_UN','QJI_UN','cm/s',un(:,lon0:lon1), > | lon0,lon1,nlevs,nlevs-1,lat) > call addfsech('QJI_VN','QJI_VN','cm/s',vn(:,lon0:lon1), > | lon0,lon1,nlevs,nlevs-1,lat) > call addfsech('QJI_W','QJI_W','cm/s',vn(:,lon0:lon1), > | lon0,lon1,nlevs,nlevs-1,lat) > call addfsech('QJI_UI','QJI_UI','cm/s',ui(:,lon0:lon1), > | lon0,lon1,nlevs,nlevs-1,lat) > call addfsech('QJI_VI','QJI_VI','cm/s',vi(:,lon0:lon1), > | lon0,lon1,nlevs,nlevs-1,lat) > call addfsech('QJI_WI','QJI_WI','cm/s',wi(:,lon0:lon1), > | lon0,lon1,nlevs,nlevs-1,lat) > call addfsech('QJI_LAM1','QJI_LAM','1/s',lam1(:,lon0:lon1), > | lon0,lon1,nlevs,nlevs-1,lat) > call addfsech('QJI_TN','QJI_TN','ergs/s/g',qji_tn(:,lon0:lon1), > | lon0,lon1,nlevs,nlevs-1,lat) ======================================================================== Diff of /fis/hao/tgcm/tiegcm1.92/src/qrj.F and /ptmp/foster/ganglu_tiegcm_amie/modsrc2/qrj.F 3,7d2 < ! < ! This software is part of the NCAR TIE-GCM. Use is governed by the < ! Open Source Academic Research License Agreement contained in the file < ! tiegcmlicense.txt. < ! 9c4,6 < use addfld_module,only: addfld --- > use hist_module,only: nstep,modeltime > use init_module,only: istep > ! 11a9,13 > ! Coefficients for wavelength scans in qrj. > ! call addfsech('ZN4S',' ',' ',zn4s,lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('ZN4S',' ',' ',zn4s,lon0,lon1,nlevs,nlevs,lat) > ! These are referenced in routines qrj, init_sflux, init_qrj > ! 15,28c17,26 < | euveff(nlevp1), < | sigeuv(3,lmax), < | rlmeuv(lmax), < | feuv(lmax), < | fsrc(l1), < | sigsrc(l1), < | rlmsrc(l1), < | sigin4s(lmax), < | quench(4), < | wave1(lmax), ! short bound of wave bins < | wave2(lmax), ! long bound of wave bins < | sfmin(lmax), ! reference solar minimum flux of EUVAC model < | afac(lmax), ! The A factor of EUVAC model < | sflux(lmax) ! Solar flux for each time step --- > | euveff(nlevp1), ! > | sigeuv(3,lmax), ! > | rlmeuv(lmax), ! > | feuv(lmax), ! > | fsrc(l1), ! > | sigsrc(l1), ! > | rlmsrc(l1), ! > | sigin4s(lmax), ! > | quench(4), ! > | sflux(lmax) ! 81d78 < use fields_module,only: tlbc 97c94 < integer :: k,i,l,ier --- > integer :: k,i,l,nlevs,ier 155,156c152,153 < ! call addfld('XNMBARI',' ',' ',xnmbari(:,lon0:lon1), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > nlevs = lev1-lev0+1 > 160,161c157 < ! calculate inverse of wave length < ! --- > ! Will multiply by inverses: 180,183c176,177 < o2i(1,i) = .5*((b(i,1,1)+1.)*o2(1,i)+b(i,1,2)*o1(1,i)+ < | fb(i,1)) < o1i(1,i) = .5*(b(i,2,1)*o2(1,i)+(b(i,2,2)+1.)*o1(1,i)+ < | fb(i,2)) --- > o2i(1,i) = .5*((b(i,1,1)+1.)*o2(1,i)+b(i,1,2)*o1(1,i)+fb(i,1)) > o1i(1,i) = .5*(b(i,2,1)*o2(1,i)+(b(i,2,2)+1.)*o1(1,i)+fb(i,2)) 202,207c196,198 < ! call addfld('O2I' ,' ',' ',o2i, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('O1I' ,' ',' ',o1i, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('N2I' ,' ',' ',n2i, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('O2I' ,' ',' ',o2i,lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('O1I' ,' ',' ',o1i,lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('N2I' ,' ',' ',n2i,lon0,lon1,nlevs,nlevs,lat) 289,298c280,287 < ! call addfld('QOP2P' ,' ',' ', qop2p(lev0:lev1,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QOP2D' ,' ',' ', qop2d(lev0:lev1,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('SUM1' ,' ',' ', sum1, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('Q0' ,' ',' ',qtotal(:,:,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('RJ_QRJ',' ',' ',rj(:,:,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('QOP2P' ,' ',' ', qop2p(lev0:lev1,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('QOP2D' ,' ',' ', qop2d(lev0:lev1,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('SUM1' ,' ',' ', sum1,lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('Q0' ,' ',' ',qtotal(:,:,lat),lon0,lon1, > ! | nlevs,nlevs,lat) > ! call addfsech('R_QRJ',' ',' ',r,lon0,lon1,nlevs,nlevs,lat) 306,307c295,296 < ! call addfld('Q1' ,' ',' ',qtotal(:,:,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > call addfsech('Q1' ,' ',' ',qtotal(:,:,lat),lon0,lon1, > | nlevs,nlevs,lat) 328,329c317,318 < ! call addfld('QOP',' ',' ',qop(:,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('QOP',' ',' ',qop(:,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) 345c334 < tni(lev0,i) = tlbc(i,lat) --- > tni(1,i) = tn(lev1,i) ! tn bottom boundary is stored in top slot 396,397c385,386 < ! call addfld('Q2' ,' ',' ',qtotal(:,:,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('Q2' ,' ',' ',qtotal(:,:,lat),lon0,lon1, > ! | nlevs,nlevs,lat) 413,432c402,421 < ! call addfld('Q' ,' ',' ',qtotal(lev0:lev1,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('RJ' ,' ',' ',rj(lev0:lev1,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QOP2Pa' ,' ',' ',qop2p(lev0:lev1,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QOP2Da' ,' ',' ', qop2d(lev0:lev1,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QTEF' ,' ',' ', qtef(lev0:lev1,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QO2P' ,' ',' ', qo2p(lev0:lev1,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QN2P' ,' ',' ', qn2p(lev0:lev1,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QNP' ,' ',' ', qnp(lev0:lev1,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QOPa' ,' ',' ', qop(lev0:lev1,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QNOP' ,' ',' ', qnop(lev0:lev1,lon0:lon1,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('Q' ,' ',' ',qtotal(lev0:lev1,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('RJ' ,' ',' ',rj(lev0:lev1,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('QOP2P' ,' ',' ', qop2p(lev0:lev1,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('QOP2D' ,' ',' ', qop2d(lev0:lev1,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('QTEF' ,' ',' ', qtef(lev0:lev1,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('QO2P' ,' ',' ', qo2p(lev0:lev1,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('QN2P' ,' ',' ', qn2p(lev0:lev1,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('QNP' ,' ',' ', qnp(lev0:lev1,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('QOP' ,' ',' ', qop(lev0:lev1,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) > ! call addfsech('QNOP' ,' ',' ', qnop(lev0:lev1,lon0:lon1,lat), > ! | lon0,lon1,nlevs,nlevs,lat) 442c431 < use input_module,only: f107,f107a,see_ncfile --- > use input_module,only: f107,f107a,sd_ncfile,iseeflux 444c433,435 < use soldata_module,only: get_soldata,soldata,nwave --- > use soldata_module,only: get_soldata,soldata,nwavesd=>nwave, > | wave1sd=>wave1,wave2sd=>wave2 > use seeflux_module,only: get_seeflux 448a440 > real :: wave1(lmax),wave2(lmax) 450c442,443 < ! sflu: scaled solar flux returned by subroutine ssflux() (photons cm-2 s-1) --- > ! External: > logical,external :: time2print 452,453c445,468 < if (len_trim(see_ncfile) == 0) then < call ssflux(f107,f107a) --- > ! WAVE1 longwave bound of spectral intervals (Angstroms) > ! WAVE2 shortwave bound of intervals (= WAVE1 for indiv. lines) > ! SFLUX scaled solar flux returned by subroutine (photons cm-2 s-1) > ! > ! if (len_trim(sd_ncfile) == 0) then > ! call ssflux(f107,f107a,wave1,wave2,sflux) > ! do n = l1+1,lmax > ! feuv(n) = sflux(n)*sfeps > ! enddo > ! > ! do n = 1,l1 > ! fsrc(n) = sflux(n)*sfeps > ! enddo > ! else > ! call get_soldata(iyear,iday,int(secs),istep) > ! do n=1,l1 > ! fsrc(n)=soldata(n) > ! enddo > ! do n=l1+1,lmax > ! feuv(n)=soldata(n) > ! enddo > ! endif > if (iseeflux == 0) then > call ssflux(f107,f107a,wave1,wave2,sflux) 457d471 < 460a475,479 > ! Increase 0-20 nm soft X-ray bin by a factor of 3 in order to bring up > ! the E-region electron density by 30% > ! do n = lmax-7,lmax > ! feuv(n) = feuv(n)*3. > ! enddo 462,468c481 < call get_soldata(iyear,iday,int(secs),istep) < if (nwave /= lmax) then < write(6,"('init_sflux(): wave bins mismatch: nwave=',i4, < | ' lmax=',i4)") nwave,lmax < call shutdown('init_sflux') < endif < --- > call get_seeflux(iyear,iday,secs,wave1,wave2,sflux) 470c483 < fsrc(n)=soldata(n) --- > fsrc(n)=sflux(n)*sfeps 473c486 < feuv(n)=soldata(n) --- > feuv(n)=sflux(n)*sfeps 475a489,493 > ! Report to stdout (data is actually from previous step): > ! if (time2print(nstep,istep)) then > ! write(6,"('Step ',i6,' of ',i6,' mtime=',3i3, > ! | ' sflux=',/,(6e12.4))") istep,nstep,modeltime(1:3),sflux > ! endif ! time2print 484,533d501 < ! Initialize bins (37 bins) < ! < wave1 = (/1700.00, 1650.00, 1600.00, 1550.00, 1500.00, < | 1450.00, 1400.00, 1350.00, 1300.00, 1250.00, < | 1200.00, 1215.67, 1150.00, 1100.00, 1050.00, < | 1027.00, 987.00, 975.00, 913.00, 913.00, < | 913.00, 798.00, 798.00, 798.00, 650.00, < | 650.00, 540.00, 320.00, 290.00, 224.00, < | 155.00, 70.00, 32.00, 18.00, 8.00, < | 4.00, 0.50/) < wave2 = (/1750.00, 1700.00, 1650.00, 1600.00, 1550.00, < | 1500.00, 1450.00, 1400.00, 1350.00, 1300.00, < | 1250.00, 1215.67, 1200.00, 1150.00, 1100.00, < | 1050.00, 1027.00, 987.00, 975.00, 975.00, < | 975.00, 913.00, 913.00, 913.00, 798.00, < | 798.00, 650.00, 540.00, 320.00, 290.00, < | 224.00, 155.00, 70.00, 32.00, 18.00, < | 8.00, 4.00/) < ! < ! Solar spectrum based on EUVAC and glow for wave length less than 1050 A < ! and Woods for wavelength greater than 1050 A < ! < ! solar minimum flux (when P_index=80, unit:photon cm^-2 S^-1) < ! < sfmin=(/3.397e+11, 1.998e+11, 1.055e+11, 7.260e+10, < | 5.080e+10, 2.802e+10, 1.824e+10, 1.387e+10, < | 2.659e+10, 7.790e+09, 1.509e+10, 3.940e+11, < | 8.399e+09, 3.200e+09, 3.298e+09, 4.235e+09, < | 4.419e+09, 4.482e+09, 7.156e+08, 1.028e+09, < | 3.818e+08, 8.448e+08, 3.655e+09, 2.364e+09, < | 1.142e+09, 1.459e+09, 4.830e+09, 2.861e+09, < | 8.380e+09, 4.342e+09, 5.612e+09, 1.270e+09, < | 5.326e+08, 2.850e+07, 2.000e+06, 1.000e+04, < | 5.010e+01/) < ! < ! scaling factor A as defined in EUVAC model < ! < afac=(/5.937e-04, 6.089e-04, 1.043e-03, 1.125e-03, < | 1.531e-03, 1.202e-03, 1.873e-03, 2.632e-03, < | 2.877e-03, 2.610e-03, 3.739e-03, 4.230e-03, < | 2.541e-03, 2.099e-03, 3.007e-03, 4.825e-03, < | 5.021e-03, 3.950e-03, 4.422e-03, 4.955e-03, < | 4.915e-03, 5.437e-03, 5.261e-03, 5.310e-03, < | 3.680e-03, 5.719e-03, 5.857e-03, 1.458e-02, < | 7.059e-03, 2.575e-02, 1.433e-02, 9.182e-03, < | 1.343e-02, 6.247e-02, 2.000e-01, 3.710e-01, < | 6.240e-01/) < ! < ! 0.5*(wave1+wave2) in centimeter < ! 546d513 < ! 558c525 < ! --- > 570c537 < ! --- > 584c551 < ! --- > 596c563 < ! --- > 608c575 < ! --- > 623c590 < ! --- > 635c602 < ! --- > 647c614 < ! --- > 659c626 < ! --- > 671c638 < ! --- > 683c650 < ! --- > 695c662 < ! --- > 707c674 < ! --- > 722d688 < ! 734c700 < ! --- > 746c712 < ! --- > 761c727 < ! --- > 773c739 < ! --- > 785c751 < ! --- > 797c763 < ! --- > 809c775 < ! --- > 821c787 < ! --- > 833c799 < ! --- > 866c832 < subroutine ssflux (f107, f107a) --- > subroutine ssflux (f107, f107a,wave1, wave2, sflux) 869a836 > real,intent(out) :: wave1(lmax),wave2(lmax),sflux(lmax) 872c839,842 < real :: pind --- > real :: > | pind, > | wavel(lmax), waves(lmax), > | sfmin(lmax), afac(lmax) 874a845,889 > ! Initialize bins (37 bins) > wavel = (/1750.00, 1700.00, 1650.00, 1600.00, 1550.00, > | 1500.00, 1450.00, 1400.00, 1350.00, 1300.00, > | 1250.00, 1215.67, 1200.00, 1150.00, 1100.00, > | 1050.00, 1027.00, 987.00, 975.00, 975.00, > | 975.00, 913.00, 913.00, 913.00, 798.00, > | 798.00, 650.00, 540.00, 320.00, 290.00, > | 224.00, 155.00, 70.00, 32.00, 18.00, > | 8.00, 4.00/) > waves = (/1700.00, 1650.00, 1600.00, 1550.00, 1500.00, > | 1450.00, 1400.00, 1350.00, 1300.00, 1250.00, > | 1200.00, 1215.67, 1150.00, 1100.00, 1050.00, > | 1027.00, 987.00, 975.00, 913.00, 913.00, > | 913.00, 798.00, 798.00, 798.00, 650.00, > | 650.00, 540.00, 320.00, 290.00, 224.00, > | 155.00, 70.00, 32.00, 18.00, 8.00, > | 4.00, 0.50/) > ! > ! Solar spectrum based on EUVAC and glow for wave length less than 1050 A > ! and Woods for wavelength greater than 1050 A > ! > ! solar minimum flux (when P_index=80, unit:photon cm^-2 S^-1) > sfmin=(/3.397e+11, 1.998e+11, 1.055e+11, 7.260e+10, > | 5.080e+10, 2.802e+10, 1.824e+10, 1.387e+10, > | 2.659e+10, 7.790e+09, 1.509e+10, 3.940e+11, > | 8.399e+09, 3.200e+09, 3.298e+09, 4.235e+09, > | 4.419e+09, 4.482e+09, 7.156e+08, 1.028e+09, > | 3.818e+08, 8.448e+08, 3.655e+09, 2.364e+09, > | 1.142e+09, 1.459e+09, 4.830e+09, 2.861e+09, > | 8.380e+09, 4.342e+09, 5.612e+09, 1.270e+09, > | 5.326e+08, 2.850e+07, 2.000e+06, 1.000e+04, > | 5.010e+01/) > ! > ! scaling factor A as defined in EUVAC model > afac=(/5.937e-04, 6.089e-04, 1.043e-03, 1.125e-03, > | 1.531e-03, 1.202e-03, 1.873e-03, 2.632e-03, > | 2.877e-03, 2.610e-03, 3.739e-03, 4.230e-03, > | 2.541e-03, 2.099e-03, 3.007e-03, 4.825e-03, > | 5.021e-03, 3.950e-03, 4.422e-03, 4.955e-03, > | 4.915e-03, 5.437e-03, 5.261e-03, 5.310e-03, > | 3.680e-03, 5.719e-03, 5.857e-03, 1.458e-02, > | 7.059e-03, 2.575e-02, 1.433e-02, 9.182e-03, > | 1.343e-02, 6.247e-02, 2.000e-01, 3.710e-01, > | 6.240e-01/) > ! 882,884c897,904 < ! set solar flux to be 80% of the value when pind=80 < ! if it becomes negative < if (sflux(l) .le. 0.8*sfmin(l)) sflux(l) = 0.8*sfmin(l) --- > enddo > ! > ! bins > ! > do L=1,LMAX > WAVE1(L) = WAVEL(L) > WAVE2(L) = WAVES(L) > IF (SFLUX(L) .LT. 0.0) SFLUX(L) = 0.0 ======================================================================== >>> WARNING: Cannot find source file /fis/hao/tgcm/tiegcm1.92/src/rgrd1.F ======================================================================== >>> WARNING: Cannot find source file /fis/hao/tgcm/tiegcm1.92/src/rgrd2.F ======================================================================== >>> WARNING: Cannot find source file /fis/hao/tgcm/tiegcm1.92/src/rgrd3.F ======================================================================== >>> WARNING: Cannot find source file /fis/hao/tgcm/tiegcm1.92/src/seeflux_mod.F ======================================================================== Diff of /fis/hao/tgcm/tiegcm1.92/src/settei.F and /ptmp/foster/ganglu_tiegcm_amie/modsrc2/settei.F 5,8d4 < ! This software is part of the NCAR TIE-GCM. Use is governed by the < ! Open Source Academic Research License Agreement contained in the file < ! tiegcmlicense.txt. < ! 11c7 < use params_module,only: dz,nlonp4,spval --- > use params_module,only: dz,nlonp4 27d22 < use addfld_module,only: addfld 109,110c104,105 < ! For diagnostic plotting: < real,dimension(lev0:lev1-1,lon0:lon1) :: --- > ! For diagnostic plotting (addfsech): > real,dimension(lev0:lev1,lon0:lon1) :: 120a116 > real :: bb 133,134c129 < ! call addfld('QJI_TI',' ',' ',qji_ti(lev0:lev1-1,lon0:lon1), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('QJI_TI',' ',' ',qji_ti,lon0,lon1,nk,nkm1,lat) 144,145c139,153 < fed(i) = ( -5.0e+7*f107te*a(i)-4.0e+7*f107te)*1.2 < fen(i) = fed(i)/2. --- > ! fed(i) = ( -5.0e+7*f107te*a(i)-4.0e+7*f107te)*1.2 > ! fen(i) = fed(i)/2. > ! Change to Lei's modes > if (abs(rlatm(i,lat))-pi/4.5 >= 0.) then > bb = 5.0 > else > bb=abs(rlatm(i,lat))*180/pi > ! bb = 6.0 -3.0e-3*bb*bb + 4.8 > bb = 5.0 -4.3e-3*bb*bb + 6.85 > ! bb = 5.+4.*(1.+sin(pi*(abs(rlatm(i,lat))-pi/9.)/(pi/4.5))) > endif > fed(i) = -4.0e+7*f107te*a(i)-2.0e+7*f107te > fen(i) = fed(i)/bb > ! End of Lei's modes > 163c171 < ! For plotting (first dimension is lev0:lev1-1): --- > ! For plotting: 172,183c180,185 < ! call addfld('MAGLAT',' ',' ',a_ki , < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('CHI' ,' ',' ',chi_ki , < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('QTEAUR',' ',' ',qteaur_ki, < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('FED' ,' ',' ',fed_ki , < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('FEN' ,' ',' ',fen_ki , < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('FE' ,' ',' ',fe_ki , < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('MAGLAT',' ',' ',a_ki ,lon0,lon1,nk,nkm1,lat) > ! call addfsech('CHI' ,' ',' ',chi_ki ,lon0,lon1,nk,nkm1,lat) > ! call addfsech('QTEAUR',' ',' ',qteaur_ki,lon0,lon1,nk,nkm1,lat) > ! call addfsech('FED' ,' ',' ',fed_ki ,lon0,lon1,nk,nkm1,lat) > ! call addfsech('FEN' ,' ',' ',fen_ki ,lon0,lon1,nk,nkm1,lat) > call addfsech('FE' ,' ',' ',fe_ki ,lon0,lon1,nk,nkm1,lat) 218,227c220,224 < ! call addfld('TE_INT' ,' ',' ',te_int, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('O2_INT' ,' ',' ',o2n , < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('O1_INT' ,' ',' ',o1n , < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('TN_INT' ,' ',' ',tn_int, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('N2_INT' ,' ',' ',n2n , < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('TE_INT' ,' ',' ',te_int,lon0,lon1,nk,nkm1,lat) > ! call addfsech('O2_INT' ,' ',' ',o2n ,lon0,lon1,nk,nkm1,lat) > ! call addfsech('O1_INT' ,' ',' ',o1n ,lon0,lon1,nk,nkm1,lat) > ! call addfsech('TN_INT' ,' ',' ',tn_int,lon0,lon1,nk,nkm1,lat) > ! call addfsech('N2_INT' ,' ',' ',n2n ,lon0,lon1,nk,nkm1,lat) 253,256c250,254 < ! call addfld('XNMBARI',' ',' ',xnmbar, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('TEK0' ,' ',' ',tek0 , < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('XNMBARI',' ',' ',xnmbar,lon0,lon1,nk,nk,lat) ! s8 > ! call addfsech('O2_INT' ,' ',' ',o2n ,lon0,lon1,nk,nk,lat) ! s13 > ! call addfsech('O1_INT' ,' ',' ',o1n ,lon0,lon1,nk,nk,lat) ! s12 > ! call addfsech('N2_INT' ,' ',' ',n2n ,lon0,lon1,nk,nk,lat) ! s11 > ! call addfsech('TEK0' ,' ',' ',tek0 ,lon0,lon1,nk,nk,lat) ! s15 267,270c265,266 < ! call addfld('H_MID' ,' ',' ',h_mid(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('H_INT' ,' ',' ',h_int, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('H_MID' ,' ',' ',h_mid,lon0,lon1,nk,nkm1,lat) ! s7 > ! call addfsech('H_INT' ,' ',' ',h_int,lon0,lon1,nk,nk ,lat) ! s6 271a268 > 306,309c303,305 < ! call addfld('DIPMAG' ,' ',' ',dipmag_ki, < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('SINDIPM',' ',' ',sindipmag_ki, < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('DIPMAG' ,' ',' ',dipmag_ki,lon0,lon1,nk,nkm1,lat) > ! call addfsech('SINDIPM',' ',' ',sindipmag_ki,lon0,lon1,nk,nkm1, > ! | lat) 311,318c307,310 < ! call addfld('P_COEFa' ,' ',' ',p_coef(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('Q_COEFa' ,' ',' ',q_coef(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('R_COEFa' ,' ',' ',r_coef(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('RHS0' ,' ',' ',rhs (lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('P_COEF' ,' ',' ',p_coef,lon0,lon1,nk,nkm1,lat) ! s1 > ! call addfsech('Q_COEF' ,' ',' ',q_coef,lon0,lon1,nk,nkm1,lat) ! s2 > ! call addfsech('R_COEF' ,' ',' ',r_coef,lon0,lon1,nk,nkm1,lat) ! s3 > ! call addfsech('RHS0' ,' ',' ',rhs ,lon0,lon1,nk,nkm1,lat) ! s4 324,337c316,324 < ! call addfld('QO2P' ,' ',' ',qo2p (:,:,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QOP' ,' ',' ',qop (:,:,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QN2P' ,' ',' ',qn2p (:,:,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QNOP' ,' ',' ',qnop (:,:,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QNP' ,' ',' ',qnp (:,:,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QOP2D',' ',' ',qop2d(:,:,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) < ! call addfld('QOP2P',' ',' ',qop2p(:,:,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > > ! call addfsech('QO2P' ,' ',' ',qo2p (:,:,lat),lon0,lon1,nk,nk,lat) > ! call addfsech('QOP' ,' ',' ',qop (:,:,lat),lon0,lon1,nk,nk,lat) > ! call addfsech('QN2P' ,' ',' ',qn2p (:,:,lat),lon0,lon1,nk,nk,lat) > ! call addfsech('QNOP' ,' ',' ',qnop (:,:,lat),lon0,lon1,nk,nk,lat) > ! call addfsech('QNP' ,' ',' ',qnp (:,:,lat),lon0,lon1,nk,nk,lat) > ! call addfsech('QOP2D',' ',' ',qop2d(:,:,lat),lon0,lon1,nk,nk,lat) > ! call addfsech('QOP2P',' ',' ',qop2p(:,:,lat),lon0,lon1,nk,nk,lat) > 374,375c361 < ! call addfld('QTOT_SUM',' ',' ',qtot, < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('QTOT_SUM',' ',' ',qtot,lon0,lon1,nk,nk,lat) ! s11 383,384c369,371 < ! call addfld('QTOT',' ',' ',qtot , < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > > ! call addfsech('QTOT',' ',' ',qtot ,lon0,lon1,nk,nk,lat) ! s11 > 395,396c382,383 < ! call addfld('ROOT_NE',' ',' ',root_ne(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > > ! call addfsech('ROOT_NE',' ',' ',root_ne,lon0,lon1,nk,nkm1,lat) ! s15 442,453c429,436 < ! call addfld('XNMBARM',' ',' ',xnmbar(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('O2N' ,' ',' ',o2n(lev0:lev1-1,:) , < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('O1N' ,' ',' ',o1n(lev0:lev1-1,:) , < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('N2N' ,' ',' ',n2n(lev0:lev1-1,:) , < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('C_EN2V' ,' ',' ',coll_en2v(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('L_EN2V' ,' ',' ',loss_en2v(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('XNMBARM',' ',' ',xnmbar,lon0,lon1,nk,nkm1,lat) ! s6 > ! call addfsech('O2N' ,' ',' ',o2n ,lon0,lon1,nk,nkm1,lat) ! s14 > ! call addfsech('O1N' ,' ',' ',o1n ,lon0,lon1,nk,nkm1,lat) ! s13 > ! call addfsech('N2N' ,' ',' ',n2n ,lon0,lon1,nk,nkm1,lat) ! s12 > > ! call addfsech('C_EN2V' ,' ',' ',coll_en2v,lon0,lon1,nk,nkm1,lat) ! s9 > ! call addfsech('L_EN2V' ,' ',' ',loss_en2v,lon0,lon1,nk,nkm1,lat) ! s10 > 469a453,454 > !Set minimum value for loss_en - G. Lu 05/21/2007 > if (loss_en(k,i) < 1.e-14) loss_en(k,i)=1.e-14 513a499,500 > ! Set minimum value for loss_ei - G. Lu 05/21/2007 > if (k > 13 .and. loss_ei(k,i) < 1.e-14) loss_ei(k,i)=1.e-14 523a511,512 > ! Set minimum value for loss_ei - G. Lu 05/21/2007 > if (k > 13 .and. loss_in(k,i) < 1.e-12) loss_in(k,i)=1.e-12 539,558c528,537 < ! call addfld('L_EN2' ,' ',' ',loss_en2 (lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('L_EO2' ,' ',' ',loss_eo2 (lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('L_EO1D' ,' ',' ',loss_eo1d(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('L_EO1' ,' ',' ',loss_eo1 (lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('L_XEN' ,' ',' ',loss_xen (lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('L_EN' ,' ',' ',loss_en (lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('L_EI' ,' ',' ',loss_ei (lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('L_IN' ,' ',' ',loss_in (lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('Q_COEFb' ,' ',' ',q_coef (lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('RHS1' ,' ',' ',rhs (lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('L_EN2' ,' ',' ',loss_en2 ,lon0,lon1,nk,nkm1,lat) > ! call addfsech('L_EO2' ,' ',' ',loss_eo2 ,lon0,lon1,nk,nkm1,lat) > ! call addfsech('L_EO1D' ,' ',' ',loss_eo1d,lon0,lon1,nk,nkm1,lat) > ! call addfsech('L_EO1' ,' ',' ',loss_eo1 ,lon0,lon1,nk,nkm1,lat) > ! call addfsech('L_XEN' ,' ',' ',loss_xen ,lon0,lon1,nk,nkm1,lat) > ! call addfsech('L_EN' ,' ',' ',loss_en ,lon0,lon1,nk,nkm1,lat) > ! call addfsech('L_EI' ,' ',' ',loss_ei ,lon0,lon1,nk,nkm1,lat) > ! call addfsech('L_IN' ,' ',' ',loss_in ,lon0,lon1,nk,nkm1,lat) > ! call addfsech('Q_COEF' ,' ',' ',q_coef ,lon0,lon1,nk,nkm1,lat) > ! call addfsech('RHS1' ,' ',' ',rhs ,lon0,lon1,nk,nkm1,lat) 575,576c554 < ! call addfld('Q_ENI',' ',' ',q_eni(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('Q_ENI',' ',' ',q_eni,lon0,lon1,nk,nkm1,lat) ! s7 592,593c570,571 < ! call addfld('Q_TOT',' ',' ',qtotal(:,:,lat), < ! | 'lev',lev0,lev1,'lon',lon0,lon1,lat) --- > ! call addfsech('Q_TOT',' ',' ',qtotal(:,:,lat),lon0,lon1, > ! | nk,nk,lat) 597,604c575,578 < ! call addfld('P_COEF' ,' ',' ',p_coef(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('Q_COEF' ,' ',' ',q_coef(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('R_COEF' ,' ',' ',r_coef(lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) < ! call addfld('RHS2' ,' ',' ',rhs (lev0:lev1-1,:), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('P_COEF' ,' ',' ',p_coef,lon0,lon1,nk,nkm1,lat) ! s1 > ! call addfsech('Q_COEF' ,' ',' ',q_coef,lon0,lon1,nk,nkm1,lat) ! s2 > ! call addfsech('R_COEF' ,' ',' ',r_coef,lon0,lon1,nk,nkm1,lat) ! s3 > ! call addfsech('RHS2' ,' ',' ',rhs ,lon0,lon1,nk,nkm1,lat) ! s4 610c584 < | lev0,lev1,lev0,lev1-1,lon0,lon1,nlonp4,lat,0) --- > | lev0,lev1,lev0,lev1-1,lon0,lon1,nlonp4,lat,1) 615,616c589,590 < ! call addfld('TE_SOLV',' ',' ',te_out(lev0:lev1-1,lon0:lon1), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('TE_SOLV',' ',' ',te_out(:,lon0:lon1), > ! | lon0,lon1,nk,nkm1,lat) 634,636d607 < ! 1/9/08 btf: put spval in top level of te: < te_out(lev1,:) = spval < ! 638,639c609,610 < ! call addfld('TE_OUT',' ',' ',te_out(lev0:lev1-1,lon0:lon1), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('TE_OUT',' ',' ',te_out(:,lon0:lon1), > ! | lon0,lon1,nk,nkm1,lat) 654,659c625,626 < ! < ! 1/9/08 btf: put spval in top level of ti: < ti_out(lev1,:) = spval < ! < ! call addfld('TI_OUT',' ',' ',ti_out(lev0:lev1-1,lon0:lon1), < ! | 'lev',lev0,lev1-1,'lon',lon0,lon1,lat) --- > ! call addfsech('TI_OUT',' ',' ',ti_out(:,lon0:lon1), > ! | lon0,lon1,nk,nkm1,lat) ======================================================================== Diff of /fis/hao/tgcm/tiegcm1.92/src/tgcm.F and /ptmp/foster/ganglu_tiegcm_amie/modsrc2/tgcm.F 4,7d3 < ! This software is part of the NCAR TIE-GCM. Use is governed by the < ! Open Source Academic Research License Agreement contained in the file < ! tiegcmlicense.txt. < ! 25a22,23 > use amie_module,only: init_amie > use seeflux_module,only: init_seeflux 29,31d26 < #if defined(INTERCOMM) || defined(CISMAH) < use cism_coupling_module,only: initialize,finalize < #endif 81d75 < #if defined(INTERCOMM) || defined(CISMAH) 83,90d76 < ! Initialize code coupling communication framework < ! (i.e. InterComm or AdHoc file exchanges) < ! < if(mytid==0) call initialize < #endif < < ! < ! 98a85,89 > ! Read amie data files if requested > ! (this is not in init_module to avoid circular dependencies) > call init_amie > call init_seeflux > ! 103c94 < call apxparm(real(iyear)) --- > if (dynamo > 0) call apxparm(real(iyear)) 106c97 < call magfield --- > call magfield(dynamo) 123c114 < | ' (minutes=',f10.2,', hours=',f8.2,', days=',f10.6,')')") --- > | ' (minutes=',f8.2,', hours=',f8.2,', days=',f10.6,')')") 134,141d124 < #if defined(INTERCOMM) || defined(CISMAH) < ! < ! Finalize code coupling communication framework < ! (i.e. InterComm or AdHoc file exchanges) < ! < if (mytid==0)call finalize < #endif < ======================================================================== Diff of /fis/hao/tgcm/tiegcm1.92/src/util.F and /ptmp/foster/ganglu_tiegcm_amie/modsrc2/util.F 4,7d3 < ! This software is part of the NCAR TIE-GCM. Use is governed by the < ! Open Source Academic Research License Agreement contained in the file < ! tiegcmlicense.txt. < ! 428a425,495 > integer function isymlink(from,to,iprint) > implicit none > ! > ! Args: > character(len=*),intent(in) :: from,to > integer,intent(in) :: iprint > ! > ! Local: > logical :: exists > integer :: istat > integer,parameter :: maxlen=1024 > character(len=maxlen) :: command > ! > ! External: > integer,external :: isystem > ! > ! Check for existence of "from" file: > inquire(file=trim(from),exist=exists) > ! write(6,"('isymlink: Linking from=',a,' to=',a,' exists=',l1)") > ! | trim(from),trim(to),exists > ! > ! Make symbolic link: > write(command,"('ln -s -f ',a,' ',a)") trim(from),trim(to) > isymlink = isystem(command) > if (isymlink == 0) then > if (iprint > 0) > | write(6,"('Made symbolic link of ',a,' to ',a)") > | trim(from),trim(to) > else > write(6,"('>>> WARNING: symbolic link of ',a,' to ',a, > | ' failed: ierror=',i3,/)") trim(from),trim(to),isymlink > ! call shutdown('isymlink') > endif > end function isymlink > !------------------------------------------------------------------- > integer function ilink(from,to,iprint) > implicit none > ! > ! Args: > character(len=*),intent(in) :: from,to > integer,intent(in) :: iprint > ! > ! External: > integer,external :: link > #if defined(UNICOS) || defined(IRIX) || defined(SUN) || defined(OSF1) > ilink = link(trim(from),trim(to)) > if (ilink.eq.0) then > if (iprint > 0) > | write(6,"('Linked file ',a,' to ',a)") trim(from),trim(to) > else > write(6,"(/,'>>> WARNING: link command of ',a,' to ',a, > | ' failed: ierror=',i3,/)") trim(from),trim(to),ilink > ! call shutdown('ilink') > endif > #elif defined(AIX) || defined(LINUX) > ! > ! Note: link will fail if executing from different file system > ! than tmpdir (e.g., executing from /home but tmpdir is > ! in /ptmp) > ! > ilink = link(trim(from)//"\0",trim(to)//"\0") > if (ilink.eq.0) then > if (iprint > 0) > | write(6,"('Linked file ',a,' to ',a)") trim(from),trim(to) > else > write(6,"('>>> WARNING: link command of ',a,' to ',a, > | ' failed: ierror=',i3)") trim(from),trim(to),ilink > endif > #endif > end function ilink > !------------------------------------------------------------------- 1055d1121 < write(6,"('opts=',a)") trim(opts) 1251c1317 < integer function real_bsearch(inarray,first,last,key) --- > integer function b_search(inarray,first,last,key) 1267c1333 < real_bsearch=-1 --- > b_search=-1 1275c1341 < real_bsearch=nmin-1 --- > b_search=nmin-1 1284c1350 < real_bsearch=nmid --- > b_search=nmid 1289c1355 < end function real_bsearch --- > end function b_search 1291,1370d1356 < integer function long_bsearch(inarray,first,last,key) < implicit none < ! < ! inarray is a sorted array in asending order. The binary search routine search < ! for the beginning index where the value of key fall within in inarray (or the index < ! where the value of array[index] equals to key). < ! < ! Args: < integer,intent(in)::first,last < integer(kind=8),dimension(first:last),intent(in) :: inarray < integer(kind=8),intent(in)::key < ! < ! Local: < integer :: nmid,nmin,nmax < ! < if ((key < inarray(first)) .or. (key > inarray(last))) then < long_bsearch=-1 < return < endif < < nmin=first < nmax=last < do < if (nmin > nmax) then < long_bsearch=nmin-1 < exit < end if < nmid=(nmin+nmax)/2 < if (key > inarray(nmid)) then < nmin=nmid+1 < else if (key < inarray(nmid)) then < nmax=nmid-1 < else < long_bsearch=nmid < exit < end if < end do < < end function long_bsearch < !----------------------------------------------------------------------- < integer function int_bsearch(inarray,first,last,key) < implicit none < ! < ! inarray is a sorted array in asending order. The binary search routine search < ! for the beginning index where the value of key fall within in inarray (or the index < ! where the value of array[index] equals to key). < ! < ! Args: < integer,intent(in)::first,last < integer,dimension(first:last),intent(in) :: inarray < integer,intent(in)::key < ! < ! Local: < integer :: nmid,nmin,nmax < ! < if ((key < inarray(first)) .or. (key > inarray(last))) then < int_bsearch=-1 < return < endif < < nmin=first < nmax=last < do < if (nmin > nmax) then < int_bsearch=nmin-1 < exit < end if < nmid=(nmin+nmax)/2 < if (key > inarray(nmid)) then < nmin=nmid+1 < else if (key < inarray(nmid)) then < nmax=nmid-1 < else < int_bsearch=nmid < exit < end if < end do < < end function int_bsearch < !----------------------------------------------------------------------- 1514,1524c1500,1508 < ! Expand any environment variables imbedded in path, and return < ! expanded path. < ! Procedure: < ! If '$' is found in input path, then an env var is defined as < ! that part of path following the '$' up to (not including) the < ! next delimiter. The value of the env var is substituted in place < ! of the env var string. If no '$' is found, the routine returns < ! without changing path. < ! Environment vars can be set (using setenv) in the user's .cshrc file, < ! in the job script (e.g., setenv from a shell var), or set manually < ! in the shell before executing the model. --- > ! Expand any environment variables in path, return expanded path. > ! If '$' is found, then an env var is defined as that part of path > ! following the '$' until the next slash. If no '$' is found, > ! return without changing path. > ! Example: > ! Here, "TGCMDATA" is considered the env var: > ! path = '$TGCMDATA/dir1/file' > ! This routine is recursive, so multiple env vars can be used, e.g.: > ! path = '$MYDIR/$MYSUBDIR/file.nc' 1526,1551d1509 < ! The 7 recognized delimiters (meaning end of env var name) are: < ! '/' (forward slash), < ! '.' (dot), < ! '_' (underscore), < ! '-' (dash), < ! ':' (colon), < ! '#' (pound sign), and < ! '%' (percent sign) < ! < ! This routine is recursive, so multiple env vars can be used in the < ! same path, and in combination with different delimiters, see < ! examples below. < ! < ! Examples: < ! path = '$TGCMDATA/dir1/file.nc' (the env var is $TGCMDATA) < ! path = '$MYDIR/$MYSUBDIR/file.nc' (env vars are $MYDIR, $MYSUBDIR) < ! path = '$USER.$MODEL_$NUM.nc' (3 env vars and different delims) < ! path = '$FILEPATH' (entire path in one env var) < ! Last example: < ! In the job script: < ! set model = $tiegcm ! set a shell var < ! setenv MODEL $model ! set env var from shell var < ! In the namelist input: < ! histfile = '$TGCMDATA/TGCM.$MODEL.p001-2002-080.nc' or < ! histfile = '$TGCMDATA/TGCM.$MODEL.p001-$YEAR-$DAY.nc' < ! 1560,1563c1518 < integer,parameter :: ndelim=7 < character(len=1) :: delimiters(ndelim) = < | (/ '/', '.', '-', '_', ':', '#', '%'/) < integer :: i,idollar,idelim --- > integer :: i,idollar,islash 1578,1591c1533,1536 < idelim = 0 < do i=idollar+1,len_trim(path) ! find next delimiter < if (any(delimiters==path(i:i))) then < idelim = i < exit < endif < enddo < if (idelim <= 0) idelim = len_trim(path)+1 < envvar_name = path(idollar+1:idelim-1) < < ! write(6,"('expand_path: path=',a,' idollar=',i3, < ! | ' idelim=',i3,' envvar_name=',a)") < ! | trim(path),idollar,idelim,trim(envvar_name) < --- > islash = index(path(idollar+1:len_trim(path)),'/') > if (islash <= 0) islash = len_trim(path) > islash = islash+idollar > envvar_name = path(idollar+1:islash-1) 1597c1542 < | 'value for env var ''',a,'''')") trim(envvar_name) --- > | 'value for env var ',a)") trim(envvar_name) 1599,1601d1543 < else < ! write(6,"('expand_path: envvar=',a,' value=',a)") < ! | trim(envvar_name),trim(envvar_value) 1604c1546 < ! Put together the expanded output path: --- > ! Put together expanded output path: 1606c1548 < if (idelim < len_trim(path)) then --- > if (islash < len_trim(path)) then 1608c1550 < | path(idelim:len_trim(path)) --- > | path(islash:len_trim(path)) 1613,1614c1555,1556 < if (idelim < len_trim(path)) then < path_out = trim(envvar_value)//path(idelim:len_trim(path)) --- > if (islash < len_trim(path)) then > path_out = trim(envvar_value)//path(islash:len_trim(path)) 1622,1624d1563 < ! write(6,"('expand_path returning path = ''',a,'''')") trim(path) < ! < ! Recursive call to expand any additional env vars: 1629c1568 < logical function arrayeq(a0,a1,n) --- > logical function time2print(nstep,istep) 1631,1666c1570,1574 < real,intent(in) :: a0(n),a1(n) < integer,intent(in) :: n < integer :: i < ! < arrayeq = .true. < do i=1,n < if (a0(i) /= a1(i)) then < arrayeq = .false. < return < endif < enddo < end function arrayeq < !----------------------------------------------------------------------- < real function hp_from_bz_swvel(bz,swvel) < ! < ! Calculate hemispheric power from bz, swvel: < ! Emery, et.al., (2008, in press, JGR) < ! 6/3/08: Enforce minimum hp of 4.0 before *fac. < ! 6/6/08: Reset minimum hp from 4.0 to 2.5 before *fac, < ! as per Emery email of 6/5/08. < ! < implicit none < real,intent(in) :: bz,swvel ! in < real :: hp ! out < real :: fac = 2.0 < ! < if (bz < 0.) then < hp = 6.0 + 3.3*abs(bz) + (0.05 + 0.003*abs(bz))* < | (min(swvel,700.)-300.) < else < hp = 5.0 + 0.05 * (min(swvel,700.)-300.) < endif < ! hp = max(4.0,hp)*fac < hp = max(2.5,hp)*fac < hp_from_bz_swvel = hp < end function hp_from_bz_swvel --- > integer,intent(in) :: nstep,istep > time2print = .false. > if (nstep <= 100 .or. (nstep > 100 .and. mod(istep,10)==0)) > | time2print = .true. > end function time2print