diff --git a/src/meshfem3D/SIEM_meshing.f90 b/src/meshfem3D/SIEM_meshing.f90 index a63b516b1..64c7772ba 100644 --- a/src/meshfem3D/SIEM_meshing.f90 +++ b/src/meshfem3D/SIEM_meshing.f90 @@ -39,7 +39,7 @@ module SIEM_meshfem_par - use constants,only: CUSTOM_REAL,NDIM,NGLLZ + use constants, only: CUSTOM_REAL,NDIM,NGLLZ implicit none @@ -249,7 +249,7 @@ subroutine SIEM_mesh_create_elements(iregion_code,ilayer_loop) ! allocates temporary arrays allocate(iboolt(NGLLX,NGLLY,NGLLZ,nspec0), & - ibount(6,nspec0), & + ibount(6,nspec0), & iMPIcutt_xi(2,nspec0), & iMPIcutt_eta(2,nspec0), & xstoret(NGLLX,NGLLY,NGLLZ,nspec0), & @@ -399,7 +399,7 @@ subroutine SIEM_mesh_create_elements(iregion_code,ilayer_loop) gaminf = r1/(RINF-r1) invgaminf = (RINF-r1)/r1 !r1/(RINF-r1) use inverse instead for multiplication - if(gaminf == 0.0_CUSTOM_REAL)then + if (gaminf == 0.0_CUSTOM_REAL) then print *,'ERROR: zero division!' stop 'Invalid gaminf zero division' endif @@ -424,9 +424,9 @@ subroutine SIEM_mesh_create_elements(iregion_code,ilayer_loop) do k = 1,NGLLZ inum = 0 xp = xs(:,:,k) - !if(k.eq.1)xp=xs - !if(k.eq.2)xp=mirxs1 - !if(k.eq.3)xp=mirxs2 + !if (k==1)xp=xs + !if (k==2)xp=mirxs1 + !if (k==3)xp=mirxs2 do ispec = 1,nspec0 ispec_n = ispecnew(ispec) do j = 1,NGLLY @@ -470,7 +470,7 @@ subroutine SIEM_mesh_create_elements(iregion_code,ilayer_loop) do ispec = 1,nspec0 ispec_n = ispecnew(ispec) - do k = 1,NGLLZ ! 1 was previously set for ilayer>1 but not other + do k = 1,NGLLZ ! 1 was previously set for ilayer > 1 but not other do j = 1,NGLLY do i = 1,NGLLX iglob = iboolold(i,j,k,ispec) @@ -491,7 +491,7 @@ subroutine SIEM_mesh_create_elements(iregion_code,ilayer_loop) ! do j = 1,NGLLY ! do i = 1,NGLLX ! iglob = iboolold(i,j,k,ispec) - ! if(.not.isnode(iglob))then + ! if (.not. isnode(iglob)) then ! ib = ib+1 ! isnode(iglob) = .true. ! ibnew(iglob) = ib @@ -538,7 +538,7 @@ end function distance ! Author: Michel Olagnon ! orderpack 2.0 - ! source: http://www.fortran-2000.com/rank/ + ! source: http://www.Fortran-2000.com/rank/ subroutine i_uniinv (XDONT, IGOEST) ! UNIINV = Merge-sort inverse ranking of an array, with removal of @@ -570,7 +570,7 @@ subroutine i_uniinv (XDONT, IGOEST) ! fill-in the index array, creating ordered couples do IIND = 2, NVAL, 2 - if(XDONT(IIND-1) < XDONT(IIND)) then + if (XDONT(IIND-1) < XDONT(IIND)) then IRNGT (IIND-1) = IIND - 1 IRNGT (IIND) = IIND else @@ -578,7 +578,7 @@ subroutine i_uniinv (XDONT, IGOEST) IRNGT (IIND) = IIND - 1 endif enddo - if(modulo(NVAL,2) /= 0) then + if (modulo(NVAL,2) /= 0) then IRNGT (NVAL) = NVAL endif diff --git a/src/meshfem3D/compute_element_properties.f90 b/src/meshfem3D/compute_element_properties.f90 index 93e580cc3..f318da0a6 100644 --- a/src/meshfem3D/compute_element_properties.f90 +++ b/src/meshfem3D/compute_element_properties.f90 @@ -246,7 +246,7 @@ subroutine compute_element_properties(ispec,iregion_code,idoubling,ipass, & call compute_element_GLL_locations(xelm,yelm,zelm,ispec,nspec,xstore,ystore,zstore,shape3D) endif ! sets mesh flag - ! (to make sure that the conversions from geocentric cartesian x/y/z to geodectic lat/lon position accounts for ellipticity) + ! (to make sure that the conversions from geocentric Cartesian x/y/z to geodectic lat/lon position accounts for ellipticity) elem_is_elliptical = .true. endif endif @@ -382,7 +382,7 @@ subroutine compute_element_properties(ispec,iregion_code,idoubling,ipass, & call get_ellipticity(xelm,yelm,zelm,nspl,rspl,ellipicity_spline,ellipicity_spline2) endif ! sets mesh flag - ! (to make sure that the conversions from geocentric cartesian x/y/z to geodectic lat/lon position accounts for ellipticity) + ! (to make sure that the conversions from geocentric Cartesian x/y/z to geodectic lat/lon position accounts for ellipticity) elem_is_elliptical = .true. !debug diff --git a/src/meshfem3D/create_MPI_interfaces.f90 b/src/meshfem3D/create_MPI_interfaces.f90 index 1a34a6077..aa7c38dcf 100644 --- a/src/meshfem3D/create_MPI_interfaces.f90 +++ b/src/meshfem3D/create_MPI_interfaces.f90 @@ -638,7 +638,7 @@ subroutine cmi_get_buffers(iregion_code) ! transition infinite layer if (NSPEC_TRINFINITE > 0) then ! user output - if(myrank == 0) then + if (myrank == 0) then write(IMAIN,*) write(IMAIN,*) 'transition infinite region:' call flush_IMAIN() @@ -686,7 +686,7 @@ subroutine cmi_get_buffers(iregion_code) ! infinite layer if (NSPEC_INFINITE > 0) then ! user output - if(myrank == 0) then + if (myrank == 0) then write(IMAIN,*) write(IMAIN,*) 'infinite region:' call flush_IMAIN() diff --git a/src/meshfem3D/meshfem3D_par.f90 b/src/meshfem3D/meshfem3D_par.f90 index ea8fa688c..d9c9b3cb3 100644 --- a/src/meshfem3D/meshfem3D_par.f90 +++ b/src/meshfem3D/meshfem3D_par.f90 @@ -649,7 +649,7 @@ end module MPI_outer_core_par module MPI_trinfinite_par - use constants,only: CUSTOM_REAL,NUMFACES_SHARED,NB_SQUARE_EDGES_ONEDIR + use constants, only: CUSTOM_REAL,NUMFACES_SHARED,NB_SQUARE_EDGES_ONEDIR implicit none @@ -705,7 +705,7 @@ end module MPI_trinfinite_par module MPI_infinite_par - use constants,only: CUSTOM_REAL,NUMFACES_SHARED,NB_SQUARE_EDGES_ONEDIR + use constants, only: CUSTOM_REAL,NUMFACES_SHARED,NB_SQUARE_EDGES_ONEDIR implicit none diff --git a/src/meshfem3D/model_EMC.f90 b/src/meshfem3D/model_EMC.f90 index 792c949ff..36a75fc7d 100644 --- a/src/meshfem3D/model_EMC.f90 +++ b/src/meshfem3D/model_EMC.f90 @@ -1273,7 +1273,7 @@ subroutine fill_EMC_surface_values() ! user output write(IMAIN,*) ' updated surface entries = ',icount - if (icount == 0) write(IMAIN,*) ' no fluid (vs==0) entries found' + if (icount == 0) write(IMAIN,*) ' no fluid (vs == 0) entries found' write(IMAIN,*) call flush_IMAIN() @@ -1472,7 +1472,7 @@ subroutine EMC_setup_spline_coeffs(n,x,y,spline_b,spline_c,spline_d) ! Compute a[i] = (3/h[i]) * (a[i+1] - a[i]) - (3/h[i-1]) * (a[i] - a[i-1]) do i = 2, n-1 a(i) = (3.0 / h(i)) * (y(i+1) - y(i)) - (3.0 / h(i-1)) * (y(i) - y(i-1)) - end do + enddo ! Solve for c[i] using Thomas algorithm for tridiagonal systems l(1) = 2.0 * h(1) @@ -1482,7 +1482,7 @@ subroutine EMC_setup_spline_coeffs(n,x,y,spline_b,spline_c,spline_d) l(i) = 2.0 * (x(i+1) - x(i-1)) - h(i-1) * mu(i-1) mu(i) = h(i) / l(i) z(i) = (a(i) - h(i-1) * z(i-1)) / l(i) - end do + enddo l(n) = h(n-1) * (2.0 - mu(n-1)) z(n) = (a(n) - h(n-1) * z(n-1)) / l(n) c(n) = z(n) @@ -1490,7 +1490,7 @@ subroutine EMC_setup_spline_coeffs(n,x,y,spline_b,spline_c,spline_d) c(j) = z(j) - mu(j) * c(j+1) b(j) = (y(j+1) - y(j)) / h(j) - h(j) * (c(j+1) + 2.0 * c(j)) / 3.0 d(j) = (c(j+1) - c(j)) / (3.0 * h(j)) - end do + enddo ! return coefficients spline_b(:) = b(:) @@ -1521,7 +1521,7 @@ subroutine EMC_eval_spline(n,x,y,spline_b,spline_c,spline_d,x_target,y_interp) do while (i < n) if (x_target >= x(i) .and. x_target <= x(i+1)) exit i = i + 1 - end do + enddo ! spline interpolation y_interp = y(i) + spline_b(i) * (x_target - x(i)) + spline_c(i) * (x_target - x(i))**2 + spline_d(i) * (x_target - x(i))**3 @@ -1623,7 +1623,7 @@ subroutine fill_EMC_missing_values_interpolated() ! user output write(IMAIN,*) ' filling:' write(IMAIN,*) ' using interpolated closest model values for missing values' - write(IMAIN,*) ' interpolation method : ',INTERPOLATION_METHOD,'(1==Shepard/2==nearest/3==bilinear)' + write(IMAIN,*) ' interpolation method : ',INTERPOLATION_METHOD,'(1 == Shepard/2 == nearest/3 == bilinear)' write(IMAIN,*) call flush_IMAIN() @@ -2024,9 +2024,9 @@ subroutine do_bilinear_interpolation(vp_interp,vs_interp,rho_interp) endif ! check index bounds - if (ix < 1 .or. ix > Nx ) stop 'Invalid interpolation point 1' + if (ix < 1 .or. ix > Nx ) stop 'Invalid interpolation point 1' if (ixplus < 1 .or. ixplus > Nx) stop 'Invalid interpolation point 2' - if (iy < 1 .or. iy > Ny ) stop 'Invalid interpolation point 3' + if (iy < 1 .or. iy > Ny ) stop 'Invalid interpolation point 3' if (iyplus < 1 .or. iyplus > Ny) stop 'Invalid interpolation point 4' if (ix == ixplus) stop 'Invalid interpolation point 1 and point 2' @@ -2221,7 +2221,7 @@ function cosine_taper(distance, max_distance) result(taper_val) taper_val = 0.d0 else taper_val = 0.5d0 * (1.d0 + cos(PI * distance / max_distance)) - end if + endif end function cosine_taper 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 ca5a90900..644dc081c 100644 --- a/src/meshfem3D/write_AVS_DX_global_chunks_data_adios.f90 +++ b/src/meshfem3D/write_AVS_DX_global_chunks_data_adios.f90 @@ -865,7 +865,7 @@ subroutine prepare_AVS_DX_global_chunks_data_adios(prname,nspec, & ! removes ellipticity stretch from position x/y/z call revert_ellipticity(x,y,z,nspl,rspl,ellipicity_spline,ellipicity_spline2) endif - + ! updates radius r = dsqrt(x*x+y*y+z*z) diff --git a/src/shared/count_points.f90 b/src/shared/count_points.f90 index fb43091b2..e3f85dbb9 100644 --- a/src/shared/count_points.f90 +++ b/src/shared/count_points.f90 @@ -31,7 +31,7 @@ subroutine count_points(NEX_PER_PROC_XI,NEX_PER_PROC_ETA,ratio_divide_central_cu NGLOB2DMAX_XMIN_XMAX,NGLOB2DMAX_YMIN_YMAX, & NGLOB_REGIONS, & INCLUDE_CENTRAL_CUBE,NER_TOP_CENTRAL_CUBE_ICB,NEX_XI, & - NUMBER_OF_MESH_LAYERS,layer_offset, & + NUMBER_OF_MESH_LAYERS,layer_offset, & CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA, & last_doubling_layer) diff --git a/src/shared/euler_angles.f90 b/src/shared/euler_angles.f90 index fdb4f3851..bc1403deb 100644 --- a/src/shared/euler_angles.f90 +++ b/src/shared/euler_angles.f90 @@ -74,7 +74,7 @@ subroutine determine_chunk_corners_latlon(CENTER_LONGITUDE_IN_DEGREES,CENTER_LAT corners_lat,corners_lon) use constants, only: DEGREES_TO_RADIANS,RADIANS_TO_DEGREES,ONE,PI,TWO_PI,PI_OVER_TWO,R_UNIT_SPHERE - + implicit none double precision,intent(in) :: CENTER_LONGITUDE_IN_DEGREES,CENTER_LATITUDE_IN_DEGREES,GAMMA_ROTATION_AZIMUTH diff --git a/src/shared/read_compute_parameters.f90 b/src/shared/read_compute_parameters.f90 index 1a36a2fe0..94004c96c 100644 --- a/src/shared/read_compute_parameters.f90 +++ b/src/shared/read_compute_parameters.f90 @@ -383,7 +383,7 @@ subroutine rcp_set_mesh_parameters() NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_YMAX,NSPEC2D_BOTTOM,NSPEC2D_TOP, & NSPEC1D_RADIAL, & NGLOB2DMAX_XMIN_XMAX,NGLOB2DMAX_YMIN_YMAX, & - NUMBER_OF_MESH_LAYERS,layer_offset,& + NUMBER_OF_MESH_LAYERS,layer_offset, & CUT_SUPERBRICK_XI,CUT_SUPERBRICK_ETA,INCLUDE_CENTRAL_CUBE, & last_doubling_layer)