From f604d7c992bc5f9048a383ebd84c465e6beffe8b Mon Sep 17 00:00:00 2001 From: Daniel Peter Date: Fri, 17 May 2024 22:31:59 +0200 Subject: [PATCH] adding some more explicit type conversions --- src/meshfem3D/model_EMC.f90 | 26 +-- src/meshfem3D/save_model_meshfiles_adios.F90 | 4 +- .../write_AVS_DX_global_chunks_data.f90 | 111 +++++++----- .../write_AVS_DX_global_chunks_data_adios.f90 | 161 ++++++++---------- 4 files changed, 151 insertions(+), 151 deletions(-) diff --git a/src/meshfem3D/model_EMC.f90 b/src/meshfem3D/model_EMC.f90 index b922b2a6b..11edd79ee 100644 --- a/src/meshfem3D/model_EMC.f90 +++ b/src/meshfem3D/model_EMC.f90 @@ -797,7 +797,7 @@ subroutine scale_Brocher_rho_from_vp() rho = fac1 * vp + fac2 * vp_p2 + fac3 * vp_p3 + fac4 * vp_p4 + fac5 * vp_p5 ! Density - EMC_rho(ix,iy,iz) = rho + EMC_rho(ix,iy,iz) = real(rho,kind=CUSTOM_REAL) enddo enddo enddo @@ -861,7 +861,7 @@ subroutine scale_Brocher_vs_from_vp() vs = fac1 + fac2 * vp + fac3 * vp_p2 + fac4 * vp_p3 + fac5 * vp_p4 ! Density - EMC_vs(ix,iy,iz) = vs + EMC_vs(ix,iy,iz) = real(vs,kind=CUSTOM_REAL) enddo enddo enddo @@ -872,7 +872,7 @@ subroutine scale_Brocher_vs_from_vp() ! unit scaling to convert to same unit as vp if (EMC_vp_unit == 3) then ! use same unit as vp km/s -> m/s - EMC_vs = EMC_vs * 1000.d0 + EMC_vs = EMC_vs * 1000.0_CUSTOM_REAL EMC_vs_unit = 3 endif @@ -932,7 +932,7 @@ subroutine scale_Brocher_vp_from_vs() vp = fac1 + fac2 * vs + fac3 * vs_p2 + fac4 * vs_p3 + fac5 * vs_p4 ! Vp - EMC_vp(ix,iy,iz) = vp + EMC_vp(ix,iy,iz) = real(vp,kind=CUSTOM_REAL) enddo enddo enddo @@ -943,7 +943,7 @@ subroutine scale_Brocher_vp_from_vs() ! unit scaling to convert to same unit as vs if (EMC_vs_unit == 3) then ! use same unit as vp km/s -> m/s - EMC_vp = EMC_vp * 1000.d0 + EMC_vp = EMC_vp * 1000.0_CUSTOM_REAL EMC_vp_unit = 3 endif @@ -1674,9 +1674,9 @@ subroutine fill_EMC_missing_values_interpolated() end select ! stores interpolated value - EMC_vp(ilon,ilat,idep) = vp_interp - EMC_vs(ilon,ilat,idep) = vs_interp - EMC_rho(ilon,ilat,idep) = rho_interp + EMC_vp(ilon,ilat,idep) = real(vp_interp,kind=CUSTOM_REAL) + EMC_vs(ilon,ilat,idep) = real(vs_interp,kind=CUSTOM_REAL) + EMC_rho(ilon,ilat,idep) = real(rho_interp,kind=CUSTOM_REAL) ! update mask flag tmp_mask(ilon,ilat,idep) = .false. @@ -2553,7 +2553,7 @@ subroutine read_emc_model() ! units: 1==m, 2==km, 3==m/s, 4==km/s, 5==g/cm^3, 6==kg/cm^3, 7==kg/m^3 if (EMC_dep_unit == 1) then ! converts to km - EMC_dep(:) = EMC_dep(:) / 1000.d0 + EMC_dep(:) = EMC_dep(:) / 1000.0_CUSTOM_REAL EMC_dep_unit = 2 ! in km endif ! converts depth reference direction to positive being down (positive depth below sealevel, negative depth above) @@ -3030,23 +3030,23 @@ subroutine read_emc_model() if (EMC_rho_unit == 5) then ! converts to kg/m^3 ! rho [kg/m^3] = rho * 1000 [g/cm^3] - EMC_rho(:,:,:) = EMC_rho(:,:,:) * 1000.d0 + EMC_rho(:,:,:) = EMC_rho(:,:,:) * 1000.0_CUSTOM_REAL EMC_rho_unit = 7 ! kg/m^3 else if (EMC_rho_unit == 6) then ! converts to kg/m^3 ! rho [kg/m^3] = rho * 1000000 [kg/cm^3] - EMC_rho(:,:,:) = EMC_rho(:,:,:) * 1.d6 + EMC_rho(:,:,:) = EMC_rho(:,:,:) * 1.e6_CUSTOM_REAL EMC_rho_unit = 7 ! kg/m^3 endif ! converts velocity to default m/s if (EMC_vp_unit == 4) then ! converts to m/s - EMC_vp(:,:,:) = EMC_vp(:,:,:) * 1000.d0 + EMC_vp(:,:,:) = EMC_vp(:,:,:) * 1000.0_CUSTOM_REAL EMC_vp_unit = 3 endif if (EMC_vs_unit == 4) then ! converts to m/s - EMC_vs(:,:,:) = EMC_vs(:,:,:) * 1000.d0 + EMC_vs(:,:,:) = EMC_vs(:,:,:) * 1000.0_CUSTOM_REAL EMC_vs_unit = 3 endif diff --git a/src/meshfem3D/save_model_meshfiles_adios.F90 b/src/meshfem3D/save_model_meshfiles_adios.F90 index 48941ca44..258f2438c 100644 --- a/src/meshfem3D/save_model_meshfiles_adios.F90 +++ b/src/meshfem3D/save_model_meshfiles_adios.F90 @@ -299,8 +299,8 @@ subroutine save_model_meshfiles_adios() ! anisotropic values if (ANISOTROPIC_3D_MANTLE .and. iregion_code == IREGION_CRUST_MANTLE) then ! the scale of GPa--[g/cm^3][(km/s)^2] - scaleval = dsqrt(PI*GRAV*RHOAV) - scale_GPa = (RHOAV/1000.d0)*((R_PLANET*scaleval/1000.d0)**2) + scaleval = real(sqrt(PI*GRAV*RHOAV),kind=CUSTOM_REAL) + scale_GPa = real((RHOAV/1000.d0)*((R_PLANET*scaleval/1000.d0)**2),kind=CUSTOM_REAL) allocate(temp_store_mu0(NGLLX,NGLLY,NGLLZ,nspec),stat=ier) if (ier /= 0) stop 'Error allocating temp mu0 array' diff --git a/src/meshfem3D/write_AVS_DX_global_chunks_data.f90 b/src/meshfem3D/write_AVS_DX_global_chunks_data.f90 index 2df4f137d..ada7e7a6b 100644 --- a/src/meshfem3D/write_AVS_DX_global_chunks_data.f90 +++ b/src/meshfem3D/write_AVS_DX_global_chunks_data.f90 @@ -179,8 +179,9 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & numpoin = numpoin + 1 num_ibool_AVS_DX(iglobval(1)) = numpoin write(10,*) numpoin,sngl(xstore(1,1,1,ispec)), & - sngl(ystore(1,1,1,ispec)),sngl(zstore(1,1,1,ispec)) - vmax = sqrt((kappavstore(1,1,1,ispec)+4.*muvstore(1,1,1,ispec)/3.)/rhostore(1,1,1,ispec)) + sngl(ystore(1,1,1,ispec)),sngl(zstore(1,1,1,ispec)) + vmax = sqrt((kappavstore(1,1,1,ispec) & + +4.*muvstore(1,1,1,ispec)/3.)/rhostore(1,1,1,ispec)) vmin = sqrt(muvstore(1,1,1,ispec)/rhostore(1,1,1,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then @@ -189,7 +190,7 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & vmax = real(vp,kind=CUSTOM_REAL) vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax write(11,*) numpoin,vmin,vmax endif @@ -197,8 +198,9 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & numpoin = numpoin + 1 num_ibool_AVS_DX(iglobval(4)) = numpoin write(10,*) numpoin,sngl(xstore(1,NGLLY,1,ispec)), & - sngl(ystore(1,NGLLY,1,ispec)),sngl(zstore(1,NGLLY,1,ispec)) - vmax = sqrt((kappavstore(1,NGLLY,1,ispec)+4.*muvstore(1,NGLLY,1,ispec)/3.)/rhostore(1,NGLLY,1,ispec)) + sngl(ystore(1,NGLLY,1,ispec)),sngl(zstore(1,NGLLY,1,ispec)) + vmax = sqrt((kappavstore(1,NGLLY,1,ispec) & + +4.*muvstore(1,NGLLY,1,ispec)/3.)/rhostore(1,NGLLY,1,ispec)) vmin = sqrt(muvstore(1,NGLLY,1,ispec)/rhostore(1,NGLLY,1,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then @@ -207,7 +209,7 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & vmax = real(vp,kind=CUSTOM_REAL) vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax write(11,*) numpoin,vmin,vmax endif @@ -215,8 +217,9 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & numpoin = numpoin + 1 num_ibool_AVS_DX(iglobval(8)) = numpoin write(10,*) numpoin,sngl(xstore(1,NGLLY,NGLLZ,ispec)), & - sngl(ystore(1,NGLLY,NGLLZ,ispec)),sngl(zstore(1,NGLLY,NGLLZ,ispec)) - vmax = sqrt((kappavstore(1,NGLLY,NGLLZ,ispec)+4.*muvstore(1,NGLLY,NGLLZ,ispec)/3.)/rhostore(1,NGLLY,NGLLZ,ispec)) + sngl(ystore(1,NGLLY,NGLLZ,ispec)),sngl(zstore(1,NGLLY,NGLLZ,ispec)) + vmax = sqrt((kappavstore(1,NGLLY,NGLLZ,ispec) & + +4.*muvstore(1,NGLLY,NGLLZ,ispec)/3.)/rhostore(1,NGLLY,NGLLZ,ispec)) vmin = sqrt(muvstore(1,NGLLY,NGLLZ,ispec)/rhostore(1,NGLLY,NGLLZ,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then @@ -225,7 +228,7 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & vmax = real(vp,kind=CUSTOM_REAL) vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax write(11,*) numpoin,vmin,vmax endif @@ -233,8 +236,9 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & numpoin = numpoin + 1 num_ibool_AVS_DX(iglobval(5)) = numpoin write(10,*) numpoin,sngl(xstore(1,1,NGLLZ,ispec)), & - sngl(ystore(1,1,NGLLZ,ispec)),sngl(zstore(1,1,NGLLZ,ispec)) - vmax = sqrt((kappavstore(1,1,NGLLZ,ispec)+4.*muvstore(1,1,NGLLZ,ispec)/3.)/rhostore(1,1,NGLLZ,ispec)) + sngl(ystore(1,1,NGLLZ,ispec)),sngl(zstore(1,1,NGLLZ,ispec)) + vmax = sqrt((kappavstore(1,1,NGLLZ,ispec) & + +4.*muvstore(1,1,NGLLZ,ispec)/3.)/rhostore(1,1,NGLLZ,ispec)) vmin = sqrt(muvstore(1,1,NGLLZ,ispec)/rhostore(1,1,NGLLZ,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then @@ -243,7 +247,7 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & vmax = real(vp,kind=CUSTOM_REAL) vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax write(11,*) numpoin,vmin,vmax endif @@ -260,8 +264,9 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & numpoin = numpoin + 1 num_ibool_AVS_DX(iglobval(2)) = numpoin write(10,*) numpoin,sngl(xstore(NGLLX,1,1,ispec)), & - sngl(ystore(NGLLX,1,1,ispec)),sngl(zstore(NGLLX,1,1,ispec)) - vmax = sqrt((kappavstore(NGLLX,1,1,ispec)+4.*muvstore(NGLLX,1,1,ispec)/3.)/rhostore(NGLLX,1,1,ispec)) + sngl(ystore(NGLLX,1,1,ispec)),sngl(zstore(NGLLX,1,1,ispec)) + vmax = sqrt((kappavstore(NGLLX,1,1,ispec) & + +4.*muvstore(NGLLX,1,1,ispec)/3.)/rhostore(NGLLX,1,1,ispec)) vmin = sqrt(muvstore(NGLLX,1,1,ispec)/rhostore(NGLLX,1,1,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then @@ -270,7 +275,7 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & vmax = real(vp,kind=CUSTOM_REAL) vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax write(11,*) numpoin,vmin,vmax endif @@ -278,8 +283,9 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & numpoin = numpoin + 1 num_ibool_AVS_DX(iglobval(3)) = numpoin write(10,*) numpoin,sngl(xstore(NGLLX,NGLLY,1,ispec)), & - sngl(ystore(NGLLX,NGLLY,1,ispec)),sngl(zstore(NGLLX,NGLLY,1,ispec)) - vmax = sqrt((kappavstore(NGLLX,NGLLY,1,ispec)+4.*muvstore(NGLLX,NGLLY,1,ispec)/3.)/rhostore(NGLLX,NGLLY,1,ispec)) + sngl(ystore(NGLLX,NGLLY,1,ispec)),sngl(zstore(NGLLX,NGLLY,1,ispec)) + vmax = sqrt((kappavstore(NGLLX,NGLLY,1,ispec) & + +4.*muvstore(NGLLX,NGLLY,1,ispec)/3.)/rhostore(NGLLX,NGLLY,1,ispec)) vmin = sqrt(muvstore(NGLLX,NGLLY,1,ispec)/rhostore(NGLLX,NGLLY,1,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then @@ -288,7 +294,7 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & vmax = real(vp,kind=CUSTOM_REAL) vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax write(11,*) numpoin,vmin,vmax endif @@ -296,8 +302,9 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & numpoin = numpoin + 1 num_ibool_AVS_DX(iglobval(7)) = numpoin write(10,*) numpoin,sngl(xstore(NGLLX,NGLLY,NGLLZ,ispec)), & - sngl(ystore(NGLLX,NGLLY,NGLLZ,ispec)),sngl(zstore(NGLLX,NGLLY,NGLLZ,ispec)) - vmax = sqrt((kappavstore(NGLLX,NGLLY,NGLLZ,ispec)+4.*muvstore(NGLLX,NGLLY,NGLLZ,ispec)/3.)/rhostore(NGLLX,NGLLY,NGLLZ,ispec)) + sngl(ystore(NGLLX,NGLLY,NGLLZ,ispec)),sngl(zstore(NGLLX,NGLLY,NGLLZ,ispec)) + vmax = sqrt((kappavstore(NGLLX,NGLLY,NGLLZ,ispec) & + +4.*muvstore(NGLLX,NGLLY,NGLLZ,ispec)/3.)/rhostore(NGLLX,NGLLY,NGLLZ,ispec)) vmin = sqrt(muvstore(NGLLX,NGLLY,NGLLZ,ispec)/rhostore(NGLLX,NGLLY,NGLLZ,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then @@ -306,7 +313,7 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & vmax = real(vp,kind=CUSTOM_REAL) vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax write(11,*) numpoin,vmin,vmax endif @@ -314,8 +321,9 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & numpoin = numpoin + 1 num_ibool_AVS_DX(iglobval(6)) = numpoin write(10,*) numpoin,sngl(xstore(NGLLX,1,NGLLZ,ispec)), & - sngl(ystore(NGLLX,1,NGLLZ,ispec)),sngl(zstore(NGLLX,1,NGLLZ,ispec)) - vmax = sqrt((kappavstore(NGLLX,1,NGLLZ,ispec)+4.*muvstore(NGLLX,1,NGLLZ,ispec)/3.)/rhostore(NGLLX,1,NGLLZ,ispec)) + sngl(ystore(NGLLX,1,NGLLZ,ispec)),sngl(zstore(NGLLX,1,NGLLZ,ispec)) + vmax = sqrt((kappavstore(NGLLX,1,NGLLZ,ispec) & + +4.*muvstore(NGLLX,1,NGLLZ,ispec)/3.)/rhostore(NGLLX,1,NGLLZ,ispec)) vmin = sqrt(muvstore(NGLLX,1,NGLLZ,ispec)/rhostore(NGLLX,1,NGLLZ,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then @@ -324,7 +332,7 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & vmax = real(vp,kind=CUSTOM_REAL) vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax write(11,*) numpoin,vmin,vmax endif @@ -341,8 +349,9 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & numpoin = numpoin + 1 num_ibool_AVS_DX(iglobval(1)) = numpoin write(10,*) numpoin,sngl(xstore(1,1,1,ispec)), & - sngl(ystore(1,1,1,ispec)),sngl(zstore(1,1,1,ispec)) - vmax = sqrt((kappavstore(1,1,1,ispec)+4.*muvstore(1,1,1,ispec)/3.)/rhostore(1,1,1,ispec)) + sngl(ystore(1,1,1,ispec)),sngl(zstore(1,1,1,ispec)) + vmax = sqrt((kappavstore(1,1,1,ispec) & + +4.*muvstore(1,1,1,ispec)/3.)/rhostore(1,1,1,ispec)) vmin = sqrt(muvstore(1,1,1,ispec)/rhostore(1,1,1,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then @@ -351,7 +360,7 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & vmax = real(vp,kind=CUSTOM_REAL) vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax write(11,*) numpoin,vmin,vmax endif @@ -359,8 +368,9 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & numpoin = numpoin + 1 num_ibool_AVS_DX(iglobval(2)) = numpoin write(10,*) numpoin,sngl(xstore(NGLLX,1,1,ispec)), & - sngl(ystore(NGLLX,1,1,ispec)),sngl(zstore(NGLLX,1,1,ispec)) - vmax = sqrt((kappavstore(NGLLX,1,1,ispec)+4.*muvstore(NGLLX,1,1,ispec)/3.)/rhostore(NGLLX,1,1,ispec)) + sngl(ystore(NGLLX,1,1,ispec)),sngl(zstore(NGLLX,1,1,ispec)) + vmax = sqrt((kappavstore(NGLLX,1,1,ispec) & + +4.*muvstore(NGLLX,1,1,ispec)/3.)/rhostore(NGLLX,1,1,ispec)) vmin = sqrt(muvstore(NGLLX,1,1,ispec)/rhostore(NGLLX,1,1,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then @@ -369,7 +379,7 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & vmax = real(vp,kind=CUSTOM_REAL) vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax write(11,*) numpoin,vmin,vmax endif @@ -377,8 +387,9 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & numpoin = numpoin + 1 num_ibool_AVS_DX(iglobval(6)) = numpoin write(10,*) numpoin,sngl(xstore(NGLLX,1,NGLLZ,ispec)), & - sngl(ystore(NGLLX,1,NGLLZ,ispec)),sngl(zstore(NGLLX,1,NGLLZ,ispec)) - vmax = sqrt((kappavstore(NGLLX,1,NGLLZ,ispec)+4.*muvstore(NGLLX,1,NGLLZ,ispec)/3.)/rhostore(NGLLX,1,NGLLZ,ispec)) + sngl(ystore(NGLLX,1,NGLLZ,ispec)),sngl(zstore(NGLLX,1,NGLLZ,ispec)) + vmax = sqrt((kappavstore(NGLLX,1,NGLLZ,ispec) & + +4.*muvstore(NGLLX,1,NGLLZ,ispec)/3.)/rhostore(NGLLX,1,NGLLZ,ispec)) vmin = sqrt(muvstore(NGLLX,1,NGLLZ,ispec)/rhostore(NGLLX,1,NGLLZ,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then @@ -387,7 +398,7 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & vmax = real(vp,kind=CUSTOM_REAL) vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax write(11,*) numpoin,vmin,vmax endif @@ -395,8 +406,9 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & numpoin = numpoin + 1 num_ibool_AVS_DX(iglobval(5)) = numpoin write(10,*) numpoin,sngl(xstore(1,1,NGLLZ,ispec)), & - sngl(ystore(1,1,NGLLZ,ispec)),sngl(zstore(1,1,NGLLZ,ispec)) - vmax = sqrt((kappavstore(1,1,NGLLZ,ispec)+4.*muvstore(1,1,NGLLZ,ispec)/3.)/rhostore(1,1,NGLLZ,ispec)) + sngl(ystore(1,1,NGLLZ,ispec)),sngl(zstore(1,1,NGLLZ,ispec)) + vmax = sqrt((kappavstore(1,1,NGLLZ,ispec) & + +4.*muvstore(1,1,NGLLZ,ispec)/3.)/rhostore(1,1,NGLLZ,ispec)) vmin = sqrt(muvstore(1,1,NGLLZ,ispec)/rhostore(1,1,NGLLZ,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then @@ -405,7 +417,7 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & vmax = real(vp,kind=CUSTOM_REAL) vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax write(11,*) numpoin,vmin,vmax endif @@ -423,7 +435,8 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & num_ibool_AVS_DX(iglobval(4)) = numpoin write(10,*) numpoin,sngl(xstore(1,NGLLY,1,ispec)), & sngl(ystore(1,NGLLY,1,ispec)),sngl(zstore(1,NGLLY,1,ispec)) - vmax = sqrt((kappavstore(1,NGLLY,1,ispec)+4.*muvstore(1,NGLLY,1,ispec)/3.)/rhostore(1,NGLLY,1,ispec)) + vmax = sqrt((kappavstore(1,NGLLY,1,ispec) & + +4.*muvstore(1,NGLLY,1,ispec)/3.)/rhostore(1,NGLLY,1,ispec)) vmin = sqrt(muvstore(1,NGLLY,1,ispec)/rhostore(1,NGLLY,1,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then @@ -432,7 +445,7 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & vmax = real(vp,kind=CUSTOM_REAL) vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax write(11,*) numpoin,vmin,vmax endif @@ -440,8 +453,9 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & numpoin = numpoin + 1 num_ibool_AVS_DX(iglobval(3)) = numpoin write(10,*) numpoin,sngl(xstore(NGLLX,NGLLY,1,ispec)), & - sngl(ystore(NGLLX,NGLLY,1,ispec)),sngl(zstore(NGLLX,NGLLY,1,ispec)) - vmax = sqrt((kappavstore(NGLLX,NGLLY,1,ispec)+4.*muvstore(NGLLX,NGLLY,1,ispec)/3.)/rhostore(NGLLX,NGLLY,1,ispec)) + sngl(ystore(NGLLX,NGLLY,1,ispec)),sngl(zstore(NGLLX,NGLLY,1,ispec)) + vmax = sqrt((kappavstore(NGLLX,NGLLY,1,ispec) & + +4.*muvstore(NGLLX,NGLLY,1,ispec)/3.)/rhostore(NGLLX,NGLLY,1,ispec)) vmin = sqrt(muvstore(NGLLX,NGLLY,1,ispec)/rhostore(NGLLX,NGLLY,1,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then @@ -450,7 +464,7 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & vmax = real(vp,kind=CUSTOM_REAL) vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax write(11,*) numpoin,vmin,vmax endif @@ -458,8 +472,9 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & numpoin = numpoin + 1 num_ibool_AVS_DX(iglobval(7)) = numpoin write(10,*) numpoin,sngl(xstore(NGLLX,NGLLY,NGLLZ,ispec)), & - sngl(ystore(NGLLX,NGLLY,NGLLZ,ispec)),sngl(zstore(NGLLX,NGLLY,NGLLZ,ispec)) - vmax = sqrt((kappavstore(NGLLX,NGLLY,NGLLZ,ispec)+4.*muvstore(NGLLX,NGLLY,NGLLZ,ispec)/3.)/rhostore(NGLLX,NGLLY,NGLLZ,ispec)) + sngl(ystore(NGLLX,NGLLY,NGLLZ,ispec)),sngl(zstore(NGLLX,NGLLY,NGLLZ,ispec)) + vmax = sqrt((kappavstore(NGLLX,NGLLY,NGLLZ,ispec) & + +4.*muvstore(NGLLX,NGLLY,NGLLZ,ispec)/3.)/rhostore(NGLLX,NGLLY,NGLLZ,ispec)) vmin = sqrt(muvstore(NGLLX,NGLLY,NGLLZ,ispec)/rhostore(NGLLX,NGLLY,NGLLZ,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then @@ -468,7 +483,7 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & vmax = real(vp,kind=CUSTOM_REAL) vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax write(11,*) numpoin,vmin,vmax endif @@ -477,7 +492,8 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & num_ibool_AVS_DX(iglobval(8)) = numpoin write(10,*) numpoin,sngl(xstore(1,NGLLY,NGLLZ,ispec)), & sngl(ystore(1,NGLLY,NGLLZ,ispec)),sngl(zstore(1,NGLLY,NGLLZ,ispec)) - vmax = sqrt((kappavstore(1,NGLLY,NGLLZ,ispec)+4.*muvstore(1,NGLLY,NGLLZ,ispec)/3.)/rhostore(1,NGLLY,NGLLZ,ispec)) + vmax = sqrt((kappavstore(1,NGLLY,NGLLZ,ispec) & + +4.*muvstore(1,NGLLY,NGLLZ,ispec)/3.)/rhostore(1,NGLLY,NGLLZ,ispec)) vmin = sqrt(muvstore(1,NGLLY,NGLLZ,ispec)/rhostore(1,NGLLY,NGLLZ,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then @@ -486,7 +502,7 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & vmax = real(vp,kind=CUSTOM_REAL) vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax write(11,*) numpoin,vmin,vmax endif @@ -582,7 +598,8 @@ subroutine write_AVS_DX_global_chunks_data(prname,nspec,iboun,ibool, & print *,' attention: vs close to zero',sngl(vs),r,i,j,k,ispec dvs = 0.0 else - dvp = dvp + (sqrt((kappavstore(i,j,k,ispec)+4.*muvstore(i,j,k,ispec)/3.)/rhostore(i,j,k,ispec)) - sngl(vp))/sngl(vp) + dvp = dvp + (sqrt((kappavstore(i,j,k,ispec) & + +4.*muvstore(i,j,k,ispec)/3.)/rhostore(i,j,k,ispec)) - sngl(vp))/sngl(vp) dvs = dvs + (sqrt(muvstore(i,j,k,ispec)/rhostore(i,j,k,ispec)) - sngl(vs))/sngl(vs) endif diff --git a/src/meshfem3D/write_AVS_DX_global_chunks_data_adios.f90 b/src/meshfem3D/write_AVS_DX_global_chunks_data_adios.f90 index 5805483d5..0a41495d6 100644 --- a/src/meshfem3D/write_AVS_DX_global_chunks_data_adios.f90 +++ b/src/meshfem3D/write_AVS_DX_global_chunks_data_adios.f90 @@ -395,17 +395,17 @@ subroutine prepare_AVS_DX_global_chunks_data_adios(prname,nspec, & avs_dx_adios%z_adios(numpoin) = sngl(zstore(1,1,1,ispec)) vmax = sqrt((kappavstore(1,1,1,ispec) & - + 4.*muvstore(1,1,1,ispec)/3.)/rhostore(1,1,1,ispec)) + + 4.*muvstore(1,1,1,ispec)/3.)/rhostore(1,1,1,ispec)) vmin = sqrt(muvstore(1,1,1,ispec)/rhostore(1,1,1,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then r = dsqrt(xstore(1,1,1,ispec)**2 + ystore(1,1,1,ispec)**2 & + zstore(1,1,1,ispec)**2) call prem_display_outer_core(r,rho,vp,vs,Qkappa,Qmu,idoubling(ispec)) - vmax = vp - vmin = vp + vmax = real(vp,kind=CUSTOM_REAL) + vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax avs_dx_adios%vmin(numpoin) = vmin avs_dx_adios%vmax(numpoin) = vmax endif @@ -418,17 +418,17 @@ subroutine prepare_AVS_DX_global_chunks_data_adios(prname,nspec, & avs_dx_adios%z_adios(numpoin) = sngl(zstore(1,NGLLY,1,ispec)) vmax = sqrt((kappavstore(1,NGLLY,1,ispec) & - +4.*muvstore(1,NGLLY,1,ispec)/3.)/rhostore(1,NGLLY,1,ispec)) + +4.*muvstore(1,NGLLY,1,ispec)/3.)/rhostore(1,NGLLY,1,ispec)) vmin = sqrt(muvstore(1,NGLLY,1,ispec)/rhostore(1,NGLLY,1,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then r = dsqrt(xstore(1,NGLLY,1,ispec)**2 + ystore(1,NGLLY,1,ispec)**2 & + zstore(1,NGLLY,1,ispec)**2) call prem_display_outer_core(r,rho,vp,vs,Qkappa,Qmu,idoubling(ispec)) - vmax = vp - vmin = vp + vmax = real(vp,kind=CUSTOM_REAL) + vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax avs_dx_adios%vmin(numpoin) = vmin avs_dx_adios%vmax(numpoin) = vmax endif @@ -441,20 +441,18 @@ subroutine prepare_AVS_DX_global_chunks_data_adios(prname,nspec, & avs_dx_adios%z_adios(numpoin) = sngl(zstore(1,NGLLY,NGLLZ,ispec)) vmax = sqrt((kappavstore(1,NGLLY,NGLLZ,ispec) & - +4.*muvstore(1,NGLLY,NGLLZ,ispec)/3.) & - / rhostore(1,NGLLY,NGLLZ,ispec)) - vmin = sqrt(muvstore(1,NGLLY,NGLLZ,ispec) & - / rhostore(1,NGLLY,NGLLZ,ispec)) + +4.*muvstore(1,NGLLY,NGLLZ,ispec)/3.) / rhostore(1,NGLLY,NGLLZ,ispec)) + vmin = sqrt(muvstore(1,NGLLY,NGLLZ,ispec) / rhostore(1,NGLLY,NGLLZ,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then r = dsqrt(xstore(1,NGLLY,NGLLZ,ispec)**2 & + ystore(1,NGLLY,NGLLZ,ispec)**2 & + zstore(1,NGLLY,NGLLZ,ispec)**2) call prem_display_outer_core(r,rho,vp,vs,Qkappa,Qmu,idoubling(ispec)) - vmax = vp - vmin = vp + vmax = real(vp,kind=CUSTOM_REAL) + vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax avs_dx_adios%vmin(numpoin) = vmin avs_dx_adios%vmax(numpoin) = vmax @@ -468,17 +466,17 @@ subroutine prepare_AVS_DX_global_chunks_data_adios(prname,nspec, & avs_dx_adios%z_adios(numpoin) = sngl(zstore(1,1,NGLLZ,ispec)) vmax = sqrt((kappavstore(1,1,NGLLZ,ispec) & - +4.*muvstore(1,1,NGLLZ,ispec)/3.)/rhostore(1,1,NGLLZ,ispec)) + +4.*muvstore(1,1,NGLLZ,ispec)/3.)/rhostore(1,1,NGLLZ,ispec)) vmin = sqrt(muvstore(1,1,NGLLZ,ispec)/rhostore(1,1,NGLLZ,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then r = dsqrt(xstore(1,1,NGLLZ,ispec)**2 + ystore(1,1,NGLLZ,ispec)**2 & + zstore(1,1,NGLLZ,ispec)**2) call prem_display_outer_core(r,rho,vp,vs,Qkappa,Qmu,idoubling(ispec)) - vmax = vp - vmin = vp + vmax = real(vp,kind=CUSTOM_REAL) + vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax avs_dx_adios%vmin(numpoin) = vmin avs_dx_adios%vmax(numpoin) = vmax endif @@ -500,17 +498,17 @@ subroutine prepare_AVS_DX_global_chunks_data_adios(prname,nspec, & avs_dx_adios%z_adios(numpoin) = sngl(zstore(NGLLX,1,1,ispec)) vmax = sqrt((kappavstore(NGLLX,1,1,ispec) & - +4.*muvstore(NGLLX,1,1,ispec)/3.)/rhostore(NGLLX,1,1,ispec)) + +4.*muvstore(NGLLX,1,1,ispec)/3.)/rhostore(NGLLX,1,1,ispec)) vmin = sqrt(muvstore(NGLLX,1,1,ispec)/rhostore(NGLLX,1,1,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then r = dsqrt(xstore(NGLLX,1,1,ispec)**2 + ystore(NGLLX,1,1,ispec)**2 & + zstore(NGLLX,1,1,ispec)**2) call prem_display_outer_core(r,rho,vp,vs,Qkappa,Qmu,idoubling(ispec)) - vmax = vp - vmin = vp + vmax = real(vp,kind=CUSTOM_REAL) + vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax avs_dx_adios%vmin(numpoin) = vmin avs_dx_adios%vmax(numpoin) = vmax endif @@ -523,20 +521,18 @@ subroutine prepare_AVS_DX_global_chunks_data_adios(prname,nspec, & avs_dx_adios%z_adios(numpoin) = sngl(zstore(NGLLX,NGLLY,1,ispec)) vmax = sqrt((kappavstore(NGLLX,NGLLY,1,ispec) & - + 4.*muvstore(NGLLX,NGLLY,1,ispec)/3.) & - / rhostore(NGLLX,NGLLY,1,ispec)) - vmin = sqrt(muvstore(NGLLX,NGLLY,1,ispec) & - / rhostore(NGLLX,NGLLY,1,ispec)) + + 4.*muvstore(NGLLX,NGLLY,1,ispec)/3.) / rhostore(NGLLX,NGLLY,1,ispec)) + vmin = sqrt(muvstore(NGLLX,NGLLY,1,ispec) / rhostore(NGLLX,NGLLY,1,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then r = dsqrt(xstore(NGLLX,NGLLY,1,ispec)**2 & + ystore(NGLLX,NGLLY,1,ispec)**2 & + zstore(NGLLX,NGLLY,1,ispec)**2) call prem_display_outer_core(r,rho,vp,vs,Qkappa,Qmu,idoubling(ispec)) - vmax = vp - vmin = vp + vmax = real(vp,kind=CUSTOM_REAL) + vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax avs_dx_adios%vmin(numpoin) = vmin avs_dx_adios%vmax(numpoin) = vmax endif @@ -549,20 +545,18 @@ subroutine prepare_AVS_DX_global_chunks_data_adios(prname,nspec, & avs_dx_adios%z_adios(numpoin) = sngl(zstore(NGLLX,NGLLY,NGLLZ,ispec)) vmax = sqrt((kappavstore(NGLLX,NGLLY,NGLLZ,ispec) & - + 4.*muvstore(NGLLX,NGLLY,NGLLZ,ispec)/3.) & - / rhostore(NGLLX,NGLLY,NGLLZ,ispec)) - vmin = sqrt(muvstore(NGLLX,NGLLY,NGLLZ,ispec) & - / rhostore(NGLLX,NGLLY,NGLLZ,ispec)) + + 4.*muvstore(NGLLX,NGLLY,NGLLZ,ispec)/3.) / rhostore(NGLLX,NGLLY,NGLLZ,ispec)) + vmin = sqrt(muvstore(NGLLX,NGLLY,NGLLZ,ispec) / rhostore(NGLLX,NGLLY,NGLLZ,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then r = dsqrt(xstore(NGLLX,NGLLY,NGLLZ,ispec)**2 & + ystore(NGLLX,NGLLY,NGLLZ,ispec)**2 & + zstore(NGLLX,NGLLY,NGLLZ,ispec)**2) call prem_display_outer_core(r,rho,vp,vs,Qkappa,Qmu,idoubling(ispec)) - vmax = vp - vmin = vp + vmax = real(vp,kind=CUSTOM_REAL) + vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax avs_dx_adios%vmin(numpoin) = vmin avs_dx_adios%vmax(numpoin) = vmax endif @@ -575,20 +569,18 @@ subroutine prepare_AVS_DX_global_chunks_data_adios(prname,nspec, & avs_dx_adios%z_adios(numpoin) = sngl(zstore(NGLLX,1,NGLLZ,ispec)) vmax = sqrt((kappavstore(NGLLX,1,NGLLZ,ispec) & - + 4.*muvstore(NGLLX,1,NGLLZ,ispec)/3.) & - / rhostore(NGLLX,1,NGLLZ,ispec)) - vmin = sqrt(muvstore(NGLLX,1,NGLLZ,ispec) & - / rhostore(NGLLX,1,NGLLZ,ispec)) + + 4.*muvstore(NGLLX,1,NGLLZ,ispec)/3.) / rhostore(NGLLX,1,NGLLZ,ispec)) + vmin = sqrt(muvstore(NGLLX,1,NGLLZ,ispec) / rhostore(NGLLX,1,NGLLZ,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then r = dsqrt(xstore(NGLLX,1,NGLLZ,ispec)**2 & + ystore(NGLLX,1,NGLLZ,ispec)**2 & + zstore(NGLLX,1,NGLLZ,ispec)**2) call prem_display_outer_core(r,rho,vp,vs,Qkappa,Qmu,idoubling(ispec)) - vmax = vp - vmin = vp + vmax = real(vp,kind=CUSTOM_REAL) + vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax avs_dx_adios%vmin(numpoin) = vmin avs_dx_adios%vmax(numpoin) = vmax endif @@ -610,17 +602,17 @@ subroutine prepare_AVS_DX_global_chunks_data_adios(prname,nspec, & avs_dx_adios%z_adios(numpoin) = sngl(zstore(1,1,1,ispec)) vmax = sqrt((kappavstore(1,1,1,ispec) & - + 4.*muvstore(1,1,1,ispec)/3.)/rhostore(1,1,1,ispec)) + + 4.*muvstore(1,1,1,ispec)/3.)/rhostore(1,1,1,ispec)) vmin = sqrt(muvstore(1,1,1,ispec)/rhostore(1,1,1,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then r = dsqrt(xstore(1,1,1,ispec)**2 & + ystore(1,1,1,ispec)**2 + zstore(1,1,1,ispec)**2) call prem_display_outer_core(r,rho,vp,vs,Qkappa,Qmu,idoubling(ispec)) - vmax = vp - vmin = vp + vmax = real(vp,kind=CUSTOM_REAL) + vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax avs_dx_adios%vmin(numpoin) = vmin avs_dx_adios%vmax(numpoin) = vmax endif @@ -633,17 +625,17 @@ subroutine prepare_AVS_DX_global_chunks_data_adios(prname,nspec, & avs_dx_adios%z_adios(numpoin) = sngl(zstore(NGLLX,1,1,ispec)) vmax = sqrt((kappavstore(NGLLX,1,1,ispec) & - +4.*muvstore(NGLLX,1,1,ispec)/3.)/rhostore(NGLLX,1,1,ispec)) + +4.*muvstore(NGLLX,1,1,ispec)/3.)/rhostore(NGLLX,1,1,ispec)) vmin = sqrt(muvstore(NGLLX,1,1,ispec)/rhostore(NGLLX,1,1,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then r = dsqrt(xstore(NGLLX,1,1,ispec)**2 & + ystore(NGLLX,1,1,ispec)**2 + zstore(NGLLX,1,1,ispec)**2) call prem_display_outer_core(r,rho,vp,vs,Qkappa,Qmu,idoubling(ispec)) - vmax = vp - vmin = vp + vmax = real(vp,kind=CUSTOM_REAL) + vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax avs_dx_adios%vmin = vmin avs_dx_adios%vmax = vmax endif @@ -656,20 +648,18 @@ subroutine prepare_AVS_DX_global_chunks_data_adios(prname,nspec, & avs_dx_adios%z_adios(numpoin) = sngl(zstore(NGLLX,1,NGLLZ,ispec)) vmax = sqrt((kappavstore(NGLLX,1,NGLLZ,ispec) & - + 4.*muvstore(NGLLX,1,NGLLZ,ispec)/3.) & - / rhostore(NGLLX,1,NGLLZ,ispec)) - vmin = sqrt(muvstore(NGLLX,1,NGLLZ,ispec) & - / rhostore(NGLLX,1,NGLLZ,ispec)) + + 4.*muvstore(NGLLX,1,NGLLZ,ispec)/3.) / rhostore(NGLLX,1,NGLLZ,ispec)) + vmin = sqrt(muvstore(NGLLX,1,NGLLZ,ispec) / rhostore(NGLLX,1,NGLLZ,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then r = dsqrt(xstore(NGLLX,1,NGLLZ,ispec)**2 & + ystore(NGLLX,1,NGLLZ,ispec)**2 & + zstore(NGLLX,1,NGLLZ,ispec)**2) call prem_display_outer_core(r,rho,vp,vs,Qkappa,Qmu,idoubling(ispec)) - vmax = vp - vmin = vp + vmax = real(vp,kind=CUSTOM_REAL) + vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax avs_dx_adios%vmin(numpoin) = vmin avs_dx_adios%vmax(numpoin) = vmax endif @@ -682,18 +672,17 @@ subroutine prepare_AVS_DX_global_chunks_data_adios(prname,nspec, & avs_dx_adios%z_adios(numpoin) = sngl(zstore(1,1,NGLLZ,ispec)) vmax = sqrt((kappavstore(1,1,NGLLZ,ispec) & - + 4.*muvstore(1,1,NGLLZ,ispec)/3.) & - / rhostore(1,1,NGLLZ,ispec)) + + 4.*muvstore(1,1,NGLLZ,ispec)/3.) / rhostore(1,1,NGLLZ,ispec)) vmin = sqrt(muvstore(1,1,NGLLZ,ispec)/rhostore(1,1,NGLLZ,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then r = dsqrt(xstore(1,1,NGLLZ,ispec)**2 & + ystore(1,1,NGLLZ,ispec)**2 + zstore(1,1,NGLLZ,ispec)**2) call prem_display_outer_core(r,rho,vp,vs,Qkappa,Qmu,idoubling(ispec)) - vmax = vp - vmin = vp + vmax = real(vp,kind=CUSTOM_REAL) + vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax avs_dx_adios%vmin(numpoin) = vmin avs_dx_adios%vmax(numpoin) = vmax endif @@ -715,17 +704,17 @@ subroutine prepare_AVS_DX_global_chunks_data_adios(prname,nspec, & avs_dx_adios%z_adios(numpoin) = sngl(zstore(1,NGLLY,1,ispec)) vmax = sqrt((kappavstore(1,NGLLY,1,ispec) & - + 4.*muvstore(1,NGLLY,1,ispec)/3.)/rhostore(1,NGLLY,1,ispec)) + + 4.*muvstore(1,NGLLY,1,ispec)/3.)/rhostore(1,NGLLY,1,ispec)) vmin = sqrt(muvstore(1,NGLLY,1,ispec)/rhostore(1,NGLLY,1,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then r = dsqrt(xstore(1,NGLLY,1,ispec)**2 & + ystore(1,NGLLY,1,ispec)**2 + zstore(1,NGLLY,1,ispec)**2) call prem_display_outer_core(r,rho,vp,vs,Qkappa,Qmu,idoubling(ispec)) - vmax = vp - vmin = vp + vmax = real(vp,kind=CUSTOM_REAL) + vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax avs_dx_adios%vmin(numpoin) = vmin avs_dx_adios%vmax(numpoin) = vmax endif @@ -738,21 +727,19 @@ subroutine prepare_AVS_DX_global_chunks_data_adios(prname,nspec, & avs_dx_adios%z_adios(numpoin) = sngl(zstore(NGLLX,NGLLY,1,ispec)) vmax = sqrt((kappavstore(NGLLX,NGLLY,1,ispec) & - + 4.*muvstore(NGLLX,NGLLY,1,ispec)/3.) & - / rhostore(NGLLX,NGLLY,1,ispec)) - vmin = sqrt(muvstore(NGLLX,NGLLY,1,ispec) & - / rhostore(NGLLX,NGLLY,1,ispec)) + + 4.*muvstore(NGLLX,NGLLY,1,ispec)/3.) / rhostore(NGLLX,NGLLY,1,ispec)) + vmin = sqrt(muvstore(NGLLX,NGLLY,1,ispec) / rhostore(NGLLX,NGLLY,1,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then r = dsqrt(xstore(NGLLX,NGLLY,1,ispec)**2 & + ystore(NGLLX,NGLLY,1,ispec)**2 & + zstore(NGLLX,NGLLY,1,ispec)**2) call prem_display_outer_core(r,rho,vp,vs,Qkappa,Qmu,idoubling(ispec)) - vmax = vp - vmin = vp + vmax = real(vp,kind=CUSTOM_REAL) + vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax avs_dx_adios%vmin(numpoin) = vmin avs_dx_adios%vmax(numpoin) = vmax @@ -766,20 +753,18 @@ subroutine prepare_AVS_DX_global_chunks_data_adios(prname,nspec, & avs_dx_adios%z_adios(numpoin) = sngl(zstore(NGLLX,NGLLY,NGLLZ,ispec)) vmax = sqrt((kappavstore(NGLLX,NGLLY,NGLLZ,ispec) & - + 4.*muvstore(NGLLX,NGLLY,NGLLZ,ispec)/3.) & - / rhostore(NGLLX,NGLLY,NGLLZ,ispec)) - vmin = sqrt(muvstore(NGLLX,NGLLY,NGLLZ,ispec) & - / rhostore(NGLLX,NGLLY,NGLLZ,ispec)) + + 4.*muvstore(NGLLX,NGLLY,NGLLZ,ispec)/3.) / rhostore(NGLLX,NGLLY,NGLLZ,ispec)) + vmin = sqrt(muvstore(NGLLX,NGLLY,NGLLZ,ispec) / rhostore(NGLLX,NGLLY,NGLLZ,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then r = dsqrt(xstore(NGLLX,NGLLY,NGLLZ,ispec)**2 & + ystore(NGLLX,NGLLY,NGLLZ,ispec)**2 & + zstore(NGLLX,NGLLY,NGLLZ,ispec)**2) call prem_display_outer_core(r,rho,vp,vs,Qkappa,Qmu,idoubling(ispec)) - vmax = vp - vmin = vp + vmax = real(vp,kind=CUSTOM_REAL) + vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax avs_dx_adios%vmin(numpoin) = vmin avs_dx_adios%vmax(numpoin) = vmax endif @@ -792,20 +777,18 @@ subroutine prepare_AVS_DX_global_chunks_data_adios(prname,nspec, & avs_dx_adios%z_adios(numpoin) = sngl(zstore(1,NGLLY,NGLLZ,ispec)) vmax = sqrt((kappavstore(1,NGLLY,NGLLZ,ispec) & - + 4.*muvstore(1,NGLLY,NGLLZ,ispec)/3.) & - / rhostore(1,NGLLY,NGLLZ,ispec)) - vmin = sqrt(muvstore(1,NGLLY,NGLLZ,ispec) & - / rhostore(1,NGLLY,NGLLZ,ispec)) + + 4.*muvstore(1,NGLLY,NGLLZ,ispec)/3.) / rhostore(1,NGLLY,NGLLZ,ispec)) + vmin = sqrt(muvstore(1,NGLLY,NGLLZ,ispec) / rhostore(1,NGLLY,NGLLZ,ispec)) ! particular case of the outer core (muvstore contains 1/rho) if (idoubling(ispec) == IFLAG_OUTER_CORE_NORMAL) then r = dsqrt(xstore(1,NGLLY,NGLLZ,ispec)**2 & + ystore(1,NGLLY,NGLLZ,ispec)**2 & + zstore(1,NGLLY,NGLLZ,ispec)**2) call prem_display_outer_core(r,rho,vp,vs,Qkappa,Qmu,idoubling(ispec)) - vmax = vp - vmin = vp + vmax = real(vp,kind=CUSTOM_REAL) + vmin = real(vp,kind=CUSTOM_REAL) endif - if (vmin == 0.0) vmin=vmax + if (vmin == 0.0) vmin = vmax avs_dx_adios%vmin(numpoin) = vmin avs_dx_adios%vmax(numpoin) = vmax