C+ C NAME: C MkShiftdnma_pre C PURPOSE: C Calls MkShiftdnma to allow diagnostic values to be printed following the call to MkShiftdnma C C CATEGORY: C Data processing C CALLING SEQUENCE: C call MkShiftdnma_pre(iPrint,iDo,bSmooth,XCbe,XCtbeg,XCtend,ALng,nLng,nLat,nMap,nT,nTmax, C VV3,BB3,DD1,TT1,XCshift,XCshift3,XCshiftM,DVfact,Vratio3,Bratio3,DDfact,Dratio1,Tratio1,RR,RRMS,KPF, C FALLOFFN,FALLOFFT,FALLOFFBR,FALLOFFBT,FALLOFFBN,CLRV,CLRD,VLL,VUL,VLLLL,VLLUL,DLL,VUL, C Vtmp,Dtmp,XLLTtmp) C INPUTS: C iprint integer iprint = 0, dont't print output, iprint = 1, print output C iDo integer If iDo = 0 then the traceback matrix is preserved and there is no action taken to renew the xcshifts C or vratio and dratio C If iDo = 1 then the velocities and densities used are as conditioned from the tomography iterations. C If iDo = 2 then the velocities and densities are conditioned as in iDo=1, and vratio and dratio are C updated as well as xcshifts. C If iDo = 10 then the density data on the source surface is smoothed in latitude, longitude, and time. C bSmooth logical if .TRUE. the smooth the output base values C XCbe(2,nT) real Boundary values of time maps C XCtbeg real*8 Beginning time interval C XCtend real*8 Ending time interval C Alng real Rotations per nLng1 C nLng integer # longitude points C nLat integer # latitude points C nMap integer # heights (height begins at Sun__RAu AU) C nT integer # time intervals C nTmax integer Maximum # of time intervals C VMAP(nLng,nLat,nTmax) real 2D Map of base velocity C DMAP(nLng,nLat,nTmax) real 2D Map of base density C VV3(nLng,nLat,NMap,nTmax,3) real Maps of velocity component values at all heights and times C BB3(nLng,nLat,NMap,nTmax,3) real Maps of magnetic field component values at all heights and times C DD1(nLng,nLat,NMap,nTmax) real Maps of density values at all heights and times C TT1(nLng,nLat,NMap,nTmax) real Maps of temperature values at all heights and times C RR real Distance above sun for reference velocity map C RRMS real Distance above sun for reference magnetic field map C KPF integer The height of the first tomographic inversion map. C If 1, the magnetic field map and the first traceback map have the same values. C FALLOFFN real Fall off in density C FALLOFFT real Fall off in temperature C FALLOFFBR real Fall off in radial field C FALLOFFBT real Fall off in tangential field C FALLOFFBN real Fall off in normal field C CLRV real Velocity map radius filter distance C CLRD real Density map radius filter distance C VLL real Lower limit on traceback velocity C VUL real Upper limit on traceback velocity C VLLLL real Lower limit on traceback longitude, latitude velocity C VLLUL real Upper limit on traceback longitude, latitude velocity C DLL real Lower limit on traceback density conditioned for source surface distance C DUL real Upper limit on traceback density conditioned for source surface distance C C Vtmp(nLng,nLat,nTmax,3) real Internal scratch array C Dtmp(nLng,nLat,nTmax) real Internal scratch array C XLLTtmp(nLng,nTmax,8) real Internal scratch array C OUTPUTS: C XCshift(nLng,nLat,nMap,nT,3) real XCshift contains the kinematic final accumulated shifts (longitude at all C heights in terms of fractions of a Carrington rotation), latitude, and time C XCshift3(nLng,nLat,nMap,nT,3) real XCshift3 contains the volumetric input final accumulated shifts (longitude at C all heights in terms of fractions of a Carrington rotation), latitude, and time C XCshiftM(nLng,nLat,nTmax,3) real shift amount increments from RRMS to RR C DVfact (nLng,nLat,nMap,nTmax) real kinematic model velocity ratios C Vratio3 (nLng,nLat,nMap,nTmax,3) real velocity ratios C Bratio3 (nLng,nLat,nMap,nTmax,3) real mag ratios C DDfact (nLng,nLat,nMap,nTmax) real kinematic model density ratios C Dratio1 (nLng,nLat,nMap,nTmax) real density ratios C Tratio1 (nLng,nLat,nMap,nTmax) real temperature change C C FUNCTIONS/SUBROUTINES: C PROCEDURE: C calls MkShiftdnma C C MODIFICATION HISTORY: C MAR-1997, B. Jackson (UCSD) (original name was MAKE_TS) C MAY-1998, Paul Hick (UCSD; pphick@ucsd.edu); revision C APR-1999, Paul Hick, B. Jackson (UCSD); revision C APR-2001, B. Jackson (UCSD); revision C- subroutine MkShiftdnma_pre(iPrint,ido,bSmooth,XCbe,XCtbeg,XCtend,ALng,nLng,nLat,nMap,nT,nTmax,VMAP,DMAP, & VV3,BB3,DD1,TT1,XCshift,XCshift3,XCshiftM,DVfact,Vratio3,Bratio3,DDfact,Dratio1,Tratio1,RR,RRMS,dRR,dRRMS,KPF, & FALLOFFN,FALLOFFT,FALLOFFBR,FALLOFFBT,FALLOFFBN,CLRV,CLRD,CONDT,VLL,VUL,VLLLL,VLLUL,DLL,DUL, & Vtmp,Dtmp,XLLTtmp) real VV3 (nLng,nLat,nMap,nTmax,3), ! Input volumetric velocities & BB3 (nLng,nLat,nMap,nTmax,3), ! Input volumetric magnetic fields & DD1 (nLng,nLat,nMap,nTmax), ! Input volumetric densities & TT1 (nLng,nLat,nMap,nTmax), ! Input volumetric temperatures & VMAP (nLng,nLat,nTmax), ! Input map of base velocity & DMAP (nLng,nLat,nTmax), ! Input map of base density & XCshift (nLng,nLat,nMap,nTmax,3), ! Map of accumulated kinematic shifts at heights (from 1 RR) (in long, lat, time) & XCshift3(nLng,nLat,nMap,nTmax,3), ! Map of accumulated input vol. shifts at heights (from 1 RR) (in long, lat, time) & XCshiftM(nLng,nLat,nTmax,3), ! shift amount increments from RRMS to RR & DVfact (nLng,nLat,nMap,nTmax), ! kinematic model (radial) velocity ratios & Vratio3 (nLng,nLat,nMap,nTmax,3), ! Map of accumulated velocity ratios at heights (from 1 RR) & Bratio3 (nLng,nLat,nMap,nTmax,3), ! Map of accumulated magnetic field ratios at heights (from 1 RR) & DDfact (nLng,nLat,nMap,nTmax), ! kinematic model density ratios & Dratio1 (nLng,nLat,nMap,nTmax), ! Map of accumulated density ratios at heights (from 1 RR) & Tratio1 (nLng,nLat,nMap,nTmax), ! Map of accumulated temperature ratios at heights (from 1 RR) & XCbe (2,nTmax), ! Carrington time intervals & XLT (3), ! Internal array & BB33(3), ! Internal array & VV33(3), ! Internal array & Vtmp (nLng,nLat,nTmax,3), ! Scratch arrays & Dtmp (nLng,nLat,nTmax), & XLLTtmp (nLng,nLat,nTmax,8) real Vtmp1 (nLng,nLat,nTmax), ! Scratch arrays (not input from the main program) & Vtmp11 (nLng,nLat,nTmax), & Vtmp2 (nLng,nLat,nTmax), & Vtmp22 (nLng,nLat,nTmax), & Vtmp3 (nLng,nLat,nTmax), & Vtmp33 (nLng,nLat,nTmax), & Dtmp1 (nLng,nLat,nTmax), & Dtmp11 (nLng,nLat,nTmax), & DDfactmp(nLng,nLat,nTmax,nMap), & VMAPN (nLng,nLat,nTmax), ! Input map of base velocity (new) & DMAPN (nLng,nLat,nTmax) ! Input map of base density (new) logical bSmooth real*8 XCtbeg,XCtend,XCtfull,X integer NDLT(3) ! Internal array nLngLat = nLng*nLat nLngLatnT = nLng*nLat*nT if(iPrint.eq.1) print *, ' ' if(iPrint.eq.1) print*, 'Into mkshiftdnma_pre' C The below have three special cases. C If iDo = 0 then the traceback matrix is preserved and there is no action taken to renew the xcshifts or vratio and dratio C If iDo = 1 then the velocities and densities used are as conditioned from the tomography iterations. C If iDo = 2 then the velocities and densities are conditioned as in iDo=1, and vratio and dratio are updated as well as xcshifts. C If iDo = 10 then the density data on the source surface is smoothed in latitude, longitude, and time. C do I=1,nLng ! Initialize scratch arrays do J=1,nLat do N=1,nTmax Vtmp(I,J,N,1) = BadR4() Vtmp(I,J,N,2) = BadR4() Vtmp(I,J,N,3) = BadR4() Dtmp (I,J,N) = BadR4() Vtmp1(I,J,N) = BadR4() Vtmp11(I,J,N) = BadR4() Vtmp2(I,J,N) = BadR4() Vtmp22(I,J,N) = BadR4() Vtmp3(I,J,N) = BadR4() Vtmp33(I,J,N) = BadR4() Dtmp1(I,J,N) = BadR4() Dtmp11(I,J,N) = BadR4() VMAPN(I,J,N) = BadR4() DMAPN(I,J,N) = BadR4() end do end do end do if(iDo.gt.0) then ! Place these items from the base locations in order to save them in space and time do N=1,nT do J=1,nLat do I=1,nLng Vtmp(I,J,N,1) = VV3(I,J,1,N,1) Vtmp(I,J,N,2) = VV3(I,J,1,N,2) Vtmp(I,J,N,3) = VV3(I,J,1,N,3) Dtmp (I,J,N) = DD1(I,J,1,N) end do end do end do end if iPrint = 1 if(iPrint.eq.1) then print *, 'Average values at the beginning of the mkshiftdnma_pre subroutine.' do N=1,nT VVVV1 = 0.0 VVVV2 = 0.0 VVVV3 = 0.0 DDDD1 = 0.0 V1ANNNN = 0.0 V2ANNNN = 0.0 V3ANNNN = 0.0 DANNNN = 0.0 do J=1,nLat do I=1,nLng if(VMAP(I,J,N).eq.BadR4().or.VMAP(I,J,N).lt.0.001) then BDVVVV1 = BDVVVV1 + 1.0 else VVVV1 = VMAP(I,J,N) + VVVV1 V1ANNNN = V1ANNNN + 1.0 end if if(Vtmp(I,J,N,2).eq.BadR4()) then BDVVVV2 = BDVVVV2 + 1.0 else VVVV2 = Vtmp(I,J,N,2) + VVVV2 V2ANNNN = V2ANNNN + 1.0 end if if(Vtmp(I,J,N,3).eq.BadR4()) then BDVVVV3 = BDVVVV3 + 1.0 else VVVV3 = Vtmp(I,J,N,3) + VVVV3 V3ANNNN = V3ANNNN + 1.0 end if if(DMAP(I,J,N).eq.BadR4().or.DMAP(I,J,N).lt.0.001) then BDDDDD1 = BDDDDD1 + 1.0 else DDDD1 = DMAP(I,J,N) + DDDD1 DANNNN = DANNNN + 1.0 end if end do end do if(iPrint.eq.1) then if(V1ANNNN.ne.0.0) VVVV1 = VVVV1/V1ANNNN if(V2ANNNN.ne.0.0) VVVV2 = VVVV2/V2ANNNN if(V3ANNNN.ne.0.0) VVVV3 = VVVV3/V3ANNNN if(DANNNN.ne.0.0) DDDD1 = DDDD1/DANNNN C if(N.eq.1.or.N.eq.5.or.N.eq.10.or.N.eq.15.or.N.eq.20.or.N.eq.25.or.N.eq.30.or.N.eq.35.or.N.eq.40.or.N.eq.45) then if(N.le.nT) then write(*,'(A,I4,A,F10.4,3F10.6)') 'The ave. speed, den this',N,' map is',VVVV1,VVVV2,VVVV3,DDDD1*RR*RR end if C if(N.eq.1.or.N.eq.5.or.N.eq.10.or.N.eq.15.or.N.eq.20.or.N.eq.25.or.N.eq.30.or.N.eq.35.or.N.eq.40.or.N.eq.45) then C write(*,'(A,I4,A,F10.4,3F10.6)') 'Bad. speed, den this',N,' map is',BDVVVV1,BDVVVV2,BDVVVV3,BDDDDD1 C end if end if end do C if(iPrint.eq.1) write(*,'(A,8F9.3)') 'Bfstore ',VV3(30,5,1,22,1),Vtmp(30,5,22,1),VV3(30,5,1,22,2),Vtmp(30,5,22,2), C & VV3(30,5,1,22,3),Vtmp(30,5,22,3),DD1(30,5,1,22),Dtmp(30,5,22) end if iPrint = 0 if(iDo.eq.1.or.iDo.eq.2) then do I=1,nLng do J=1,nLat do N=1,nT Vtmp11(I,J,N) = VMAP(I,J,N) Vtmp22(I,J,N) = Vtmp(I,J,N,2) Vtmp33(I,J,N) = Vtmp(I,J,N,3) Dtmp11(I,J,N) = DMAP(I,J,N) VMAPN(I,J,N) = VMAP(I,J,N) DMAPN(I,J,N) = DMAP(I,J,N) end do end do end do call ArrR4SetMinMax(-nLngLatnt,Vtmp11,VLL,VUL) ! Constrain Vtmp11 to [VLL,VUL] (exclude bad values) call ArrR4SetMinMax(-nLngLatnt,Dtmp11,DLL,DUL) ! Constrain Dtmp11 to [DLL,DUL] (exclude bad values) do N=1,nT do I=1,nLng do J=1,nLat VV3(I,J,1,N,1) = Vtmp11(I,J,N) DD1(I,J,1,N) = Dtmp11(I,J,N) end do end do end do end if if(iDo.eq.10) then ! Place these items from the base locations in order to smooth them in space and time ! These items are smoothed only at the base of the traceback do I=1,nLng do J=1,nLat do N=1,nT Vtmp1(I,J,N) = VV3(I,J,1,N,1) Vtmp2(I,J,N) = VV3(I,J,1,N,2) Vtmp3(I,J,N) = VV3(I,J,1,N,3) Dtmp1(I,J,N) = DD1(I,J,1,N) end do end do end do call ArrR4SetMinMax(-nLngLatnt,Vtmp1,VLL,VUL) ! Constrain Vtmp to [VLL,VUL] (exclude bad values) do N=1,nT ! Timesmooth all base velocities and densities call arrR4getminmax(nLngLat,Vtmp1(1,1,N),amin,amax) if(amax.ne.BadR4()) then call GridSphere2D(ALng,nLng,nLat,1,Vtmp1(1,1,N),CLRV/2.0,3,0.0,0.0) ! All values, valid or invalid are smoothed end if call arrR4getminmax(nLngLat,Vtmp2(1,1,N),amin,amax) if(amax.ne.BadR4()) then call GridSphere2D(ALng,nLng,nLat,1,Vtmp2(1,1,N),CLRV/2.0,3,0.0,0.0) ! All values, valid or invalid are smoothed end if call arrR4getminmax(nLngLat,Vtmp3(1,1,N),amin,amax) if(amax.ne.BadR4()) then call GridSphere2D(ALng,nLng,nLat,1,Vtmp3(1,1,N),CLRV/2.0,3,0.0,0.0) ! All values, valid or invalid are smoothed end if call arrR4getminmax(nLngLat,Dtmp1(1,1,N),amin,amax) if(amax.ne.BadR4()) then call GridSphere2D(ALng,nLng,nLat,1,Dtmp1(1,1,N),CLRD/2.0,3,0.0,0.0) ! All values, valid or invalid are smoothed end if end do call Timesmooth(nLng,nLat,nT,Vtmp1, 1,0.5*CONDT/aNdayG,0.,Vtmp11) ! All values, valid or invalid are smoothed call Timesmooth(nLng,nLat,nT,Vtmp2, 1,0.5*CONDT/aNdayG,0.,Vtmp22) ! All values, valid or invalid are smoothed call Timesmooth(nLng,nLat,nT,Vtmp3, 1,0.5*CONDT/aNdayG,0.,Vtmp33) ! All values, valid or invalid are smoothed call Timesmooth(nLng,nLat,nT,Dtmp1, 1,0.5*CONDT/aNdayG,0.,Dtmp11) ! All values, valid or invalid are smoothed do N=1,nT do I=1,nLng do J=1,nLat VV3(I,J,1,N,1) = Vtmp11(I,J,N) VV3(I,J,1,N,2) = Vtmp22(I,J,N) VV3(I,J,1,N,3) = Vtmp33(I,J,N) DD1(I,J,1,N) = Dtmp11(I,J,N) end do end do end do if(iPrint.eq.1) write(*,'(A,8F9.3)') 'INstore1',VV3(30,5,1,22,1),Vtmp1(30,5,22),VV3(30,5,1,22,2),Vtmp2(30,5,22), & VV3(30,5,1,22,3),Vtmp3(30,5,22),DD1(30,5,1,22),Dtmp1(30,5,22) end if iPrint=1 if(iPrint.eq.1) write(*,'(A,8F9.3)') 'INstore2',VV3(30,5,1,22,1),Vtmp11(30,5,22),VV3(30,5,1,22,2),Vtmp22(30,5,22), & VV3(30,5,1,22,3),Vtmp33(30,5,22),DD1(30,5,1,22),Dtmp11(30,5,22) call MkShiftdnmam(iPrint,XCbe,XCtbeg,XCtend,ALng,nLng,nLat,nMap,nT,nTmax, & VV3,BB3,DD1,TT1,XCshift3,XCshiftM,Vratio3,Bratio3,Dratio1,Tratio1,RR,RRMS,dRR,dRRMS,KPF, & FALLOFFN,FALLOFFT,FALLOFFBR,FALLOFFBT,FALLOFFBN,CLRV,CLRD,VLL,VUL,VLLLL,VLLUL, & Vtmp,Dtmp,XLLTtmp) iPrint=0 if(iDo.gt.0) then C The following shifts over the current matrix and ratios for use in the UCSD tomography C print*, 'Transferring to UCSD shift system after MkShiftdnma' do N=1,nT do K=1, nMap do J=1,nLat do I=1,nLng C if(iDo.eq.2) then ! if set, this transfers only on the initial update when iDo=2 XCshift(I,J,K,N,1) = XCshift3(I,J,K,N,1) ! These would always be the same for each MHD iteration XCshift(I,J,K,N,2) = XCshift3(I,J,K,N,2) ! but are not because the base values are conditioned XCshift(I,J,K,N,3) = XCshift3(I,J,K,N,3) ! depending on iDo .gt. 1, or iDo = 10. C end if if(iDo.eq.2) then ! if set, this transfers only on the initial update when iDo=2 DVfact (I,J,K,N) = Vratio3 (I,J,K,N,1) ! Only Vratio3(I,J,K,N,1) is transferred for tomographic use. DDfact (I,J,K,N) = Dratio1 (I,J,K,N) ! Meant to only provide this on the beginning MHD iteration end if if(iPrint.eq.1) then if(NX.eq.1.and.J.eq.5.and.I.eq.30.and.N.eq.2.and.K.eq.10) & write(*,'(A,4I4,2F12.8)'), 'In xc3dtshift_rrms.f',I,J,L,NX,XCshift(I,J,K,L,NX),XCshift3(I,J,K,L,NX) if(NX.eq.3.and.J.eq.5.and.I.eq.30.and.N.eq.2.and.K.eq.10) & write(*,'(A,4I4,2F12.8)'), 'In xc3dtshift_rrms.f',I,J,L,NX,XCshift(I,J,K,L,NX),XCshift3(I,J,K,L,NX) end if end do end do end do end do do N=1,nT ! Place these base items back the way they were before do I=1,nLng do J=1,nLat VV3(I,J,1,N,1) = Vtmp(I,J,N,1) VV3(I,J,1,N,2) = Vtmp(I,J,N,2) VV3(I,J,1,N,3) = Vtmp(I,J,N,3) DD1(I,J,1,N) = Dtmp(I,J,N) end do end do end do do N=1,nTmax ! If iDo .eq. 1 place these base items back the way they were before. do I=1,nLng do J=1,nLat VMAP(I,J,N) = VMAPN(I,J,N) DMAP(I,J,N) = DMAPN(I,J,N) end do end do end do if(iPrint.eq.1) write(*,'(A,8F9.3)') 'Afstore ',VV3(30,5,1,22,1),Vtmp(30,5,22,1),VV3(30,5,1,22,2),Vtmp(30,5,22,2), & VV3(30,5,1,22,3),Vtmp(30,5,22,3),DD1(30,5,1,22),Dtmp(30,5,22) end if C*********************************************************************** iPrint = 1 if(iPrint.eq.1) then print *, ' ' print *, 'Average values at the end of the mkshiftdnma_pre subroutine.' do N=1,nT VVVV1 = 0.0 VVVV2 = 0.0 VVVV3 = 0.0 DDDD1 = 0.0 ANNNN = 0.0 do J=1,nLat do I=1,nLng VVVV1 = VMAP(I,J,N) + VVVV1 VVVV2 = Vtmp(I,J,N,2) + VVVV2 VVVV3 = Vtmp(I,J,N,3) + VVVV3 DDDD1 = DMAP(I,J,N) + DDDD1 ANNNN = ANNNN + 1.0 end do end do if(ANNNN.ne.0.0) then VVVV1 = VVVV1/ANNNN VVVV2 = VVVV2/ANNNN VVVV3 = VVVV3/ANNNN DDDD1 = DDDD1/ANNNN C if(N.eq.1.or.N.eq.5.or.N.eq.10.or.N.eq.15.or.N.eq.20.or.N.eq.25.or.N.eq.30.or.N.eq.35.or.N.eq.40.or.N.eq.41) then C write(*,'(A,I4,A,F10.4,3F9.5)') 'The ave. speed, den this',N,' map at k=1 is ',VVVV1,VVVV2,VVVV3,DDDD1*RR*RR C end if C if(N.eq.42.or.N.eq.43.or.N.eq.44.or.N.eq.45.or.N.eq.46.or.N.eq.47.or.N.eq.48) then if(N.le.nT) then write(*,'(A,I4,A,F10.4,3F9.5)') 'The ave. speed, den this',N,' map at k=1 is ',VVVV1,VVVV2,VVVV3,DDDD1*RR*RR end if end if C end if end do print *, ' ' do N=1,nT VVVV1 = 0.0 VVVV2 = 0.0 VVVV3 = 0.0 DDDD1 = 0.0 ANNNN = 0.0 do J=1,nLat do I=1,nLng VVVV1 = XCshift(I,J,10,N,1) + VVVV1 C VVVV2 = XCshift(I,J,10,N,2) + VVVV2 C VVVV3 = XCshift(I,J,10,N,3) + VVVV3 VVVV2 = XCshift(I,J,10,N,3) + VVVV2 C DDDD1 = DVfact (I,J,10,N) + DDDD1 VVVV3 = DVfact (I,J,10,N) + VVVV3 DDDD1 = DDfact (I,J,10,N) + DDDD1 ANNNN = ANNNN + 1.0 end do end do C if(iPrint.eq.1) then if(ANNNN.ne.0.0) then VVVV1 = VVVV1/ANNNN VVVV2 = VVVV2/ANNNN VVVV3 = VVVV3/ANNNN DDDD1 = DDDD1/ANNNN C if(N.eq.1.or.N.eq.5.or.N.eq.10.or.N.eq.15.or.N.eq.20.or.N.eq.25.or.N.eq.30.or.N.eq.35.or.N.eq.40.or.N.eq.41) then C write(*,'(A,I4,A,F10.4,3F9.5)') 'The ave. XCShi, DVf this',N,' map at K=10 is',VVVV1,VVVV2,VVVV3,DDDD1 C write(*,'(A,I4,A,F10.4,3F9.5)') 'The ave. XCShi, VDf this',N,' map at K=10 is',VVVV1,VVVV2,VVVV3,DDDD1 C end if C if(N.eq.42.or.N.eq.43.or.N.eq.44.or.N.eq.45.or.N.eq.46.or.N.eq.47.or.N.eq.48) then C write(*,'(A,I4,A,F10.4,3F9.5)') 'The ave. XCShi, DVf this',N,' map at K=10 is',VVVV1,VVVV2,VVVV3,DDDD1 if(N.le.nT) then write(*,'(A,I4,A,F10.4,3F9.5)') 'The ave. XCShi, VDf this',N,' map at K=10 is',VVVV1,VVVV2,VVVV3,DDDD1 end if end if C end if end do print *, ' ' iprint = 0 end if C*********************************************************************** if(bSmooth) then ! If smooth is yes, smooth the DDfact values in space and time. DLLL = 0.0 DULL = 3.0 do K=1, nMap do I=1,nLng do J=1,nLat do N=1,nT DDfactmp (I,J,N,K) = BadR4() Dtmp1(I,J,N) = DDfact (I,J,K,N) end do end do end do call ArrR4SetMinMax(-nLngLatnt,Dtmp1,DLLL,DULL) ! Constrain Dtmp1 to [DLLL,DULL] (exclude bad values) do N=1,nT ! Timesmooth all base velocities and densities call arrR4getminmax(nLngLat,Dtmp1(1,1,N),amin,amax) write(*,'(A,I3,A,I3,A,2F10.5)') 'The min, max DDfacts this N =',N,' and K =',K,' are',amin,amax if(amax.ne.BadR4()) then call GridSphere2D(ALng,nLng,nLat,1,Dtmp1(1,1,N),CLRD/2.0,3,0.0,0.0) ! All values, valid or invalid are smoothed else print *, 'All DDfacts are bad at this nMap level: stop!' stop end if end do call Timesmooth(nLng,nLat,nT,Dtmp1, 1,0.5*CONDT/aNdayG,0.,DDfactmp(1,1,1,K)) ! All values, valid or invalid are smoothed end do print *,' ' do K=1, nMap do N=1,nT call arrR4getminmax(nLngLat,DDfactmp(1,1,N,K),amin,amax) write(*,'(A,I3,A,I3,A,2F10.5)') 'The min, max DDfactmps this N =',N,' and K =',K,' are',amin,amax do I=1,nLng do J=1,nLat DDfact(I,J,K,N) = DDfactmp(I,J,N,K) end do end do end do end do end if return end