libppmnumerics-r1036/0000755000175000017500000000000011616215010013327 5ustar omaromarlibppmnumerics-r1036/src/0000755000175000017500000000000011616214712014126 5ustar omaromarlibppmnumerics-r1036/src/ppm_gmm_create_3dmatrix.m0000644000175000017500000001300611616214647021105 0ustar omaromar% compute and factorize the matrix for the tri-cubic interpolation in 3D % in ppm_gmm_kickoff. % % $Log: ppm_gmm_create_3dmatrix.m,v $ % Revision 1.1.1.1 2007/07/13 10:18:55 ivos % CBL version of the PPM library % % Revision 1.1 2005/03/10 01:53:00 ivos % Initial check-in. % %------------------------------------------------------------------------------- A = zeros(64,64); for p=0:3, pm1 = p-1; % 0.0**p ohp = 0.0; if (p==0), ohp = 1.0; end; % 0.0**(p-1) ohpm1 = 0.0; if (p==1), ohpm1 = 1.0; end; for n=0:3, nm1 = n-1; % 0.0**n ohn = 0.0; if (n==0), ohn = 1.0; end; % 0.0**(n-1) ohnm1 = 0.0, if (n==1), ohnm1 = 1.0; end; for m=0:3, mm1 = m-1; % 0.0**m ohm = 0.0; if (m==0), ohm = 1.0; end; % 0.0**(m-1) ohmm1 = 0.0; if (m==1), ohmm1 = 1.0; end; % coefficient index ind = 16*p+4*n+m+1; % m --> x % n --> y % p --> z %------------------------------------------------------------- % VALUES %------------------------------------------------------------- A(1,ind) = ohm*ohn*ohp; A(2,ind) = ohn*ohp; A(3,ind) = ohm*ohp; A(4,ind) = ohp; A(5,ind) = ohm*ohn; A(6,ind) = ohn; A(7,ind) = ohm; A(8,ind) = 1.0; %------------------------------------------------------------- % Dx %------------------------------------------------------------- A(9,ind) = m*ohmm1*ohn*ohp; A(10,ind) = m*ohn*ohp; A(11,ind) = m*ohmm1*ohp; A(12,ind) = m*ohp; A(13,ind) = m*ohmm1*ohn; A(14,ind) = m*ohn; A(15,ind) = m*ohmm1; A(16,ind) = m; %------------------------------------------------------------- % Dy %------------------------------------------------------------- A(17,ind) = n*ohm*ohnm1*ohp; A(18,ind) = n*ohnm1*ohp; A(19,ind) = n*ohm*ohp; A(20,ind) = n*ohp; A(21,ind) = n*ohm*ohnm1; A(22,ind) = n*ohnm1; A(23,ind) = n*ohm; A(24,ind) = n; %------------------------------------------------------------- % Dz %------------------------------------------------------------- A(25,ind) = p*ohm*ohn*ohpm1; A(26,ind) = p*ohn*ohpm1; A(27,ind) = p*ohm*ohpm1; A(28,ind) = p*ohpm1; A(29,ind) = p*ohm*ohn; A(30,ind) = p*ohn; A(31,ind) = p*ohm; A(32,ind) = p; %------------------------------------------------------------- % DxDy %------------------------------------------------------------- f = m*n; A(33,ind) = f*ohmm1*ohnm1*ohp; A(34,ind) = f*ohnm1*ohp; A(35,ind) = f*ohmm1*ohp; A(36,ind) = f*ohp; A(37,ind) = f*ohmm1*ohnm1; A(38,ind) = f*ohnm1; A(39,ind) = f*ohmm1; A(40,ind) = f; %------------------------------------------------------------- % DxDz %------------------------------------------------------------- f = m*p; A(41,ind) = f*ohmm1*ohn*ohpm1; A(42,ind) = f*ohn*ohpm1; A(43,ind) = f*ohmm1*ohpm1; A(44,ind) = f*ohpm1; A(45,ind) = f*ohmm1*ohn; A(46,ind) = f*ohn; A(47,ind) = f*ohmm1; A(48,ind) = f; %------------------------------------------------------------- % DyDz %------------------------------------------------------------- f = n*p; A(49,ind) = f*ohm*ohnm1*ohpm1; A(50,ind) = f*ohnm1*ohpm1; A(51,ind) = f*ohm*ohpm1; A(52,ind) = f*ohpm1; A(53,ind) = f*ohm*ohnm1; A(54,ind) = f*ohnm1; A(55,ind) = f*ohm; A(56,ind) = f; %------------------------------------------------------------- % DxDyDz %------------------------------------------------------------- f = m*n*p; A(57,ind) = f*ohmm1*ohnm1*ohpm1; A(58,ind) = f*ohnm1*ohpm1; A(59,ind) = f*ohmm1*ohpm1; A(60,ind) = f*ohpm1; A(61,ind) = f*ohmm1*ohnm1; A(62,ind) = f*ohnm1; A(63,ind) = f*ohmm1; A(64,ind) = f; end; end; end; [L,U,P] = lu(A); ALU = (L-eye(64))+U; ind = P*[1:1:64]'; save 'gaga_ind.dat' ind -ASCII; ALUT = ALU'; % FORTRAN HAS COLUMN MAJOR save 'gaga_a.dat' ALUT -ASCII; libppmnumerics-r1036/src/ppm_hamjac_reinit_loc_3d.f0000644000175000017500000002214011616214647021177 0ustar omaromar !------------------------------------------------------------------------- ! Subroutine : ppm_hamjac_reinit_3d !------------------------------------------------------------------------- ! ! Purpose : Solve Hamilton-Jacobi for Gowas reinit ! ! Input : ! ! Input/Output : ! ! Output : ! ! Remarks : ! ! ! References : ! ! Revisions : !------------------------------------------------------------------------- ! $Log: ppm_hamjac_reinit_loc_3d.f,v $ ! Revision 1.1.1.1 2006/07/25 15:18:19 menahel ! initial import ! ! Revision 1.2 2005/08/25 16:48:50 ivos ! Fixed format string. pgf90 barked. ! ! Revision 1.1 2005/07/25 00:34:02 ivos ! Initial check-in. ! !------------------------------------------------------------------------- ! Parallel Particle Mesh Library (PPM) ! Institute of Computational Science ! ETH Zentrum, Hirschengraben 84 ! CH-8092 Zurich, Switzerland !------------------------------------------------------------------------- #if __MODE == __SCA #if __KIND == __SINGLE_PRECISION SUBROUTINE ppm_hamjac_reinit_loc_3ds (phi, iloc, np, trgt, tol, maxstep,& & topo_id, mesh_id, ghostsize, info) #elif __KIND == __DOUBLE_PRECISION SUBROUTINE ppm_hamjac_reinit_loc_3dd (phi, iloc, np, trgt, tol, maxstep,& & topo_id, mesh_id, ghostsize, info) #endif #elif __MODE == __VEC #if __KIND == __SINGLE_PRECISION SUBROUTINE ppm_hamjac_reinit_loc_3dsV(phi, lda, iloc, np, idx, trgt,tol,& & maxstep,topo_id, mesh_id, ghostsize,info) #elif __KIND == __DOUBLE_PRECISION SUBROUTINE ppm_hamjac_reinit_loc_3ddV(phi, lda, iloc, np, idx, trgt,tol,& & maxstep,topo_id, mesh_id, ghostsize,info) #endif #endif USE ppm_module_data USE ppm_module_error USE ppm_module_write USE ppm_module_substart USE ppm_module_alloc USE ppm_module_substop USE ppm_module_map USE ppm_module_typedef USE ppm_module_map_field USE ppm_module_map_field_ghost IMPLICIT NONE #if __KIND == __SINGLE_PRECISION INTEGER, PARAMETER :: MK = ppm_kind_single #elif __KIND == __DOUBLE_PRECISION INTEGER, PARAMETER :: MK = ppm_kind_double #endif !----------------------------------------------------- ! Arguments !----------------------------------------------------- #if __MODE == __SCA REAL(MK), DIMENSION(:,:,:,:), POINTER :: phi #elif __MODE == __VEC REAL(MK), DIMENSION(:,:,:,:,:), POINTER :: phi INTEGER, INTENT(in) :: idx, lda #endif INTEGER, INTENT(in) :: topo_id, mesh_id INTEGER, DIMENSION(3), INTENT(in) :: ghostsize INTEGER, INTENT(inout) :: info INTEGER, INTENT(in) :: maxstep REAL(mk), INTENT(in) :: tol, trgt !----------------------------------------------------- ! Aliases !----------------------------------------------------- INTEGER, DIMENSION(:), POINTER :: isublist INTEGER, DIMENSION(:,:), INTENT(in) :: iloc INTEGER :: np, p REAL(mk), DIMENSION(:,:,:,:), POINTER :: tphi INTEGER :: nsublist INTEGER, DIMENSION(:,:), POINTER :: ndata INTEGER :: topoid,meshid REAL(MK), DIMENSION(:), POINTER :: min_phys, max_phys TYPE(ppm_t_topo), POINTER :: topo TYPE(ppm_t_equi_mesh), POINTER :: mesh !----------------------------------------------------- ! standard stuff !----------------------------------------------------- INTEGER :: isub,isubl,i,j,k INTEGER :: maptype,istep,iopt INTEGER :: ldl(4),ldu(4),ndata_max(3) REAL(mk) :: len_phys(3) REAL(mk) :: t0, res CHARACTER(LEN=ppm_char) :: cbuf CALL substart('ppm_hamjac_reinit_loc_3d',t0,info) !----------------------------------------------------- ! Get the mesh data !----------------------------------------------------- topo => ppm_topo(topo_id)%t mesh => topo%mesh(mesh_id) meshid = mesh%ID nsublist = topo%nsublist ndata => mesh%nnodes isublist => topo%isublist #if __KIND == __SINGLE_PRECISION min_phys => topo%min_physs max_phys => topo%max_physs #elif __KIND == __DOUBLE_PRECISION min_phys => topo%min_physd max_phys => topo%max_physd #endif !----------------------------------------------------- ! RATIONALE Thu May 26 20:51:19 PDT 2005: ! loop ghostmap doit. easy. !----------------------------------------------------- !----------------------------------------------------- ! allocate temporary storage !----------------------------------------------------- ldl(1:3) = 1 - ghostsize(1:3); ldl(4) = 1 ndata_max(1) = MAXVAL(ndata(1,1:nsublist)) ndata_max(2) = MAXVAL(ndata(2,1:nsublist)) ndata_max(3) = MAXVAL(ndata(3,1:nsublist)) ldu(1) = ndata_max(1) + ghostsize(1) ldu(2) = ndata_max(2) + ghostsize(2) ldu(3) = ndata_max(3) + ghostsize(3) ldu(4) = nsublist iopt = ppm_param_alloc_fit CALL ppm_alloc(tphi,ldl,ldu,iopt,info) IF(info.NE.0) THEN info = ppm_error_fatal CALL ppm_error(ppm_err_alloc,'ppm_hamjac_reinit_loc_3d', & & 'temp storage for hamjac',__LINE__,info) GOTO 9999 END IF !----------------------------------------------------- ! COMMENT Thu May 26 21:05:23 PDT 2005: simple euler here, DO TVD !----------------------------------------------------- DO istep=1,maxstep !--- map the gowas #if __MODE == __SCA CALL ppm_map_field_ghost_get(topo_id,mesh_id,ghostsize,info) CALL ppm_map_field_push(topo_id,mesh_id,phi,info) CALL ppm_map_field_send(info) CALL ppm_map_field_pop(topo_id,mesh_id,phi,ghostsize,info) CALL ppm_hamjac_reinit_loc_step(phi,tphi,iloc,np,trgt,res,topo_id,& & mesh_id,ghostsize,info) #elif __MODE == __VEC CALL ppm_map_field_ghost_get(topo_id,mesh_id,ghostsize,info) CALL ppm_map_field_push(topo_id,mesh_id,phi,lda,info) CALL ppm_map_field_send(info) CALL ppm_map_field_pop(topo_id,mesh_id,phi,lda,ghostsize,info) CALL ppm_hamjac_reinit_loc_step(phi,idx,tphi,iloc,np,trgt,res,topo_id,& & mesh_id,ghostsize,info) #endif !----------------------------------------------------- ! maybe put a if(debug)then !----------------------------------------------------- WRITE(cbuf,'(A,I4,A,E12.5)') 'Iteration ',istep,' Residual: ',res CALL ppm_write(ppm_rank,'ppm_hamjac_reinit_loc_3d',cbuf,info) !----------------------------------------------------- ! copy the data back !----------------------------------------------------- DO p=1,np isub = iloc(4,p) i = iloc(1,p) j = iloc(2,p) k = iloc(3,p) #if __MODE == __SCA phi(i,j,k,isub) = tphi(i,j,k,isub) #elif __MODE == __VEC phi(idx,i,j,k,isub) = tphi(i,j,k,isub) #endif END DO IF(res.LT.tol) GOTO 666 END DO info = ppm_error_warning CALL ppm_error(ppm_err_converge,'ppm_hamjac_reinit_loc_3d', & & 'failed to reach target residual',__LINE__,info) info = ppm_param_success 666 CONTINUE iopt = ppm_param_dealloc CALL ppm_alloc(tphi,ldl,ldu,iopt,info) IF(info.NE.0) THEN info = ppm_error_error CALL ppm_error(ppm_err_dealloc,'ppm_hamjac_reinit_loc_3d', & & 'temp storage for hamjac not freed',__LINE__,info) GOTO 9999 END IF 9999 CONTINUE #if __MODE == __SCA #if __KIND == __SINGLE_PRECISION END SUBROUTINE ppm_hamjac_reinit_loc_3ds #elif __KIND == __DOUBLE_PRECISION END SUBROUTINE ppm_hamjac_reinit_loc_3dd #endif #elif __MODE == __VEC #if __KIND == __SINGLE_PRECISION END SUBROUTINE ppm_hamjac_reinit_loc_3dsV #elif __KIND == __DOUBLE_PRECISION END SUBROUTINE ppm_hamjac_reinit_loc_3ddV #endif #endif libppmnumerics-r1036/src/ppm_fdsolver_fft_fd_3d.f0000644000175000017500000004274511616214647020716 0ustar omaromar !------------------------------------------------------------------------- ! Subroutine : ppm_fdsolver_fft_fd_3d !------------------------------------------------------------------------- ! ! Purpose : This routine performs Fast Fourier Transform forth ! using the precomputed plans in ppm_fdsolver_init ! ! Input : data_in(:,:,:) (F) 3d data array to be transformed ! ! Input/output : lda(:) (I) size of data ! ! Output : data_out(:,:,:) (F) transformed data ! info (I) return status. =0 if no error. ! ! Remarks : ! ! References : ! ! Revisions : !------------------------------------------------------------------------- ! $Log: ppm_fdsolver_fft_fd_3d.f,v $ ! Revision 1.1.1.1 2007/07/13 10:18:54 ivos ! CBL version of the PPM library ! ! Revision 1.5 2006/09/04 18:34:43 pchatela ! Fixes and cleanups to make it compile for ! release-1-0 ! ! Revision 1.4 2005/02/17 17:50:26 hiebers ! removed typo in ppm_module_data_fieldsolver ! ! Revision 1.3 2005/02/16 22:22:59 ivos ! Bugfix: replaced non-existing ppm_module_data_fdsolver with ! ppm_module_data_fieldsolver. ! ! Revision 1.2 2005/02/16 12:41:44 hiebers ! removed print statements ! ! Revision 1.1 2005/02/16 11:53:24 hiebers ! initial implementation ! ! !------------------------------------------------------------------------- ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see . ! ! Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Switzerland !------------------------------------------------------------------------- #if __CASE == __SLAB #if __KIND == __SINGLE_PRECISION SUBROUTINE ppm_fdsolver_fft_fd_slab_3ds(data_in,lda,data_out,info) #elif __KIND == __DOUBLE_PRECISION SUBROUTINE ppm_fdsolver_fft_fd_slab_3dd(data_in,lda,data_out,info) #endif #else #if __KIND == __SINGLE_PRECISION SUBROUTINE ppm_fdsolver_fft_fd_3ds(data_in,lda,data_out,info) #elif __KIND == __DOUBLE_PRECISION SUBROUTINE ppm_fdsolver_fft_fd_3dd(data_in,lda,data_out,info) #elif __KIND == __SINGLE_PRECISION_COMPLEX SUBROUTINE ppm_fdsolver_fft_fd_3dc(data_in,lda,data_out,info) #elif __KIND == __DOUBLE_PRECISION_COMPLEX SUBROUTINE ppm_fdsolver_fft_fd_3dcc(data_in,lda,data_out,info) #elif __KIND == __SINGLE_PRECISION_COMPLEX_Z SUBROUTINE ppm_fdsolver_fft_fd_z_3dc(data_in,lda,data_out,info) #elif __KIND == __DOUBLE_PRECISION_COMPLEX_Z SUBROUTINE ppm_fdsolver_fft_fd_z_3dcc(data_in,lda,data_out,info) #endif #endif !------------------------------------------------------------------------- ! Includes !------------------------------------------------------------------------- #include "ppm_define.h" !------------------------------------------------------------------------- ! Modules !------------------------------------------------------------------------- USE ppm_module_data USE ppm_module_data_fieldsolver USE ppm_module_substart USE ppm_module_substop USE ppm_module_error USE ppm_module_alloc IMPLICIT NONE #if __KIND == __SINGLE_PRECISION | __KIND ==__SINGLE_PRECISION_COMPLEX INTEGER, PARAMETER :: MK = ppm_kind_single #elif __KIND ==__SINGLE_PRECISION_COMPLEX_Z INTEGER, PARAMETER :: MK = ppm_kind_single #elif __KIND == __DOUBLE_PRECISION | __KIND ==__DOUBLE_PRECISION_COMPLEX INTEGER, PARAMETER :: MK = ppm_kind_double #elif __KIND ==__DOUBLE_PRECISION_COMPLEX_Z INTEGER, PARAMETER :: MK = ppm_kind_double #endif !------------------------------------------------------------------------- ! FFTW include !------------------------------------------------------------------------- #ifdef __FFTW INCLUDE "fftw3.f" #endif !------------------------------------------------------------------------- ! Arguments !------------------------------------------------------------------------- ! input data #if __KIND == __SINGLE_PRECISION | __KIND == __DOUBLE_PRECISION REAL(MK), DIMENSION(:,:,:) , INTENT(IN ) :: data_in #elif __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX COMPLEX(MK), DIMENSION(:,:,:) , INTENT(IN ) :: data_in #elif __KIND == __SINGLE_PRECISION_COMPLEX_Z|__KIND == __DOUBLE_PRECISION_COMPLEX_Z COMPLEX(MK), DIMENSION(:,:,:) , INTENT(IN ) :: data_in #endif ! size of array INTEGER, DIMENSION(3) , INTENT(INOUT) :: lda ! output data, fast fourier transformed COMPLEX(MK), DIMENSION(:,:,:) , POINTER :: data_out INTEGER , INTENT( OUT) :: info !------------------------------------------------------------------------- ! Local variables !------------------------------------------------------------------------- ! timer REAL(MK) :: t0 ! counters INTEGER :: i,j,k,iopt ! size of the data_in INTEGER :: Nx_in, Ny_in, Nz_in ! size of the data_out INTEGER :: Nx_out, Ny_out, Nz_out #ifdef __FFTW ! FFTW Plan INTEGER*8 :: Plan INTEGER :: mbistride, mbrank, mbidist, mbiembed INTEGER :: mboembed, mbhowmany, mbodist #endif #ifdef __MATHKEISAN ! MATHKEISAN variables for MathKeisan FFTs INTEGER :: isign_fft,isys #if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX INTEGER :: incx, incy #elif __KIND == __SINGLE_PRECISION_COMPLEX_Z | __KIND == __DOUBLE_PRECISION_COMPLEX_Z INTEGER :: incx, incy #endif !scale of the transformation REAL(MK) :: scale_fft ! working storage REAL(MK), DIMENSION(:),POINTER :: table, work ! the size of the working storage INTEGER, DIMENSION(1) :: lda_table, lda_work #endif !------------------------------------------------------------------------- ! Externals !------------------------------------------------------------------------- !------------------------------------------------------------------------- ! Initialise !------------------------------------------------------------------------- CALL substart('ppm_fdsolver_fft_fd_3d',t0,info) #if !(defined(__FFTW) | defined(__MATHKEISAN)) !------------------------------------------------------------------------- ! Error if FFT library support is not available !------------------------------------------------------------------------- info = ppm_error_error #ifndef __FFTW CALL ppm_error(ppm_err_nofftw,'ppm_fdsolver_fft_fd_3d', & & 'PPM was compiled without fftw support',__LINE__,info) #endif #ifndef __MATHKEISAN CALL ppm_error(ppm_err_noMathKeisan,'ppm_fdsolver_fft_fd_3d', & & 'PPM was compiled without MATHKEISAN support',__LINE__,info) #endif GOTO 9999 #else !------------------------------------------------------------------------- ! Check arguments !------------------------------------------------------------------------- IF (ppm_debug .GT. 0) THEN IF (SIZE(lda,1) .LT. 3) THEN info = ppm_error_error CALL ppm_error(ppm_err_argument,'ppm_fdsolver_fft_fd_3d', & & 'lda must be at least of size 3',__LINE__,info) GOTO 9999 ENDIF IF (lda(1) .LE. 0) THEN info = ppm_error_error CALL ppm_error(ppm_err_argument,'ppm_fdsolver_fft_fd_3d', & & 'mesh size: lda(1) must be >0',__LINE__,info) GOTO 9999 ENDIF IF (lda(2) .LE. 0) THEN info = ppm_error_error CALL ppm_error(ppm_err_argument,'ppm_fdsolver_fft_fd_3d', & & 'mesh size: lda(2) must be >0',__LINE__,info) GOTO 9999 ENDIF IF (lda(3) .LE. 0) THEN info = ppm_error_error CALL ppm_error(ppm_err_argument,'ppm_fdsolver_fft_fd_3d', & & 'mesh size: lda(3) must be >0' ,__LINE__,info) GOTO 9999 ENDIF ENDIF ! Nx_in=lda(1) ! subtract 1 to fit ppm-convention Nx_in=lda(1)-1 Ny_in=lda(2) Nz_in=lda(3) !------------------------------------------------------------------------- ! Allocate result array !------------------------------------------------------------------------- #if __KIND == __SINGLE_PRECISION | __KIND == __DOUBLE_PRECISION Nx_out = Nx_in/2 + 1 #elif __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX Nx_out = Nx_in #elif __KIND == __SINGLE_PRECISION_COMPLEX_Z | __KIND == __DOUBLE_PRECISION_COMPLEX_Z Nx_out = Nx_in #endif Ny_out = Ny_in Nz_out = Nz_in #if __KIND == __SINGLE_PRECISION | __KIND == __DOUBLE_PRECISION lda(1) = Nx_out #elif __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX lda(1) = Nx_out+1 ! to fit ppm-convention #elif __KIND == __SINGLE_PRECISION_COMPLEX_Z| __KIND == __DOUBLE_PRECISION_COMPLEX_Z lda(1) = Nx_out+1 ! to fit ppm-convention #endif lda(2) = Ny_out lda(3) = Nz_out CALL ppm_alloc(data_out,lda,ppm_param_alloc_fit,info) IF (info .NE. 0) THEN info = ppm_error_fatal CALL ppm_error(ppm_err_alloc,'ppm_fdsolver_fft_fd_3d', & & 'fft result DATA_OUT',__LINE__,info) GOTO 9999 ENDIF !------------------------------------------------------------------------- ! FFT - Transform in x-direction !------------------------------------------------------------------------- !------------------------------------------------------------------------- ! NEC version - Use MathKeisan Library !------------------------------------------------------------------------- #ifdef __MATHKEISAN #if __CASE == __SLAB !------------------------------------------------------------------------- ! not implemented yet !------------------------------------------------------------------------- info = ppm_error_fatal CALL ppm_error(ppm_err_alloc,'ppm_fdsolver_fft_fd_2d', & & 'version not implemented',__LINE__,info) GOTO 9999 #else !------------------------------------------------------------------------- ! Allocate working storage !------------------------------------------------------------------------- lda_work = 4*Nx_in CALL ppm_alloc(work,lda_work,ppm_param_alloc_fit,info) IF (info .NE. 0) THEN info = ppm_error_fatal CALL ppm_error(ppm_err_alloc,'ppm_fdsolver_fft_fd_2d', & & 'work not allocated',__LINE__,info) GOTO 9999 ENDIF !------------------------------------------------------------------------- ! Forward FFT !------------------------------------------------------------------------- scale_fft = 1 isign_fft = -1 DO k=1,Nz_in DO j=1,Ny_in #if __KIND == __SINGLE_PRECISION CALL scfft(isign_fft, Nx_in, scale_fft, data_in(1,j,k), & & data_out(1,j,k), table_fd_s, work, isys) #elif __KIND == __DOUBLE_PRECISION CALL dzfft(isign_fft, Nx_in, scale_fft, data_in(1,j,k), & & data_out(1,j,k), table_fd_d, work, isys) #elif __KIND == __SINGLE_PRECISION_COMPLEX CALL cfft(isign_fft, Nx_in, scale_fft, data_in(1,j,k), incx, & & data_out(1,j,k), incy, table_fd_c_y, lda_table_y, & & work, lda_work(1),isys) #elif __KIND == __DOUBLE_PRECISION_COMPLEX CALL zfft(isign_fft, Nx_in, scale_fft, data_in(1,j,k), incx, & & data_out(1,j,k), incy, table_fd_cc_y, lda_table_y, & & work, lda_work(1),isys) #elif __KIND == __SINGLE_PRECISION_COMPLEX_Z CALL cfft(isign_fft, Nx_in, scale_fft, data_in(1,j,k), incx, & & data_out(1,j,k), incy, table_fd_c_z, lda_table_z, & & work, lda_work(1),isys) #elif __KIND == __DOUBLE_PRECISION_COMPLEX_Z CALL zfft(isign_fft, Nx_in, scale_fft, data_in(1,j,k), incx, & & data_out(1,j,k), incy, table_fd_cc_z, lda_table_z, & & work, lda_work(1),isys) #endif ENDDO ENDDO !------------------------------------------------------------------------- ! Deallocate Memory !------------------------------------------------------------------------- CALL ppm_alloc(work,lda_work,ppm_param_dealloc,info) IF (info .NE. 0) THEN WRITE(mesg,'(A)') 'could not deallocate memory' info = ppm_error_error CALL ppm_error(ppm_err_dealloc,'ppm_fdsolver_fft_fd_3d',mesg,__LINE__,& & info) GOTO 9999 ENDIF #endif #else !------------------------------------------------------------------------- ! FFTW version for LINUX,... !------------------------------------------------------------------------- #if __CASE == __SLAB #if __KIND == __SINGLE_PRECISION CALL sfftw_execute_dft_r2c(Plan_slab_fd_s,data_in(1,1,1),data_out(1,1,1) ) #elif __KIND == __DOUBLE_PRECISION CALL dfftw_execute_dft_r2c(Plan_slab_fd_d,data_in(1,1,1),data_out(1,1,1) ) #endif #else #if __KIND == __SINGLE_PRECISION CALL sfftw_execute_dft_r2c(Plan_fd_s,data_in(1,1,1),data_out(1,1,1) ) #elif __KIND == __DOUBLE_PRECISION CALL dfftw_execute_dft_r2c(Plan_fd_d,data_in(1,1,1),data_out(1,1,1) ) #elif __KIND == __SINGLE_PRECISION_COMPLEX CALL sfftw_execute_dft(Plan_fd_c_y,data_in(1,1,1),data_out(1,1,1) ) #elif __KIND == __DOUBLE_PRECISION_COMPLEX CALL dfftw_execute_dft(Plan_fd_cc_y,data_in(1,1,1),data_out(1,1,1) ) #elif __KIND == __SINGLE_PRECISION_COMPLEX_Z CALL sfftw_execute_dft(Plan_fd_c_z,data_in(1,1,1),data_out(1,1,1) ) #elif __KIND == __DOUBLE_PRECISION_COMPLEX_Z CALL dfftw_execute_dft(Plan_fd_cc_z,data_in(1,1,1),data_out(1,1,1) ) #endif #endif #endif #endif #if __KIND == __SINGLE_PRECISION_COMPLEX | __KIND == __DOUBLE_PRECISION_COMPLEX !------------------------------------------------------------------------- ! Copy margin to conform with PPM convention !------------------------------------------------------------------------- DO j=1,Ny_out DO k=1,Nz_out data_out(lda(1),j,k) = data_out(1,j,k) ENDDO ENDDO #endif #if __KIND == __SINGLE_PRECISION_COMPLEX_Z | __KIND == __DOUBLE_PRECISION_COMPLEX_Z !------------------------------------------------------------------------- ! Copy margin to conform with PPM convention !------------------------------------------------------------------------- DO j=1,Ny_out DO k=1,Nz_out data_out(lda(1),j,k) = data_out(1,j,k) ENDDO ENDDO #endif #if __CASE == __SLAB DO i=1,Nx_out DO k=1,Nz_out data_out(i,lda(2),k) = data_out(i,1,k) ENDDO ENDDO #endif !------------------------------------------------------------------------- ! Return !------------------------------------------------------------------------- 9999 CONTINUE CALL substop('ppm_fdsolver_fft_fd_3d',t0,info) RETURN #if __CASE == __SLAB #if __KIND == __SINGLE_PRECISION END SUBROUTINE ppm_fdsolver_fft_fd_slab_3ds #elif __KIND == __DOUBLE_PRECISION END SUBROUTINE ppm_fdsolver_fft_fd_slab_3dd #endif #else #if __KIND == __SINGLE_PRECISION END SUBROUTINE ppm_fdsolver_fft_fd_3ds #elif __KIND == __DOUBLE_PRECISION END SUBROUTINE ppm_fdsolver_fft_fd_3dd #elif __KIND == __SINGLE_PRECISION_COMPLEX END SUBROUTINE ppm_fdsolver_fft_fd_3dc #elif __KIND == __DOUBLE_PRECISION_COMPLEX END SUBROUTINE ppm_fdsolver_fft_fd_3dcc #elif __KIND == __SINGLE_PRECISION_COMPLEX_Z END SUBROUTINE ppm_fdsolver_fft_fd_z_3dc #elif __KIND == __DOUBLE_PRECISION_COMPLEX_Z END SUBROUTINE ppm_fdsolver_fft_fd_z_3dcc #endif #endif libppmnumerics-r1036/src/ppm_module_ode_create_ode.f0000644000175000017500000000477411616214647021462 0ustar omaromar !------------------------------------------------------------------------- ! Module : ppm_module_ode_create_ode !------------------------------------------------------------------------- ! ! Purpose : procedure module for ppm_ode_create_ode ! ! Remarks : ! ! References : ! ! Revisions : !------------------------------------------------------------------------- ! $Log: ppm_module_ode_create_ode.f,v $ ! Revision 1.1.1.1 2007/07/13 10:19:00 ivos ! CBL version of the PPM library ! ! Revision 1.2 2004/07/26 11:20:29 michaebe ! added dummy interface ! ! Revision 1.1 2004/07/26 07:45:47 michaebe ! Procedure modules created in the course of atomization. ! ! !------------------------------------------------------------------------- ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see . ! ! Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Switzerland !------------------------------------------------------------------------- #define __SINGLE_PRECISION 1 #define __DOUBLE_PRECISION 2 MODULE ppm_module_ode_create_ode !----------------------------------------------------- ! Dummy interface !----------------------------------------------------- INTERFACE ppm_ode_create_ode MODULE PROCEDURE ppm_ode_create_ode END INTERFACE CONTAINS #include "ppm_ode_create_ode.f" END MODULE ppm_module_ode_create_ode libppmnumerics-r1036/src/ppm_ode_finalize.f0000644000175000017500000001203511616214647017611 0ustar omaromar !------------------------------------------------------------------------- ! Subroutine : ppm_ode_finalize !------------------------------------------------------------------------- ! ! Purpose : garbage collection of the ode ! ! Input : ! ! Output : info (I) return status ! ! Remarks : ! ! References : ! ! Revisions : !------------------------------------------------------------------------- ! $Log: ppm_ode_finalize.f,v $ ! Revision 1.1.1.1 2007/07/13 10:19:00 ivos ! CBL version of the PPM library ! ! Revision 1.7 2004/07/26 15:38:51 ivos ! Inserted missing USE statements to resolve undefined references ! at link stage. ! ! Revision 1.6 2004/07/26 13:49:18 ivos ! Removed Routines sections from the header comment. ! ! Revision 1.5 2004/07/26 11:33:03 michaebe ! inserted the use of the ppm ode data module. ! ! Revision 1.4 2004/07/26 07:47:52 michaebe ! Atomized. Otherwise no changes. ! ! Revision 1.3 2004/06/10 16:20:03 ivos ! Moved all cpp directtives to column 1. The NEC cpp did not recognize ! them otherwise!!! ! ! Revision 1.2 2004/02/20 14:55:38 michaebe ! added the use of ppm_module_util. ! ! Revision 1.1 2004/02/19 08:33:54 michaebe ! initial implementation. ! !------------------------------------------------------------------------- ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see . ! ! Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Switzerland !------------------------------------------------------------------------- SUBROUTINE ppm_ode_finalize(info) !----------------------------------------------------------------------- ! Includes !----------------------------------------------------------------------- #include "ppm_define.h" !----------------------------------------------------------------------- ! Modules !----------------------------------------------------------------------- USE ppm_module_data_ode USE ppm_module_data USE ppm_module_substart USE ppm_module_substop USE ppm_module_error USE ppm_module_alloc IMPLICIT NONE !----------------------------------------------------------------------- ! Arguments !----------------------------------------------------------------------- INTEGER, INTENT( out) :: info INTEGER :: iopt INTEGER, DIMENSION(3) :: tlda !----------------------------------------------------------------------- ! call substart !----------------------------------------------------------------------- CALL substart('ppm_ode_finalize',t0,info) !----------------------------------------------------------------------- ! check input arguments !----------------------------------------------------------------------- IF(ppm_debug.GT.0) THEN !-------------------------------------------------------------------- ! check if ppm is initialized !-------------------------------------------------------------------- IF(.NOT.ppm_initialized) THEN info = ppm_error_error CALL ppm_error(ppm_err_ppm_noinit,'ppm_ode_finalize',& & 'Please call ppm_init first!',__LINE__,info) GOTO 9999 END IF END IF iopt = ppm_param_dealloc tlda(1) = ppm_max_mid_allocd #include "ppm_ode_modalloc.h" 9999 CONTINUE !----------------------------------------------------------------------- ! substop !----------------------------------------------------------------------- CALL substop('ppm_ode_finalize',t0,info) RETURN END SUBROUTINE ppm_ode_finalize libppmnumerics-r1036/src/ppm_fmm_expansion.f0000644000175000017500000005055711616214647020037 0ustar omaromar !------------------------------------------------------------------------- ! Subroutine : ppm_fmm_expansion !------------------------------------------------------------------------- ! ! Purpose : Compute the expansions of the leaf boxes of the created ! tree structure. ! Calls ppm_fmm_traverse, which traverses the tree and ! shifts the expansions up the tree. ! ! ! Input : xpunord(:,:) (F) particle positions ! wpunord(:,:) (F) particle strengths ! Np (I) number of particles. ! lda (I) leading dimension of vector case ! ! Input/output : ! ! Output : ! info (I) return status. 0 upon success. ! ! Remarks : ! ! References : ! ! Revisions : !------------------------------------------------------------------------- ! $Log: ppm_fmm_expansion.f,v $ ! Revision 1.1.1.1 2007/07/13 10:18:54 ivos ! CBL version of the PPM library ! ! Revision 1.20 2006/09/04 18:34:45 pchatela ! Fixes and cleanups to make it compile for ! release-1-0 ! ! Revision 1.19 2006/06/29 10:28:34 pchatela ! Added vector strengths support ! ! Revision 1.18 2006/06/20 15:17:05 hiebers ! BUGFIX: adjusted indices of ppm_boxid and ppm_subid ! ! Revision 1.17 2006/06/16 07:52:20 hiebers ! Added a new list of topo IDs (topoidlist) to prevent ! overwriting user defined topologies ! ! Revision 1.16 2006/02/03 09:39:12 ivos ! Changed the expansion loop to allow vectorization. ! ! Revision 1.15 2005/09/19 13:03:27 polasekb ! code cosmetics ! ! Revision 1.14 2005/09/11 11:43:59 polasekb ! moved mapping and second tree call to init ! ! Revision 1.13 2005/08/25 13:52:28 polasekb ! mapping of boxpart added ! ! Revision 1.12 2005/08/23 14:22:43 polasekb ! corrected to xpunord and wpunord ! ! Revision 1.11 2005/08/23 14:11:38 polasekb ! fixed the formula for the Cnm ! ! Revision 1.10 2005/08/11 15:13:15 polasekb ! now using maxboxcost from the data file ! ! Revision 1.9 2005/08/08 13:33:41 polasekb ! init some more variables ! ! Revision 1.8 2005/08/04 16:01:01 polasekb ! moved some data allocation to init ! ! Revision 1.7 2005/07/29 12:35:27 polasekb ! changed diagonal to radius ! ! Revision 1.6 2005/07/27 15:01:27 polasekb ! changed tree variables ! ! Revision 1.5 2005/07/25 14:39:54 polasekb ! adapted to new constants saved in the ! ppm_module_data_fmm file ! adapted function call to ppm_fmm_traverse ! ! Revision 1.4 2005/07/21 13:20:25 polasekb ! nullify lpdx, lhbx pointers ! ! Revision 1.3 2005/06/02 14:18:39 polasekb ! removed variable totalmass ! changed some comments ! ! Revision 1.2 2005/05/27 12:45:29 polasekb ! removed debug output ! ! Revision 1.1 2005/05/27 07:56:40 polasekb ! initial implementation ! ! Revision 0 2004/11/16 15:59:14 polasekb ! start ! !------------------------------------------------------------------------- ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see . ! ! Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Switzerland !------------------------------------------------------------------------- #if (__KIND == __SINGLE_PRECISION && __DIM == __SFIELD) SUBROUTINE ppm_fmm_expansion_s_sf(xpunord,wpunord,Np,info) #elif (__KIND == __DOUBLE_PRECISION && __DIM == __SFIELD) SUBROUTINE ppm_fmm_expansion_d_sf(xpunord,wpunord,Np,info) #elif (__KIND == __SINGLE_PRECISION && __DIM == __VFIELD) SUBROUTINE ppm_fmm_expansion_s_vf(xpunord,wpunord,lda,Np,info) #elif (__KIND == __DOUBLE_PRECISION && __DIM == __VFIELD) SUBROUTINE ppm_fmm_expansion_d_vf(xpunord,wpunord,lda,Np,info) #endif !------------------------------------------------------------------------- ! Modules !------------------------------------------------------------------------- USE ppm_module_data USE ppm_module_data_fmm USE ppm_module_fmm_traverse USE ppm_module_typedef USE ppm_module_substart USE ppm_module_substop USE ppm_module_error USE ppm_module_alloc USE ppm_module_util_cart2sph USE ppm_module_write IMPLICIT NONE !------------------------------------------------------------------------- ! Includes !------------------------------------------------------------------------- #include "ppm_define.h" #ifdef __MPI INCLUDE 'mpif.h' #endif !------------------------------------------------------------------------- ! Precision !------------------------------------------------------------------------- #if __KIND == __SINGLE_PRECISION INTEGER, PARAMETER :: MK = ppm_kind_single #else INTEGER, PARAMETER :: MK = ppm_kind_double #endif !------------------------------------------------------------------------- ! Arguments !------------------------------------------------------------------------- REAL(MK),DIMENSION(:,:),POINTER :: xpunord INTEGER ,INTENT(INOUT) :: Np INTEGER ,INTENT( OUT) :: info #if __DIM == __SFIELD REAL(MK),DIMENSION(:) ,POINTER :: wpunord #else REAL(MK),DIMENSION(:,:),POINTER :: wpunord INTEGER :: lda #endif !------------------------------------------------------------------------- ! Local variables !------------------------------------------------------------------------- ! auxiliary variables LOGICAL ,DIMENSION(3) :: fixed INTEGER :: iopt,i,j,k,m,n,l INTEGER :: first,last,box,nrpart INTEGER ,DIMENSION(2) :: ldu2 REAL(MK) :: sine,cosine,val,prod REAL(MK) :: angle,reci REAL(MK) :: t0,x0,y0,z0 REAL(MK) :: dx,dy,dz,dist REAL(MK),DIMENSION(:,:), POINTER :: min_box,max_box REAL(MK),DIMENSION(:,:), POINTER :: min_sub,max_sub COMPLEX(MK),PARAMETER :: CI=(0.0_MK,1.0_MK) COMPLEX(MK) :: temp CHARACTER(LEN=ppm_char) :: cbuf ! parallelisation INTEGER :: isub,topoid INTEGER :: nsublist REAL(MK),DIMENSION(:) , POINTER :: boxcost ! traversing INTEGER :: root ! fmm REAL(MK),DIMENSION(:) , POINTER :: rho,theta,phi,radius REAL(MK),DIMENSION(:) , POINTER :: fac,fracfac REAL(MK),DIMENSION(:,:), POINTER :: Anm,Pnm,sqrtfac,xp REAL(MK),DIMENSION(:,:), POINTER :: centerofbox COMPLEX(MK),DIMENSION(:,:) ,POINTER :: Ynm TYPE(ppm_t_topo) , POINTER :: topo #if __DIM == __SFIELD COMPLEX(MK),DIMENSION(:,:) ,POINTER :: Cnm COMPLEX(MK),DIMENSION(:,:,:),POINTER :: expansion #else COMPLEX(MK),DIMENSION(:,:,:) ,POINTER:: Cnm COMPLEX(MK),DIMENSION(:,:,:,:),POINTER:: expansion #endif !------------------------------------------------------------------------- ! Initialize !------------------------------------------------------------------------- CALL substart('ppm_fmm_expansion',t0,info) !------------------------------------------------------------------------- ! Check arguments !------------------------------------------------------------------------- IF (ppm_debug.GT.0) THEN IF (Np.LT. 0) THEN info = ppm_error_error CALL ppm_error(ppm_err_argument,'ppm_fmm_expansion', & & 'number of particles must be >= 0 !',__LINE__,info) GOTO 9999 ENDIF IF (.NOT. ppm_fmm_initialized) THEN info = ppm_error_error CALL ppm_error(ppm_err_argument,'ppm_fmm_expansion', & & 'Please call ppm_fmm_init first',__LINE__,info) GOTO 9999 ENDIF ENDIF !------------------------------------------------------------------------- ! Checking precision and pointing tree data to correct variables !------------------------------------------------------------------------- #if __KIND == __SINGLE_PRECISION min_box => min_box_s max_box => max_box_s boxcost => boxcost_s centerofbox => centerofbox_s radius => radius_s #if __DIM == __SFIELD expansion => expansion_s_sf Cnm => Cnm_s_sf #else expansion => expansion_s_vf Cnm => Cnm_s_vf #endif Anm => Anm_s sqrtfac => sqrtfac_s fracfac => fracfac_s fac => fac_s Ynm => Ynm_s Pnm => Pnm_s rho => rho_s theta => theta_s phi => phi_s #else min_box => min_box_d max_box => max_box_d boxcost => boxcost_d centerofbox => centerofbox_d radius => radius_d #if __DIM == __SFIELD expansion => expansion_d_sf Cnm => Cnm_d_sf #else expansion => expansion_d_vf Cnm => Cnm_d_vf #endif Anm => Anm_d sqrtfac => sqrtfac_d fracfac => fracfac_d fac => fac_d Ynm => Ynm_d Pnm => Pnm_d rho => rho_d theta => theta_d phi => phi_d #endif !------------------------------------------------------------------------- ! Allocating temporary array for sorted particle positions ! according to tree !------------------------------------------------------------------------- iopt = ppm_param_alloc_fit ldu2(1) = ppm_dim ldu2(2) = Np CALL ppm_alloc(xp,ldu2,iopt,info) IF (info .NE. 0) THEN info = ppm_error_fatal CALL ppm_error(ppm_err_alloc,'ppm_fmm_expansion', & & 'error allocating xp',__LINE__,info) GOTO 9999 ENDIF !------------------------------------------------------------------------- ! Computing the expansions of the leafs !------------------------------------------------------------------------- topoid = topoidlist(nlevel) topo => ppm_topo(topoid)%t DO i=1,topo%nsublist !---------------------------------------------------------------------- ! initialize arrays !---------------------------------------------------------------------- DO j=0,order DO k= -order,order #if __DIM == __SFIELD Cnm(j,k) = 0.0_MK #else DO l=1,lda Cnm(l,j,k) = 0.0_MK ENDDO #endif Ynm(j,k) = 0.0_MK Pnm(j,k) = 0.0_MK ENDDO ENDDO !---------------------------------------------------------------------- ! Store the subid and boxid and the indices of the first and the last ! particle in the box !---------------------------------------------------------------------- isub = topo%isublist(i) box = ppm_boxid(isub,nlevel) first = lhbx(1,box) last = lhbx(2,box) !---------------------------------------------------------------------- ! Sort xp (particle order from tree) !---------------------------------------------------------------------- IF(ppm_dim.EQ.2)THEN DO j=first,last xp(1,j) = xpunord(1,lpdx(j)) xp(2,j) = xpunord(2,lpdx(j)) ENDDO ENDIF IF(ppm_dim.EQ.3)THEN DO j=first,last xp(1,j) = xpunord(1,lpdx(j)) xp(2,j) = xpunord(2,lpdx(j)) xp(3,j) = xpunord(3,lpdx(j)) ENDDO ENDIF nrpart = last-first + 1 !---------------------------------------------------------------------- ! Compute the spherical coord. of the particles !---------------------------------------------------------------------- IF(nrpart.GT.0)THEN CALL ppm_util_cart2sph(xp(1,first:last), & & xp(2,first:last),xp(3,first:last),nrpart, & & centerofbox(1,box),centerofbox(2,box),centerofbox(3,box), & & rho(first:last),theta(first:last),phi(first:last),info) IF (info .NE. 0) THEN CALL ppm_error(ppm_err_sub_failed,'ppm_fmm_expansion', & & 'Failed calling util_cart2sph',__LINE__,info) ENDIF ENDIF !---------------------------------------------------------------------- ! Loop over the particles in the leaves !---------------------------------------------------------------------- DO j=first,last cosine = COS(theta(j)) sine = SIN(theta(j)) !------------------------------------------------------------------- ! Recurrence for Pnm !------------------------------------------------------------------- val = -sine prod = 1.0_MK DO m=0,order Pnm(m,m) = fracfac(m)*prod prod = prod * val ENDDO DO m=0,order-1 Pnm(m+1,m) = cosine*REAL(2*m + 1,MK)*Pnm(m,m) ENDDO DO n=2,order val = cosine*REAL(2*n-1,MK) DO m=0,n-2 Pnm(n,m)=(val*Pnm(n-1,m) - & & DBLE(n+m-1)*Pnm(n-2,m))/REAL(n-m,MK) ENDDO ENDDO !------------------------------------------------------------------- ! Compute Ynm(n,m) and Ynm(n,-m) !------------------------------------------------------------------- DO n=0,order m = 0 angle = REAL(m,MK)*phi(j) Ynm(n,m) = sqrtfac(n,m)*Pnm(n,m)* & & CMPLX(COS(angle),SIN(angle)) DO m=1,n angle = REAL(m,MK)*phi(j) Ynm(n,m) = sqrtfac(n,m)* & & Pnm(n,m)*CMPLX(COS(angle),SIN(angle)) Ynm(n,-m) = CONJG(Ynm(n,m)) ENDDO ENDDO !------------------------------------------------------------------- ! Computing Cnm(n,m) - the expansion coefficients !------------------------------------------------------------------- prod = 1.0_MK val = rho(j) DO n=0,order DO m=0,n #if __DIM == __SFIELD Cnm(n,m) = Cnm(n,m) + (wpunord(lpdx(j))*prod*Ynm(n,m)* & & Anm(n,m))/((-1)**n) #else DO l =1,lda Cnm(l,n,m) = Cnm(l,n,m) + (wpunord(l,lpdx(j))*prod*Ynm(n,m)* & & Anm(n,m))/((-1)**n) ENDDO #endif ENDDO prod = prod * val ENDDO ENDDO !particles in one sub !---------------------------------------------------------------------- ! Computing Cnm(n,-m) !---------------------------------------------------------------------- DO n=0,order DO m=1,n #if __DIM == __SFIELD Cnm(n,-m) = CONJG(Cnm(n,m)) #else DO l =1,lda Cnm(l,n,-m) = CONJG(Cnm(l,n,m)) ENDDO #endif ENDDO ENDDO DO m=1,order temp = CI**(-m) DO n=m,order #if __DIM == __SFIELD Cnm(n,m) = Cnm(n,m)*temp Cnm(n,-m)= Cnm(n,-m)*temp #else DO l=1,lda Cnm(l,n,m) = Cnm(l,n,m)*temp Cnm(l,n,-m)= Cnm(l,n,-m)*temp ENDDO #endif ENDDO ENDDO !---------------------------------------------------------------------- ! Save expansion in fmm_module_data file !---------------------------------------------------------------------- #if __DIM == __SFIELD DO n=0,order DO m=-order,order expansion(box,n,m) = Cnm(n,m) ENDDO ENDDO #else DO n=0,order DO m=-order,order DO l=1,lda expansion(l,box,n,m) = Cnm(l,n,m) ENDDO ENDDO ENDDO #endif ENDDO !loop over all subs !------------------------------------------------------------------------- ! Nullify data pointers !------------------------------------------------------------------------- NULLIFY(min_box) NULLIFY(max_box) NULLIFY(boxcost) NULLIFY(centerofbox) NULLIFY(radius) NULLIFY(expansion) NULLIFY(Anm) NULLIFY(sqrtfac) NULLIFY(fracfac) NULLIFY(Ynm) NULLIFY(Pnm) NULLIFY(Cnm) !------------------------------------------------------------------------- ! Traverse the tree and shift the expansions upwards !------------------------------------------------------------------------- IF (parent(1) .EQ. ppm_param_undefined) THEN root = 1 ELSE DO i=2,nbox IF (parent(i) .EQ. ppm_param_undefined) THEN root = i EXIT ENDIF ENDDO ENDIF #if __DIM == __SFIELD CALL ppm_fmm_traverse(root,t0,info) #else CALL ppm_fmm_traverse(root,lda,t0,info) #endif IF (info.NE.0) THEN CALL ppm_error(ppm_err_sub_failed,'ppm_fmm_expansion', & & 'traversing tree failed',__LINE__,info) ENDIF IF (ppm_debug .GT. 0) THEN CALL ppm_write(ppm_rank,'ppm_fmm_expansion','traversed tree',info) ENDIF !------------------------------------------------------------------------- ! deallocate local data !------------------------------------------------------------------------- CALL ppm_alloc(xp,ldu2,ppm_param_dealloc,info) IF (info .NE. 0) THEN WRITE(cbuf,'(A,I3,A)') 'for ',info,'error while dealloc' info = ppm_error_error CALL ppm_error(ppm_err_dealloc,'ppm_fmm_expansion',cbuf,__LINE__,& & info) GOTO 9999 ENDIF !------------------------------------------------------------------------- ! Return !------------------------------------------------------------------------- 9999 CONTINUE CALL substop('ppm_fmm_expansion',t0,info) RETURN #if (__KIND == __SINGLE_PRECISION && __DIM == __SFIELD) END SUBROUTINE ppm_fmm_expansion_s_sf #elif (__KIND == __DOUBLE_PRECISION && __DIM == __SFIELD) END SUBROUTINE ppm_fmm_expansion_d_sf #elif (__KIND == __SINGLE_PRECISION && __DIM == __VFIELD) END SUBROUTINE ppm_fmm_expansion_s_vf #elif (__KIND == __DOUBLE_PRECISION && __DIM == __VFIELD) END SUBROUTINE ppm_fmm_expansion_d_vf #endif libppmnumerics-r1036/src/ppm_template_comp_pp_ring.f0000644000175000017500000002705711616214647021542 0ustar omaromar !------------------------------------------------------------------------- ! Subroutine : ppm_template_comp_pp_ring !------------------------------------------------------------------------- ! ! Purpose : Template for the user subroutine which computes ! direct particle-particle interactions using the ! ring topology. How to use this template: ! (1) copy this file to your application code dir ! (2) rename the file and this routine (make sure ! to also replace all the occurrences of the ! subroutine name in all WRITE statements). ! (3) change address in header and add your CVS ! Log (if needed). ! (4) declare and add additional arguments ! (5) add USE and INCLUDE statements for your ! modules and header files ! (6) define the precision of floating point data ! (maybe provide different versions of this ! subroutine for different precisions) ! (7) add particle-particle interactions where ! needed (search for USER CODE) ! (8) Optional: Make argument checking conditional ! on the debug level of your application ! (9) Optional: Make this routine use your own ! error logging, message writing, allocation, ! subroutine start, subroutine stop and ! timing routines. ! ! Input : xp(:,:) (F) : particle co-ordinates [Group 1] ! vp(:,:) (F) : particle data used for interaction ! (e.g. vorticity, strength, ...) ! [Group 1] ! ... (.) : USER: add more input arguments for ! group 1 here if needed. ! needed ! Npart (I) : number of particles on this proc. ! [Group 1] ! xp2(:,:) (F) : particle co-ordinates [Group 2] ! vp2(:,:) (F) : particle data used for interaction ! (e.g. vorticity, strength, ...) ! [Group 2] ! ... (.) : USER: add more input arguments for ! group 1 here if needed. ! Lpart (I) : number of particles [Group 2] ! lsymm (L) : Whether to use symmetry or not: ! .FALSE. pp interaction w/o symmetry ! .TRUE. pp interaction w/ symmetry ! mode (I) : Whether the two groups are the ! same or not: ! 0 not the same group ! 1 the same group ! ! Input/output : params(:) (F) : user defined parameters and/or ! output from the interaction (i.e. ! potential energy) ! fp(:,:) (F) : Change of particle data due ! to interaction [Group 1] ! fp2(:,:) (F) : Change of particle data due ! to interaction [Group 2] ! ... (.) : USER: add more output arguments for ! if needed. ! Output : info (I) : return status. 0 if no error. ! ! Routines : ! ! Remarks : Search for USER in this file and fill in ! the particle-particle interactions in all 4 places. ! Use the fp and fp2 array to return the result. ! ! ! References : ! ! Revisions : !------------------------------------------------------------------------- ! $Revision: 1.1.1.1 $ ! Revision 1.2 2004/04/23 17:25:33 oingo ! Revision 1.1 2004/04/22 08:29:06 oingo !------------------------------------------------------------------------- ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see . ! ! Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Switzerland !------------------------------------------------------------------------- SUBROUTINE ppm_template_comp_pp_ring(xp, vp, fp ,Npart, & & xp2,vp2,fp2,Lpart, & & lsymm,params,mode,info) !------------------------------------------------------------------------- ! Modules !------------------------------------------------------------------------- ! USER: USE statements here... IMPLICIT NONE !------------------------------------------------------------------------- ! Includes !------------------------------------------------------------------------- INCLUDE 'ppm_param.h' !------------------------------------------------------------------------- ! USER: Define precision !------------------------------------------------------------------------- ! INTEGER, PARAMETER :: MK = ppm_kind_single INTEGER, PARAMETER :: MK = ppm_kind_double !------------------------------------------------------------------------- ! Arguments !------------------------------------------------------------------------- REAL(MK), DIMENSION(:,:), INTENT(IN ) :: xp REAL(MK), DIMENSION(:,:), INTENT(IN ) :: vp ! USER: add more arguments here if needed REAL(MK), DIMENSION(:,:), INTENT(INOUT) :: fp INTEGER , INTENT(IN ) :: Npart REAL(MK), DIMENSION(:,:), INTENT(IN ) :: xp2 REAL(MK), DIMENSION(:,:), INTENT(IN ) :: vp2 ! USER: add more arguments here if needed REAL(MK), DIMENSION(:,:), INTENT(INOUT) :: fp2 INTEGER , INTENT(IN ) :: Lpart LOGICAL , INTENT(IN ) :: lsymm REAL(MK), DIMENSION(:), INTENT(INOUT) :: params INTEGER , INTENT(IN ) :: mode INTEGER , INTENT( OUT) :: info !------------------------------------------------------------------------- ! Local variables !------------------------------------------------------------------------- ! counters INTEGER :: i,j ! coordinate differences REAL(MK) :: dx,dy,dz ! square of inter particle distance REAL(MK) :: dij !------------------------------------------------------------------------- ! Externals !------------------------------------------------------------------------- !------------------------------------------------------------------------- ! Initialise !------------------------------------------------------------------------- info = 0 !------------------------------------------------------------------------- ! Check arguments ! USER: You might want to make this conditional on the debug level ! of your application... !------------------------------------------------------------------------- IF (Npart .LE. 0) THEN WRITE(*,'(2A)') '(ppm_template_comp_pp_ring): ', & & 'Npart must be >0' info = -1 GOTO 9999 ENDIF IF (Lpart .LE. 0) THEN WRITE(*,'(2A)') '(ppm_template_comp_pp_ring): ', & & 'Lpart must be >0' info = -1 GOTO 9999 ENDIF IF ((mode .NE. 0) .AND. (mode .NE. 1)) THEN WRITE(*,'(2A)') '(ppm_template_comp_pp_ring): ', & & 'MODE must be either 0 or 1' info = -1 GOTO 9999 ENDIF !------------------------------------------------------------------------- ! Check if we are computing the selfinteraction (i.e. Group1 .EQ. Group2) !------------------------------------------------------------------------- IF (mode .EQ. 1) THEN IF (lsymm) THEN DO i = 1,Npart DO j = i+1,Lpart !----------------------------------------------------------- ! USER CODE HERE (with symmetry) ! dx = xp(1,i) - xp2(1,j) ! dy = xp(2,i) - xp2(2,j) ! dz = xp(3,i) - xp2(3,j) ! dij = (dx*dx)+(dy*dy)+(dz*dz) ! ... !----------------------------------------------------------- ENDDO ENDDO ELSE DO i = 1,Npart DO j = 1,Lpart IF (i .EQ. j) CYCLE !----------------------------------------------------------- ! USER CODE HERE (without symmetry) !----------------------------------------------------------- ENDDO ENDDO ENDIF !------------------------------------------------------------------------- ! Here we compute the interaction between two different groups !------------------------------------------------------------------------- ELSE IF (lsymm) THEN DO i = 1,Npart DO j = 1,Lpart !----------------------------------------------------------- ! USER CODE HERE (with symmetry) !----------------------------------------------------------- ENDDO ENDDO ELSE DO i = 1,Npart DO j = 1,Lpart !----------------------------------------------------------- ! USER CODE HERE (without symmetry) !----------------------------------------------------------- ENDDO ENDDO ENDIF ENDIF !------------------------------------------------------------------------- ! Return !------------------------------------------------------------------------- 9999 CONTINUE RETURN END SUBROUTINE ppm_template_comp_pp_ring libppmnumerics-r1036/src/ppm_gmm_march_fwd.f0000644000175000017500000010030111616214647017745 0ustar omaromar !------------------------------------------------------------------------- ! Subroutine : ppm_gmm_march_fwd !------------------------------------------------------------------------- ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see . ! ! Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Switzerland !------------------------------------------------------------------------- #if __DIM == __2D #if __KIND == __SINGLE_PRECISION SUBROUTINE ppm_gmm_march_fwd_2ds(fdta,width,order,npos,TM, & & rhscst,dxinv,dyinv,dzinv,ghostsize,info,speed,chi) #elif __KIND == __DOUBLE_PRECISION SUBROUTINE ppm_gmm_march_fwd_2dd(fdta,width,order,npos,TM, & & rhscst,dxinv,dyinv,dzinv,ghostsize,info,speed,chi) #endif #elif __DIM == __3D #if __KIND == __SINGLE_PRECISION SUBROUTINE ppm_gmm_march_fwd_3ds(fdta,width,order,npos,TM, & & rhscst,dxinv,dyinv,dzinv,ghostsize,info,speed,chi) #elif __KIND == __DOUBLE_PRECISION SUBROUTINE ppm_gmm_march_fwd_3dd(fdta,width,order,npos,TM, & & rhscst,dxinv,dyinv,dzinv,ghostsize,info,speed,chi) #endif #endif !!! This routine performs the forward marching step of the GMM. See !!! ppm_gmm_march for details. !!! !!! === References === !!! !!! Chopp:2001, Kim:2001b !------------------------------------------------------------------------- ! Modules !------------------------------------------------------------------------- USE ppm_module_data USE ppm_module_numerics_data USE ppm_module_data_gmm USE ppm_module_substart USE ppm_module_substop USE ppm_module_error USE ppm_module_alloc USE ppm_module_typedef USE ppm_module_map_field IMPLICIT NONE #if __KIND == __SINGLE_PRECISION INTEGER, PARAMETER :: MK = ppm_kind_single #else INTEGER, PARAMETER :: MK = ppm_kind_double #endif !------------------------------------------------------------------------- ! Includes !------------------------------------------------------------------------- #include "ppm_define.h" #ifdef __MPI INCLUDE 'mpif.h' #endif !------------------------------------------------------------------------- ! Arguments !------------------------------------------------------------------------- #if __DIM == __2D REAL(MK), DIMENSION(:,:,:) , POINTER :: fdta !!! pointer to level function. REAL(MK), DIMENSION(:,:,:) , INTENT(IN), OPTIONAL :: speed !!! rank 4 (3d) or rank 3 (2d) field of front speeds. !!! OPTIONAL to override rhscst. REAL(MK), DIMENSION(:,:,:,:) , INTENT(IN), OPTIONAL :: chi !!! rank 5 (3d) or rank 4 (2d) field specifying the positions of the !!! grid nodes. 1st index: 1..ppm_dim, then i,j,[k],isub. !!! OPTIONAL. Uniform grid is assumed if absent. #elif __DIM == __3D REAL(MK), DIMENSION(:,:,:,:) , POINTER :: fdta !!! pointer to level function. REAL(MK), DIMENSION(:,:,:,:) , INTENT(IN), OPTIONAL :: speed !!! rank 4 (3d) or rank 3 (2d) field of front speeds. !!! OPTIONAL to override rhscst. REAL(MK), DIMENSION(:,:,:,:,:) , INTENT(IN), OPTIONAL :: chi !!! rank 5 (3d) or rank 4 (2d) field specifying the positions of the !!! grid nodes. 1st index: 1..ppm_dim, then i,j,[k],isub. !!! OPTIONAL. Uniform grid is assumed if absent. #endif REAL(MK) , INTENT(IN ) :: width !!! Width of the narrow band to be produced on each side of the interface. REAL(MK) , INTENT(IN ) :: rhscst !!! constant value for the right hand side of grad u * grad f = c. !!! If speed is present, this argument will be ignored. REAL(MK) , INTENT(IN ) :: TM !!! Current threshold for wave front location. REAL(MK) , INTENT(IN ) :: dxinv !!! inverse of the x grid spacing. REAL(MK) , INTENT(IN ) :: dyinv !!! inverse of the y grid spacing. REAL(MK) , INTENT(IN ) :: dzinv !!! inverse of the z grid spacing. (Not used in 2D version). INTEGER, DIMENSION(3) , INTENT(IN ) :: ghostsize !!! Size of the ghostlayer on all sides. INTEGER , INTENT(IN ) :: order !!! Order of the method to be used. One of !!! !!! *ppm_param_order_1 !!! *ppm_param_order_2 !!! *ppm_param_order_3 INTEGER , INTENT(INOUT) :: npos !!! Current number of points in the close set. INTEGER , INTENT( OUT) :: info !!! Return status, 0 upon success !------------------------------------------------------------------------- ! Local variables !------------------------------------------------------------------------- INTEGER :: i,j,k,p,xhi,yhi,zhi,ii,jj,kk INTEGER :: npos0,jsub,isub,iopt INTEGER :: i1,i2,i3 INTEGER, DIMENSION(-3:3) :: sx,sy,sz INTEGER, DIMENSION(4) :: ldu REAL(MK) :: t0,onethird,onetwelfth REAL(MK) :: dxihalf,dyihalf,dzihalf REAL(MK) :: dxitwelve,dyitwelve,dzitwelve REAL(MK) :: valijk,det,hsave,fdta0 REAL(MK) :: lmyeps,ainv,big,absfdta0 REAL(MK), DIMENSION(3) :: coefs REAL(MK), DIMENSION(3,3) :: jac,ji REAL(MK), DIMENSION(-3:3,ppm_dim):: phi,psi REAL(MK), DIMENSION(ppm_dim) :: alpha,beta REAL(MK), DIMENSION(2) :: roots TYPE(ppm_t_topo), POINTER :: topo TYPE(ppm_t_equi_mesh), POINTER :: mesh !------------------------------------------------------------------------- ! Externals !------------------------------------------------------------------------- !------------------------------------------------------------------------- ! Initialise !------------------------------------------------------------------------- CALL substart('ppm_gmm_march_fwd',t0,info) topo => ppm_topo(gmm_topoid)%t mesh => topo%mesh(gmm_meshid) phi = 0.0_MK psi = 0.0_MK big = HUGE(big) hsave = 0.9_MK*big onethird = 1.0_MK/3.0_MK onetwelfth = 1.0_MK/12.0_MK #if __KIND == __SINGLE_PRECISION lmyeps = ppm_myepss #else lmyeps = ppm_myepsd #endif dxihalf = 0.5_MK*dxinv dyihalf = 0.5_MK*dyinv dxitwelve = onetwelfth*dxinv dyitwelve = onetwelfth*dyinv #if __DIM == __3D dzihalf = 0.5_MK*dzinv dzitwelve = onetwelfth*dzinv #endif !------------------------------------------------------------------------- ! Check arguments !------------------------------------------------------------------------- IF (ppm_debug .GT. 0) THEN IF (width .LT. 0.0_MK) THEN info = ppm_error_error CALL ppm_error(ppm_err_ppm_noinit,'ppm_gmm_march_fwd', & & 'width must be positive!',__LINE__,info) GOTO 9999 ENDIF IF ((order.NE.ppm_param_order_1).AND.(order.NE.ppm_param_order_2) & & .AND.(order.NE.ppm_param_order_3)) THEN info = ppm_error_error CALL ppm_error(ppm_err_ppm_noinit,'ppm_gmm_march_fwd', & & 'order must be 1, 2, or 3!',__LINE__,info) GOTO 9999 ENDIF ENDIF ! ppm_debug for argument check #if __DIM == __3D npos0 = npos !------------------------------------------------------------------------- ! Forward order: update neighbors of points in ggm_ipos !------------------------------------------------------------------------- DO p=1,npos IF (p .GT. npos0) EXIT ii = gmm_ipos(1,p) jj = gmm_ipos(2,p) kk = gmm_ipos(3,p) jsub = gmm_ipos(4,p) isub = topo%isublist(jsub) xhi = mesh%nnodes(1,isub) yhi = mesh%nnodes(2,isub) zhi = mesh%nnodes(3,isub) fdta0= fdta(ii,jj,kk,jsub) absfdta0 = fdta0 IF (absfdta0 .LT. 0.0_MK) absfdta0 = -absfdta0 !--------------------------------------------------------------------- ! GMM update condition (see Kim:2001a) !--------------------------------------------------------------------- IF (.NOT.(absfdta0.GT.TM)) THEN !----------------------------------------------------------------- ! Compute non-accepted neighbors !----------------------------------------------------------------- i = ii - 1 j = jj k = kk IF (i.GT.0) THEN IF ((gmm_state3d(i,j,k,jsub) .NE. & & ppm_gmm_param_accepted) .AND. & & (ABS(fdta(i,j,k,jsub)).GT.absfdta0)) THEN !--------------------------------------------------------- ! Update point i,j,k !--------------------------------------------------------- #include "ppm_gmm_slvupwnd.inc" IF (valijk .LT. hsave) THEN IF (ABS(valijk).LT.ABS(fdta(i,j,k,jsub))) THEN IF ((valijk*fdta(i,j,k,jsub).GE.0.0_MK) .OR. & & (fdta(i,j,k,jsub).GT.hsave)) THEN fdta(i,j,k,jsub) = valijk ENDIF ENDIF !----------------------------------------------------- ! Keep in or add to close set !----------------------------------------------------- IF ((gmm_state3d(i,j,k,jsub) .EQ. & & ppm_gmm_param_far) .AND. & & (ABS(fdta(i,j,k,jsub)) .LT. width)) THEN gmm_state3d(i,j,k,jsub) = & & ppm_gmm_param_close #include "ppm_gmm_add_to_list.inc" ENDIF ENDIF ENDIF ENDIF i = ii + 1 j = jj k = kk IF (i.LE.xhi) THEN IF ((gmm_state3d(i,j,k,jsub) .NE. & & ppm_gmm_param_accepted) .AND. & & (ABS(fdta(i,j,k,jsub)).GT.absfdta0)) THEN !--------------------------------------------------------- ! Update point i,j,k !--------------------------------------------------------- #include "ppm_gmm_slvupwnd.inc" IF (valijk .LT. hsave) THEN IF (ABS(valijk).LT.ABS(fdta(i,j,k,jsub))) THEN IF ((valijk*fdta(i,j,k,jsub).GE.0.0_MK) .OR. & & (fdta(i,j,k,jsub).GT.hsave)) THEN fdta(i,j,k,jsub) = valijk ENDIF ENDIF !----------------------------------------------------- ! Keep in or add to close set !----------------------------------------------------- IF ((gmm_state3d(i,j,k,jsub) .EQ. & & ppm_gmm_param_far) .AND. & & (ABS(fdta(i,j,k,jsub)) .LT. width)) THEN gmm_state3d(i,j,k,jsub) = & & ppm_gmm_param_close #include "ppm_gmm_add_to_list.inc" ENDIF ENDIF ENDIF ENDIF i = ii j = jj - 1 k = kk IF (j.GT.0) THEN IF ((gmm_state3d(i,j,k,jsub) .NE. & & ppm_gmm_param_accepted) .AND. & & (ABS(fdta(i,j,k,jsub)).GT.absfdta0)) THEN !--------------------------------------------------------- ! Update point i,j,k !--------------------------------------------------------- #include "ppm_gmm_slvupwnd.inc" IF (valijk .LT. hsave) THEN IF (ABS(valijk).LT.ABS(fdta(i,j,k,jsub))) THEN IF ((valijk*fdta(i,j,k,jsub).GE.0.0_MK) .OR. & & (fdta(i,j,k,jsub).GT.hsave)) THEN fdta(i,j,k,jsub) = valijk ENDIF ENDIF !----------------------------------------------------- ! Keep in or add to close set !----------------------------------------------------- IF ((gmm_state3d(i,j,k,jsub) .EQ. & & ppm_gmm_param_far) .AND. & & (ABS(fdta(i,j,k,jsub)) .LT. width)) THEN gmm_state3d(i,j,k,jsub) = & & ppm_gmm_param_close #include "ppm_gmm_add_to_list.inc" ENDIF ENDIF ENDIF ENDIF i = ii j = jj + 1 k = kk IF (j.LE.yhi) THEN IF ((gmm_state3d(i,j,k,jsub) .NE. & & ppm_gmm_param_accepted) .AND. & & (ABS(fdta(i,j,k,jsub)).GT.absfdta0)) THEN !--------------------------------------------------------- ! Update point i,j,k !--------------------------------------------------------- #include "ppm_gmm_slvupwnd.inc" IF (valijk .LT. hsave) THEN IF (ABS(valijk).LT.ABS(fdta(i,j,k,jsub))) THEN IF ((valijk*fdta(i,j,k,jsub).GE.0.0_MK) .OR. & & (fdta(i,j,k,jsub).GT.hsave)) THEN fdta(i,j,k,jsub) = valijk ENDIF ENDIF !----------------------------------------------------- ! Keep in or add to close set !----------------------------------------------------- IF ((gmm_state3d(i,j,k,jsub) .EQ. & & ppm_gmm_param_far) .AND. & & (ABS(fdta(i,j,k,jsub)) .LT. width)) THEN gmm_state3d(i,j,k,jsub) = & & ppm_gmm_param_close #include "ppm_gmm_add_to_list.inc" ENDIF ENDIF ENDIF ENDIF i = ii j = jj k = kk - 1 IF (k.GT.0) THEN IF ((gmm_state3d(i,j,k,jsub) .NE. & & ppm_gmm_param_accepted) .AND. & & (ABS(fdta(i,j,k,jsub)).GT.absfdta0)) THEN !--------------------------------------------------------- ! Update point i,j,k !--------------------------------------------------------- #include "ppm_gmm_slvupwnd.inc" IF (valijk .LT. hsave) THEN IF (ABS(valijk).LT.ABS(fdta(i,j,k,jsub))) THEN IF ((valijk*fdta(i,j,k,jsub).GE.0.0_MK) .OR. & & (fdta(i,j,k,jsub).GT.hsave)) THEN fdta(i,j,k,jsub) = valijk ENDIF ENDIF !----------------------------------------------------- ! Keep in or add to close set !----------------------------------------------------- IF ((gmm_state3d(i,j,k,jsub) .EQ. & & ppm_gmm_param_far) .AND. & & (ABS(fdta(i,j,k,jsub)) .LT. width)) THEN gmm_state3d(i,j,k,jsub) = & & ppm_gmm_param_close #include "ppm_gmm_add_to_list.inc" ENDIF ENDIF ENDIF ENDIF i = ii j = jj k = kk + 1 IF (k.LE.zhi) THEN IF ((gmm_state3d(i,j,k,jsub) .NE. & & ppm_gmm_param_accepted) .AND. & & (ABS(fdta(i,j,k,jsub)).GT.absfdta0)) THEN !--------------------------------------------------------- ! Update point i,j,k !--------------------------------------------------------- #include "ppm_gmm_slvupwnd.inc" IF (valijk .LT. hsave) THEN IF (ABS(valijk).LT.ABS(fdta(i,j,k,jsub))) THEN IF ((valijk*fdta(i,j,k,jsub).GE.0.0_MK) .OR. & & (fdta(i,j,k,jsub).GT.hsave)) THEN fdta(i,j,k,jsub) = valijk ENDIF ENDIF !----------------------------------------------------- ! Keep in or add to close set !----------------------------------------------------- IF ((gmm_state3d(i,j,k,jsub) .EQ. & & ppm_gmm_param_far) .AND. & & (ABS(fdta(i,j,k,jsub)) .LT. width)) THEN gmm_state3d(i,j,k,jsub) = & & ppm_gmm_param_close #include "ppm_gmm_add_to_list.inc" ENDIF ENDIF ENDIF ENDIF !----------------------------------------------------------------- ! Accept this point and remove it from the list !----------------------------------------------------------------- gmm_state3d(ii,jj,kk,jsub) = ppm_gmm_param_accepted gmm_ipos(1,p) = gmm_ipos(1,npos0) gmm_ipos(2,p) = gmm_ipos(2,npos0) gmm_ipos(3,p) = gmm_ipos(3,npos0) gmm_ipos(4,p) = gmm_ipos(4,npos0) npos0 = npos0 - 1 ENDIF ! TT .LE. TM ENDDO ! p=1,npos npos = npos0 ! WRITE(cbuf,'(A,I2.2,A)') 'state_',Marchit,'.out' ! OPEN(40,FILE=cbuf,STATUS='REPLACE',ACTION='WRITE') ! WRITE(cbuf,'(A,I2.2,A)') 'value_',Marchit,'.out' ! OPEN(30,FILE=cbuf,STATUS='REPLACE',ACTION='WRITE') ! DO kk=1,zhi ! DO jj=1,yhi ! DO ii=1,xhi ! WRITE(40,'(I3)') gmm_state3d(ii,jj,kk,jsub) ! IF (fdta(ii,jj,kk,jsub) .GT. hsave) THEN ! WRITE(30,'(E20.8)') 0.0_MK ! ELSE ! WRITE(30,'(E20.8)') fdta(ii,jj,kk,jsub) ! ENDIF ! ENDDO ! ENDDO ! ENDDO ! CLOSE(30) ! CLOSE(40) !------------------------------------------------------------------------- ! Update ghost layers for both fdta AND gmm_state3d !------------------------------------------------------------------------- CALL ppm_map_field_push(gmm_topoid,gmm_meshid,fdta,info) IF (info .NE. ppm_param_success) THEN info = ppm_error_error CALL ppm_error(ppm_err_sub_failed,'ppm_gmm_march_fwd', & & 'pushing field data failed',__LINE__,info) GOTO 9999 ENDIF CALL ppm_map_field_push(gmm_topoid,gmm_meshid,gmm_state3d,info) IF (info .NE. ppm_param_success) THEN info = ppm_error_error CALL ppm_error(ppm_err_sub_failed,'ppm_gmm_march_fwd', & & 'pushing status data failed',__LINE__,info) GOTO 9999 ENDIF CALL ppm_map_field_send(info) IF (info .NE. ppm_param_success) THEN info = ppm_error_error CALL ppm_error(ppm_err_sub_failed,'ppm_gmm_march_fwd', & & 'sending ghosts failed',__LINE__,info) GOTO 9999 ENDIF CALL ppm_map_field_pop(gmm_topoid,gmm_meshid,gmm_state3d,ghostsize,info) IF (info .NE. ppm_param_success) THEN info = ppm_error_error CALL ppm_error(ppm_err_sub_failed,'ppm_gmm_march_fwd', & & 'popping status data failed',__LINE__,info) GOTO 9999 ENDIF CALL ppm_map_field_pop(gmm_topoid,gmm_meshid,fdta,ghostsize,info) IF (info .NE. ppm_param_success) THEN info = ppm_error_error CALL ppm_error(ppm_err_sub_failed,'ppm_gmm_march_fwd', & & 'popping field data failed',__LINE__,info) GOTO 9999 ENDIF #elif __DIM == __2D npos0 = npos !------------------------------------------------------------------------- ! Forward order: update neighbors of points in ggm_ipos !------------------------------------------------------------------------- DO p=1,npos IF (p .GT. npos0) EXIT ii = gmm_ipos(1,p) jj = gmm_ipos(2,p) jsub = gmm_ipos(3,p) isub = topo%isublist(jsub) xhi = mesh%nnodes(1,isub) yhi = mesh%nnodes(2,isub) fdta0= fdta(ii,jj,jsub) absfdta0 = fdta0 IF (absfdta0 .LT. 0.0_MK) absfdta0 = -absfdta0 !--------------------------------------------------------------------- ! GMM update condition (see Kim:2001a) !--------------------------------------------------------------------- IF (.NOT.(absfdta0.GT.TM)) THEN !----------------------------------------------------------------- ! Compute non-accepted neighbors !----------------------------------------------------------------- i = ii - 1 j = jj IF (i.GT.0) THEN IF ((gmm_state2d(i,j,jsub) .NE. & & ppm_gmm_param_accepted) .AND. & & (ABS(fdta(i,j,jsub)).GT.absfdta0)) THEN !--------------------------------------------------------- ! Update point i,j !--------------------------------------------------------- #include "ppm_gmm_slvupwnd.inc" IF (valijk .LT. hsave) THEN IF (ABS(valijk).LT.ABS(fdta(i,j,jsub))) THEN IF ((valijk*fdta(i,j,jsub).GE.0.0_MK) .OR. & & (fdta(i,j,jsub).GT.hsave)) THEN fdta(i,j,jsub) = valijk ENDIF ENDIF !----------------------------------------------------- ! Keep in or add to close set !----------------------------------------------------- IF ((gmm_state2d(i,j,jsub) .EQ. & & ppm_gmm_param_far) .AND. & & (ABS(fdta(i,j,jsub)) .LT. width)) THEN gmm_state2d(i,j,jsub) = & & ppm_gmm_param_close #include "ppm_gmm_add_to_list.inc" ENDIF ENDIF ENDIF ENDIF i = ii + 1 j = jj IF (i.LE.xhi) THEN IF ((gmm_state2d(i,j,jsub) .NE. & & ppm_gmm_param_accepted) .AND. & & (ABS(fdta(i,j,jsub)).GT.absfdta0)) THEN !--------------------------------------------------------- ! Update point i,j !--------------------------------------------------------- #include "ppm_gmm_slvupwnd.inc" IF (valijk .LT. hsave) THEN IF (ABS(valijk).LT.ABS(fdta(i,j,jsub))) THEN IF ((valijk*fdta(i,j,jsub).GE.0.0_MK) .OR. & & (fdta(i,j,jsub).GT.hsave)) THEN fdta(i,j,jsub) = valijk ENDIF ENDIF !----------------------------------------------------- ! Keep in or add to close set !----------------------------------------------------- IF ((gmm_state2d(i,j,jsub) .EQ. & & ppm_gmm_param_far) .AND. & & (ABS(fdta(i,j,jsub)) .LT. width)) THEN gmm_state2d(i,j,jsub) = & & ppm_gmm_param_close #include "ppm_gmm_add_to_list.inc" ENDIF ENDIF ENDIF ENDIF i = ii j = jj - 1 IF (j.GT.0) THEN IF ((gmm_state2d(i,j,jsub) .NE. & & ppm_gmm_param_accepted) .AND. & & (ABS(fdta(i,j,jsub)).GT.absfdta0)) THEN !--------------------------------------------------------- ! Update point i,j !--------------------------------------------------------- #include "ppm_gmm_slvupwnd.inc" IF (valijk .LT. hsave) THEN IF (ABS(valijk).LT.ABS(fdta(i,j,jsub))) THEN IF ((valijk*fdta(i,j,jsub).GE.0.0_MK) .OR. & & (fdta(i,j,jsub).GT.hsave)) THEN fdta(i,j,jsub) = valijk ENDIF ENDIF !----------------------------------------------------- ! Keep in or add to close set !----------------------------------------------------- IF ((gmm_state2d(i,j,jsub) .EQ. & & ppm_gmm_param_far) .AND. & & (ABS(fdta(i,j,jsub)) .LT. width)) THEN gmm_state2d(i,j,jsub) = & & ppm_gmm_param_close #include "ppm_gmm_add_to_list.inc" ENDIF ENDIF ENDIF ENDIF i = ii j = jj + 1 IF (j.LE.yhi) THEN IF ((gmm_state2d(i,j,jsub) .NE. & & ppm_gmm_param_accepted) .AND. & & (ABS(fdta(i,j,jsub)).GT.absfdta0)) THEN !--------------------------------------------------------- ! Update point i,j !--------------------------------------------------------- #include "ppm_gmm_slvupwnd.inc" IF (valijk .LT. hsave) THEN IF (ABS(valijk).LT.ABS(fdta(i,j,jsub))) THEN IF ((valijk*fdta(i,j,jsub).GE.0.0_MK) .OR. & & (fdta(i,j,jsub).GT.hsave)) THEN fdta(i,j,jsub) = valijk ENDIF ENDIF !----------------------------------------------------- ! Keep in or add to close set !----------------------------------------------------- IF ((gmm_state2d(i,j,jsub) .EQ. & & ppm_gmm_param_far) .AND. & & (ABS(fdta(i,j,jsub)) .LT. width)) THEN gmm_state2d(i,j,jsub) = & & ppm_gmm_param_close #include "ppm_gmm_add_to_list.inc" ENDIF ENDIF ENDIF ENDIF !----------------------------------------------------------------- ! Accept this point and remove it from the list !----------------------------------------------------------------- gmm_state2d(ii,jj,jsub) = ppm_gmm_param_accepted gmm_ipos(1,p) = gmm_ipos(1,npos0) gmm_ipos(2,p) = gmm_ipos(2,npos0) gmm_ipos(3,p) = gmm_ipos(3,npos0) npos0 = npos0 - 1 ENDIF ! TT .LE. TM ENDDO ! p=1,npos npos = npos0 !------------------------------------------------------------------------- ! Update ghost layers for both fdta AND gmm_state2d !------------------------------------------------------------------------- CALL ppm_map_field_push(gmm_topoid,gmm_meshid,fdta,info) IF (info .NE. ppm_param_success) THEN info = ppm_error_error CALL ppm_error(ppm_err_sub_failed,'ppm_gmm_march_fwd', & & 'pushing field data failed',__LINE__,info) GOTO 9999 ENDIF CALL ppm_map_field_push(gmm_topoid,gmm_meshid,gmm_state2d,info) IF (info .NE. ppm_param_success) THEN info = ppm_error_error CALL ppm_error(ppm_err_sub_failed,'ppm_gmm_march_fwd', & & 'pushing status data failed',__LINE__,info) GOTO 9999 ENDIF CALL ppm_map_field_send(info) IF (info .NE. ppm_param_success) THEN info = ppm_error_error CALL ppm_error(ppm_err_sub_failed,'ppm_gmm_march_fwd', & & 'sending ghosts failed',__LINE__,info) GOTO 9999 ENDIF CALL ppm_map_field_pop(gmm_topoid,gmm_meshid,gmm_state2d,ghostsize,info) IF (info .NE. ppm_param_success) THEN info = ppm_error_error CALL ppm_error(ppm_err_sub_failed,'ppm_gmm_march_fwd', & & 'popping status data failed',__LINE__,info) GOTO 9999 ENDIF CALL ppm_map_field_pop(gmm_topoid,gmm_meshid,fdta,ghostsize,info) IF (info .NE. ppm_param_success) THEN info = ppm_error_error CALL ppm_error(ppm_err_sub_failed,'ppm_gmm_march_fwd', & & 'popping field data failed',__LINE__,info) GOTO 9999 ENDIF #endif !------------------------------------------------------------------------- ! Return !------------------------------------------------------------------------- 9999 CONTINUE CALL substop('ppm_gmm_march_fwd',t0,info) RETURN #if __DIM == __2D #if __KIND == __SINGLE_PRECISION END SUBROUTINE ppm_gmm_march_fwd_2ds #elif __KIND == __DOUBLE_PRECISION END SUBROUTINE ppm_gmm_march_fwd_2dd #endif #elif __DIM == __3D #if __KIND == __SINGLE_PRECISION END SUBROUTINE ppm_gmm_march_fwd_3ds #elif __KIND == __DOUBLE_PRECISION END SUBROUTINE ppm_gmm_march_fwd_3dd #endif #endif libppmnumerics-r1036/src/ppm_fdsolver_solve_3d.f0000644000175000017500000015033711616214647020613 0ustar omaromar !------------------------------------------------------------------------- ! Subroutine : ppm_fdsolver_solve_3d !------------------------------------------------------------------------- ! ! Purpose : Poisson solver using FFTW ! Solves the negative poisson equation in a 3-dimensional ! periodic domain: ! - Laplacian of Phi = omega ! It takes the field quantity omega in DATA_fv which is ! assumed to be periodic outside the domain. The most ! efficient initial topology for the fieldsolver is ! a x-pencil topology. After performing a FFT on the ! x-pencils the data is mapped onto y-pencils and ! later onto z-pencils. ! The version solve_init is based on recomputed FFT-plans ! created in ppm_fdsolver_init and destroyed in ! ppm_fdsolver_finalize. ! In the slab version (solve_slab) the FFTs are performed ! on xy slabs and on z-penzils to save field mappings. ! This version requires the call of ppm_fdsolver_init and ! ppm_fdsolver_finalize. ! The poisson equation is solved in the Fourier space ! and the result transformed backward. ! The solution Phi is finally returned in DATA_fv. ! Note: field quantity must live on current topology ! ! Usage: ! ! ppm_fdsolver_init(arguments) ! ! ppm_fdsolver_solve_init(arguments) ! or ppm_fdsolver_solve_slab(arguments) ! ! ppm_fdsolver_finalize(info) ! ! ! Standalone Usage: ! ! ppm_fdsolver_solve(arguments) ! ! Input : ! lda_fv (I) size of leading dimension in VectorCase ! mesh_id_data(I) mesh ID of the current data field mesh ! topo_ids(2) (I) topology IDs on which the FFTs are ! performed ! topo_ids(1) first topology in ! solve: xpencils ! solve_init: xpencils ! solve_slab: xy slab ! topo_ids(2) second topology in ! solve: ypencils ! solve_init: ypencils ! solve_slab: zpencils ! topo_ids(3) third topology in ! solve: zpencils ! solve_init: xpencils ! solve_slab: not used ! ! mesh_ids(3) (I) mesh IDs where the FFTs are performed ! mesh_ids(1) first mesh ! solve: xpencils,real ! solve_init: xpencils,real ! solve_slab: xy slab ,real ! mesh_ids(2) second mesh ! solve: xpencils,complex ! solve_init: xpencils,complex ! solve_slab: xy slab ,complex ! mesh_ids(3) third mesh ! solve: ypencils,complex ! solve_init: ypencils,complex ! solve_slab: zpencils,complex ! mesh_ids(4) forth mesh ! solve: zpencils,complex ! solve_init: zpencils,complex ! solve_slab: not used ! ghostsize(3) (I)ghostsize ! ! ! Input/output : ! DATA_fv(:,:,:,:) (F) field data ! ! Output : info (I) return status. =0 if no error. ! ! Remarks : ! ! References : ! ! Revisions : !------------------------------------------------------------------------- ! $Log: ppm_fdsolver_solve_3d.f,v $ ! Revision 1.1.1.1 2007/07/13 10:18:54 ivos ! CBL version of the PPM library ! ! Revision 1.28 2006/09/04 18:34:45 pchatela ! Fixes and cleanups to make it compile for ! release-1-0 ! ! Revision 1.26 2006/04/10 08:54:30 pchatela ! Made xp a REAL, DIMENSION(:,:), POINTER to get rid of warnings ! ! Revision 1.25 2006/04/07 17:41:29 hiebers ! Changed type of variable xp to POINTER ! ! Revision 1.24 2005/08/23 15:23:12 hiebers ! Bugfix in scalar version by adjusting an argument in the call ! of the FFT routines ! ! Revision 1.23 2005/08/03 14:35:12 ivos ! Shortened the subrountine names to meet the F90 31-character limit ! standard. pgf90 on gonzales had problems... ! ! Revision 1.22 2005/02/16 12:38:20 hiebers ! bugfix in preprocessor if statement ! ! Revision 1.21 2005/02/16 12:01:07 hiebers ! Major addition: finalized scalar and vector version, ! implemented version that uses FFT plans created ! in ppm_fdsolver_init and destroyed in ppm_fdsolver_finalize ! whereas the version remains a standalone solver, ! implemented version that uses xy-slab topology ! and z-pencil topology (needs ppm_fdsolver_init and finalize) ! ! Revision 1.20 2005/02/01 16:38:56 hiebers ! reduced size of DATA_fv_com ! ! Revision 1.19 2004/11/03 11:14:55 hiebers ! Exchanged __SXF90 by __MATHKEISAN ! ! Revision 1.18 2004/10/01 16:08:59 ivos ! Replaced REAL(ppm_kind_double) :: t0 with REAL(MK) t0. ! ! Revision 1.17 2004/08/27 09:45:15 hiebers ! added ghostsize as an argument ! ! Revision 1.16 2004/08/26 10:45:52 hiebers ! eliminated correction of the field margin. correction is now done in ! the fft routines. ! ! Revision 1.9 2004/08/19 13:14:28 hiebers ! debugged scalar/vector version ! ! Revision 1.8 2004/08/18 16:32:43 hiebers ! intermediate status of debugging vector version ! ! Revision 1.7 2004/08/18 13:35:33 hiebers ! bug fix for non xpencil-topology version ! ! Revision 1.3 2004/07/26 15:38:47 ivos ! Inserted missing USE statements to resolve undefined references ! at link stage. ! ! Revision 1.2 2004/07/26 11:59:38 ivos ! Fixes to make it compile. ! ! Revision 1.1 2004/07/26 08:52:29 hiebers ! Recommited, formerly ppm_module_fieldsolver ! ! Revision 1.1 2004/05/19 15:32:46 hiebers ! implementation from scratch ! !------------------------------------------------------------------------- ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see . ! ! Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Switzerland !------------------------------------------------------------------------- #if __CASE == __SLAB #if __DIM == __SFIELD #if __KIND == __SINGLE_PRECISION SUBROUTINE ppm_fdsolver_solve_slab_3d_ss(DATA_fv,mesh_id_data,topo_ids, & & field_topoid,mesh_ids,ghostsize,info) #elif __KIND == __DOUBLE_PRECISION SUBROUTINE ppm_fdsolver_solve_slab_3d_sd(DATA_fv,mesh_id_data,topo_ids, & & field_topoid,mesh_ids,ghostsize,info) #endif #endif #if __DIM == __VFIELD #if __KIND == __SINGLE_PRECISION SUBROUTINE ppm_fdsolver_solve_slab_3d_vs(DATA_fv,lda_fv,mesh_id_data, & & field_topoid,topo_ids,mesh_ids,ghostsize,info) #elif __KIND == __DOUBLE_PRECISION SUBROUTINE ppm_fdsolver_solve_slab_3d_vd(DATA_fv,lda_fv,mesh_id_data, & & field_topoid,topo_ids,mesh_ids,ghostsize,info) #endif #endif #elif __CASE == __INIT #if __DIM == __SFIELD #if __KIND == __SINGLE_PRECISION SUBROUTINE ppm_fdsolver_solve_init_3d_ss(DATA_fv,mesh_id_data,topo_ids, & & field_topoid,mesh_ids,ghostsize,info) #elif __KIND == __DOUBLE_PRECISION SUBROUTINE ppm_fdsolver_solve_init_3d_sd(DATA_fv,mesh_id_data,topo_ids, & & field_topoid,mesh_ids,ghostsize,info) #endif #endif #if __DIM == __VFIELD #if __KIND == __SINGLE_PRECISION SUBROUTINE ppm_fdsolver_solve_init_3d_vs(DATA_fv,lda_fv,mesh_id_data, & & field_topoid,topo_ids,mesh_ids,ghostsize,info) #elif __KIND == __DOUBLE_PRECISION SUBROUTINE ppm_fdsolver_solve_init_3d_vd(DATA_fv,lda_fv,mesh_id_data, & & field_topoid,topo_ids,mesh_ids,ghostsize,info) #endif #endif #else #if __DIM == __SFIELD #if __KIND == __SINGLE_PRECISION SUBROUTINE ppm_fdsolver_solve_3d_ss(DATA_fv,mesh_id_data,topo_ids, & & field_topoid,mesh_ids,ghostsize,info) #elif __KIND == __DOUBLE_PRECISION SUBROUTINE ppm_fdsolver_solve_3d_sd(DATA_fv,mesh_id_data,topo_ids, & & field_topoid,mesh_ids,ghostsize,info) #endif #endif #if __DIM == __VFIELD #if __KIND == __SINGLE_PRECISION SUBROUTINE ppm_fdsolver_solve_3d_vs(DATA_fv,lda_fv,mesh_id_data, & & field_topoid,topo_ids,mesh_ids,ghostsize,info) #elif __KIND == __DOUBLE_PRECISION SUBROUTINE ppm_fdsolver_solve_3d_vd(DATA_fv,lda_fv,mesh_id_data, & & field_topoid,topo_ids,mesh_ids,ghostsize,info) #endif #endif #endif !------------------------------------------------------------------------- ! Includes !------------------------------------------------------------------------- #include "ppm_define.h" !------------------------------------------------------------------------- ! Modules !------------------------------------------------------------------------- USE ppm_module_data USE ppm_module_mktopo USE ppm_module_mesh_define USE ppm_module_fdsolver_map USE ppm_module_util_fft_forward USE ppm_module_util_fft_backward USE ppm_module_fdsolver_poisson USE ppm_module_fdsolver_fft_fd USE ppm_module_fdsolver_fft_bd USE ppm_module_error USE ppm_module_alloc USE ppm_module_write USE ppm_module_substart USE ppm_module_substop IMPLICIT NONE #if __KIND == __SINGLE_PRECISION INTEGER, PARAMETER :: MK = ppm_kind_single #elif __KIND == __DOUBLE_PRECISION INTEGER, PARAMETER :: MK = ppm_kind_double #endif !------------------------------------------------------------------------- ! Arguments !------------------------------------------------------------------------- ! data #if __DIM == __SFIELD REAL(MK), DIMENSION(:,:,:,:), POINTER :: DATA_fv #elif __DIM == __VFIELD REAL(MK), DIMENSION(:,:,:,:,:), POINTER :: DATA_fv #endif ! mesh ID of the data ! Note F.Perignon: I remove the INTENT(IN) for mesh_id_data to make the lib work, but I guess its ! not a proper solution ... INTEGER :: mesh_id_data ! topo ID of the field INTEGER , INTENT(IN) :: field_topoid #if __DIM == __VFIELD INTEGER , INTENT(IN) :: lda_fv #endif ! topo / mesh ID for the mapping INTEGER, DIMENSION(3) , INTENT(IN ) :: topo_ids INTEGER, DIMENSION(4) , INTENT(IN ) :: mesh_ids INTEGER, DIMENSION(3) , INTENT(IN ) :: ghostsize INTEGER , INTENT( OUT) :: info !------------------------------------------------------------------------- ! Local variables !------------------------------------------------------------------------- ! timer REAL(MK) :: t0 ! parameter for alloc INTEGER, DIMENSION(3) :: lda ! counters INTEGER :: i,j,k,l,m INTEGER :: ires, jres, lres ! 1/number of gridpoints REAL(MK) :: rN ! result #if __DIM == __SFIELD INTEGER, PARAMETER :: lda_fv = 1 #endif #if __DIM == __SFIELD INTEGER , DIMENSION(4 ) :: lda_DATA_fv COMPLEX(MK), DIMENSION(:,:,:,:), POINTER :: DATA_fv_com INTEGER , DIMENSION(4 ) :: lda_DATA_fv_com #elif __DIM == __VFIELD INTEGER , DIMENSION(5 ) :: lda_DATA_fv COMPLEX(MK), DIMENSION(:,:,:,:,:), POINTER :: DATA_fv_com INTEGER , DIMENSION(5 ) :: lda_DATA_fv_com #endif INTEGER, DIMENSION(2) :: topo_ids_tmp INTEGER, DIMENSION(2) :: mesh_ids_tmp REAL(MK), DIMENSION(:,:,:), POINTER :: data_in COMPLEX(MK), DIMENSION(:,:,:), POINTER :: data_com COMPLEX(MK), DIMENSION(:,:,:), POINTER :: FFT_x, FFT_xy, FFT_xyz REAL(MK), DIMENSION(:,:,:), POINTER :: Result ! variables REAL(MK), DIMENSION(:,:),POINTER :: xp INTEGER :: Npart INTEGER :: decomp, assign REAL(MK), DIMENSION(3 ) :: min_phys, max_phys REAL(MK), DIMENSION(3 ) :: length REAL(MK), DIMENSION(3 ) :: length_phys INTEGER , DIMENSION(6 ) :: bcdef INTEGER :: nsubs,topo_id, mesh_id INTEGER :: yhmax, zhmax INTEGER :: mesh_id_xpen, mesh_id_ypen INTEGER :: mesh_id_xpen_complex INTEGER :: mesh_id_zpen REAL(MK), DIMENSION(: ), POINTER :: cost INTEGER , DIMENSION(:,:), POINTER :: istart, istart_xpen_complex INTEGER , DIMENSION(:,:), POINTER :: istart_ypen, istart_trans INTEGER , DIMENSION(:,:), POINTER :: istart_zpen INTEGER , DIMENSION(:,:), POINTER :: ndata, ndata_xpen_complex INTEGER , DIMENSION(:,:), POINTER :: ndata_ypen, ndata_trans INTEGER , DIMENSION(:,:), POINTER :: ndata_zpen INTEGER , DIMENSION(ppm_dim) :: maxndata INTEGER , DIMENSION(ppm_dim) :: maxndata_ypen INTEGER , DIMENSION(ppm_dim) :: maxndata_zpen INTEGER , DIMENSION(: ), POINTER :: isublist => NULL() INTEGER :: nsublist INTEGER :: dim,n,idom INTEGER :: iopt INTEGER :: topo_id_xpen, topo_id_ypen INTEGER :: topo_id_zpen INTEGER, DIMENSION(3) :: Nm, Nm_com, Nm_poisson LOGICAL :: Its_xpencil_topo LOGICAL :: Its_xyslab_topo CHARACTER(LEN=ppm_char) :: mesg TYPE(ppm_t_topo) , POINTER :: f_topo TYPE(ppm_t_equi_mesh) , POINTER :: f_mesh !------------------------------------------------------------------------- ! Initialise !------------------------------------------------------------------------- CALL substart('ppm_fdsolver_solve_3d',t0,info) f_topo => ppm_topo(field_topoid)%t f_mesh => f_topo%mesh(mesh_id_data) !------------------------------------------------------------------------- ! Check arguments !------------------------------------------------------------------------- IF (ppm_debug .GT. 0) THEN IF (.NOT. ppm_initialized) THEN info = ppm_error_error CALL ppm_error(ppm_err_ppm_noinit,'ppm_fdsolver_solve_3d', & & 'Please call ppm_init first!',__LINE__,info) GOTO 9999 ENDIF IF (field_topoid .LE. 0) THEN info = ppm_error_error CALL ppm_error(ppm_err_argument,'ppm_fdsolver_solve_3d', & & 'No field topology has been defined so far',__LINE__,info) GOTO 9999 ENDIF ENDIF #if !(defined(__FFTW) | defined(__MATHKEISAN)) !------------------------------------------------------------------------- ! Error if FFTW library or NEC is not available !------------------------------------------------------------------------- info = ppm_error_error #ifndef __FFTW CALL ppm_error(ppm_err_nofftw,'ppm_fdsolver_solve_3d', & & 'PPM was compiled without fftw support',__LINE__,info) #endif #ifndef __MATHKEISAN CALL ppm_error(ppm_err_noMathKeisan,'ppm_fdsolver_solve_3d', & & 'PPM was compiled without MATHKEISAN support',__LINE__,info) #endif GOTO 9999 #else !------------------------------------------------------------------------- ! Initialize variables !------------------------------------------------------------------------- bcdef(1:6) = ppm_param_bcdef_periodic assign = ppm_param_assign_internal Nm(1) = f_mesh%Nm(1) Nm(2) = f_mesh%Nm(2) Nm(3) = f_mesh%Nm(3) Nm_com(1) = Nm(1)/2+1 Nm_com(2) = Nm(2) Nm_com(3) = Nm(3) Npart = 0 #if __KIND == __SINGLE_PRECISION min_phys(1) = f_topo%min_physs(1) min_phys(2) = f_topo%min_physs(2) min_phys(3) = f_topo%min_physs(3) max_phys(1) = f_topo%max_physs(1) max_phys(2) = f_topo%max_physs(2) max_phys(3) = f_topo%max_physs(3) #elif __KIND == __DOUBLE_PRECISION min_phys(1) = f_topo%min_physd(1) min_phys(2) = f_topo%min_physd(2) min_phys(3) = f_topo%min_physd(3) max_phys(1) = f_topo%max_physd(1) max_phys(2) = f_topo%max_physd(2) max_phys(3) = f_topo%max_physd(3) #endif IF (ppm_debug .GT. 0) THEN WRITE(mesg,'(A,3F15.3)' ) 'minimal extent', min_phys(1), min_phys(2), & & min_phys(3) CALL ppm_write(ppm_rank,'ppm_fdsolver_solve',mesg,j) WRITE(mesg,'(A,3F15.3)' ) 'maximal extent', max_phys(1), max_phys(2), & & max_phys(3) CALL ppm_write(ppm_rank,'ppm_fdsolver_solve',mesg,j) ENDIF length_phys(1) = max_phys(1) - min_phys(1) length_phys(2) = max_phys(2) - min_phys(2) length_phys(3) = max_phys(3) - min_phys(3) !------------------------------------------------------------------------- ! Check if x_pencil topology !------------------------------------------------------------------------- Its_xpencil_topo = .TRUE. Its_xyslab_topo = .TRUE. DO k=1,f_topo%nsublist idom = f_topo%isublist(k) #if __KIND == __SINGLE_PRECISION length(1) = f_topo%max_subs(1,idom) - f_topo%min_subs(1,idom) length(2) = f_topo%max_subs(2,idom) - f_topo%min_subs(2,idom) IF( abs(length(1) - length_phys(1)).GT.(ppm_myepss) ) THEN Its_xpencil_topo=.FALSE. Its_xyslab_topo =.FALSE. ENDIF IF( abs(length(2) - length_phys(2)).GT.(ppm_myepss) ) THEN Its_xyslab_topo =.FALSE. ENDIF #elif __KIND == __DOUBLE_PRECISION length(1) = f_topo%max_subd(1,idom) - f_topo%min_subd(1,idom) length(2) = f_topo%max_subd(2,idom) - f_topo%min_subd(2,idom) IF( abs(length(1) - length_phys(1)).GT.(ppm_myepsd) ) THEN Its_xpencil_topo=.FALSE. Its_xyslab_topo =.FALSE. ENDIF IF( abs(length(2) - length_phys(2)).GT.(ppm_myepsd) ) THEN Its_xyslab_topo =.FALSE. ENDIF #endif ENDDO IF (ppm_debug .GT. 0) THEN IF(Its_xyslab_topo) THEN WRITE(mesg,'(A)' ) 'XY slab topology' CALL ppm_write(ppm_rank,'ppm_fdsolver_solve',mesg,j) ELSE WRITE(mesg,'(A)' ) 'Not XY slab topology' CALL ppm_write(ppm_rank,'ppm_fdsolver_solve',mesg,j) ENDIF IF(Its_xpencil_topo) THEN WRITE(mesg,'(A)' ) 'X pencil topology' CALL ppm_write(ppm_rank,'ppm_fdsolver_solve',mesg,j) ELSE WRITE(mesg,'(A)' ) 'Not X pencil topology' CALL ppm_write(ppm_rank,'ppm_fdsolver_solve',mesg,j) ENDIF ENDIF #if __CASE == __SLAB !------------------------------------------------------------------------- ! Setting of xy slab topology !------------------------------------------------------------------------- IF(Its_xyslab_topo) THEN topo_id_xpen = field_topoid mesh_id_xpen = mesh_id_data topo_id_zpen = topo_ids(2) mesh_id_xpen_complex = mesh_ids(2) mesh_id_zpen = mesh_ids(3) ELSE topo_id_xpen = topo_ids(1) topo_id_zpen = topo_ids(2) mesh_id_xpen = mesh_ids(1) mesh_id_xpen_complex = mesh_ids(2) mesh_id_zpen = mesh_ids(3) ENDIF IF (ppm_debug .GT. 0) THEN WRITE(mesg,'(A)' ) ' ID topo mesh' CALL ppm_write(ppm_rank,'ppm_fdsolver_solve',mesg,j) WRITE(mesg,'(A)' ) '-----------------------------------' CALL ppm_write(ppm_rank,'ppm_fdsolver_solve',mesg,j) WRITE(mesg,'(A,2I4)' ) 'Original ',field_topoid, mesh_id_data CALL ppm_write(ppm_rank,'ppm_fdsolver_solve',mesg,j) WRITE(mesg,'(A,2I4)' ) 'XZ Slab ', topo_id_xpen, mesh_id_xpen CALL ppm_write(ppm_rank,'ppm_fdsolver_solve',mesg,j) WRITE(mesg,'(A,2I4)' ) 'XZ Slab Complex', topo_id_xpen, & & mesh_id_xpen_complex CALL ppm_write(ppm_rank,'ppm_fdsolver_solve',mesg,j) WRITE(mesg,'(A,2I4)' ) 'Z Pencil Complex', topo_id_zpen, mesh_id_zpen CALL ppm_write(ppm_rank,'ppm_fdsolver_solve',mesg,j) ENDIF !------------------------------------------------------------------------- ! Decompose domain in xy slabs !------------------------------------------------------------------------- IF(.NOT.Its_xyslab_topo) THEN assign = ppm_param_assign_internal decomp = ppm_param_decomp_xy_slab CALL ppm_mktopo(topo_id_xpen,mesh_id_xpen,xp,Npart,decomp,assign,& & min_phys,max_phys,bcdef,ghostsize,cost,Nm, & & info,nsubs) CALL ppm_meshinfo(topo_id_xpen,mesh_id_xpen,Nm,istart,ndata,& & maxndata,isublist,nsublist,info) topo_ids_tmp(1) = field_topoid topo_ids_tmp(2) = topo_id_xpen mesh_ids_tmp(1) = mesh_id_data mesh_ids_tmp(2) = mesh_id_xpen #if __DIM == __SFIELD CALL ppm_fdsolver_map(DATA_fv,topo_ids_tmp, mesh_ids_tmp, & & ghostsize, info) #elif __DIM == __VFIELD CALL ppm_fdsolver_map(DATA_fv,lda_fv, topo_ids_tmp, mesh_ids_tmp,& & ghostsize, info) #endif topo_ids_tmp(1) = topo_id_xpen topo_ids_tmp(2) = topo_id_zpen mesh_id_data = f_mesh%ID ENDIF #else !------------------------------------------------------------------------- ! Setting of x-pencil topology !------------------------------------------------------------------------- IF(Its_xpencil_topo) THEN topo_id_xpen = field_topoid mesh_id_xpen = mesh_id_data topo_id_ypen = topo_ids(2) topo_id_zpen = topo_ids(3) mesh_id_xpen_complex = mesh_ids(2) mesh_id_ypen = mesh_ids(3) mesh_id_zpen = mesh_ids(4) ELSE topo_id_xpen = topo_ids(1) topo_id_ypen = topo_ids(2) topo_id_zpen = topo_ids(3) mesh_id_xpen = mesh_ids(1) mesh_id_xpen_complex = mesh_ids(2) mesh_id_ypen = mesh_ids(3) mesh_id_zpen = mesh_ids(4) ENDIF IF (ppm_debug .GT. 0) THEN WRITE(mesg,'(A)' ) ' ID topo mesh' CALL ppm_write(ppm_rank,'ppm_fdsolver_solve',mesg,j) WRITE(mesg,'(A)' ) '-----------------------------------' CALL ppm_write(ppm_rank,'ppm_fdsolver_solve',mesg,j) WRITE(mesg,'(A,2I4)' ) 'Original ',field_topoid, mesh_id_data CALL ppm_write(ppm_rank,'ppm_fdsolver_solve',mesg,j) WRITE(mesg,'(A,2I4)' ) 'X Pencil ', topo_id_xpen, mesh_id_xpen CALL ppm_write(ppm_rank,'ppm_fdsolver_solve',mesg,j) WRITE(mesg,'(A,2I4)' ) 'X Pencil Complex', topo_id_xpen, & & mesh_id_xpen_complex CALL ppm_write(ppm_rank,'ppm_fdsolver_solve',mesg,j) WRITE(mesg,'(A,2I4)' ) 'Y Pencil Complex', topo_id_ypen, mesh_id_ypen CALL ppm_write(ppm_rank,'ppm_fdsolver_solve',mesg,j) WRITE(mesg,'(A,2I4)' ) 'Z Pencil Complex', topo_id_zpen, mesh_id_zpen CALL ppm_write(ppm_rank,'ppm_fdsolver_solve',mesg,j) ENDIF !------------------------------------------------------------------------- ! Decompose domain in xpencils !------------------------------------------------------------------------- IF(.NOT.Its_xpencil_topo) THEN assign = ppm_param_assign_internal decomp = ppm_param_decomp_xpencil CALL ppm_mktopo(topo_id_xpen,mesh_id_xpen,xp,Npart,decomp,assign,& & min_phys,max_phys,bcdef,ghostsize,cost,Nm, & & info,nsubs) CALL ppm_meshinfo(topo_id_xpen,mesh_id_xpen,Nm,istart,ndata,& & maxndata,isublist,nsublist,info) topo_ids_tmp(1) = field_topoid topo_ids_tmp(2) = topo_id_xpen mesh_ids_tmp(1) = mesh_id_data mesh_ids_tmp(2) = mesh_id_xpen #if __DIM == __SFIELD CALL ppm_fdsolver_map(DATA_fv,topo_ids_tmp, mesh_ids_tmp, & & ghostsize, info) #elif __DIM == __VFIELD CALL ppm_fdsolver_map(DATA_fv,lda_fv, topo_ids_tmp, mesh_ids_tmp, & & ghostsize, info) #endif topo_ids_tmp(1) = topo_id_xpen topo_ids_tmp(2) = topo_id_ypen mesh_id_data = f_topo%mesh(mesh_id_xpen)%ID ENDIF #endif !------------------------------------------------------------------------- ! Allocate complex array !------------------------------------------------------------------------- yhmax = 0 zhmax = 0 DO i=1,f_topo%nsublist idom = f_topo%isublist(i) IF (f_mesh%nnodes(2,idom) .GT. yhmax) THEN yhmax = f_mesh%nnodes(2,idom) ENDIF IF (f_mesh%nnodes(3,idom) .GT. zhmax) THEN zhmax = f_mesh%nnodes(3,idom) ENDIF ENDDO #if __DIM == __SFIELD lda_DATA_fv_com(1)= Nm_com(1) lda_DATA_fv_com(2)= yhmax lda_DATA_fv_com(3)= zhmax lda_DATA_fv_com(4)= f_topo%nsublist #elif __DIM == __VFIELD lda_DATA_fv_com(1)= lda_fv lda_DATA_fv_com(2)= Nm_com(1) lda_DATA_fv_com(3)= yhmax lda_DATA_fv_com(4)= zhmax lda_DATA_fv_com(5)= f_topo%nsublist #endif iopt = ppm_param_alloc_fit CALL ppm_alloc(DATA_fv_com, lda_DATA_fv_com, iopt,info) IF (info .NE. 0) THEN info = ppm_error_fatal CALL ppm_error(ppm_err_alloc,'ppm_fdsolver_solve_3d', & & 'data array',__LINE__,info) GOTO 9999 ENDIF !------------------------------------------------------------------------- ! FFT - Transformation in x-direction !------------------------------------------------------------------------- iopt = ppm_param_alloc_fit lda(1)=3 lda(2)=f_topo%nsubs CALL ppm_alloc(ndata,lda,iopt,info) IF (info .NE. 0) THEN info = ppm_error_fatal CALL ppm_error(ppm_err_alloc,'ppm_fdsolver_solve_3d', & & 'ndata array',__LINE__,info) GOTO 9999 ENDIF ndata = f_mesh%nnodes DO k=1,f_topo%nsublist idom = f_topo%isublist(k) CALL ppm_alloc(data_in, ndata(:,idom), iopt, info) IF (info .NE. 0) THEN info = ppm_error_fatal CALL ppm_error(ppm_err_alloc,'ppm_fdsolver_solve_3d', & & 'data_in array',__LINE__,info) GOTO 9999 ENDIF #if __DIM == __SFIELD DO l=1, ndata(3,idom) DO j=1, ndata(2,idom) DO i=1, ndata(1,idom) data_in(i,j,l) = DATA_fv(i,j,l,k) ENDDO ENDDO ENDDO lda = ndata(:,idom) #if __CASE == __SLAB CALL ppm_fdsolver_fft_fd_slab(data_in, lda,FFT_x,info) #elif __CASE == __INIT CALL ppm_fdsolver_fft_fd(data_in, lda,FFT_x,info) #else CALL ppm_util_fft_forward(data_in, lda,FFT_x,info) #endif DO l=1, lda(3) DO j=1, lda(2) DO i=1, lda(1) DATA_fv_com(i,j,l,k) = FFT_x(i,j,l) ENDDO ENDDO ENDDO iopt = ppm_param_dealloc CALL ppm_alloc(FFT_x, ndata(:,idom), iopt, info) IF (info .NE. 0) THEN WRITE(mesg,'(A)') 'could not deallocate memory' info = ppm_error_error CALL ppm_error(ppm_err_dealloc,'ppm_fdsolver_solve',mesg,__LINE__,& & info) GOTO 9999 ENDIF #elif __DIM == __VFIELD DO n=1,lda_fv DO l=1, ndata(3,idom) DO j=1, ndata(2,idom) DO i=1, ndata(1,idom) data_in(i,j,l) = DATA_fv(n,i,j,l,k) ENDDO ENDDO ENDDO lda = ndata(:,idom) #if __CASE == __SLAB CALL ppm_fdsolver_fft_fd_slab(data_in, lda,FFT_x,info) #elif __CASE == __INIT CALL ppm_fdsolver_fft_fd(data_in, lda,FFT_x,info) #else CALL ppm_util_fft_forward(data_in, lda,FFT_x,info) #endif DO l=1, lda(3) DO j=1, lda(2) DO i=1, lda(1) DATA_fv_com(n,i,j,l,k) = FFT_x(i,j,l) ENDDO ENDDO ENDDO ENDDO iopt = ppm_param_dealloc CALL ppm_alloc(data_in, ndata(:,idom), iopt, info) CALL ppm_alloc(FFT_x, ndata(:,idom), iopt, info) IF (info .NE. 0) THEN WRITE(mesg,'(A)') 'could not deallocate memory' info = ppm_error_error CALL ppm_error(ppm_err_dealloc,'ppm_fdsolver_solve_3d',mesg,__LINE__,& & info) GOTO 9999 ENDIF #endif ENDDO !------------------------------------------------------------------------- ! Decompose complex domain in xpencils !------------------------------------------------------------------------- CALL ppm_mesh_define(topo_id_xpen,mesh_id_xpen_complex,Nm_com, & & istart_xpen_complex, ndata_xpen_complex, info) !------------------------------------------------------------------------- ! Decompose domain in ypencils !------------------------------------------------------------------------- decomp = ppm_param_decomp_ypencil CALL ppm_mktopo(topo_id_ypen,mesh_id_ypen,xp,Npart,decomp,assign, & & min_phys,max_phys,bcdef,ghostsize,cost,Nm,& & info,nsubs) CALL ppm_meshinfo(topo_id_ypen,mesh_id_ypen,Nm,istart_ypen,ndata_ypen,& & maxndata_ypen,isublist,nsublist,info) idom = f_topo%isublist(1) !------------------------------------------------------------------------- ! Decompose domain in zpencils !------------------------------------------------------------------------- decomp = ppm_param_decomp_zpencil CALL ppm_mktopo(topo_id_zpen,mesh_id_zpen,xp,Npart,decomp,assign, & & min_phys,max_phys,bcdef,ghostsize,cost,Nm,& & info,nsubs) CALL ppm_meshinfo(topo_id_zpen,mesh_id_zpen,Nm,istart_zpen,ndata_zpen,& & maxndata_zpen,isublist,nsublist,info) idom = f_topo%isublist(1) #if __CASE == __SLAB GOTO 1000 #endif !------------------------------------------------------------------------- ! Transpose x-direction and y-direction !------------------------------------------------------------------------- topo_ids_tmp(1) = topo_id_xpen topo_ids_tmp(2) = topo_id_ypen mesh_ids_tmp(1) = mesh_id_xpen_complex mesh_ids_tmp(2) = mesh_id_ypen #if __DIM == __SFIELD CALL ppm_fdsolver_map(DATA_fv_com,topo_ids_tmp, mesh_ids_tmp, & & ghostsize, info) #elif __DIM == __VFIELD CALL ppm_fdsolver_map(DATA_fv_com,lda_fv,topo_ids_tmp, mesh_ids_tmp, & & ghostsize, info) #endif DO k=1,f_topo%nsublist idom = f_topo%isublist(k) lda(1)=3 lda(2)=idom iopt = ppm_param_alloc_fit CALL ppm_alloc(ndata_trans,lda,iopt, info) ndata_trans(1,idom)=ndata_ypen(2,idom) ndata_trans(2,idom)=ndata_ypen(1,idom) ndata_trans(3,idom)=ndata_ypen(3,idom) #if __DIM == __VFIELD DO n=1,lda_fv #endif CALL ppm_alloc(data_com,ndata_trans(:,idom),iopt, info) DO l=1, ndata_ypen(3,idom) DO j=1, ndata_ypen(2,idom) DO i=1, ndata_ypen(1,idom) #if __DIM == __SFIELD data_com(j,i,l)= DATA_fv_com(i,j,l,k) #elif __DIM == __VFIELD data_com(j,i,l)= DATA_fv_com(n,i,j,l,k) #endif ENDDO ENDDO ENDDO !------------------------------------------------------------------------- ! FFT - Transformation in y-direction !------------------------------------------------------------------------- #if __CASE == __INIT CALL ppm_fdsolver_fft_fd(data_com,ndata_trans(:,idom),FFT_xy,info) #else CALL ppm_util_fft_forward(data_com,ndata_trans(:,idom),FFT_xy,info) #endif !------------------------------------------------------------------------- ! Transpose back x-direction and y-direction !------------------------------------------------------------------------- DO l=1, ndata_ypen(3,idom) DO i=1, ndata_ypen(1,idom) DO j=1, ndata_ypen(2,idom) #if __DIM == __SFIELD DATA_fv_com(i,j,l,k) = FFT_xy(j,i,l) #elif __DIM == __VFIELD DATA_fv_com(n,i,j,l,k) = FFT_xy(j,i,l) #endif ENDDO ENDDO ENDDO ENDDO iopt = ppm_param_dealloc CALL ppm_alloc(data_com,ndata_trans(:,idom),iopt, info) CALL ppm_alloc(FFT_xy, ndata_trans(:,idom),iopt, info) IF (info .NE. 0) THEN WRITE(mesg,'(A)') 'could not deallocate memory' info = ppm_error_error CALL ppm_error(ppm_err_dealloc,'ppm_fdsolver_solve_3d',mesg,__LINE__,& & info) GOTO 9999 ENDIF #if __DIM == __VFIELD ENDDO #endif 1000 CONTINUE! CASE SLAB continues !------------------------------------------------------------------------- ! Transpose x-direction and z-direction !------------------------------------------------------------------------- topo_ids_tmp(1) = topo_id_ypen topo_ids_tmp(2) = topo_id_zpen mesh_ids_tmp(1) = mesh_id_ypen mesh_ids_tmp(2) = mesh_id_zpen #if __CASE == __SLAB topo_ids_tmp(1) = topo_id_xpen mesh_ids_tmp(1) = mesh_id_xpen_complex #endif #if __DIM == __SFIELD CALL ppm_fdsolver_map(DATA_fv_com,topo_ids_tmp, mesh_ids_tmp, & & ghostsize, info) #elif __DIM == __VFIELD CALL ppm_fdsolver_map(DATA_fv_com,lda_fv,topo_ids_tmp, mesh_ids_tmp, & & ghostsize, info) #endif DO k=1,f_topo%nsublist idom = f_topo%isublist(k) lda(1)=3 lda(2)=idom iopt = ppm_param_alloc_fit CALL ppm_alloc(ndata_trans,lda,iopt, info) IF (info .NE. 0) THEN info = ppm_error_fatal CALL ppm_error(ppm_err_alloc,'ppm_fdsolver_solve_3d', & & 'ndata not allocated',__LINE__,info) GOTO 9999 ENDIF ndata_trans(1,idom)=ndata_zpen(3,idom) ndata_trans(2,idom)=ndata_zpen(2,idom) ndata_trans(3,idom)=ndata_zpen(1,idom) CALL ppm_alloc(data_com,ndata_trans(:,idom),iopt, info) IF (info .NE. 0) THEN info = ppm_error_fatal CALL ppm_error(ppm_err_alloc,'ppm_fdsolver_solve_3d', & & 'data_com not allocated',__LINE__,info) GOTO 9999 ENDIF #if __DIM == __VFIELD DO n=1,lda_fv #endif DO l=1, ndata_zpen(3,idom) DO j=1, ndata_zpen(2,idom) DO i=1, ndata_zpen(1,idom) #if __DIM == __SFIELD data_com(l,j,i)= DATA_fv_com(i,j,l,k) #elif __DIM == __VFIELD data_com(l,j,i)= DATA_fv_com(n,i,j,l,k) #endif ENDDO ENDDO ENDDO !------------------------------------------------------------------------- ! FFT - Transformation in z-direction !------------------------------------------------------------------------- #if __CASE == __SLAB CALL ppm_fdsolver_fft_fd_z(data_com,ndata_trans(:,idom),FFT_xyz,info) #elif __CASE == __INIT CALL ppm_fdsolver_fft_fd_z(data_com,ndata_trans(:,idom),FFT_xyz,info) #else CALL ppm_util_fft_forward(data_com,ndata_trans(:,idom),FFT_xyz,info) #endif !------------------------------------------------------------------------- ! Solve Poisson Equation !------------------------------------------------------------------------- lda(1)=3 lda(2)=idom iopt = ppm_param_alloc_fit CALL ppm_alloc(istart,lda,iopt,info) IF (info .NE. 0) THEN info = ppm_error_fatal CALL ppm_error(ppm_err_alloc,'ppm_fdsolver_solve_3d', & & 'istart not allocated',__LINE__,info) GOTO 9999 ENDIF ! transpose x-z of istart istart(1,idom)= istart_zpen(3,idom) istart(2,idom)= istart_zpen(2,idom) istart(3,idom)= istart_zpen(1,idom) length(1) = length_phys(3) length(2) = length_phys(2) length(3) = length_phys(1) Nm_poisson(1) = Nm_com(3)-1 ! corrected by -1 for ppm convention Nm_poisson(2) = Nm_com(2)-1 ! corrected by -1 for ppm convention Nm_poisson(3) = Nm_com(1) CALL ppm_fdsolver_poisson(FFT_xyz, ndata_trans(1:3,idom), & & istart(1:3,idom),length, Nm_poisson, info) iopt = ppm_param_dealloc CALL ppm_alloc(istart,lda,iopt,info) IF (info .NE. 0) THEN info = ppm_error_fatal CALL ppm_error(ppm_err_alloc,'ppm_fdsolver_solve_3d', & & 'istart not allocated',__LINE__,info) GOTO 9999 ENDIF !------------------------------------------------------------------------- ! FFT - Backward Transformation in z-direction !------------------------------------------------------------------------- #if __CASE == __SLAB CALL ppm_fdsolver_fft_bd_z(FFT_xyz,ndata_trans(:,idom),data_com,info) #elif __CASE == __INIT CALL ppm_fdsolver_fft_bd_z(FFT_xyz,ndata_trans(:,idom),data_com,info) #else CALL ppm_util_fft_backward(FFT_xyz,ndata_trans(:,idom),data_com,info) #endif iopt = ppm_param_dealloc CALL ppm_alloc(FFT_xyz,lda,iopt,info) !------------------------------------------------------------------------- ! Transpose back z-direction and x-direction !------------------------------------------------------------------------- DO i=1, ndata_zpen(1,idom) DO j=1, ndata_zpen(2,idom) DO l=1, ndata_zpen(3,idom) #if __DIM == __SFIELD DATA_fv_com(i,j,l,k) = data_com(l,j,i) #elif __DIM == __VFIELD DATA_fv_com(n,i,j,l,k) = data_com(l,j,i) #endif ENDDO ENDDO ENDDO #if __DIM == __VFIELD ENDDO #endif iopt = ppm_param_dealloc CALL ppm_alloc(data_com, lda, iopt,info) IF (info .NE. 0) THEN WRITE(mesg,'(A)') 'could not deallocate memory' info = ppm_error_error CALL ppm_error(ppm_err_dealloc,'ppm_fdsolver_solve',mesg,__LINE__,& & info) GOTO 9999 ENDIF ENDDO ! end of do-loop over k=1,f_topo%nsublist #if __CASE == __SLAB GOTO 2000 #endif topo_ids_tmp(1) = topo_id_zpen topo_ids_tmp(2) = topo_id_ypen mesh_ids_tmp(1) = mesh_id_zpen mesh_ids_tmp(2) = mesh_id_ypen #if __DIM == __SFIELD CALL ppm_fdsolver_map(DATA_fv_com, topo_ids_tmp, mesh_ids_tmp, & & ghostsize, info) #elif __DIM == __VFIELD CALL ppm_fdsolver_map(DATA_fv_com,lda_fv,topo_ids_tmp, mesh_ids_tmp, & & ghostsize, info) #endif DO k=1,f_topo%nsublist idom = f_topo%isublist(k) iopt = ppm_param_alloc_fit ndata_trans(1,idom) = ndata_ypen(2,idom) ndata_trans(2,idom) = ndata_ypen(1,idom) ndata_trans(3,idom) = ndata_ypen(3,idom) CALL ppm_alloc(FFT_xy, ndata_trans(:,idom), iopt, info) IF (info .NE. 0) THEN info = ppm_error_fatal CALL ppm_error(ppm_err_alloc,'ppm_fdsolver_solve', & & 'FFT_xy array',__LINE__,info) GOTO 9999 ENDIF #if __DIM == __VFIELD DO n=1,lda_fv #endif DO l=1, ndata_ypen(3,idom) DO j=1, ndata_ypen(2,idom) DO i=1, ndata_ypen(1,idom) #if __DIM == __SFIELD FFT_xy(j,i,l)= DATA_fv_com(i,j,l,k) #elif __DIM == __VFIELD FFT_xy(j,i,l)= DATA_fv_com(n,i,j,l,k) #endif ENDDO ENDDO ENDDO !------------------------------------------------------------------------- ! FFT - Backward Transformation in y-direction !------------------------------------------------------------------------- #if __CASE == __INIT CALL ppm_fdsolver_fft_bd(FFT_xy, ndata_trans(:,idom),data_com,info) #else CALL ppm_util_fft_backward(FFT_xy,ndata_trans(:,idom),data_com,info) #endif !------------------------------------------------------------------------- ! Transpose y-direction and x-direction !------------------------------------------------------------------------- DO l=1, ndata_ypen(3,idom) DO i=1, ndata_ypen(1,idom) DO j=1, ndata_ypen(2,idom) #if __DIM == __SFIELD DATA_fv_com(i,j,l,k) = data_com(j,i,l) #elif __DIM == __VFIELD DATA_fv_com(n,i,j,l,k) = data_com(j,i,l) #endif ENDDO ENDDO ENDDO #if __DIM == __VFIELD ENDDO #endif iopt = ppm_param_dealloc CALL ppm_alloc(data_com, lda, iopt,info) CALL ppm_alloc(FFT_xy, lda, iopt,info) IF (info .NE. 0) THEN info = ppm_error_fatal CALL ppm_error(ppm_err_alloc,'ppm_fdsolver_solve', & & 'FFT_x array',__LINE__,info) GOTO 9999 ENDIF ENDDO ! end of do-loop k=1,f_topo%nsublist 2000 CONTINUE ! CASE SLAB continues topo_ids_tmp(1) = topo_id_ypen topo_ids_tmp(2) = topo_id_xpen mesh_ids_tmp(1) = mesh_id_ypen mesh_ids_tmp(2) = mesh_id_xpen_complex #if __CASE == __SLAB topo_ids_tmp(1) = topo_id_zpen mesh_ids_tmp(1) = mesh_id_zpen #endif #if __DIM == __SFIELD CALL ppm_fdsolver_map(DATA_fv_com,topo_ids_tmp, mesh_ids_tmp, & & ghostsize, info) #elif __DIM == __VFIELD CALL ppm_fdsolver_map(DATA_fv_com,lda_fv,topo_ids_tmp, mesh_ids_tmp, & & ghostsize, info) #endif DO k=1,f_topo%nsublist idom = f_topo%isublist(k) iopt = ppm_param_alloc_fit CALL ppm_alloc(FFT_x,ndata_xpen_complex(:,idom), iopt, info) #if __DIM == __VFIELD DO n=1,lda_fv #endif lda = ndata_xpen_complex(:,idom) DO l=1, ndata_xpen_complex(3,idom) DO j=1, ndata_xpen_complex(2,idom) DO i=1, ndata_xpen_complex(1,idom) #if __DIM == __SFIELD FFT_x(i,j,l) = DATA_fv_com(i,j,l,k) #elif __DIM == __VFIELD FFT_x(i,j,l) = DATA_fv_com(n,i,j,l,k) #endif ENDDO ENDDO ENDDO !------------------------------------------------------------------------- ! FFT - Backward Transformation in x-direction !------------------------------------------------------------------------- #if __CASE == __SLAB CALL ppm_fdsolver_fft_bd_slab(FFT_x, lda ,Result,info) #elif __CASE == __INIT CALL ppm_fdsolver_fft_bd(FFT_x, lda ,Result,info) #else CALL ppm_util_fft_backward(FFT_x, lda ,Result,info) #endif !------------------------------------------------------------------------- ! Correct Inverse by problem size factor 1/(Nx*Ny*Nz) ! Subtract 1 to fit ppm convention !------------------------------------------------------------------------- rN = 1.0_MK/real(((Nm(1)-1)*(Nm(2)-1)*(Nm(3)-1)), MK) DO l=1, lda(3) DO j=1, lda(2) DO i=1, lda(1) #if __DIM == __SFIELD DATA_fv(i,j,l,k) = Result(i,j,l)*rN #elif __DIM == __VFIELD DATA_fv(n,i,j,l,k) = Result(i,j,l)*rN #endif ENDDO ENDDO ENDDO #if __DIM == __VFIELD ENDDO #endif ENDDO ! end of do-loop k=1,f_topo%nsublist iopt = ppm_param_dealloc CALL ppm_alloc(FFT_x,lda,iopt, info) #if __CASE == __SLAB !------------------------------------------------------------------------- ! Map to original topology if not xy-slab topology !------------------------------------------------------------------------- IF(.NOT.Its_xyslab_topo) THEN topo_ids_tmp(1) = topo_id_xpen topo_ids_tmp(2) = field_topoid mesh_ids_tmp(1) = mesh_id_xpen mesh_ids_tmp(2) = mesh_id_data #if __DIM == __SFIELD CALL ppm_fdsolver_map(DATA_fv, topo_ids_tmp, mesh_ids_tmp, & & ghostsize, info) #elif __DIM == __VFIELD CALL ppm_fdsolver_map(DATA_fv,lda_fv, topo_ids_tmp, mesh_ids_tmp, & & ghostsize, info) #endif ENDIF #else !------------------------------------------------------------------------- ! Map to original topology if not x-pencil topology !------------------------------------------------------------------------- IF(.NOT.Its_xpencil_topo) THEN topo_ids_tmp(1) = topo_id_xpen topo_ids_tmp(2) = field_topoid mesh_ids_tmp(1) = mesh_id_xpen mesh_ids_tmp(2) = mesh_id_data #if __DIM == __SFIELD CALL ppm_fdsolver_map(DATA_fv, topo_ids_tmp, mesh_ids_tmp, & & ghostsize, info) #elif __DIM == __VFIELD CALL ppm_fdsolver_map(DATA_fv,lda_fv, topo_ids_tmp, mesh_ids_tmp, & & ghostsize, info) #endif ENDIF #endif !------------------------------------------------------------------------- ! Deallocate memory !------------------------------------------------------------------------- iopt = ppm_param_dealloc CALL ppm_alloc(Result, lda, iopt,info) CALL ppm_alloc(data_in, lda, iopt,info) CALL ppm_alloc(data_com, lda, iopt,info) CALL ppm_alloc(FFT_x, lda, iopt,info) CALL ppm_alloc(FFT_xy, lda, iopt,info) CALL ppm_alloc(FFT_xyz, lda, iopt,info) CALL ppm_alloc(DATA_fv_com, lda_DATA_fv_com, iopt,info) CALL ppm_alloc(ndata,lda,iopt,info) CALL ppm_alloc(ndata_trans,lda,iopt, info) CALL ppm_alloc(cost,lda,iopt, info) CALL ppm_alloc(istart,lda,iopt, info) CALL ppm_alloc(istart_xpen_complex,lda,iopt, info) CALL ppm_alloc(istart_ypen,lda,iopt, info) CALL ppm_alloc(istart_zpen,lda,iopt, info) CALL ppm_alloc(istart_trans,lda,iopt, info) CALL ppm_alloc(ndata,lda,iopt, info) CALL ppm_alloc(ndata_xpen_complex,lda,iopt, info) CALL ppm_alloc(ndata_ypen,lda,iopt, info) CALL ppm_alloc(ndata_zpen,lda,iopt, info) CALL ppm_alloc(ndata_trans,lda,iopt, info) IF (info .NE. 0) THEN WRITE(mesg,'(A)') 'could not deallocate memory' info = ppm_error_error CALL ppm_error(ppm_err_dealloc,'ppm_fdsolver_solve',mesg,__LINE__,& & info) GOTO 9999 ENDIF #endif !------------------------------------------------------------------------- ! Return !------------------------------------------------------------------------- 9999 CONTINUE CALL substop('ppm_fdsolver_solve_3d',t0,info) RETURN #if __CASE == __SLAB #if __DIM == __SFIELD #if __KIND == __SINGLE_PRECISION END SUBROUTINE ppm_fdsolver_solve_slab_3d_ss #elif __KIND == __DOUBLE_PRECISION END SUBROUTINE ppm_fdsolver_solve_slab_3d_sd #endif #endif #if __DIM == __VFIELD #if __KIND == __SINGLE_PRECISION END SUBROUTINE ppm_fdsolver_solve_slab_3d_vs #elif __KIND == __DOUBLE_PRECISION END SUBROUTINE ppm_fdsolver_solve_slab_3d_vd #endif #endif #elif __CASE == __INIT #if __DIM == __SFIELD #if __KIND == __SINGLE_PRECISION END SUBROUTINE ppm_fdsolver_solve_init_3d_ss #elif __KIND == __DOUBLE_PRECISION END SUBROUTINE ppm_fdsolver_solve_init_3d_sd #endif #endif #if __DIM == __VFIELD #if __KIND == __SINGLE_PRECISION END SUBROUTINE ppm_fdsolver_solve_init_3d_vs #elif __KIND == __DOUBLE_PRECISION END SUBROUTINE ppm_fdsolver_solve_init_3d_vd #endif #endif #else #if __DIM == __SFIELD #if __KIND == __SINGLE_PRECISION END SUBROUTINE ppm_fdsolver_solve_3d_ss #elif __KIND == __DOUBLE_PRECISION END SUBROUTINE ppm_fdsolver_solve_3d_sd #endif #endif #if __DIM == __VFIELD #if __KIND == __SINGLE_PRECISION END SUBROUTINE ppm_fdsolver_solve_3d_vs #elif __KIND == __DOUBLE_PRECISION END SUBROUTINE ppm_fdsolver_solve_3d_vd #endif #endif #endif libppmnumerics-r1036/src/ppm_mg_prolong.f0000644000175000017500000006152011616214647017327 0ustar omaromar !------------------------------------------------------------------------ ! Subroutine : ppm_mg_prolong !------------------------------------------------------------------------ ! Purpose : In this routine we prolong the corrections from ! coarser to finer levels ! ! ! Input : mlev (I) current level in V-cycle ! ! Input/output : ! ! Output : info (I) return status. 0 upon success ! ! Remarks : ! ! References : ! ! Revisions : !------------------------------------------------------------------------ ! $Log: ppm_mg_prolong.f,v $ ! Revision 1.1.1.1 2007/07/13 10:18:56 ivos ! CBL version of the PPM library ! ! Revision 1.7 2006/09/26 16:01:23 ivos ! Fixed wrongly indented CPP directives. Remember: they have to start in ! Col 1, otherwise it does not compile on certain systems. In fact, this ! code did NOT compile as it was!! ! ! Revision 1.6 2006/07/21 11:30:56 kotsalie ! FRIDAY ! ! Revision 1.5 2005/04/21 04:55:03 ivos ! fix: corrected misplaced cpp endif statements. ! ! Revision 1.4 2005/03/14 13:17:18 kotsalie ! COMMITED THE VECTOR CASE. IT IS FOR LDA=3 ! ! Revision 1.3 2004/09/28 14:08:14 kotsalie ! *** empty log message *** ! ! Revision 1.2 2004/09/23 12:16:50 kotsalie ! Added USE statement ! ! Revision 1.1 2004/09/22 18:36:05 kotsalie ! MG new version ! !------------------------------------------------------------------------ ! Parallel Particle Mesh Library (PPM) ! Institute of Computational Science ! ETH Zentrum, Hirschengraben 84 ! CH-8092 Zurich, Switzerland !------------------------------------------------------------------------ #if __DIM == __SFIELD #if __MESH_DIM == __2D #if __KIND == __SINGLE_PRECISION SUBROUTINE ppm_mg_prolong_2d_sca_s(mlev,info) #elif __KIND == __DOUBLE_PRECISION SUBROUTINE ppm_mg_prolong_2d_sca_d(mlev,info) #endif #elif __MESH_DIM == __3D #if __KIND == __SINGLE_PRECISION SUBROUTINE ppm_mg_prolong_3d_sca_s(mlev,info) #elif __KIND == __DOUBLE_PRECISION SUBROUTINE ppm_mg_prolong_3d_sca_d(mlev,info) #endif #endif #elif __DIM == __VFIELD #if __MESH_DIM == __2D #if __KIND == __SINGLE_PRECISION SUBROUTINE ppm_mg_prolong_2d_vec_s(mlev,info) #elif __KIND == __DOUBLE_PRECISION SUBROUTINE ppm_mg_prolong_2d_vec_d(mlev,info) #endif #elif __MESH_DIM == __3D #if __KIND == __SINGLE_PRECISION SUBROUTINE ppm_mg_prolong_3d_vec_s(mlev,info) #elif __KIND == __DOUBLE_PRECISION SUBROUTINE ppm_mg_prolong_3d_vec_d(mlev,info) #endif #endif #endif !---------------------------------------------------------------------- ! Includes !---------------------------------------------------------------------- #include "ppm_define.h" !---------------------------------------------------------------------- ! Modules !---------------------------------------------------------------------- USE ppm_module_data USE ppm_module_data_mg USE ppm_module_substart USE ppm_module_substop USE ppm_module_error USE ppm_module_alloc USE ppm_module_write IMPLICIT NONE #if __KIND == __SINGLE_PRECISION INTEGER, PARAMETER :: MK = ppm_kind_single #else INTEGER, PARAMETER :: MK = ppm_kind_double #endif !---------------------------------------------------------------------- ! Arguments !---------------------------------------------------------------------- INTEGER, INTENT(IN) :: mlev INTEGER, INTENT(INOUT) :: info !----------------------------------------------------------------- ! Local variables !---------------------------------------------------------------------- CHARACTER(LEN=256) :: cbuf INTEGER :: isub,j,j2,i,i2 INTEGER,DIMENSION(5) :: ldl5,ldu5 INTEGER,DIMENSION(4) :: ldl4,ldu4 INTEGER,DIMENSION(4) :: ldl3,ldu3 INTEGER :: iopt,topoid INTEGER :: aa,bb,cc,dd,ee,gg,iface #if __MESH_DIM == __3D INTEGER :: k,k2 #endif INTEGER :: mlevp1,ilda REAL(MK) :: t0 #if __DIM == __SFIELD #if __MESH_DIM == __2D #if __KIND == __SINGLE_PRECISION TYPE(mg_field_2d_sca_s),DIMENSION(:,:),POINTER :: mgfield #elif __KIND == __DOUBLE_PRECISION TYPE(mg_field_2d_sca_d),DIMENSION(:,:),POINTER :: mgfield #endif #elif __MESH_DIM == __3D #if __KIND == __SINGLE_PRECISION TYPE(mg_field_3d_sca_s),DIMENSION(:,:),POINTER :: mgfield #elif __KIND == __DOUBLE_PRECISION TYPE(mg_field_3d_sca_d),DIMENSION(:,:),POINTER :: mgfield #endif #endif #elif __DIM == __VFIELD #if __MESH_DIM == __2D #if __KIND == __SINGLE_PRECISION TYPE(mg_field_2d_vec_s),DIMENSION(:,:),POINTER :: mgfield #elif __KIND == __DOUBLE_PRECISION TYPE(mg_field_2d_vec_d),DIMENSION(:,:),POINTER :: mgfield #endif #elif __MESH_DIM == __3D #if __KIND == __SINGLE_PRECISION TYPE(mg_field_3d_vec_s),DIMENSION(:,:),POINTER :: mgfield #elif __KIND == __DOUBLE_PRECISION TYPE(mg_field_3d_vec_d),DIMENSION(:,:),POINTER :: mgfield #endif #endif #endif #if __DIM == __SFIELD #if __MESH_DIM == __2D REAL(MK),DIMENSION(:,:),POINTER :: tuc REAL(MK),DIMENSION(:,:),POINTER :: puc #elif __MESH_DIM == __3D REAL(MK),DIMENSION(:,:,:),POINTER :: tuc REAL(MK),DIMENSION(:,:,:),POINTER :: puc #endif #elif __DIM == __VFIELD #if __MESH_DIM == __2D REAL(MK),DIMENSION(:,:,:),POINTER :: tuc REAL(MK),DIMENSION(:,:,:),POINTER :: puc #elif __MESH_DIM == __3D REAL(MK),DIMENSION(:,:,:,:),POINTER :: tuc REAL(MK),DIMENSION(:,:,:,:),POINTER :: puc #endif #endif !---------------------------------------------------------------------- !Externals !---------------------------------------------------------------------- !---------------------------------------------------------------------- !Initialize !---------------------------------------------------------------------- CALL substart('ppm_mg_prolong',t0,info) !---------------------------------------------------------------------- ! Check arguments !---------------------------------------------------------------------- IF (ppm_debug .GT. 0) THEN IF (mlev.LT.1) THEN info = ppm_error_error CALL ppm_error(ppm_err_argument,'ppm_mg_prolong', & & 'level must be >0',__LINE__,info) GOTO 9999 ENDIF ENDIF !---------------------------------------------------------------------- !Definition of necessary variables and allocation of arrays !---------------------------------------------------------------------- #if __DIM == __SFIELD #if __MESH_DIM == __2D #if __KIND == __SINGLE_PRECISION mgfield=>mgfield_2d_sca_s #elif __KIND == __DOUBLE_PRECISION mgfield=>mgfield_2d_sca_d #endif #elif __MESH_DIM == __3D #if __KIND == __SINGLE_PRECISION mgfield=>mgfield_3d_sca_s #elif __KIND == __DOUBLE_PRECISION mgfield=>mgfield_3d_sca_d #endif #endif #elif __DIM == __VFIELD #if __MESH_DIM == __2D #if __KIND == __SINGLE_PRECISION mgfield=>mgfield_2d_vec_s #elif __KIND == __DOUBLE_PRECISION mgfield=>mgfield_2d_vec_d #endif #elif __MESH_DIM == __3D #if __KIND == __SINGLE_PRECISION mgfield=>mgfield_3d_vec_s #elif __KIND == __DOUBLE_PRECISION mgfield=>mgfield_3d_vec_d #endif #endif #endif !---------------------------------------------------------------------- !Implementation !---------------------------------------------------------------------- mlevp1 = mlev + 1 IF (l_print) THEN WRITE(cbuf,*) 'WELCOME TO THE PROLONG LEVEL:',mlev CALL PPM_WRITE(ppm_rank,'mg_prolong',cbuf,info) ENDIF #if __DIM == __SFIELD #if __MESH_DIM == __2D !---------------------------------------------------------------------- !prolongation using a 9-point operator !---------------------------------------------------------------------- DO isub=1,nsubs tuc=>mgfield(isub,mlevp1)%uc puc=>mgfield(isub,mlev)%uc DO j=1,max_node(2,mlevp1) j2=2*j DO i=1,max_node(1,mlevp1) i2=2*i puc(i2-1,j2-1) = & & puc(i2-1,j2-1) + & & tuc(i,j) puc(i2,j2-1) = & & puc(i2,j2-1) + & & 0.5_MK * (tuc(i,j)+& & tuc(i+1,j)) puc(i2-1,j2) = & & puc(i2-1,j2) + & & 0.5_MK * ( tuc(i,j) + & & tuc(i,j+1)) puc(i2,j2) = & & puc(i2,j2) + & & 0.25_MK * ( tuc(i,j)+& & tuc(i+1,j) + & & tuc(i+1,j+1)+& & tuc(i,j+1)) ENDDO ENDDO ENDDO #elif __MESH_DIM == __3D !---------------------------------------------------------------------- !prolongation using a 27-point operator !---------------------------------------------------------------------- DO isub=1,nsubs tuc=>mgfield(isub,mlevp1)%uc puc=>mgfield(isub,mlev)%uc DO k=1,max_node(3,mlevp1) k2=2*k DO j=1,max_node(2,mlevp1) j2=2*j DO i=1,max_node(1,mlevp1) i2=2*i puc(i2-1,j2-1,k2-1) = & & puc(i2-1,j2-1,k2-1) + & & tuc(i,j,k) puc(i2,j2-1,k2-1) = & & puc(i2,j2-1,k2-1) + & & 0.5_MK * (tuc(i,j,k)+& & tuc(i+1,j,k)) puc(i2-1,j2,k2-1) = & & puc(i2-1,j2,k2-1) + & & 0.5_MK * ( tuc(i,j,k) + & & tuc(i,j+1,k)) puc(i2,j2,k2-1) = & & puc(i2,j2,k2-1) + & & 0.25_MK * ( tuc(i,j,k)+& & tuc(i+1,j,k) + & & tuc(i+1,j+1,k)+& & tuc(i,j+1,k)) puc(i2-1,j2-1,k2) = & & puc(i2-1,j2-1,k2) + & & 0.5_MK * (tuc(i,j,k)+& & tuc(i,j,k+1)) puc(i2,j2-1,k2) = & & puc(i2,j2-1,k2) + & & 0.25_MK * ( tuc(i,j,k)+& & tuc(i+1,j,k) + & & tuc(i+1,j,k+1)+& & tuc(i,j,k+1)) puc(i2-1,j2,k2) = & & puc(i2-1,j2,k2) + & & 0.25_MK * ( tuc(i,j,k)+& & tuc(i,j+1,k) + & & tuc(i,j,k+1)+& & tuc(i,j+1,k+1)) puc(i2,j2,k2) = & & puc(i2,j2,k2) + & & 0.125_MK * (tuc(i,j,k)+& & tuc(i+1,j,k) + & & tuc(i+1,j+1,k)+& & tuc(i,j+1,k)+& & tuc(i,j,k+1) + & & tuc(i+1,j,k+1)+& & tuc(i,j+1,k+1)+& & tuc(i+1,j+1,k+1)) ENDDO ENDDO ENDDO ENDDO #endif #elif __DIM == __VFIELD #if __MESH_DIM == __2D !---------------------------------------------------------------------- !prolongation using a 9-point operator !---------------------------------------------------------------------- DO isub=1,nsubs tuc=>mgfield(isub,mlevp1)%uc puc=>mgfield(isub,mlev)%uc DO j=1,max_node(2,mlevp1) j2=2*j DO i=1,max_node(1,mlevp1) i2=2*i DO ilda=1,vecdim puc(ilda,i2-1,j2-1) = & & puc(ilda,i2-1,j2-1) + & & tuc(ilda,i,j) puc(ilda,i2,j2-1) = & & puc(ilda,i2,j2-1) + & & 0.5_MK * (tuc(ilda,i,j)+& & tuc(ilda,i+1,j)) puc(ilda,i2-1,j2) = & & puc(ilda,i2-1,j2) + & & 0.5_MK * ( tuc(ilda,i,j) + & & tuc(ilda,i,j+1)) puc(ilda,i2,j2) = & & puc(ilda,i2,j2) + & & 0.25_MK * ( tuc(ilda,i,j)+& & tuc(ilda,i+1,j) + & & tuc(ilda,i+1,j+1)+& & tuc(ilda,i,j+1)) ENDDO ENDDO ENDDO ENDDO #elif __MESH_DIM == __3D !---------------------------------------------------------------------- !prolongation using a 27-point operator !---------------------------------------------------------------------- DO isub=1,nsubs tuc=>mgfield(isub,mlevp1)%uc puc=>mgfield(isub,mlev)%uc DO k=1,max_node(3,mlevp1) k2=2*k DO j=1,max_node(2,mlevp1) j2=2*j DO i=1,max_node(1,mlevp1) i2=2*i #ifdef __VECTOR puc(1,i2-1,j2-1,k2-1) = & & puc(1,i2-1,j2-1,k2-1) + & & tuc(1,i,j,k) puc(1,i2,j2-1,k2-1) = & & puc(1,i2,j2-1,k2-1) + & & 0.5_MK * (tuc(1,i,j,k)+& & tuc(1,i+1,j,k)) puc(1,i2-1,j2,k2-1) = & & puc(1,i2-1,j2,k2-1) + & & 0.5_MK * ( tuc(1,i,j,k) + & & tuc(1,i,j+1,k)) puc(1,i2,j2,k2-1) = & & puc(1,i2,j2,k2-1) + & & 0.25_MK * ( tuc(1,i,j,k)+& & tuc(1,i+1,j,k) + & & tuc(1,i+1,j+1,k)+& & tuc(1,i,j+1,k)) puc(1,i2-1,j2-1,k2) = & & puc(1,i2-1,j2-1,k2) + & & 0.5_MK * (tuc(1,i,j,k)+& & tuc(1,i,j,k+1)) puc(1,i2,j2-1,k2) = & & puc(1,i2,j2-1,k2) + & & 0.25_MK * ( tuc(1,i,j,k)+& & tuc(1,i+1,j,k) + & & tuc(1,i+1,j,k+1)+& & tuc(1,i,j,k+1)) puc(1,i2-1,j2,k2) = & & puc(1,i2-1,j2,k2) + & & 0.25_MK * ( tuc(1,i,j,k)+& & tuc(1,i,j+1,k) + & & tuc(1,i,j,k+1)+& & tuc(1,i,j+1,k+1)) puc(1,i2,j2,k2) = & & puc(1,i2,j2,k2) + & & 0.125_MK * (tuc(1,i,j,k)+& & tuc(1,i+1,j,k) + & & tuc(1,i+1,j+1,k)+& & tuc(1,i,j+1,k)+& & tuc(1,i,j,k+1) + & & tuc(1,i+1,j,k+1)+& & tuc(1,i,j+1,k+1)+& & tuc(1,i+1,j+1,k+1)) puc(2,i2-1,j2-1,k2-1) = & & puc(2,i2-1,j2-1,k2-1) + & & tuc(2,i,j,k) puc(2,i2,j2-1,k2-1) = & & puc(2,i2,j2-1,k2-1) + & & 0.5_MK * (tuc(2,i,j,k)+& & tuc(2,i+1,j,k)) puc(2,i2-1,j2,k2-1) = & & puc(2,i2-1,j2,k2-1) + & & 0.5_MK * ( tuc(2,i,j,k) + & & tuc(2,i,j+1,k)) puc(2,i2,j2,k2-1) = & & puc(2,i2,j2,k2-1) + & & 0.25_MK * ( tuc(2,i,j,k)+& & tuc(2,i+1,j,k) + & & tuc(2,i+1,j+1,k)+& & tuc(2,i,j+1,k)) puc(2,i2-1,j2-1,k2) = & & puc(2,i2-1,j2-1,k2) + & & 0.5_MK * (tuc(2,i,j,k)+& & tuc(2,i,j,k+1)) puc(2,i2,j2-1,k2) = & & puc(2,i2,j2-1,k2) + & & 0.25_MK * ( tuc(2,i,j,k)+& & tuc(2,i+1,j,k) + & & tuc(2,i+1,j,k+1)+& & tuc(2,i,j,k+1)) puc(2,i2-1,j2,k2) = & & puc(2,i2-1,j2,k2) + & & 0.25_MK * ( tuc(2,i,j,k)+& & tuc(2,i,j+1,k) + & & tuc(2,i,j,k+1)+& & tuc(2,i,j+1,k+1)) puc(2,i2,j2,k2) = & & puc(2,i2,j2,k2) + & & 0.125_MK * (tuc(2,i,j,k)+& & tuc(2,i+1,j,k) + & & tuc(2,i+1,j+1,k)+& & tuc(2,i,j+1,k)+& & tuc(2,i,j,k+1) + & & tuc(2,i+1,j,k+1)+& & tuc(2,i,j+1,k+1)+& & tuc(2,i+1,j+1,k+1)) puc(3,i2-1,j2-1,k2-1) = & & puc(3,i2-1,j2-1,k2-1) + & & tuc(3,i,j,k) puc(3,i2,j2-1,k2-1) = & & puc(3,i2,j2-1,k2-1) + & & 0.5_MK * (tuc(3,i,j,k)+& & tuc(3,i+1,j,k)) puc(3,i2-1,j2,k2-1) = & & puc(3,i2-1,j2,k2-1) + & & 0.5_MK * ( tuc(3,i,j,k) + & & tuc(3,i,j+1,k)) puc(3,i2,j2,k2-1) = & & puc(3,i2,j2,k2-1) + & & 0.25_MK * ( tuc(3,i,j,k)+& & tuc(3,i+1,j,k) + & & tuc(3,i+1,j+1,k)+& & tuc(3,i,j+1,k)) puc(3,i2-1,j2-1,k2) = & & puc(3,i2-1,j2-1,k2) + & & 0.5_MK * (tuc(3,i,j,k)+& & tuc(3,i,j,k+1)) puc(3,i2,j2-1,k2) = & & puc(3,i2,j2-1,k2) + & & 0.25_MK * ( tuc(3,i,j,k)+& & tuc(3,i+1,j,k) + & & tuc(3,i+1,j,k+1)+& & tuc(3,i,j,k+1)) puc(3,i2-1,j2,k2) = & & puc(3,i2-1,j2,k2) + & & 0.25_MK * ( tuc(3,i,j,k)+& & tuc(3,i,j+1,k) + & & tuc(3,i,j,k+1)+& & tuc(3,i,j+1,k+1)) puc(3,i2,j2,k2) = & & puc(3,i2,j2,k2) + & & 0.125_MK * (tuc(3,i,j,k)+& & tuc(3,i+1,j,k) + & & tuc(3,i+1,j+1,k)+& & tuc(3,i,j+1,k)+& & tuc(3,i,j,k+1) + & & tuc(3,i+1,j,k+1)+& & tuc(3,i,j+1,k+1)+& & tuc(3,i+1,j+1,k+1)) #else DO ilda=1,vecdim puc(ilda,i2-1,j2-1,k2-1) = & & puc(ilda,i2-1,j2-1,k2-1) + & & tuc(ilda,i,j,k) puc(ilda,i2,j2-1,k2-1) = & & puc(ilda,i2,j2-1,k2-1) + & & 0.5_MK * (tuc(ilda,i,j,k)+& & tuc(ilda,i+1,j,k)) puc(ilda,i2-1,j2,k2-1) = & & puc(ilda,i2-1,j2,k2-1) + & & 0.5_MK * ( tuc(ilda,i,j,k) + & & tuc(ilda,i,j+1,k)) puc(ilda,i2,j2,k2-1) = & & puc(ilda,i2,j2,k2-1) + & & 0.25_MK * ( tuc(ilda,i,j,k)+& & tuc(ilda,i+1,j,k) + & & tuc(ilda,i+1,j+1,k)+& & tuc(ilda,i,j+1,k)) puc(ilda,i2-1,j2-1,k2) = & & puc(ilda,i2-1,j2-1,k2) + & & 0.5_MK * (tuc(ilda,i,j,k)+& & tuc(ilda,i,j,k+1)) puc(ilda,i2,j2-1,k2) = & & puc(ilda,i2,j2-1,k2) + & & 0.25_MK * ( tuc(ilda,i,j,k)+& & tuc(ilda,i+1,j,k) + & & tuc(ilda,i+1,j,k+1)+& & tuc(ilda,i,j,k+1)) puc(ilda,i2-1,j2,k2) = & & puc(ilda,i2-1,j2,k2) + & & 0.25_MK * ( tuc(ilda,i,j,k)+& & tuc(ilda,i,j+1,k) + & & tuc(ilda,i,j,k+1)+& & tuc(ilda,i,j+1,k+1)) puc(ilda,i2,j2,k2) = & & puc(ilda,i2,j2,k2) + & & 0.125_MK * (tuc(ilda,i,j,k)+& & tuc(ilda,i+1,j,k) + & & tuc(ilda,i+1,j+1,k)+& & tuc(ilda,i,j+1,k)+& & tuc(ilda,i,j,k+1) + & & tuc(ilda,i+1,j,k+1)+& & tuc(ilda,i,j+1,k+1)+& & tuc(ilda,i+1,j+1,k+1)) ENDDO #endif ENDDO ENDDO ENDDO ENDDO #endif #endif !---------------------------------------------------------------------- !RETURN !---------------------------------------------------------------------- 9999 CONTINUE CALL substop('ppm_mg_prolong',t0,info) RETURN #if __DIM == __SFIELD #if __MESH_DIM == __2D #if __KIND == __SINGLE_PRECISION END SUBROUTINE ppm_mg_prolong_2d_sca_s #elif __KIND == __DOUBLE_PRECISION END SUBROUTINE ppm_mg_prolong_2d_sca_d #endif #elif __MESH_DIM == __3D #if __KIND == __SINGLE_PRECISION END SUBROUTINE ppm_mg_prolong_3d_sca_s #elif __KIND == __DOUBLE_PRECISION END SUBROUTINE ppm_mg_prolong_3d_sca_d #endif #endif #elif __DIM == __VFIELD #if __MESH_DIM == __2D #if __KIND == __SINGLE_PRECISION END SUBROUTINE ppm_mg_prolong_2d_vec_s #elif __KIND == __DOUBLE_PRECISION END SUBROUTINE ppm_mg_prolong_2d_vec_d #endif #elif __MESH_DIM == __3D #if __KIND == __SINGLE_PRECISION END SUBROUTINE ppm_mg_prolong_3d_vec_s #elif __KIND == __DOUBLE_PRECISION END SUBROUTINE ppm_mg_prolong_3d_vec_d #endif #endif #endif libppmnumerics-r1036/src/ppm_gmm_march.f0000644000175000017500000012376411616214647017127 0ustar omaromar !------------------------------------------------------------------------- ! Subroutine : ppm_gmm_march !------------------------------------------------------------------------- ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see . ! ! Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Switzerland !------------------------------------------------------------------------- #if __DIM == __2D #if __KIND == __SINGLE_PRECISION SUBROUTINE ppm_gmm_march_2ds(width,order,fdata,rhscst,MaxIter,info, & & speed,udata,chi) #elif __KIND == __DOUBLE_PRECISION SUBROUTINE ppm_gmm_march_2dd(width,order,fdata,rhscst,MaxIter,info, & & speed,udata,chi) #endif #elif __DIM == __3D #if __KIND == __SINGLE_PRECISION SUBROUTINE ppm_gmm_march_3ds(width,order,fdata,rhscst,MaxIter,info, & & speed,udata,chi) #elif __KIND == __DOUBLE_PRECISION SUBROUTINE ppm_gmm_march_3dd(width,order,fdata,rhscst,MaxIter,info, & & speed,udata,chi) #endif #endif !!! This routine performs the group marching to !!! extend the infprmation from the interface to a !!! narrow band. This is used for level set !!! reinitialization or function extension. The !!! interface is assumed to be at the zero level. !!! Use postprocess shifting if this is not the case. !!! !!! [NOTE] !!! This routine uses the o(N) group marching method !!! of Kim, rather than o(NlogN) fast marching. If !!! combines this with the high order equations by !!! Chopp to get 2nd or 3rd order accurate !!! extrapolations in linear time. !!! speed should maybe be passed as speed**2. This !!! would save the multiplication in gmm_slvupwind, !!! but would require SQRTs in the initial !!! conversion from distance to travel time. !!! When recomputing the close neighbors one could !!! detect local minima and directly remove (i.e. !!! accept) them to avoid unnecessary double !!! computations. !!! To be more memory efficient, we could maybe !!! allocate gmm_state only for the sub we are !!! currently working on instead of for the full local !!! field. This will however only give cashback if !!! there are lots of subs per proc, which is currently !!! not the case for mesh topologies. !!! !!! === References === !!! !!! D.L. Chopp. Some improvements on the fast marching method. SIAM J. !!! Sci. Comput. 23(1):230-244, 2001. !!! S. Kim. An O(N) level set method for Eikonal equations. SIAM J. Sci. !!! Comput. 22(6):2178-2193, 2001. !------------------------------------------------------------------------- ! Modules !------------------------------------------------------------------------- USE ppm_module_data USE ppm_module_numerics_data USE ppm_module_data_gmm USE ppm_module_gmm_march_fwd USE ppm_module_gmm_march_bkwd USE ppm_module_gmm_extend_fwd USE ppm_module_gmm_extend_bkwd USE ppm_module_substart USE ppm_module_substop USE ppm_module_error USE ppm_module_write USE ppm_module_alloc USE ppm_module_map_field USE ppm_module_map_field_ghost IMPLICIT NONE #if __KIND == __SINGLE_PRECISION INTEGER, PARAMETER :: MK = ppm_kind_single #else INTEGER, PARAMETER :: MK = ppm_kind_double #endif !------------------------------------------------------------------------- ! Includes !------------------------------------------------------------------------- #include "ppm_define.h" #ifdef __MPI INCLUDE 'mpif.h' #endif !------------------------------------------------------------------------- ! Arguments !------------------------------------------------------------------------- #if __DIM == __2D REAL(MK), DIMENSION(:,:,:) , INTENT(IN), OPTIONAL :: speed #elif __DIM == __3D REAL(MK), DIMENSION(:,:,:,:) , INTENT(IN), OPTIONAL :: speed #endif !!! rank 4 (3d) or rank 3 (2d) field of front speeds. !!! OPTIONAL to override rhscst. #if __DIM == __2D REAL(MK), DIMENSION(:,:,:) , POINTER :: fdata #elif __DIM == __3D REAL(MK), DIMENSION(:,:,:,:) , POINTER :: fdata #endif !!! Level data. Either rank 3 (for 2D scalar fields), or rank !!! 4 (for 3D scalar fields). Indices: (i,k,[k],isub). On input: !!! signed distance function after initialization as returned by !!! ppm_gmm_kickoff. Uninitialized values must be set to HUGE. !!! On output: approximation of the extended signed distance !!! function in the whole band. Points far from the interface will have !!! the value HUGE. #if __DIM == __2D REAL(MK), DIMENSION(:,:,:) , POINTER, OPTIONAL :: udata #elif __DIM == __3D REAL(MK), DIMENSION(:,:,:,:) , POINTER, OPTIONAL :: udata #endif !!! Function data. OPTIONAL. If present, udata will be extended in the !!! whole band such that its gradient is orthogonal to the gradient !!! of fdata. fdata in this case is a pure input and needs to be !!! available in the whole band. Needs to be a scalar field. #if __DIM == __2D REAL(MK), DIMENSION(:,:,:,:) , INTENT(IN), OPTIONAL :: chi #elif __DIM == __3D REAL(MK), DIMENSION(:,:,:,:,:) , INTENT(IN), OPTIONAL :: chi #endif !!! rank 5 (3d) or rank 4 (2d) field specifying the positions of the !!! grid nodes. 1st index: 1..ppm_dim, then i,j,[k],isub. !!! OPTIONAL. Uniform grid is assumed if absent. Ghostlayers of size !!! >=1 must be pre-filled. REAL(MK) , INTENT(IN ) :: width !!! Width of the narrow band to be produced on each side of the interface. REAL(MK) , INTENT(IN ) :: rhscst !!! constant value for the right hand side of grad u * grad f = c. If !!! speed is present, this argument will be ignored. INTEGER , INTENT(IN ) :: order !!! Order of the method to be used. One of !!! !!! *ppm_param_order_1 !!! *ppm_param_order_2 !!! *ppm_param_order_3 INTEGER , INTENT(IN ) :: MaxIter !!! argument specifying the maximum number of allowed iterations. !!! This can be useful since a cyclic dependency in the GMM algorithms !!! could cause infinite loops. INTEGER , INTENT( OUT) :: info !!! Return status, 0 upon success !------------------------------------------------------------------------- ! Local variables !------------------------------------------------------------------------- INTEGER :: i,j,k,p,iopt,xhi,yhi,zhi INTEGER :: npos,npos0,jsub,isub INTEGER :: nposg INTEGER :: nord INTEGER :: Marchit INTEGER, DIMENSION(3) :: ghostsize INTEGER, DIMENSION(4) :: ldl,ldu REAL(MK),DIMENSION(2) :: coefs REAL(MK) :: t0,deltaT,sqrtdiminv,smin REAL(MK) :: TM,dx,dy,dz,dxinv,dyinv,dzinv REAL(MK) :: hsave,mindx REAL(MK) :: ainv,big TYPE(ppm_t_topo) , POINTER :: topo TYPE(ppm_t_equi_mesh), POINTER :: mesh #ifdef __MPI REAL(MK) :: allsmin #endif LOGICAL :: lok CHARACTER(LEN=ppm_char) :: cbuf #if __DIM == __2D REAL(MK), DIMENSION(:,:,: ), POINTER :: fdta REAL(MK), DIMENSION(:,:,: ), POINTER :: dta #elif __DIM == __3D REAL(MK), DIMENSION(:,:,:,: ), POINTER :: fdta REAL(MK), DIMENSION(:,:,:,: ), POINTER :: dta #endif !------------------------------------------------------------------------- ! Externals !------------------------------------------------------------------------- !------------------------------------------------------------------------- ! Initialise !------------------------------------------------------------------------- CALL substart('ppm_gmm_march',t0,info) big = HUGE(big) hsave = 0.9_MK*big #if __DIM == __2D sqrtdiminv = 1.0_MK/SQRT(2.0_MK) #else sqrtdiminv = 1.0_MK/SQRT(3.0_MK) #endif topo => ppm_topo(gmm_topoid)%t mesh => topo%mesh(gmm_meshid) !------------------------------------------------------------------------- ! Check arguments !------------------------------------------------------------------------- IF (ppm_debug .GT. 0) THEN IF (.NOT. ppm_initialized) THEN info = ppm_error_error CALL ppm_error(ppm_err_ppm_noinit,'ppm_gmm_march', & & 'Please call ppm_init first!',__LINE__,info) GOTO 9999 ENDIF IF (width .LT. 0.0_MK) THEN info = ppm_error_error CALL ppm_error(ppm_err_ppm_noinit,'ppm_gmm_march', & & 'width must be positive!',__LINE__,info) GOTO 9999 ENDIF IF ((order.NE.ppm_param_order_1).AND.(order.NE.ppm_param_order_2) & & .AND.(order.NE.ppm_param_order_3)) THEN info = ppm_error_error CALL ppm_error(ppm_err_ppm_noinit,'ppm_gmm_march', & & 'order must be 1, 2, or 3!',__LINE__,info) GOTO 9999 ENDIF #if __DIM == __3D IF (SIZE(fdata,4) .LT. topo%nsublist) THEN info = ppm_error_error CALL ppm_error(ppm_err_argument,'ppm_gmm_march', & & 'field data for some subs is missing',__LINE__,info) GOTO 9999 ENDIF IF (UBOUND(fdata,1) .LT. maxxhi) THEN info = ppm_error_error CALL ppm_error(ppm_err_argument,'ppm_gmm_march', & & 'x dimension of field data does not match mesh',__LINE__,info) GOTO 9999 ENDIF IF (UBOUND(fdata,2) .LT. maxyhi) THEN info = ppm_error_error CALL ppm_error(ppm_err_argument,'ppm_gmm_march', & & 'y dimension of field data does not match mesh',__LINE__,info) GOTO 9999 ENDIF IF (UBOUND(fdata,3) .LT. maxzhi) THEN info = ppm_error_error CALL ppm_error(ppm_err_argument,'ppm_gmm_march', & & 'z dimension of field data does not match mesh',__LINE__,info) GOTO 9999 ENDIF #elif __DIM == __2D IF (SIZE(fdata,3) .LT. topo%nsublist) THEN info = ppm_error_error CALL ppm_error(ppm_err_argument,'ppm_gmm_march', & & 'field data for some subs is missing',__LINE__,info) GOTO 9999 ENDIF IF (UBOUND(fdata,1) .LT. maxxhi) THEN info = ppm_error_error CALL ppm_error(ppm_err_argument,'ppm_gmm_march', & & 'x dimension of field data does not match mesh',__LINE__,info) GOTO 9999 ENDIF IF (UBOUND(fdata,2) .LT. maxyhi) THEN info = ppm_error_error CALL ppm_error(ppm_err_argument,'ppm_gmm_march', & & 'y dimension of field data does not match mesh',__LINE__,info) GOTO 9999 ENDIF #endif ENDIF ! ppm_debug for argument check !------------------------------------------------------------------------- ! Determine ghostsize needed. Only change if larger than what it ! already is. Do not shrink as this would freak out the client... !------------------------------------------------------------------------- #if __DIM == __3D i = MIN(1-LBOUND(fdata,1),1-LBOUND(fdata,2),1-LBOUND(fdata,3)) #else i = MIN(1-LBOUND(fdata,1),1-LBOUND(fdata,2)) #endif IF (order .EQ. ppm_param_order_1) THEN ghostsize = MAX(1,i) nord = 1 ! IF (ppm_debug .GT. 0) THEN WRITE(cbuf,'(A)') 'Using first order upwinding' CALL ppm_write(ppm_rank,'ppm_gmm_march',cbuf,info) ! ENDIF ELSEIF (order .EQ. ppm_param_order_2) THEN ghostsize = MAX(2,i) nord = 2 ! IF (ppm_debug .GT. 0) THEN WRITE(cbuf,'(A)') 'Using second order upwinding' CALL ppm_write(ppm_rank,'ppm_gmm_march',cbuf,info) ! ENDIF ELSE ghostsize = MAX(3,i) nord = 3 ! IF (ppm_debug .GT. 0) THEN WRITE(cbuf,'(A)') 'Using third order upwinding' CALL ppm_write(ppm_rank,'ppm_gmm_march',cbuf,info) ! ENDIF ENDIF !------------------------------------------------------------------------- ! Set the pointers !------------------------------------------------------------------------- IF (PRESENT(udata)) THEN !--------------------------------------------------------------------- ! March udata and use fdata as level set !--------------------------------------------------------------------- dta => udata fdta => fdata ELSE !--------------------------------------------------------------------- ! March the level set itself !--------------------------------------------------------------------- dta => fdata fdta => fdata ENDIF !------------------------------------------------------------------------- ! Find mesh spacing !------------------------------------------------------------------------- IF (ppm_kind .EQ. ppm_kind_single) THEN dx = (topo%max_physs(1)-topo%min_physs(1))/ & & REAL(mesh%Nm(1)-1,ppm_kind_single) dy = (topo%max_physs(2)-topo%min_physs(2))/ & & REAL(mesh%Nm(2)-1,ppm_kind_single) IF (ppm_dim .GT. 2) THEN dz = (topo%max_physs(3)-topo%min_physs(3))/ & & REAL(mesh%Nm(3)-1, & & ppm_kind_single) ENDIF ELSE dx = (topo%max_physs(1)-topo%min_physs(1))/ & & REAL(mesh%Nm(1)-1,ppm_kind_double) dy = (topo%max_physs(2)-topo%min_physs(2))/ & & REAL(mesh%Nm(2)-1,ppm_kind_double) IF (ppm_dim .GT. 2) THEN dz = (topo%max_physs(3)-topo%min_physs(3))/ & & REAL(mesh%Nm(3)-1, & & ppm_kind_double) ENDIF ENDIF dxinv = 1.0_MK/dx dyinv = 1.0_MK/dy #if __DIM == __3D dzinv = 1.0_MK/dz mindx = MIN(dx,dy,dz) #else dzinv = 0.0_MK mindx = MIN(dx,dy) #endif !------------------------------------------------------------------------- ! Initialize the ghost layers. !------------------------------------------------------------------------- CALL ppm_map_field_ghost_get(gmm_topoid,gmm_meshid,ghostsize,info) IF (info .NE. ppm_param_success) THEN info = ppm_error_error CALL ppm_error(ppm_err_sub_failed,'ppm_gmm_march', & & 'ghost get mapping failed',__LINE__,info) GOTO 9999 ENDIF CALL ppm_map_field_push(gmm_topoid,gmm_meshid,fdta,info) IF (info .NE. ppm_param_success) THEN info = ppm_error_error CALL ppm_error(ppm_err_sub_failed,'ppm_gmm_march', & & 'pushing level data failed',__LINE__,info) GOTO 9999 ENDIF IF (PRESENT(udata)) THEN CALL ppm_map_field_push(gmm_topoid,gmm_meshid,dta,info) IF (info .NE. ppm_param_success) THEN info = ppm_error_error CALL ppm_error(ppm_err_sub_failed,'ppm_gmm_march', & & 'pushing field data failed',__LINE__,info) GOTO 9999 ENDIF ENDIF CALL ppm_map_field_send(info) IF (info .NE. ppm_param_success) THEN info = ppm_error_error CALL ppm_error(ppm_err_sub_failed,'ppm_gmm_march', & & 'sending ghosts failed',__LINE__,info) GOTO 9999 ENDIF IF (PRESENT(udata)) THEN CALL ppm_map_field_pop(gmm_topoid,gmm_meshid,dta,ghostsize,info) IF (info .NE. ppm_param_success) THEN info = ppm_error_error CALL ppm_error(ppm_err_sub_failed,'ppm_gmm_march', & & 'popping field data failed',__LINE__,info) GOTO 9999 ENDIF ENDIF CALL ppm_map_field_pop(gmm_topoid,gmm_meshid,fdta,ghostsize,info) IF (info .NE. ppm_param_success) THEN info = ppm_error_error CALL ppm_error(ppm_err_sub_failed,'ppm_gmm_march', & & 'popping level data failed',__LINE__,info) GOTO 9999 ENDIF ! because it has not been mapped IF (.NOT.(PRESENT(udata))) dta => fdta !------------------------------------------------------------------------- ! Allocate and initialize status array !------------------------------------------------------------------------- iopt = ppm_param_alloc_grow #if __DIM == __3D ldl(1) = 1-ghostsize(1) ldl(2) = 1-ghostsize(2) ldl(3) = 1-ghostsize(3) ldl(4) = 1 ldu(1) = maxxhi+ghostsize(1) ldu(2) = maxyhi+ghostsize(2) ldu(3) = maxzhi+ghostsize(3) ldu(4) = topo%nsublist CALL ppm_alloc(gmm_state3d,ldl,ldu,iopt,info) #else ldl(1) = 1-ghostsize(1) ldl(2) = 1-ghostsize(2) ldl(3) = 1 ldu(1) = maxxhi+ghostsize(1) ldu(2) = maxyhi+ghostsize(2) ldu(3) = topo%nsublist CALL ppm_alloc(gmm_state2d,ldl,ldu,iopt,info) #endif IF (info .NE. 0) THEN info = ppm_error_fatal CALL ppm_error(ppm_err_alloc,'ppm_gmm_march', & & 'point status array GMM_STATE',__LINE__,info) GOTO 9999 ENDIF #if __DIM == __3D gmm_state3d = ppm_gmm_param_far !------------------------------------------------------------------------- ! Convert distance to travel time and find minimum slowness (= ! max speed) !------------------------------------------------------------------------- DO jsub=1,topo%nsublist IF (PRESENT(speed)) THEN isub = topo%isublist(jsub) xhi = mesh%nnodes(1,isub) yhi = mesh%nnodes(2,isub) zhi = mesh%nnodes(3,isub) smin = -big DO k=1,zhi DO j=1,yhi DO i=1,xhi IF (speed(i,j,k,jsub) .GT. smin) & & smin = speed(i,j,k,jsub) IF (dta(i,j,k,jsub) .LT. hsave) THEN dta(i,j,k,jsub)=dta(i,j,k,jsub)/speed(i,j,k,jsub) ENDIF ENDDO ENDDO ENDDO smin = 1.0_MK/smin #ifdef __MPI !----------------------------------------------------------------- ! Ensure consistent computations on all processors !----------------------------------------------------------------- #if __KIND == __SINGLE_PRECISION CALL MPI_Allreduce(smin,allsmin,1,MPI_REAL,MPI_MIN, & & ppm_comm,info) #else CALL MPI_Allreduce(smin,allsmin,1,MPI_DOUBLE_PRECISION,MPI_MIN, & & ppm_comm,info) #endif IF (info .NE. 0) THEN info = ppm_error_fatal CALL ppm_error(ppm_err_mpi_fail,'ppm_gmm_march', & & 'MPI_ALLREDUCE of smin',__LINE__,info) GOTO 9999 ENDIF smin = allsmin #endif ELSE smin = 1.0_MK ENDIF ENDDO ! jsub !------------------------------------------------------------------------- ! Initialize travel limit (see Kim:2001a) !------------------------------------------------------------------------- deltaT = 0.99_MK*sqrtdiminv*mindx*smin !IF (.NOT.PRESENT(udata)) deltaT = (10.0_MK**REAL(-nord+1,MK))*deltaT !------------------------------------------------------------------------- ! Make a list of all initialized points and find the minimum ! travel time on the boundary of the band. !------------------------------------------------------------------------- npos0 = 0 DO jsub=1,topo%nsublist isub = topo%isublist(jsub) xhi = mesh%nnodes(1,isub) yhi = mesh%nnodes(2,isub) zhi = mesh%nnodes(3,isub) TM = big DO k=1,zhi DO j=1,yhi DO i=1,xhi coefs(1) = dta(i,j,k,jsub) coefs(2) = fdta(i,j,k,jsub) IF ((coefs(1).LT.hsave).AND.(gmm_state3d(i,j,k,jsub).EQ.& & ppm_gmm_param_far)) THEN IF ((dta(i-1,j,k,jsub) .GT. hsave) .OR. & & (dta(i+1,j,k,jsub) .GT. hsave) .OR. & & (dta(i,j-1,k,jsub) .GT. hsave) .OR. & & (dta(i,j+1,k,jsub) .GT. hsave) .OR. & & (dta(i,j,k-1,jsub) .GT. hsave) .OR. & & (dta(i,j,k+1,jsub) .GT. hsave)) THEN !------------------------------------------------- ! Add points on the surface to close set and ! set TM to min distance to interface !------------------------------------------------- IF (ABS(coefs(2)) .LT. TM) TM = ABS(coefs(2)) gmm_state3d(i,j,k,jsub) = ppm_gmm_param_close #include "ppm_gmm_add_to_list.inc" ELSE gmm_state3d(i,j,k,jsub) = ppm_gmm_param_accepted ENDIF ENDIF ENDDO ! mesh cell i ENDDO ! mesh cell j ENDDO ! mesh cell k ENDDO ! jsub npos = npos0 !------------------------------------------------------------------------- ! Initialize ghost layers for state array !------------------------------------------------------------------------- CALL ppm_map_field_push(gmm_topoid,gmm_meshid,gmm_state3d,info) IF (info .NE. ppm_param_success) THEN info = ppm_error_error CALL ppm_error(ppm_err_sub_failed,'ppm_gmm_march', & & 'pushing status data failed',__LINE__,info) GOTO 9999 ENDIF CALL ppm_map_field_send(info) IF (info .NE. ppm_param_success) THEN info = ppm_error_error CALL ppm_error(ppm_err_sub_failed,'ppm_gmm_march', & & 'sending status ghosts failed',__LINE__,info) GOTO 9999 ENDIF CALL ppm_map_field_pop(gmm_topoid,gmm_meshid,gmm_state3d,ghostsize,info) IF (info .NE. ppm_param_success) THEN info = ppm_error_error CALL ppm_error(ppm_err_sub_failed,'ppm_gmm_march', & & 'popping status data failed',__LINE__,info) GOTO 9999 ENDIF !------------------------------------------------------------------------- ! Initialize the global gamma size !------------------------------------------------------------------------- #ifdef __MPI CALL MPI_AllReduce(npos,nposg,1,MPI_INTEGER,MPI_SUM,ppm_comm,info) #else nposg = npos #endif !------------------------------------------------------------------------- ! March !------------------------------------------------------------------------- Marchit = 0 DO WHILE ((nposg .GT. 0) .AND. (Marchit .LT. MaxIter)) Marchit = Marchit + 1 TM = TM + deltaT IF (ppm_debug .GT. 0) THEN WRITE(cbuf,'(A,I4,A,I9)') 'Iteration ',Marchit, & & ': Number of points in list: ',npos CALL ppm_write(ppm_rank,'ppm_gmm_march',cbuf,info) IF (npos.LE.5) THEN DO i=1,npos WRITE(cbuf,'(A,I9,I9,I9)') 'Point ', gmm_ipos(1,i), gmm_ipos(2,i), gmm_ipos(3,i) CALL ppm_write(ppm_rank,'ppm_gmm_march',cbuf,info) END DO END IF ENDIF !--------------------------------------------------------------------- ! Hard-core debuging !--------------------------------------------------------------------- ! WRITE(cbuf,'(A,I4.4,A)') 'state_',Marchit,'.out' ! OPEN(50,FILE=cbuf,STATUS='REPLACE',ACTION='WRITE') ! WRITE(cbuf,'(A,I4.4,A)') 'level_',Marchit,'.out' ! OPEN(40,FILE=cbuf,STATUS='REPLACE',ACTION='WRITE') ! DO k=1,zhi ! DO j=1,yhi ! DO i=1,xhi ! IF (ABS(fdta(i,j,k,1)) .LT. hsave) THEN ! WRITE(40,*) fdta(i,j,k,1) ! ELSE ! WRITE(40,*) 0.0_MK ! ENDIF ! WRITE(50,*) gmm_state3d(i,j,k,1) ! ENDDO ! ENDDO ! ENDDO ! CLOSE(40) ! CLOSE(50) !--------------------------------------------------------------------- ! Reverse order: recompute neighbors of points in ggm_ipos to ! fix stability. !--------------------------------------------------------------------- IF (PRESENT(udata)) THEN DO i=1,nord IF (PRESENT(speed)) THEN CALL ppm_gmm_extend_bkwd(fdta,dta,width,order,npos,TM, & & rhscst,dxinv,dyinv,dzinv,ghostsize,info,speed) ELSE CALL ppm_gmm_extend_bkwd(fdta,dta,width,order,npos,TM, & & rhscst,dxinv,dyinv,dzinv,ghostsize,info) ENDIF IF (info .NE. 0) THEN info = ppm_error_error CALL ppm_error(ppm_err_sub_failed,'ppm_gmm_march', & & 'Backward extension failed.',__LINE__,info) GOTO 8888 ENDIF ENDDO ELSE IF (PRESENT(speed)) THEN CALL ppm_gmm_march_bkwd(fdta,width,order,npos,TM, & & rhscst,dxinv,dyinv,dzinv,ghostsize,info,speed) ELSE CALL ppm_gmm_march_bkwd(fdta,width,order,npos,TM, & & rhscst,dxinv,dyinv,dzinv,ghostsize,info) ENDIF IF (info .NE. 0) THEN info = ppm_error_error CALL ppm_error(ppm_err_sub_failed,'ppm_gmm_march', & & 'Backward marching failed.',__LINE__,info) GOTO 8888 ENDIF ENDIF !--------------------------------------------------------------------- ! Forward order: update neighbors of points in ggm_ipos and ! advance front !--------------------------------------------------------------------- IF (PRESENT(udata)) THEN IF (PRESENT(speed)) THEN CALL ppm_gmm_extend_fwd(fdta,dta,width,order,npos,TM, & & rhscst,dxinv,dyinv,dzinv,ghostsize,info,speed) ELSE CALL ppm_gmm_extend_fwd(fdta,dta,width,order,npos,TM, & & rhscst,dxinv,dyinv,dzinv,ghostsize,info) ENDIF ELSE IF (PRESENT(speed)) THEN CALL ppm_gmm_march_fwd(fdta,width,order,npos,TM, & & rhscst,dxinv,dyinv,dzinv,ghostsize,info,speed) ELSE CALL ppm_gmm_march_fwd(fdta,width,order,npos,TM, & & rhscst,dxinv,dyinv,dzinv,ghostsize,info) ENDIF ENDIF IF (info .NE. 0) THEN info = ppm_error_error CALL ppm_error(ppm_err_sub_failed,'ppm_gmm_march', & & 'Forward marching failed.',__LINE__,info) GOTO 8888 ENDIF !--------------------------------------------------------------------- ! Update the global gamma size !--------------------------------------------------------------------- #ifdef __MPI CALL MPI_AllReduce(npos,nposg,1,MPI_INTEGER,MPI_SUM,ppm_comm,info) #else nposg = npos #endif ENDDO ! while nposg.GT.0 #elif __DIM == __2D gmm_state2d = ppm_gmm_param_far !------------------------------------------------------------------------- ! Convert distance to travel time and find minimum slowness (= ! max speed) !------------------------------------------------------------------------- DO jsub=1,topo%nsublist IF (PRESENT(speed)) THEN isub = topo%isublist(jsub) xhi = mesh%nnodes(1,isub) yhi = mesh%nnodes(2,isub) smin = -big DO j=1,yhi DO i=1,xhi IF (speed(i,j,jsub) .GT. smin) & & smin = speed(i,j,jsub) IF (dta(i,j,jsub) .LT. hsave) THEN dta(i,j,jsub) = & & dta(i,j,jsub)/speed(i,j,jsub) ENDIF ENDDO ENDDO smin = 1.0_MK/smin #ifdef __MPI !----------------------------------------------------------------- ! Ensure consistent computations on all processors !----------------------------------------------------------------- #if __KIND == __SINGLE_PRECISION CALL MPI_Allreduce(smin,allsmin,1,MPI_REAL,MPI_MIN, & & ppm_comm,info) #else CALL MPI_Allreduce(smin,allsmin,1,MPI_DOUBLE_PRECISION,MPI_MIN, & & ppm_comm,info) #endif IF (info .NE. 0) THEN info = ppm_error_fatal CALL ppm_error(ppm_err_mpi_fail,'ppm_gmm_march', & & 'MPI_ALLREDUCE of smin',__LINE__,info) GOTO 9999 ENDIF smin = allsmin #endif ELSE smin = 1.0_MK ENDIF ENDDO ! jsub !------------------------------------------------------------------------- ! Initialize travel limit (see Kim:2001a) !------------------------------------------------------------------------- deltaT = 0.99_MK*sqrtdiminv*mindx*smin !IF (.NOT.PRESENT(udata)) deltaT = (10.0_MK**REAL(-nord+1,MK))*deltaT !------------------------------------------------------------------------- ! Make a list of all initialized points and find the minimum ! travel time on the boundary of the band. !------------------------------------------------------------------------- npos0 = 0 DO jsub=1,topo%nsublist isub = topo%isublist(jsub) xhi = mesh%nnodes(1,isub) yhi = mesh%nnodes(2,isub) TM = big DO j=1,yhi DO i=1,xhi coefs(1) = dta(i,j,jsub) coefs(2) = fdta(i,j,jsub) IF ((coefs(1).LT.hsave).AND.(gmm_state2d(i,j,jsub).EQ.& & ppm_gmm_param_far)) THEN IF ((dta(i-1,j,jsub) .GT. hsave) .OR. & & (dta(i+1,j,jsub) .GT. hsave) .OR. & & (dta(i,j-1,jsub) .GT. hsave) .OR. & & (dta(i,j+1,jsub) .GT. hsave)) THEN !----------------------------------------------------- ! Add points on the surface to close set and ! set TM to min distance to interface !----------------------------------------------------- IF (ABS(coefs(2)) .LT. TM) TM = ABS(coefs(2)) gmm_state2d(i,j,jsub) = ppm_gmm_param_close #include "ppm_gmm_add_to_list.inc" ELSE gmm_state2d(i,j,jsub) = ppm_gmm_param_accepted ENDIF ENDIF ENDDO ! mesh cell i ENDDO ! mesh cell j ENDDO ! jsub npos = npos0 !------------------------------------------------------------------------- ! Initialize ghost layers for state array !------------------------------------------------------------------------- CALL ppm_map_field_push(gmm_topoid,gmm_meshid,gmm_state2d,info) IF (info .NE. ppm_param_success) THEN info = ppm_error_error CALL ppm_error(ppm_err_sub_failed,'ppm_gmm_march', & & 'pushing status data failed',__LINE__,info) GOTO 9999 ENDIF CALL ppm_map_field_send(info) IF (info .NE. ppm_param_success) THEN info = ppm_error_error CALL ppm_error(ppm_err_sub_failed,'ppm_gmm_march', & & 'sending status ghosts failed',__LINE__,info) GOTO 9999 ENDIF CALL ppm_map_field_pop(gmm_topoid,gmm_meshid,gmm_state2d,ghostsize,info) IF (info .NE. ppm_param_success) THEN info = ppm_error_error CALL ppm_error(ppm_err_sub_failed,'ppm_gmm_march', & & 'popping status data failed',__LINE__,info) GOTO 9999 ENDIF !------------------------------------------------------------------------- ! Initialize the global gamma size !------------------------------------------------------------------------- #ifdef __MPI CALL MPI_AllReduce(npos,nposg,1,MPI_INTEGER,MPI_SUM,ppm_comm,info) #else nposg = npos #endif !------------------------------------------------------------------------- ! March !------------------------------------------------------------------------- Marchit = 0 DO WHILE ((nposg .GT. 0) .AND. (Marchit .LT. MaxIter)) Marchit = Marchit + 1 TM = TM + deltaT IF (ppm_debug .GT. 0) THEN WRITE(cbuf,'(A,I4,A,I9)') 'Iteration ',Marchit, & & ': Number of points in list: ',npos CALL ppm_write(ppm_rank,'ppm_gmm_march',cbuf,info) ENDIF !--------------------------------------------------------------------- ! Reverse order: recompute neighbors of points in ggm_ipos to ! fix stability !--------------------------------------------------------------------- IF (PRESENT(udata)) THEN DO i=1,nord IF (PRESENT(speed)) THEN IF (PRESENT(chi)) THEN CALL ppm_gmm_extend_bkwd(fdta,dta,width,order,npos,& & TM,rhscst,dxinv,dyinv,dzinv,ghostsize,info, & & speed,chi) ELSE CALL ppm_gmm_extend_bkwd(fdta,dta,width,order,npos,& & TM,rhscst,dxinv,dyinv,dzinv,ghostsize,info,speed) ENDIF ELSE IF (PRESENT(chi)) THEN CALL ppm_gmm_extend_bkwd(fdta,dta,width,order,npos, & & TM,rhscst,dxinv,dyinv,dzinv,ghostsize,info, & & chi=chi) ELSE CALL ppm_gmm_extend_bkwd(fdta,dta,width,order,npos, & & TM,rhscst,dxinv,dyinv,dzinv,ghostsize,info) ENDIF ENDIF IF (info .NE. 0) THEN info = ppm_error_error CALL ppm_error(ppm_err_sub_failed,'ppm_gmm_march', & & 'Backward extension failed.',__LINE__,info) GOTO 8888 ENDIF ENDDO ELSE IF (PRESENT(speed)) THEN IF (PRESENT(chi)) THEN CALL ppm_gmm_march_bkwd(fdta,width,order,npos,TM, & & rhscst,dxinv,dyinv,dzinv,ghostsize,info,speed,chi) ELSE CALL ppm_gmm_march_bkwd(fdta,width,order,npos,TM, & & rhscst,dxinv,dyinv,dzinv,ghostsize,info,speed) ENDIF ELSE IF (PRESENT(chi)) THEN CALL ppm_gmm_march_bkwd(fdta,width,order,npos,TM, & & rhscst,dxinv,dyinv,dzinv,ghostsize,info,chi=chi) ELSE CALL ppm_gmm_march_bkwd(fdta,width,order,npos,TM, & & rhscst,dxinv,dyinv,dzinv,ghostsize,info) ENDIF ENDIF ENDIF IF (info .NE. 0) THEN info = ppm_error_error CALL ppm_error(ppm_err_sub_failed,'ppm_gmm_march', & & 'Backward marching failed.',__LINE__,info) GOTO 8888 ENDIF !--------------------------------------------------------------------- ! Forward order: update neighbors of points in ggm_ipos and ! advance front !--------------------------------------------------------------------- IF (PRESENT(udata)) THEN IF (PRESENT(speed)) THEN IF (PRESENT(chi)) THEN CALL ppm_gmm_extend_fwd(fdta,dta,width,order,npos,TM, & & rhscst,dxinv,dyinv,dzinv,ghostsize,info,speed,chi) ELSE CALL ppm_gmm_extend_fwd(fdta,dta,width,order,npos,TM, & & rhscst,dxinv,dyinv,dzinv,ghostsize,info,speed) ENDIF ELSE IF (PRESENT(chi)) THEN CALL ppm_gmm_extend_fwd(fdta,dta,width,order,npos,TM, & & rhscst,dxinv,dyinv,dzinv,ghostsize,info,chi=chi) ELSE CALL ppm_gmm_extend_fwd(fdta,dta,width,order,npos,TM, & & rhscst,dxinv,dyinv,dzinv,ghostsize,info) ENDIF ENDIF ELSE IF (PRESENT(speed)) THEN IF (PRESENT(chi)) THEN CALL ppm_gmm_march_fwd(fdta,width,order,npos,TM, & & rhscst,dxinv,dyinv,dzinv,ghostsize,info,speed,chi) ELSE CALL ppm_gmm_march_fwd(fdta,width,order,npos,TM, & & rhscst,dxinv,dyinv,dzinv,ghostsize,info,speed) ENDIF ELSE IF (PRESENT(chi)) THEN CALL ppm_gmm_march_fwd(fdta,width,order,npos,TM, & & rhscst,dxinv,dyinv,dzinv,ghostsize,info,chi=chi) ELSE CALL ppm_gmm_march_fwd(fdta,width,order,npos,TM, & & rhscst,dxinv,dyinv,dzinv,ghostsize,info) ENDIF ENDIF ENDIF IF (info .NE. 0) THEN info = ppm_error_error CALL ppm_error(ppm_err_sub_failed,'ppm_gmm_march', & & 'Forward marching failed.',__LINE__,info) GOTO 8888 ENDIF !--------------------------------------------------------------------- ! Update the global gamma size !--------------------------------------------------------------------- #ifdef __MPI CALL MPI_AllReduce(npos,nposg,1,MPI_INTEGER,MPI_SUM,ppm_comm,info) #else nposg = npos #endif ENDDO ! while nposg.GT.0 #endif !------------------------------------------------------------------------- ! Deallocate status array !------------------------------------------------------------------------- 8888 iopt = ppm_param_dealloc #if __DIM == __3D CALL ppm_alloc(gmm_state3d,ldu,iopt,info) IF (info .NE. 0) THEN info = ppm_error_error CALL ppm_error(ppm_err_dealloc,'ppm_gmm_march', & & 'point status array GMM_STATE3D',__LINE__,info) ENDIF #elif __DIM == __2D CALL ppm_alloc(gmm_state2d,ldu,iopt,info) IF (info .NE. 0) THEN info = ppm_error_error CALL ppm_error(ppm_err_dealloc,'ppm_gmm_march', & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #endif !------------------------------------------------------------------------- ! In case one of the mappings reallocated the data, we might want to ! pass back out the new data and save it from destruction upon ! subroutine termination. !------------------------------------------------------------------------- fdata => fdta IF (PRESENT(udata)) udata => dta NULLIFY(dta) NULLIFY(fdta) !------------------------------------------------------------------------- ! Return !------------------------------------------------------------------------- 9999 CONTINUE CALL substop('ppm_gmm_march',t0,info) RETURN #if __DIM == __2D #if __KIND == __SINGLE_PRECISION END SUBROUTINE ppm_gmm_march_2ds #elif __KIND == __DOUBLE_PRECISION END SUBROUTINE ppm_gmm_march_2dd #endif #elif __DIM == __3D #if __KIND == __SINGLE_PRECISION END SUBROUTINE ppm_gmm_march_3ds #elif __KIND == __DOUBLE_PRECISION END SUBROUTINE ppm_gmm_march_3dd #endif #endif libppmnumerics-r1036/src/ppm_module_data_fmm.f0000644000175000017500000003572011616214647020304 0ustar omaromar !------------------------------------------------------------------------- ! Module : ppm_module_data_fmm !------------------------------------------------------------------------- ! ! Purpose : fast mulipole method, data ! ! ! Remarks : ! ! References : ! ! Revisions : !------------------------------------------------------------------------- ! $Log: ppm_module_data_fmm.f,v $ ! Revision 1.1.1.1 2007/07/13 10:18:57 ivos ! CBL version of the PPM library ! ! Revision 1.13 2006/09/04 18:34:52 pchatela ! Fixes and cleanups to make it compile for ! release-1-0 ! ! Revision 1.12 2006/06/29 10:28:36 pchatela ! Added vector strengths support ! ! Revision 1.11 2006/06/16 07:50:28 hiebers ! added list of topo IDs ! ! Revision 1.10 2005/09/19 13:03:30 polasekb ! code cosmetics ! ! Revision 1.9 2005/09/12 13:30:19 polasekb ! added ppm_subid ! ! Revision 1.8 2005/08/11 15:13:33 polasekb ! added maxboxcost ! ! Revision 1.7 2005/08/08 13:34:44 polasekb ! removed fmm_prec ! ! Revision 1.6 2005/08/04 16:02:46 polasekb ! addes some new data ! ! Revision 1.5 2005/07/29 12:36:51 polasekb ! changed diagonal to radius ! ! Revision 1.4 2005/07/27 21:11:54 polasekb ! added totalmass (again) ! ! Revision 1.3 2005/07/25 14:28:32 polasekb ! added some constants for the spherical harmonics ! ! Revision 1.2 2005/06/02 13:55:16 polasekb ! removed totalmass ! ! Revision 1.1 2005/05/27 08:04:09 polasekb ! initial implementation ! ! ! Revision 0 2004/11/11 4:04:15 polasekb ! Start. ! !------------------------------------------------------------------------- ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! version 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see . ! ! Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Switzerland !------------------------------------------------------------------------- MODULE ppm_module_data_fmm !------------------------------------------------------------------------- !Modules !------------------------------------------------------------------------- USE ppm_module_data,ONLY:ppm_kind_single,ppm_kind_double PRIVATE :: ppm_kind_single,ppm_kind_double !------------------------------------------------------------------------- ! Define Initialization-FLAG !------------------------------------------------------------------------- LOGICAL :: ppm_fmm_initialized = .FALSE. !------------------------------------------------------------------------- ! Define order of expansion !------------------------------------------------------------------------- INTEGER :: order !------------------------------------------------------------------------- ! Define radius of tree boxes !------------------------------------------------------------------------- REAL(ppm_kind_single),DIMENSION(:),POINTER :: radius_s REAL(ppm_kind_double),DIMENSION(:),POINTER :: radius_d !------------------------------------------------------------------------- ! Define expansions of all tree boxes ! 1st index: boxid ! 2nd/3rd index: expansion !------------------------------------------------------------------------- COMPLEX(ppm_kind_single),DIMENSION(:,:,:) ,POINTER :: expansion_s_sf COMPLEX(ppm_kind_double),DIMENSION(:,:,:) ,POINTER :: expansion_d_sf COMPLEX(ppm_kind_single),DIMENSION(:,:,:,:),POINTER :: expansion_s_vf COMPLEX(ppm_kind_double),DIMENSION(:,:,:,:),POINTER :: expansion_d_vf !------------------------------------------------------------------------- ! Define center of mass of tree boxes !------------------------------------------------------------------------- REAL(ppm_kind_single),DIMENSION(:,:),POINTER :: centerofbox_s REAL(ppm_kind_double),DIMENSION(:,:),POINTER :: centerofbox_d !------------------------------------------------------------------------- ! Define totalmass of tree boxes !------------------------------------------------------------------------- REAL(ppm_kind_single),DIMENSION(:),POINTER :: totalmass_s REAL(ppm_kind_double),DIMENSION(:),POINTER :: totalmass_d !------------------------------------------------------------------------- ! Store tree output in data file !------------------------------------------------------------------------- !------------------------------------------------------------------------- ! Define min_box, minimum extent of tree boxes !------------------------------------------------------------------------- REAL(ppm_kind_single),DIMENSION(:,:),POINTER :: min_box_s REAL(ppm_kind_double),DIMENSION(:,:),POINTER :: min_box_d !------------------------------------------------------------------------- ! Define max_box, maximum extent of tree boxes !------------------------------------------------------------------------- REAL(ppm_kind_single),DIMENSION(:,:),POINTER :: max_box_s REAL(ppm_kind_double),DIMENSION(:,:),POINTER :: max_box_d !------------------------------------------------------------------------- ! Define nbox, total number of boxes !------------------------------------------------------------------------- INTEGER :: nbox !------------------------------------------------------------------------- ! Define nchld, number of children of the box !------------------------------------------------------------------------- INTEGER,DIMENSION(:),POINTER :: nchld !------------------------------------------------------------------------- ! Define lhbx, pointer to first and last point in box (in lpdx) ! 1st index: 1 or 2, first and last ! 2nd index: box id !------------------------------------------------------------------------- INTEGER,DIMENSION(:,:),POINTER :: lhbx !------------------------------------------------------------------------- ! Define lpdx, permutation of xp, particles ordered according to tree !------------------------------------------------------------------------- INTEGER,DIMENSION(:),POINTER :: lpdx !------------------------------------------------------------------------- ! Define boxcost !------------------------------------------------------------------------- REAL(ppm_kind_single),DIMENSION(:),POINTER :: boxcost_s REAL(ppm_kind_double),DIMENSION(:),POINTER :: boxcost_d !------------------------------------------------------------------------- ! Define parent, the partent of t--------------------------------------- INTEGER,DIMENSION(:),POINTER :: nchld !---------------------------------ld sEAL(ppm_kind_singl3p DE --------------------------- DE -------(1-8----oct----), pointer to first and last point in box (in lpdx) ! 1st index: 1 or 2, first and last ! 2nd index: box id !------------------------------------ DE ---------------------------------- INTEGER,DIMENSION(:),POINTER :: lpdx , ----------------------------------------------------- ! Define parent, the partent of t--------------------------------------- INTE ,:),POINTER :: max_box_s REAL(ppm_kind_double),DIMENSION(:,:),POINTER :: max_box_d pl,-------------------- ---------------------------------------------- ! Define parent, the partent of t--------------------------------------- INTE pl,:),POINTER :: max_box_s REAL(ppm_kind_double),DIMENSION(:,:),POINTER :: max_box_d , ---------------- -------------------------------------------------- ! Define nbox, total number of boxes !----------------------------------NTE ,:),POINTER :: max_box_s REAL(ppm_kind_double),DIMENSION(:,:),POINTER :: max_box_d rengths suppo ---------------------------------------------- ! Define parent, the partent of t--------------------------------------- INTEsts fa-----:),POINTER :: max_box_s REAL(ppm_kind_double),DIMENSION(:,:),POINTER :: max_box_Eto hs T---------d it! Define expansions of all tree boxes ! 1st index: boxid ! 2nd/3rd index:--------------------------------- INTEGER,DIMENSION(:),POINTER :: lpdx !isinnd lasCALL ublast point ------------ ublast point - to first aus-----pologylast point in box (in lpdx) ! 1st index: 1 or 2, first and last ! 2nd index: box id !------------------------------------------------------------------------------- INTEGER,DIMENSION(:),POINTER :: lpdx e cos.- ublas-------last point ---------------last point - to first aus-----pologylast point in box (in lpdx) ! 1st index: 1 or 2, first and last ! 2nd index: box id !----------------------------------------e cosm--------------------------------- INTEGER,DIMENSION(:),POINTER :: lpdx !----,PI_Ich---------ersi---I_Ich-------------------------------------------------- ! Define parent, the partent of t--------------------------------------- gle),D----,:),POINTER :: min_box_s REAL(ppm_kind_double),DIMENSION(:,:),POINTER :: min_box_d !),DIMEN,-------------n ------------ ------------------------------------------------- ! Define parent, the partent of t--cost !--------- ,DIMEN------------------------------------- ,DIMEN--------sm--------------------------------- INTEGER,DIMENSION(:),POINTER :: lpdx-----elea ! Revision -------------------------------------------------------------- MODULE ppm_module_data_fmm----------------------------------------------------- MODULE ppm_module_data_fmm_d An------------------------------------- ! Module : ppm_module_dataoxes !---------------------------------,DIAn----------------------------- REAL(ppm_kind_singl,DIAn------------------------------------- INTEGER,DIMENSION(:),POINTER :: lpdx eqrtfac------------------------------------ ! Module : ppm_module_dataoxes !---------------------------------,DIeqrtfac---------------------------- REAL(ppm_kind_singl,DIeqrtfac------------------------------------ INTEGER,DIMENSION(:),POINTER :: lpdx Cn------------------------------------- ! Module : ppm_module_datasion_s_sf COMPLEX(ppm_kind_doublppm_kind_singleCn---------------------- COMPLEX(ppm_kind_singlppm_kind_singleCn--ER :: expansion_s_sf COMPLEX(ppm_kind_double)kind_singl,DICn---- :: expansion_d_sf COMPLEX(ppm_kind_single)kind_singl,DICn--ER :: expansion_s_vf COMPLEX(ppm_kind_double),DIMENSION(:,:,:,:),POINTER :: expansion_d_vf Inne ENDDO ! while nposg.GT.0 #elif __DIM == __2D gmm_state2d = ppm_gmm_paramsion_s_sf COMPLEX(ppm_kind_doublppm_kind_s,DIInne ------------------ COMPLEX(ppm_kind_singlppm_kind_s,DIInne ------------------------------------ INTEGER,DIMENSION(:),POINTER :: lpdx Oute ENDDO ! while nposg.GT.0 #elif __DIM == __2D gmm_state2d = ppm_gmm_paramsion_s_sf COMPLEX(ppm_kind_doublppm_kind_s,DIOute ------------------ COMPLEX(ppm_kind_singlppm_kind_s,DIOute ------------------------------------ INTEGER,DIMENSION(:),POINTER :: lpdx Yn------------------------------------- ! Module : ppm_module_datasion_s_sf COMPLEX(ppm_kind_doublppm_kind_s,DIYn------------------- COMPLEX(ppm_kind_singlppm_kind_s,DIYn------------------------------------------- INTEGER,DIMENSION(:),POINTER :: lpdx Pn------------------------------------- ! Module : ppm_module_dataoxes !---------------------------------,DIPn----------------------------- REAL(ppm_kind_singl,DIPn------------------------------------- INTEGER,DIMENSION(:),POINTER :: lpdx fracfac------------------------------------ ! Module : ppm_module_dataoxes !--------------------- kind_singl,DIfracfac---------------------------- REAL(pp kind_singl,DIfracfac------------------------------------ INTEGER,DIMENSION(:),POINTER :: lpdx rho------------------------------------ ! Module : ppm_module_dataoxes !--------------------- kind_singl,DIrho---------------------------- REAL(pp kind_singl,DIrho------------------------------------------ INTEGER,DIMENSION(:),POINTER :: lpdx ---prec ------------------------- INTEGER,DIMENSION(:),POINTER :: loxes !--------------------- kind_singl,DI---pr---------------------------- REAL(pp kind_singl,DI---pr------------------------------------------ INTEGER,DIMENSION(:),POINTER :: lpdx p yhi = m ------------------------- INTEGER,DIMENSION(:),POINTER :: loxes !--------------------- kind_singl,DIp y---------------------------- REAL(pp kind_singl,DIp y------------------------------------ INTEGER,DIMENSION(:),POINTER :: lpdx fac------------------------------------ ! Module : ppm_module_dataoxes !--------------------- kind_singl,DIfac---------------------------- REAL(pp kind_singl,DIfac----_PREtzerland !--------- KIND == __DOUBLE_PRECISION util_fft_f _2dINE ppm_gmm_march_3dd #endif #endif libpmerics-r1036/src/ppm_module_da42052m.f11100000644000175000017500000003572011616214647020304 0ustar omaromar-------------------------------- INTEGER,DIMENSION(:),POINTER :: lpd Sght want t--------------- ------util_fft_f _2d--------------------------------- INTEGER,DIMENSION(:),POINTER :: lp :: lpd !-----------:Zuricht want tperf ms F----Fourier Transf m u---- :: lpd FFTW License ! Def(x) dimppm_err :: lp :: lpd In---- ------:Z-----in(le),DI (F)------toion)transf mesmetics ! In---/-------: lda(:- (I)----- ------------------ :: lpd metics ! O------------:Z--------(le),DI(F)-transf mes----------------------------== __2DDDDDDDDDDD(I)-r _error . =0 iU Ge ,iopter General Public ! ! Pur:- :: lpd metics mulipole methoose : fast m ! ! Remarks : ! ! References : ! ! Revisions : !-util_fft_f _2dIN-----------------------------------------------9:01---- ! $Log: ppm_module_data_fmm.f,v $ ! Revision 1.1.1.1 2007/07/13 10:18:57 ivo9 ! CBL version of the PPM library ! ! Revision 1.13 2006/09/04 18:34:52 pchatela ! Fixes 5/0236 nups4 13:3 ! Added vecuERCHftw_many_df---- upCHftonics ! ! Revision------08:040---1:09:55:3 ! Added v ! Ex addes __SXF90fy __MATHKEISAN (Hfto r th.f,v $ cific Gen ! ! $ cific ! ! Revision 1.4 1 200608:0/01-8/089:07/0-- ! $LReplaces --------------------- ,DI-0py of -----MK)-t0er General Public ! ! Revision 1.4 20025 pcha3vo9 ! Added vecf ofd memory 200kr General Public ! ! Revis8on 1.4 27/266/0212vos ! Added vector stSX MathKeisan Ints on t (NEC ! ! Revision 1.4 7on 1.4 27/266/7:42 13:3-- ! $Lo addes -- ------ints on t ! the Pada -----ules arraotalFITNESS FOR A PARTI ! Revision 1.74/023 21:1:51:55:3 ! Added v T. M----Lic ------------R A PARTI ! Revisi5n 1.74/0236 075:4:50: wal GNU ! $Lo addes f _-------- -- --------MK)ITNESS FOR A PARTI ! Revisi4n 1.74/02361-8/031:20:3-- ! $Lo addes ) TM = Ale_Hftw.fpings a cpp ) TM = A-- a f90fINCLUDEITNESS FOR A PARTI ! Revisi3n 1.74/02361-85:29:50:3-- ! $LSalmaheavylist of to:aheadt (c) mat , ) TM = s merg , conantumass ! ! aract----spherica------- column, firsalmass cf ofd, blankh.fne------------e mipa metLic guotal rengshe spher, --o a cop.fne------og wrappe all initi Bugf o:c guotalo r thnow! eckeriBEFORE_daty r thassignerica-Nx-in..ITNESS FOR A PARTI ! Revisi2n 1.74/02361-80/12 23:3 ! Added vec addes guotalo, ) TM = ricengthn= __2D, ) TM = rihit .L .h------------sho---- strene--ca-80! aract---, exTM = ri !-,__L------------) TM = riHftw3.fTNESS FOR A PART ! Remarks : ! ! References : ! ! Revisions ! !------------------------------------------------------------------------- ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! on 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see . ! ! Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Swprocessors !---------------CISION ENutil_fft_f _2ds(-----in,lda,---------------- #march== __3D #if __KIND == __SINGLECISION ENutil_fft_f _2dd(-----in,lda,---------------- #march== __3D #i !--------_-------_SINGLECISION ENutil_fft_f _2dc(-----in,lda,---------------- #march== __3D #if __KIND == __-------_SINGLECISION ENutil_fft_f _2dcc(-----in,lda,---------------- _march', & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #endif TM = sParallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Swpr TM = ABS(co.L .h"ch', & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #endi !------------------------------------------------------------------------- !Modules !------- !Modules !--------a ! ules !--------op ! ules !---ppm_alloc(gmules !---------loc(gmI---ICIT NONEwprocessors !-------- |ssors #i !--------_-------Software-------- ANYAMEingl,DIMKD !---------- #march== __3D #if __KIND == _ |ssors #if __KIND == __-------Software-------- ANYAMEingl,DIMKD !--_module- _march', & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #endiFFTW LiTM = Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Swproma sssoFFTWoftware--CLUDE "Hftw3.f"e- _march', & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #endiA guotalo ch', & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #endin-------- processors !-------- |ssors #if __KIND == __SINGLE-----MK), REAL(ppm_kSINGLE,e----NT(INGLE- ,DI-----in-- #march== __3D #i !--------_-------|ssors #if __KIND == __-------_SINGLE--------MK), REAL(ppm_kSINGLEE,e----NT(INGLE- ,DI-----in-- _march', ----- -------------------- ------------ SINGLEE,e----NT(INON - ,DIldach', -------------------fourier transf mesmetics --------MK), REAL(ppm_kSIN- A-------------::Z---------------------- ,e----NT( ON - ,DI----ch', & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #endiLo ! variab ! tch', & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #endtimNU ! -----MK)--------------------------------,DI-0NDIF #endc tet ! Added oxes !----------------------------,DI-,jSTATEch', ----- -----in Added oxes !----------------------------,DINx-in, Ny-in-h', ----- -----PM i Added oxes !----------------------------,DINx----- Ny-----gamma sizFFTWoftware!iFFTW P Added oxes *8 !----------------------------,DIP Added oxes ----------------------------,DImbn 3 od mb & Imbnon 3 Imbnembesmetics oxes ----------------------------,DImboembes Imbhowmany Imboon 3-- _marc gamma sizeATHKEISANat it willATHKEISAN variab ! tHANTMathKeisan FFT Added oxes !----------------------------,DI-sign_fft,I-sys procch== __3D #i !--------_------- |ssors #if __KIND == __-------_SINGLEoxes !----------------------------,DI-ncx, ) Ty-- _march', -- ! - transf mmass !-----MK)--------------------------------,DI- ! -_fftch', -workor_errorage_SINGLE-----MK), REAL(pp------------------ ,DI-ab !,-workNDIF #endt ! --- workor_errorage_SINGLE-------- ----------1)-------------------,DIlda_-ab !,-lda_workN- _march', & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #endiExt !nal tch', & & 'point status array GMM_STATE2D',__LINE__,info) ENch', & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #endif ------s----------------- ! Define lpdx, permutation of xp, particles ordered according to ----------a ------util_fft_f _2d-----------proce!(.L d(izFFTW) |s.L d(izlATHKEISAN) fdata => fdta IF (PRESENT(udata)) udata => dta NULLIFY(dta) NULLIFY(fdtaEpm_a iU FFTW .f,v $ NEC! not availab------------------------------------------------------- ! Store tree output in------ __2D CALL ppm_alpronma sizFFTWoftwareate2d,ldu,iopt,info) noHftw,-----util_fft_f _2d-- info =' !was ! d ! PPM iHftw ! _error(ppm_err_depm_gmm_mronma sizeATHKEISANat it wate2d,ldu,iopt,info) noMathKeisan,-----util_fft_f _2d-- info =' !was ! d ! PPM ilATHKEISAN ! _error(ppm_err_depm_gmm_t it wmm_ma! Re c- #ifdef __M=> fdta IF (PRESENT(udata)) udata => dta NULLIFY(dta) NULLIFY(fdtaC eck guotalodef __M=> fdta IF (PRESENT(udata)) udata => dta NULLIFY(dta) NULLIFY(f----S(co.LT. MPI_SNDIF #elif __DIM ==----SIZE(lda,1)-.L_SN2,info) ENDIF ENDIF ENDIF IF ( guotal,-----util_fft_f _2d-- info ========='lda mu---b -t 200ngths --- 2error(ppm_err_sub_failed,'ppm_gmm_ma! Rb_failed,'pcst,dxinv,dyinv,dzinlda(1)-.Lsize,info) ENDIF ENDIF ENDIF IF ( guotal,-----util_fft_f _2d-- info =========',__L ---: lda(1)-mu---b >0error(ppm_err_sub_failed,'ppm_gmm_ma! Rb_failed,'pcst,dxinv,dyinv,dzinlda(2)-.Lsize,info) ENDIF ENDIF ENDIF IF ( guotal,-----util_fft_f _2d-- info =========',__L ---: lda(2)-mu---b >0error(ppm_err_sub_failed,'ppm_gmm_ma! Rb_failed,'pcst,dxinv,dycst,dxinv,dy!----tract 1------tNDIF-convtalss !Nx-inENDlda(1)-1 ! !Ny-inENDlda(2 fdata => fdta IF (PRESENT(udata)) udata => dta NULLIFY(dta) NULLIFY(fdtaA !--result----------------------------------------------------------------- ! Deallocate stprocessors !-------- |ssors #if __KIND == __SINGLENx----ENDNx-in/2 + 1-- #march== __3D #i !--------_------- |ssors #if __KIND == __-------_SINGLENx----ENDNx-inepm_gmm_t it w Ny----=Ny-in-processors !-------- |ssors #if __KIND == __SINGLElda(1)-=ENx------ #march== __3D #i !--------_------- |ssors #if __KIND == __-------_SINGLElda(1)-=ENx----+1LIFY(fdt-----tNDIF-convtalss pm_gmm_t it wlda(2 =Ny----- ENDIF int st---------lda, !-----int s_--t3D',__LINE__,info) ENDIF #elif __DIM == __2D CALL f---lif __DIM == ENDIF IF ( IF (info util_fft_f _2d-- info = ppm_fft-result-DATA_OUTerror(ppm_err_sub_failed,'pmm_ma! Rb_failecst,dxinv,dy!--------------------------------------------------- ! Deallocate stLIFY(fdtaFFT - Transf m inEx-direct! Define expansions of all tree boxes ! 1st index: boxid ! 2nd/3rd index:inv,dy!--------------------------------------------------- ! Deallocate stLIFY(fdtaNEC!neral Pu- UseTMathKeisan Lf,v $ ! --------------------------------------------------- ! Deallocate stgamma sizeATHKEISANat it wi--------------------------------------------------- ! Deallocate stt it wiNOTE:Zurichfft-r want s doe not curR,DIly work tHANT---bitv $ ion, eithe N--------------------, f m nEND2**p * 3**q *n, eithe 5**r, y of p, q, r >= 0efine expansions of all tree boxes ! 1st index: boxid ! 2nd/3rd index:inv,dy!--------------------------------------------------- ! Deallocate stLIFY(fdtaA !--workor_errorage_SINGLE!--------------------------------------------------- ! Deallocate stLIFY(flda_-ab !(1)-=E2*Nx-inE+ 64- ENDIF int st-ab !,lda_-ab !, !-----int s_--t3D',__LINE__,info) ENDIF #elif __DIM == __2D CALL f---lif __DIM == ENDIF IF ( IF (info util_fft_f _2d-- info = ppm_-ab ! not a--------error(ppm_err_sub_failed,'pmm_ma! Rb_failecst,dxinv,dylda_work(1)-=E4*Nx-in- ENDIF int stwork,lda_work, !-----int s_--t3D',__LINE__,info) ENDIF #elif __DIM == __2D CALL f---lif __DIM == ENDIF IF ( IF (info util_fft_f _2d-- info = ppm_work not a--------error(ppm_err_sub_failed,'pmm_ma! Rb_failecst,dxinv,dy & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #endif ------ze_SINGLE!--------------------------------------------------- ! Deallocate stLIFY(f- ! -_fftD 1n------ sign_fftD 0efine ejine e 1nprocessors !--------------- ENf- fft(-sign_fft,INx-in, - ! -_fft,Z-----in(1,j), ELSE --------(1,j), -ab !,-work,I-sys--- #march== __3D #if __KIND == __SINGLE ENfdzfft(-sign_fft,INx-in, - ! -_fft,Z-----in(1,j), ELSE --------(1,j), -ab !,-work,I-sys--- #march== __3D #i !--------_-------_SINGLE-ncxD 1n------ ncyD 1n------ ENf fft(-sign_fft,INx-in, - ! -_fft,Z-----in(1,j), -ncx, ELSE --------(1,j), ncy, -ab !,-lda_-ab !(1),-work,I ELSE lda_work(1),I-sys--- #march== __3D #if __KIND == __-------_SINGLE-ncxD 1n------ ncyD 1n------ ENfzfft(-sign_fft,INx-in, - ! -_fft,Z-----in(1,j), -ncx, ELSE --------(1,j), ncy, -ab !,-lda_-ab !(1),-work,I ELSE lda_work(1),I-sys--- _march', & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #endiF FFT ----------------------------------------------------- ! Store tree output in------ sign_fftD -1n------DO j=1,Ny-in-processors !--------if __DIM == ENf- fft(-sign_fft,INx-in, - ! -_fft,Z-----in(1,j), ELSE --------(1,j), -ab !,-work,I-sys--- #march== __3D #if __KIND == __SINGLEM == ENfdzfft(-sign_fft,INx-in, - ! -_fft,Z-----in(1,j), ELSE --------(1,j), -ab !,-work,I-sys--- #march== __3D #i !--------_-------_SINGLEM == ENf fft(-sign_fft,INx-in, - ! -_fft,Z-----in(1,j), -ncx, ELSE --------(1,j), ncy, -ab !,-lda_-ab !(1),-work,I ELSE lda_work(1),I-sys--- #march== __3D #if __KIND == __-------_SINGLEM == ENfzfft(-sign_fft,INx-in, - ! -_fft,Z-----in(1,j), -ncx, ELSE --------(1,j), ncy, -ab !,-lda_-ab !(1),-work,I ELSE lda_work(1),I-sys--- _march', cstDOch', & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #endD----------workor_errorage_SINGLE!--------------------------------------------------- ! Deallocate stLIFY(fTATED !----- IF - ENDIF int st-ab !, lda, TATE3D',__LINE__, ENDIF int stwork,ldaSTATE3D',__L- #ifdef __M=> fdta IF (PRESENT(udata)) udata => dta NULLIFY(dta) NULLIFY(fdtaFFTW neral PuHANTr(pUX,..ITNESS FO> fdta IF (PRESENT(udata)) udata => dta NULLIFY(dta) NULLIFY(fMBRankh D 1n------MBHowmany-=ENy-in-h', MBiEmbes D -1n------MBoEmbes D -1n------MBI 3 od D 1n------MBiDengt D UBOUND(-----in, 1)n------MBoDengt D UBOUND(---------1)nprocessors !--------------- ENsHftw_plan_many_df-_r2c(P ,fMBRank,Nx-in, MBHowmany,I Z-----in(1,1),IMBiEmbes,MBI 3 od ,MBiDeng,I Z--------(1,1),MBoEmbes,MBI 3 od ,MBoDeng,FFTW_ESTIMATE)------- ENsHftw_execute(P )------- ENsHftw_de 3 oy_plan(P )-- #march== __3D #if __KIND == __SINGLE ENdHftw_plan_many_df-_r2c(P ,fMBRank,Nx-in, MBHowmany,I Z-----in(1,1),IMBiEmbes,MBI 3 od ,MBiDeng,I Z--------(1,1),MBoEmbes,MBI 3 od ,MBoDeng,FFTW_ESTIMATE)------- ENdHftw_execute(P )------- ENdHftw_de 3 oy_plan(P )-- #march== __3D #i !--------_-------_SINGLE ENsHftw_plan_many_df-(P ,fMBRank,Nx-in, MBHowmany,I Z-----in(1,1),IMBiEmbes,MBI 3 od ,MBiDeng,I Z--------(1,1),MBoEmbes,MBI 3 od ,MBoDeng,I ZFFTW_FORWARD, FFTW_ESTIMATE)------- ENsHftw_execute(P )------- ENsHftw_de 3 oy_plan(P )-- #march== __3D #if __KIND == __-------_SINGLE ENdHftw_plan_many_df-(P ,fMBRank,Nx-in, MBHowmany,I Z-----in(1,1),IMBiEmbes,MBI 3 od ,MBiDeng,I Z--------(1,1),MBoEmbes,MBI 3 od ,MBoDeng,I ZFFTW_FORWARD, FFTW_ESTIMATE)------- ENdHftw_execute(P )------- ENdHftw_de 3 oy_plan(P )-- _gmm_m _gmm_m _gmm procch== __3D #i !--------_------- |ssors #if __KIND == __-------_SINGLE=> fdta IF (PRESENT(udata)) udata => dta NULLIFY(dta) NULLIFY(fdtaC ! GmargLiceo conf m y of the convtalss !=> fdta IF (PRESENT(udata)) udata => dta NULLIFY(dta) NULLIFY(fDO j=1,Ny----- --------(lda(1),j)D --------(1,j)ch', cstDO', -- _march', & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #endiR ch', & & 'point status array GMM_STATE2D',__LINE__,info) END! ReCONT(pUE------- ENs----op------util_fft_f _2d-----------------RETURN nprocessors !---------------_PRECISION ENutil_fft_f _2ds-- #march== __3D #if __KIND == __SINGLE_PRECISION ENutil_fft_f _2dd-- #march== __3D #i !--------_-------_SINGLE_PRECISION ENutil_fft_f _2dc-- #march== __3D #if __KIND == __-------_SINGLE_PRECISION ENutil_fft_f _2dcc-- _marcomarKIND == __DOUBLE_PRECISION bem_quadr!---n------INE ppm_gmm_march_3dd #endif #endif libmerics-r1036/src/ppm_module_da13536m.f14070000644000175000017500000003572011616214647020304 0ustar omaromarh', & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #endiSght want t--------------- -- ------bem_quadr!---n------ch', & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #enNDIF #endi !-----------:ZR s ----------quadra e-------uHANTen the impliiiiiiiiiiiiiiiiigi disr!--NDIF #enNDIF #endiIn---- ------:Zr!------(I)-DI----quadra e-r!--NDIF #enNDIF #endiIn---/-------: NDIF #enNDIF #endiO------------:Znqp ----(I)-DI----------quadra e-------the impliiiiiiiiiiiiiiiii __2DDDD(I)-DIr _error . 0thn=succesFITNESS FOR A PARTI ! Pur:TNESS FOR A PARTI ipole methoose : fast m ! ! Remarks : ! ! References : ! ! Revisions : !-bem_quadr!---n------IN-----------------------------------------------8:54---- ! $Log: ppm_module_data_fmm.f,v $ ! Revision 1.1.1.1 208/07/13 10:18:57 iv41 ! CBL version of the PPM library ! ! Revision 1.13 2006/09/04 18:34:52 pchatela ! 7/07/13 15361-80/44:07 ! CBL versioAor stHam__D-r!-- ! $LSy och loop ra h. an iU h.n #ifdef __M=52 pchatela ! 6 200608:0/01-8/033:31---- ! $List of toITNESS FOR A PARTI ! Revisi5 200608:0/01-8/088:56/0-- ! $LReplaces --------------------- ,DI-0py of -----MK)-t0er General Public ! ! Revis4on 1.4 27/276/7:06:48/0-- ! $LRenames-!----et----afee Smov-----heir-d it! Dica-- !----.hITNESS FOR A PARTI ! Revisi3n 1.74/0---(DD(I)d6:5:3-- ! $Lo of th ! ! TNESS FOR A PARTI ! Revisi2n 1.74/02/266/7:42033/0-- ! $LR addes -- ERCH------ints on t ! t. Upda -----ules arraotalFITNESS FOR A PARTI ! Revisio1 1.74/02/216/0213:319 ---go A PARTI ------ 2006/0. Notcengtsmetics ! ! Remarks : ! ! References : ! ! Revisions ! !------------------------------------------------------------------------- ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! n 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see . ! ! Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, SwprallelISION ENuem_quadr!---n------I(!---,qp ------------R & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #endif TM = sParallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Swpr TM = ABS(co.L .h"ch', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif !------------------------------------------------------------------------- !Modules !------- !Modules !---- __DOUBL---- !Modules !--------a ! ules !--------op ! ules !---ppm_alloc(gmu---ICIT NONEwp', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif guotalo ch', & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #en------- ----NT(INGLE- ,DI-!--NDIF #en------- ----NT(I ON - ,DI-qp ----(((((((((((DIF #en------- ----NT(I ON - ,DI----ch', & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #endiLo ! variab ! tch', & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #en-------------------- DI-0NDIF #end & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #endiExt !nal tch', & & 'point status array GMM_STATE2D',__LINE__,info) ENch', & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #endif ------s--ch', & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #en---------a ------uem_quadr!---n------I----------------R> fdta IF (PRESENT(udata)) udata => dta NULLIFY(dta) NULLIFY(fdtaC eck ANTen tr!---- set ----------q-----uH---------l ! --------------------------------------------------- ! Deallocate stg ! SELECTn--es (!---------- SE( !----- em_quadr!---ncght (b_failed,'pqp - 1n------ SE( !----- em_quadr!---nno sPb_failed,'pqp - 13------ SE( !----- em_quadr!---nedgsPb_failed,'pqp - 13------ SE( !----- em_quadr!---ncneb_failed,'pqp - 17------ SE( !----- em_quadr!---n3 oyud, !----- em_quadr!---nhm__D-7b_failed,'pqp - 17------ SE( !----- em_quadr!---nhm__D-3b_failed,'pqp - 13------ SE( !----- em_quadr!---nhm__D-4b_failed,'pqp - 14------ SE( !----- em_quadr!---nhm__D-12b_failed,'pqp - 1n2------ SE DEFAULT_failed,'pqp - 1NDIF #enPRECIELECTDIF #enDIF #en-F (qp -.EQNDIF #elif __DIM == ENDIF ENDIF ENDIF IF ( guotal,-----uem_quadr!---n------I-- info = ppm_wUnknownquadra e-r!--Nrror(ppm_err_sub_failed,'pm_ma! Rb_failecst,dxinv,dy & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #endif sch', & & 'point status array GMM_STATE2D',__LINE__,info) ENDI ReCONT(pUE------- ENs----op------uem_quadr!---n------I----------------RETURN npIF #enPRECISION ENuem_quadr!---n------IomarIND == __DOUBLE_PRECISION b !---pgmm_rei------ze_NE ppm_gmm_march_3dd #endif #endif lerics-r1036/src/ppm_module_da107463.f12060000644000175000017500000003572011616214647020304 0ustar omaromarnv,dy & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #endif iled,'p------------ - b !---pgmm_rei------ze_inv,dy & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #endDIF #endif!-----------:Zuricht !---) TM = s m ! -ource co s ANTen tr-------------- ! Corei------ze_t want tpU Generch----methodTNESS FOR A PARTI ! Pur:TNESS FOR A PARTI ipole methoose : fast m ! ! Remarks : ! ! References : ! ! Revisions : !-b !---pgmm_rei------ze_NE----------------------------------------------8:54/0-- ! $LRg: ppm_module_data_fmm.f,v $ ! Revision 1.1.1.1 2083xes 5/024276/7106:41---- ! $Lognvtarge mecengt le , )M lib upCHco s,shedmze_d co s (Sh )ral Publiche PPMaddes -3 ouc e-r- a llow------ col ! s of TNESS FOR A PARTI ! Revisi2n 1.74/024271 04:4823:3 - ! $Log lib unts on t the PP spher, unneesFI$ tarloa stHpm_moduITNESS FOR A PARTI ! Revisio1 1.74/02361-804:/088:3-- ! $LS ------ ted otalFs of TNESS FOR A PARTI ! Remarks : ! ! References : ! ! Revisions ! !------------------------------------------------------------------------- ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! n 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see . ! ! Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Swpralle ! ! Remarks : ! ! References : ! ! Revisions : --ypsParallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, SwprL . !-------- |1prL . __KIND == _ |||||||||2prL . 2D 3prL . 3D 4Parallelzerland !--gmm_rei------ze_i_failed,'p Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich,_failed,'p : -nts on t tha-- !gmm_rei------ze_inv,dy ,'p Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich,_failed,'p-----FACE- !gmm_rei------ze_inv,dy ,'plelzerlandPROCEDURE- !gmm_rei------ze_2ds--nv,dy ,'plelzerlandPROCEDURE- !gmm_rei------ze_2dsd-nv,dy ,'plelzerlandPROCEDURE- !gmm_rei------ze_23s--nv,dy ,'plelzerlandPROCEDURE- !gmm_rei------ze_23sd-nv,dy ,'pPREC-----FACEi_failed,'p Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich,_failed,'p : TM = A-- ! -ource _failed,'p Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich,_failed,'pONT(AINS prL . IM 2DprL . = __3 !----------r TM = ABS(co.gmm_rei------ze_NE" #uma size= __prL . = __3 __KIND == __Sr TM = ABS(co.gmm_rei------ze_NE" #uma size= __pruma size IM prL . IM 3DprL . = __3 !----------r TM = ABS(co.gmm_rei------ze_NE" #uma size= __prL . = __3 __KIND == __Sr TM = ABS(co.gmm_rei------ze_NE" #uma size= __pruma size IM pdy ,'pPRECzerland !--gmm_rei------ze_iomarIND == __DOUBLE_PRECISION b !---pgmm_chNE ppm_gmm_march_3dd #endif #endif libpmlerics-r1036/src/ppm_module_da10752m.f10463.0000644000175000017500000003572011616214647020304 0ustar omaromarled,'p Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich,-ENDIF #endif iled,'p------------ - - b !---pgmm_chinv,dy & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #endDIF #endif!-----------:Zuricht !---) TM = s m ! -ource co s ANTen tr-------------- ! Coch---- want tpU Generch----methodTNESS FOR A PARTI ! Pur:TNESS FOR A PARTI ipole methoose : fast m ! ! Remarks : ! ! References : ! ! Revisions : !-b !---pgmm_chNE----------------------------------------------8:54/0-- ! $LRg: ppm_module_data_fmm.f,v $ ! Revision 1.1.1.1 208n 1.74/024271 04:4823---- ! $Log lib unts on t the PP spher, unneesFI$ tarloa stHpm_moduITNESS FOR A PARTI ! Revisio1 1.74/023610/7103741---- ! $Lo ------ ecke-in. BE !E: NotcengtsmLicepcense alyetSAIC Group (ETH Z ! Remarks : ! ! References : ! ! Revisions ! !------------------------------------------------------------------------- ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! n 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see . ! ! Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Swpralle ! ! Remarks : ! ! References : ! ! Revisions : --ypsParallel Particle Mesh Li : ! ! References : ! ! RevisirL . !-------- |1prL . __KIND == _ |||||||||2prL . 2D 3prL . 3D 4Parallelzerland !--gmm_chi_failed,'p Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich,_failed,'p : -nts on t tha-- !gmm_chinv,dy ,'p Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich,_failed,'p-----FACE- !gmm_chinv,dy ,'p elzerlandPROCEDURE- !gmm_ch2ds--nv,dy ,'plelzerlandPROCEDURE- !gmm_ch2dsd-nv,dy ,'plelzerlandPROCEDURE- !gmm_ch23s--nv,dy ,'plelzerlandPROCEDURE- !gmm_ch23sd-nv,dy ,'pPREC-----FACEi_failed,'p Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich,_failed,'p : TM = A-- ! -ource _failed,'p Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich,_failed,'pONT(AINS prL . IM 2DprL . = __3 !----------r TM = ABS(co.gmm_chNE" #uma size= __prL . = __3 __KIND == __Sr TM = ABS(co.gmm_chNE" #uma size= __pruma size IM prL . IM 3DprL . = __3 !----------r TM = ABS(co.gmm_chNE" #uma size= __prL . = __3 __KIND == __Sr TM = ABS(co.gmm_chNE" #uma size= __pruma size IM pdy ,'pPRECzerland !--gmm_chiomarIND == __DOUBLE_PRECISION bhamjac_rei---_gtsp2dsNE ppm_gmm_march_3dd #endif #endif liberics-r1036/src/ppm_module_da122540.f14070.0000644000175000017500000003572011616214647020304 0ustar omaromarled,'p Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich,-isions : iSght want t--------------- bhamjac_rei---_gtsp2ds ! ! Remarks : ! ! References : ! ! Revisions : --------------!-----------:ZuSol SeHb (lton-JacobiHANTAGoas rei------------------------------n---- ------:Zr-------------- ! Copyr-------------n----/O-----: NDIF #enN------ ! Copyr-------------------------:Zn--------------------------- ! Pur:TNDIF #enN------ ! Copyr-------------------------- pole methoose ------------------ ! ! Remarks : ! ! References : ! ! Revisions : : !-bhamjac_rei---_gtsp2dsNE-------------- -----------------------602/265 15-8:519 menahel---------- --i------ tedo ! u!---------- -------------- 1.74/02/265 00 iv40---- ! $Lo Lo ------ ecke-in.AIC Group (ETH Z ! Remarks : ! ! References : ! ! Revisions icense along with PPM. If not, ! see . ! ! P (ETH Z ! Remarks : ! ! References : ! ! RevisinprocessorzerE3D #i CAprocessors !---------------CISION ENuhamjac_rei---_gtsp2dss (phi, tphi, trgt,resuI ZFFFFFFFFFFFFFFFFFFFFFFFFFFtopo_i ImbPM._i Imghost---:, ------ #march== __3D #if __KIND == __SINGLECISION ENuhamjac_rei---_gtsp2dsd (phi, tphi, trgt,resuI topo_i ImbPM._i Imghost---:, ------ #gmm_m _march=zerE3D #i VECm _m_a iVECTOR NOTu---IEME---D - _marc gFFFFFFFFles !------- !Modu gFFFFFFFFles !---- ENDIF les !--------a ! u ules !--------op ! u ules !-----ypsa s !Modu gFFFFFFFF---ICIT NONEwp', processsors !--------if __DIM =------- ANYAMEingl,DIMKD !---------- #marcch== __3D #if __KIND == _ |Modu gFFFFFFFF------- ANYAMEingl,DIMKD !--_module- _marchgFFFFFFFFZ ! Remarks : ! ! References : gFFFFFFFFZif guotalo gFFFFFFFFZ ! Remarks : ! ! References : gFFFFFFFF----MK), REAL(ppm_k,---) A--------DIMphi, tphigFFFFFFFF------- A---NT(Iin-------------------,DIltopo_i ImbPM._i gFFFFFFFF------- A REAL(pp2) A---NT(Iin------DIlghost---:gFFFFFFFF------- A---NT(Iinwan-----------------DI----ch', FF----Mmk),---NT(Iwan-------------------DI-resh', FF----Mmk),A---NT(Iin-------------------DIltrgthgFFFFFFFFZ ! Remarks : ! ! References : gFFFFFFFFZif liase gFFFFFFFFZ ! Remarks : ! ! References : gFFFFFFFF------- ------------ A-------------:,DI-sior motgFFFFFFFF-------------------------,------------DIlnior motgFFFFFFFF------- REAL(ppm_kS A-------------DIln--- !Modu -------------------------,------------DIltopoi ImbPM.i gFFFFFFFF----MK), REAL(pp---A-------------::Z-min_phyuI max_phyugFFFFFFFFTYPE( !t_topo) -------------:,DI-topogFFFFFFFFTYPE( !t_equi_bPM. A-------------:,DI-bPM. !Modu gFFFFFFFFZ ! Remarks : ! ! References : gFFFFFFFFZif-a n--r -3 uffgFFFFFFFFZ ! Remarks : ! ! References : gFFFFFFFF-------------------------,------------DIlsior,sior ,,jSTkgFFFFFFFF----MK),-----------------,------------DIllen_phyu(2b_failed,'Z ! Remarks : ! ! References : gFFFFFFFFZifWENO-3 uffgFFFFFFFFZ ! Remarks : ! ! References : gFFFFFFFF----Mmk)-DIlonegp2) Aoposp2) Awenoeps Awenotau, pbsh', FF----Mmk)-DIllaps(-1:1,2) Arposp2) Arnegp2) Adxp2) Adxi(2b_failed,'----Mmk)-DIlphipp2) Aphinp2) Aphimidp2) Arms Adphi_dtgFFFFFFFF---------DIlslapgFFFFFFFF------- ANYAMEingl REAL(pp3,3)-DIloffs ZF='--SHAPE((/2,1,0,1,0,-1,0,-1,-2/),(/3,3/)b_failed,'----Mmk)-DIlt0 !Modu gFFFFFFFF---------a ------uhamjac_rei---_gtsp2ds----------------R gFFFFFFFFZ ! Remarks : ! ! References : gFFFFFFFFZifGet -__L --- !Modu Z ! Remarks : ! ! References : gFFFFFFFFtopo => topo(topo_i )%tgFFFFFFFF__L => topo%__L (bPM._i )gFFFFFFFF__L idF='__L %IDgFFFFFFFFnior motF='topo%nior motgFFFFFFFFn--- FFFF=> __L %nno sPgFFFFFFFFiior motF=> topo%sior motgrocesssors !--------if __DIM =min_phyu => topo%_in_phyuPgFFFFFFFFmax_phyu => topo%_ax_phyus- #marcch== __3D #if __KIND == _ |Modu gFFFFFFFFmin_phyu => topo%_in_phyudgFFFFFFFFmax_phyu => topo%_ax_phyud- _marchgFFFFFFFFlen_phyu()-=E4_ax_phyu()-=-Fmin_phyu(1)gFFFFFFFFlen_phyu(2-=E4_ax_phyu(2-=-Fmin_phyu(2b_failed,'dxp)--------=Flen_phyu()-/----Mm_L %Nm1)-1 ,mk)_failed,'dxp2--------=Flen_phyu(2-/----Mm_L %Nm12-1 ,mk)_failed,'dxip)-------=---0_mk/dxp)-_failed,'dxip2-------=---0_mk/dxp2b_failed,'wenoeps-=---0e-6_mk_failed,'wenotau- 1N.25_mk*MINV--Mdx)hgFFFFFFFF = -HUGE( )hgFFFFFFFFDOFiior=1,nior motgFFFFFFFFFFFiior = sior mot(siorb_failed,'ppmO j=1,Nn--- (2,sior b_failed,'ppm_gmDOFi1,Nn--- (1,sior b_failed,'ppm_gm gFFFFFFFFFFFFFFFFF!DOFilap1,N3gFFFFFFFFFFFFFFFFF!FFFlaps(2-ilap,)-=E4phi(i+offs(1,slap)jSTsiorb FFFF!FFFFFFFF& -2-0_mk *4phi(i+offs(2,slap)jSTsiorb FFFF!FFFFFFFF& +4phi(i+offs(3,slap)jSTsiorbgFFFFFFFFFFFFFFFFF!FFFlaps(2-ilap,2-=E4phi(i,j+offs(1,slap)jsiorb FFFF!FFFFFFFF& -2-0_mk *4phi(i,j+offs(2,slap)jsiorb FFFF!FFFFFFFF& +4phi(i,j+offs(3,slap)jsiorb FFFF!PRECOch', laps(1,)-=E4phi(i+2jSTsiorb FFFFFFFFFFFF& -2-0_mk *4phi(i+1jSTsiorb FFFFFFFFFFFF& +4phi(i,jjsiorb FFFFlaps(1,2-=E4phi(i,j+2Tsiorb FFFFFFFFFFFF& -2-0_mk *4phi(i,j+1Tsiorb FFFFFFFFFFFF& +4phi(i,jjsiorb FFFFlaps(0,)-=E4phi(i+1jSTsiorb FFFFFFFFFFFF& -2-0_mk *4phi(ijSTsiorb FFFFFFFFFFFF& +4phi(i-1,jjsiorb FFFFlaps(0,2-=E4phi(i,j+1Tsiorb FFFFFFFFF& -2-0_mk *4phi(ijSTsiorb FFFFFFFFF& +4phi(i,j-1jsiorb FFFFlaps(-1,)-=E4phi(ijSTsiorb FFFFFFFFF& -2-0_mk *4phi(i-1jSTsiorb FFFFFFFFF& +4phi(i-2,jjsiorb FFFFlaps(-1,2-=E4phi(i,jTsiorb FFFFFFFFF& -2-0_mk *4phi(ijS-1Tsiorb FFFFFFFFF& +4phi(i,j-2jsiorb FFFF FFFF FFFFrposp)-=E4(wenoeps-+Flaps( 1,)-**2-/(wenoeps-+Flaps(0,)-**2- FFFFrnegp)-=E4(wenoeps-+Flaps(-1,)-**2-/(wenoeps-+Flaps(0,)-**2- FFFFrposp2)=E4(wenoeps-+Flaps( 1,2-**2-/(wenoeps-+Flaps(0,2-**2- FFFFrnegp2)=E4(wenoeps-+Flaps(-1,2-**2-/(wenoeps-+Flaps(0,2-**2- FFFFoposp)-=E4--0_mk/(--0_mk+2-0_mk*rposp)-**2- FFFFoposp2)=E4--0_mk/(--0_mk+2-0_mk*rposp2-**2- FFFFonegp)-=E4--0_mk/(--0_mk+2-0_mk*rnegp)-**2- FFFFonegp2)=E4--0_mk/(--0_mk+2-0_mk*rnegp2)**2- FFFFphimidp)-=E4phi(i+1jSTsiorb-phi(i-1,jjsiorb FFFFphimidp2)=E4phi(i,j+1Tsiorb-phi(i,j-1jsiorb FFFFphipp)-=E40.5_mk*(phimidp)-=- FFFFFFFFF& oposp)-*( FFFFFFFFF& 4phi(i+2jSTsiorb - FFFFFFFFF& 3-0_mk*(phi(i+1jSTsiorb -4phi(i jSTsiorbb - FFFFFFFFF& 4phi(i-1,jjsiorb))*dxip)- FFFFphipp2-=E40.5_mk*(phimidp2-=- FFFFFFFFF& oposp2-*( FFFFFFFFF& 4phi(i,j+2Tsiorb - FFFFFFFFF& 3-0_mk*(phi(i,j+1Tsiorb -4phi(i jSTsiorbb - FFFFFFFFF& 4phi(i,j-1jsiorb))*dxip2- FFFFphinp)-=E40.5_mk*(phimidp)-=- FFFFFFFFF& onegp)-*( FFFFFFFFF& 4phi(i+1jSTsiorb - FFFFFFFFF& 3-0_mk*(phi(i jSTsiorb -4phi(i-1,jjsiorb) - FFFFFFFFF& 4phi(i-2,jjsiorb))*dxip)- FFFFphinp2-=E40.5_mk*(phimidp2-=- FFFFFFFFF& onegp2)*( FFFFFFFFF& 4phi(i,j+1Tsiorb - FFFFFFFFF& 3-0_mk*(phi(i,j jsiorb -4phi(i,j-1jsiorb) - FFFFFFFFF& 4phi(i,j-2jsiorb))*dxip2- FFFF! collect FFFFIF(phi(i,jjsiorb.GT.0-0_mkF #elif __DIM == pb = SQRT( FFFFFFFFFFFF& MAX(-MIN(phipp)-,0-0_mkF,MAX(phinp)-,0-0_mkF)**2+ FFFFFFFFFFFF& MAX(-MIN(phipp2-,0-0_mkF,MAX(phinp2-,0-0_mkF)**2) FFFFFFFFFFFF& -ltrgth FFFFFFFFFFFFELSEIF(phi(i,jjsiorb.LT.0-0_mkF #elif __DIM == pb = SQRT( FFFFFFFFFFFF& MAX(MAX(phipp)-,0-0_mkF,-MIN(phinp)-,0-0_mkF)**2+ FFFFFFFFFFFF& MAX(MAX(phipp2-,0-0_mkF,-MIN(phinp2-,0-0_mkF)**2) FFFFFFFFFFFF& -ltrgth FFFFFFFFFFFFELSEf __DIM == pb = 0-0_mkh FFFFFFFFFFFFEREC-Fh FFFFFFFFFFFFdphi_dt = pb *4phi(ijSTsiorb / FFFFFFFFF& SQRT(phi(ijSTsiorb**2+N.25_mk*SUM(phimid**2))F FFFFtphi(ijSTsiorb E4phi(i,jTsiorb -'wenotau-*Adphi_dtg FFFFr = MAX(rms ABS(dphi_dt)- FPRECOch', FPRECOch', FPRECOch', hgFFFFFFFF e = rmshgFFFFFFFF ENs----op------uhamjac_rei---_gtsp2ds-----------processors !---------------_PRECISION ENuhamjac_rei---_gtsp2dss - #march== __3D #if __KIND == __SINGLE_PRECISION ENuhamjac_rei---_gtsp2dsd - _marchgFFFFFF FFFFFFF g FFFFFFF h', hg------R gFFFFFFFFgFFFFFFFFgFFFFFFFFgomarIND == __DOUBLE_PRECISION bfdsol Sr_sol S2dsNE ppm_gmm_march_3dd #endif #endif libbbbberics-r1036/src/ppm_module_da101403.f10670.0000644000175000017500000003572011616214647020304 0ustar omaromarFFFFFF & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #endiSght want t--------------- -- - bfdsol Sr_sol S2ds FFFFFF & & 'point status array GMM_STATE2D',__LINE__,info) ENDIF #endDIF #endiS!-----------:ZuPoissn=suol Sr u----FFTW_DIF #endiSSSSSSSSSSSSSSSSSol S --egativ-----ssn=sequs of Licea 2-dimensof -- DIF #endiSSSSSSSSSSSSSSSSpDOUodic dn-h', MN------ ! Copyrrrrrrrrr- Lalaceiaule_dPhi = omegah', MN------ ! CoIt takS -fieldquadntie thmegaLiceDATA_fv which h', MN------ ! Coassums -- beSpDOUodic wansi A-- ! dn-. T -_ost h', MN------ ! Coefficie t-i------ topology ANTen trfielduol Sr h', MN------ ! Coa x-penci- topology. Aee SmpDO m ---FaFFT -ostribu h', MN------ ! Cox-penci- ---- Fcht apps -on- y-penci- whertr-------------- ! Coagaicea FT - DO m edTNESS FOR------ ! CoT -eral Pubsol S2i---- bass -onee tom---e FFT -lan(the impliiiiiiiiiiiiiiiii creatsmLicep bfdsol Sr_i---- e 3 oy_smLicDIF #endiSSSSSSSSSSSSSSSSp bfdsol Sr_fin--ze_NNESS FOR------ ! CoT ----ssn=sequs of Lisbsol S License,Fouri Smspacthe impliiiiiiiiiiiiiiiiig ! e ult trn(t m ed back _NNESS FOR------ ! CoT -solu of LPhi ch), n--lyr _S LiceDATA_fvNNESS FOR------ ! CoNote:-fieldquadntie tm liv--f Lcurre t-topologyDIF #endDIF #endiSSSSSSSSSSSSSSSSUsage----DIF #endiSSSh', MN------ ! Copyrp bfdsol Sr_i---( guotal,Pb_failed!SSSh', MN------ ! Copyrp bfdsol Sr_sol S2i---( guotal,Pb_failed!SSSh', MN------ ! Copyrp bfdsol Sr_fin--ze_(-----------R>SSSh', MN---DIF #endiSSSSSSSSSSSSSSSSSa n--loneSUsage-DIF #endDIF #endiSSSSSSSSSSSSSSSSpyrp bfdsol Sr_sol S( guotal,Pb_failed!DIF #endiSn---- ------:Zr-------------- ! Copda_wfv (F) lea---- dimensof (vectNTecass-f ly)-------------- ! CopbPM._i ---- I)-D__L IDNU Genercurre t---- FfieldqbPM. !Modu------- ! Coptopo_i sp2)=I)-Dtopology IDs-f Lwhich nse,FFTs artr-------------- ! CoSSSSSSSSSSSSSSpyrpDO m ed-------------- ! CoSSSSSSSSSSSSSSpyrtopo_i sp1)-i------ topology-------------- ! CoSSSSSSSSSSSSSSpyrrrrrrrrrrrrrrsol S-------xpenci- r-------------- ! CoSSSSSSSSSSSSSSpyrrrrrrrrrrrrrrsol S2i---:-xpenci- r-------------- ! CoSSSSSSSSSSSSSSpyrtopo_i sp2)=s to topology-------------- ! CoSSSSSSSSSSSSSSpyrrrrrrrrrrrrrrsol S-------ypenci- r-------------- ! CoSSSSSSSSSSSSSSpyrrrrrrrrrrrrrrsol S2i---:-ypenci- r---------------------- ! CopbPM._i s(3)=I)-D__L ID whertrnse,FFTs artrpDO m ed-------------- ! CoSSSSSSSSSSSSSSpyrbPM._i s(1)-fir __L -------------- ! CoSSSSSSSSSSSSSSpyrrrrrrrrrrrrsol S-------xpenci- ,real r-------------- ! CoSSSSSSSSSSSSSSpyrrrrrrrrrrrrsol S2i---:-xpenci- ,real r-------------- ! CoSSSSSSSSSSSSSSpyrbPM._i s(2)=s to __L -------------- ! CoSSSSSSSSSSSSSSpyrrrrrrrrrrrrsol S-------xpenci- , lex-------------- ! CoSSSSSSSSSSSSSSpyrrrrrrrrrrrrsol S2i---:-xpenci- , lex r-------------- ! CoSSSSSSSSSSSSSSpyrbPM._i s(3)=thir __L -------------- ! CoSSSSSSSSSSSSSSpyrrrrrrrrrrrrsol S-------ypenci- , lex-------------- ! CoSSSSSSSSSSSSSSpyrrrrrrrrrrrrsol S2i---:-ypenci- , lex r-------------- ! CoSghost---:(3)=I)-ghost---:gFFFFFF------- ! CoSSSSSSSSSSSSSSp_failed!DIF #endiSn-----------: NDIF #enN CoSSSSSSSSSSSSSSpDATA_fvpm_k,-,:) (F) fieldq--- FFFFSSSSp_failed!------ ! CoSSSSSSSSSSSSSSp_failed!------ ! CoSSSSSSSSSSSSSSp_failed!DIF #endiS------------:Zn__2DDDD( D(I)-D _error . 0=0iU no NNESS FOR------ ! CoSp_failed!-- ! Pur:TNESS FOR A PARTI ipole methoose : fast m ! ! Remarks : ! ! References : ! ! Revisions : !-bfdsol Sr_sol S2dsNE----------------------------------------------8:54---- ! $Log: ppm_module_data_fmm.f,v $ ! Revision 1.1.1.1 2081507/13 10:18:57 iv414 ! CBL version of the PPM library ! ! Revision 1.13 2006/09/04 18:34:52 pchatela ! 71307/13 104610/7:54-:29 ! CBL versionMa A-xpea ---- REAL(ppm_kS A-------- get ridle_d n---s 18:34:52 pchatela ! 71207/13 104607 17:41:5:3-hiebm_m ! $Logaddes --ypele_dariab ! -xpe ------- 18:34:52 pchatela ! 71- 1.74/028/0---4:35:1207- ! $LoShorte_S L- ! -ht wannt t-amesry eet -F90 31- race Smlim-------------a n--r . pgf9thn=sgonza! tchad pro ! ms..TNESS FOR A PARTI ! Revisio10 1.74/023621 15-41:21 -hiebm_m ! $Lofof d bugLiceassign---pda_wDATA_fv_ NESS FOR A PARTI ! Revisio9 1.74/022216/11:58:4:3-hiebm_m ! $LoMajNTeaddt! Di: fin--ze_d scalarhe PPvectNTepm_moduNESS FOR------ ted otalFstHpm_modu (at youse FFT lan(t creatsmNESS FOR------ tcep bfdsol Sr_i---- e 3 oy_smLicrp bfdsol Sr_fin--ze_NESS FOR------ wherta -pm_modu P spaicthe--a n--loneSsol SrNESS FOR A PARTI ! Revisio8200608:01/0---1:14:/03-hiebm_m ! $LoExMaddes -__SXF90 bych=zATHKEISANNESS FOR A PARTI ! Revisio7200608:0/01-8/088:56/0-- ! $LRenlaces --------------------- ,DI-0py of -----MK)-t0er General Public ! ! Revis4 200608:28/19 13:14:093-hiebm_m ! $Lodebugg_d scalar/vectNTepm_moduNESS FOR Public ! ! Revis45200608:28/17 12:12:173-hiebm_m ! $Loar stHscalar/vectNTepm_modus 18:34:52 pchatela ! 7on 1.4 27/278--4:7 473-hiebm_m ! $Lofof d bugLice want t-c---u--q- bfdsol Sr_---ssn= 18:34:52 pchatela ! 7n 1.74/0---(DD(5:3 473-- ! $Lo -serFstHm-ss---ples arraotalFIy resol SPM). .PP spole met ! $Loa link arrg TNESS FOR A PARTI ! Revisi2n 1.74/02/266/11:59:3 3-- ! $Lo of th ! ! TNESS FOR A PARTI ! Revisi21 1.74/02/266/7:562:78--hiebm_m ! $LoR tomm-- , ) m erly !----fielduol SrNESS FOR A PARTI ! Revisi2n 1.74/02/266/07:7888:3-hiebm_m ! $Lohed mze_d oop s 18:34:52 pchatela ! 71 1.74/025/19 15:32:7:3-hiebm_m ! $Loted otalFs of fromHscratw.gnus ! ! Remarks : ! ! References : ! ! Revisions ! !------------------------------------------------------------------------- ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! n 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see . ! ! Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Swprocessor SE D #ifINITprocessor IM FIELDprocessors !---------------CISION ENufdsol Sr_sol S2i---2ds_ss(DATA_fv,pbPM._i ---- , info field_topoi Itopo_i s,bPM._i s,ghost---:,------ #march== __3D #if __KIND == __SINGLECISION ENufdsol Sr_sol S2i---2ds_sd(DATA_fv,pbPM._i ---- , info field_topoi Itopo_i s,bPM._i s,ghost---:,------ #gmm_m _gmm_m ocessor IM VFIELDprocessors !---------------CISION ENufdsol Sr_sol S2i---2ds_vs(DATA_fv,pda_wfv,pbPM._i ---- , info field_topoi Itopo_i s,bPM._i s,ghost---:,------ #march== __3D #if __KIND == __SINGLECISION ENufdsol Sr_sol S2i---2ds_vd(DATA_fv,pda_wfv,pbPM._i ---- , info field_topoi Itopo_i s,bPM._i s,ghost---:,------ #gmm_m _gmm_m elre rocessor IM FIELDprocessors !---------------CISION ENufdsol Sr_sol S2ds_ss(DATA_fv,pbPM._i ---- , info field_topoi Itopo_i s,bPM._i s,ghost---:,------ #march== __3D #if __KIND == __SINGLECISION ENufdsol Sr_sol S2ds_sd(DATA_fv,pbPM._i ---- , info field_topoi Itopo_i s,bPM._i s,ghost---:,------ #gmm_m _gmm_m ocessor IM VFIELDprocessors !---------------CISION ENufdsol Sr_sol S2ds_vs(DATA_fv,pda_wfv,pbPM._i ---- , info field_topoi Itopo_i s,bPM._i s,ghost---:,------ #march== __3D #if __KIND == __SINGLECISION ENufdsol Sr_sol S2ds_vd(DATA_fv,pda_wfv,pbPM._i ---- , info field_topoi Itopo_i s,bPM._i s,ghost---:,------ #gmm_m _gmm_m egmm_mrallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Swpnus f TM = sParallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Swpr TM = ABS(co.L .h"ch', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif !-------------------------------------------MM_STATE2D',__L! CH-8092 Zurich, SwpIF #enles !------- !ModupIF #enles !--------a ! ules !--------op ! ules !---pwr-- ! ules !---p ENDIF les !---p lloc ENDIF les !---pmktopogFFFFFFles !-----opo_ge ! ules !----bPM._L . ! ules !----fdsol Sr_ma ! ules !---pantl_fft_ANT _ ! ules !---pantl_fft_back _ ! ules !----fdsol Sr_fft_A_ ! ules !----fdsol Sr_fft_b_ ! ules !----fdsol Sr_---ssn= 18:34:les !---ppm_alloc(gmu---ICIT NONEwprocessors !---------------C------- ANYAMEingl,DIMKD !---------- #march== __3D #if __KIND == __SINGLEC------- ANYAMEingl,DIMKD !--_module- _march', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif guotalo gFFFFFF & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endi__L IDNU Gener--- !Modu!oNote F.Pe nDi: IP spherGener---NT(ING)HANTABPM._i ---- h !enerlib work, ! vI gu !ourm ! $Lene pror r-solu of L..TNESS FO-------------------------,----DI-bPM._i ---- ! $Ltopo IDNU GenerfieldNESS FO-------------------------,-,r---NT(ING)H,----DI-field_topoi rocessor IM FIELDp ! $L--- ! ----MK), REAL(ppm_k,-) -------------:,-DI-DATA_fv- #marccsor IM VFIELDp ! $L--- ! ----MK), REAL(ppm_k,-,-) -------------:DI-DATA_fv-ESS FO-------------------------,-,r---NT(ING)H,----DI-da_wfv- _march', Ltopo /i__L IDNANTen tr app---SINGLEC------- A REAL(pp2)----,-,r---NT(ING-,-) -,DIltopo_i sSINGLEC------- A REAL(pp3)----,-,r---NT(ING-,-) -,DIlbPM._i s SINGLEC------- A REAL(pp2)----,-,r---NT(ING-,-) -,DIlghost---:gFFFFFF-------------------------,-,r---NT(I N ) -,DIl---ch', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifLoculdariab ! gFFFFFF & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enditimSrNESS FO----MK),-----------------,------------ H,----DI-t4 18:34:5epcenmet (c) 20 lloc ENDIF ------- A REAL(pp2)----,------------ H,----DI-da_ 18:34:5ecwannm_m ! -------------------------,------------ H,----DI-k,,jSTuNESS FOR-1/ numb (cU Ggrid-----IESS FO----MK),-----------------,------------ H,----DI-rNNESS FOR! e ult e hoy rocessor IM FIELDp ! ------- ANYAMEingl,------,------------ H,----DI-da_wfv =|1pr_gmm_m ocessor IM FIELDp ! CO--IEXMK), REAL(ppm_k,-) ------------DI-DATA_fv_ NESS FO-------- REAL(pp3,-) -,-------- H,----DI-da_wDATA_fv_ N #marccsor IM VFIELDp ! CO--IEXMK), REAL(ppm_k,-_kS A------------DI-DATA_fv_ NESS FO-------- REAL(pp4,-) -,-------- H,----DI-da_wDATA_fv_ N #march', ----MK), REAL(ppk,-) ------------DI---- _icDIF #enCO--IEXMK), REAL(ppm_k) ------------DI---- _ NESS FOCO--IEXMK), REAL(ppm_k) ------------DI-FFT_x,-FFT_xyh', ----MK), REAL(ppk,-) ------------DI-Re ultftware Fouriab ! gFFFFFF----MK), REAL(ppm_k),-------------:,DI-xp ! -------------------------,------------ HDI-Np ! u-------------------------,------------ HDI-d tom-,eassigngFFFFFF----MK), REAL(pp2,-) -,-------- H,--:Z-min_phyuI max_phyugFFFFFF----MK), REAL(pp2,-) -,-------- H,--:Z-lengthgFFFFFF----MK), REAL(pp2,-) -,-------- H,--:Z-length_phyugFFFFFF-------- REAL(pp4,-) -,-------- H,--:Z-bca si ! u-------------------------,------------ HDI-niorsItopo_i ,bPM._i ! u-------------------------,------------ HDI-bPM._i -xpen,bPM._i _ypen ! u-------------------------,------------ HDI-bPM._i -xpen_ lex-----------MK), REAL(ppm--) A------------ HDI-cos ! u-------- REAL(ppm_kS A--------------DIlsia ,lsia -xpen_ lex i ! u-------- REAL(ppm_kS A--------------DIlsia _ypen,sia _trn(t ! u-------- REAL(ppm_kS A--------------DIln--- Nn--- -xpen_ lex--------------- REAL(ppm_kS A--------------DIln--- _ypen,n--- _trn(t ! u-------- REAL(pp(co.Lim) -,-------- DI-baxn--- !Modu-------- REAL(pp(co.Lim) -,-------- DI-baxn--- _ypen ! u-------- REAL(pp(co.Lim) -,-------- DI-baxn--- _zpen ! u-------- REAL(ppm--) A------------ HDI-iior motF=> NULL() ! u-------------------------,------------ HDI-nior motgFFFFFF-------------------------,------------ HDI-dim, yhbax,iopt,id NESS FO-------------------------,------------ HDI-topo_i -xpen,topo_i -ypen ! u------- A REAL(pp2)----,------------ HDIltopo_i s_tmp ! u------- A REAL(pp3)----,------------ HDIlbPM._i s_tmp SINGLEC------- A REAL(pp2)----,------------ HDIlNm,Nm_ ,Nm_---ssn= 18:34:LOGICAL------------------,------------ HDI-Its_xpenci-_topogFFFFFFCHYAMC---(LEN=(co. r)----,------------DIlbPM-SINGLECTYPE( !t_topo)-------- A------------ HDI-f_topogFFFFFFTYPE( !t_equi_bPM. --- A------------ HDI-f_bPM. !Modu- & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endio ------ire details & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #en---------a ------ufdsol Sr_sol S2ds-----------p !Modu- & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endiCecke aguotalo gFFFFFF & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enIF p(co.Lebug .GT. 0F #elif __DIM == IF p.NOT. (co.i------ze_dF #elif __DIM == __2DD pm_al- ENDIF IF #en----- pm_al( pm__ noi---,----ufdsol Sr_sol S2ds-- info 'P006/0-c---u(co.i----fir!',__LINE__------------R GOTO 9999------R END-Fh FFFFFIF pfield_topoi .LE. 0F #elif __DIM == __2DD pm_al- ENDIF IF #en----- pm_al( pm__aguotalo,----ufdsol Sr_sol S2ds-- info 'No fieldqtopology has been . .PPso far',__LINE__------------R GOTO 9999------R END-Fh FEND-Fh Fh Ff_topo => topo(field_topoi )%tgFFFFFFf_bPM. => f_topo%__L (bPM._i ---- ) !Modu- & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endioCecke arcFTW_-If not, is availb ! -U GarcNEC If not,arallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Swpr rcc!(. .P(__FTW_) | . .P(__zATHKEISAN)b_failed__2DD pm_al- r rma sizeFTW_DIF #en----- pm_al( pm__nofftw,----ufdsol Sr_sol S2ds-- info 'fdsol Sr needscFTW_ If not, ' ,__LINE__-------r_gmm_m ocma sizezATHKEISANNESS FO----- pm_al( pm__noMathKeisan,----ufdsol Sr_sol S2ds-- info ' ! as ! d ! PPM iszATHKEISAN---pdo ',__LINE__------- #march', GOTO 9999- elre !Modu- & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endioI------ze_dariab ! gFFFFFF & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endim', =|1p bca s(1:4--------=F---upcenm_bca s_ !spacthe implassign =|---upcenm_assign_nts onal-------topo_i s_tmp =|topo_i sSINGLECbPM._i s_tmp =|bPM._i sSINGLECNm1)- =|f_bPM.%Nm1)-SINGLECNm12- =|f_bPM.%Nm12-SINGLECNm_ 1)- =CNm1)-/2+1SINGLECNm_ 12- =CNm12-SINGLECN ! =|0processors !---------------Cmin_phyu(1) =|f_topo%_in_phyuP1)-SINGLECmin_phyu(2b =|f_topo%_in_phyuP12-SINGLEC_ax_phyu()-==|f_topo%_ax_phyus1)-SINGLECmax_phyu(2-==|f_topo%_ax_phyus12-- #march== __3D #if __KIND == __SINGLECmin_phyu(1) =|f_topo%_in_phyud1)-SINGLECmin_phyu(2b =|f_topo%_in_phyud12-SINGLEC_ax_phyu()-==|f_topo%_ax_phyud1)-SINGLECmax_phyu(2-==|f_topo%_ax_phyud12-- #march', IF p(co.Lebug .GT. 0F #elif __DIM ==WRITE(bPMg,'(A,2F15.3)' ) '_inimal extalo-- min_phyu(1),Cmin_phyu(2b f __DIM ==----- wr-- p(co.rn(k,----ufdsol Sr_sol S2ds--bPMg,j)f __DIM ==WRITE(bPMg,'(A,2F15.3)' ) '_aximal extalo-- max_phyu()-,Cmax_phyu(2-=f __DIM ==----- wr-- p(co.rn(k,----ufdsol Sr_sol S2ds--bPMg,j)f __DIMEND-Fh Flength_phyu()-=E4_ax_phyu()-=-Fmin_phyu(1)gFFFFFFlength_phyu(2-=E4_ax_phyu(2-=-Fmin_phyu(2b_failed- & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endiCecke arcx_penci- topologygFFFFFF & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enIts_xpenci-_topo=E4.TRUETNESS FODO k=1,f_topo%nior motgFFFFFFFFFid ==|f_topo%sior mot(k)processors !---------------CFFFlength()-==|f_topo%_ax_----(1,sd -=-Ff_topo%_in_----(1,sd -------CFFFIF( a--(length()-=-Flength_phyu()-b.GT.p(co.myepss) F #eliF Its_xpenci-_topo=.FALSETNESS FODIMEND-Fh #march== __3D #if __KIND == __SINGLECFFFlength()-==|f_topo%_ax_---d(1,sd -=-Ff_topo%_in_---d(1,sd -------CFFFIF( a--(length()-=-Flength_phyu()-b.GT.p(co.myepsd) F #eliF Its_xpenci-_topo=.FALSETNESS FODIMEND-Fh #march', ENDOch', IF p(co.Lebug .GT. 0F #elif __DIM ==IF(Its_xpenci-_topoF #elif __DIM == WRITE(bPMg,'(A)' ) 'X penci- topology'F ----- wr-- p(co.rn(k,----ufdsol Sr_sol S2ds--bPMg,j)f __DIM ==ELSEf __DIM == WRITE(bPMg,'(A)' ) 'NotcX penci- topology'F ----- wr-- p(co.rn(k,----ufdsol Sr_sol S2ds--bPMg,j)f __DIM ==END-Fh FEND-Fh FZ ! Remarks : ! ! References : ! ! Revisions Sett---pU Gx-penci- topologye ! ! Remarks : ! ! References : ! ! Revisions IF(Its_xpenci-_topoF #elif __DIM ==topo_i -xpen __DIM ===-field_topoi __DIM ==bPM._i -xpen __DIM ===-bPM._i ---- ! --topo_i s_tmpp)-------=-topo_i -xpenf __DIM ==topo_i -ypen __DIM ===-topo_i s_tmpp2- bPM._i -xpen_ lex =|bPM._i s_tmpp2- bPM._i -ypen __DIM ===-bPM._i s_tmpp)-h FELSEf __DIM ==topo_i -xpen __DIM ===-topo_i s_tmpp)-f __DIM ==topo_i -ypen __DIM ===-topo_i s_tmpp2- bPM._i -xpen __DIM ===-bPM._i s_tmpp)-h F bPM._i -xpen_ lex =|bPM._i s_tmpp2- bPM._i -ypen __DIM ===-bPM._i s_tmpp3)f __DIMEND-Fh FIF p(co.Lebug .GT. 0F #elif __DIM ==WRITE(bPMg,'(A)' ) ' IDNNNNNNNNNNNNNtopo=-bPM.' f __DIM ==----- wr-- p(co.rn(k,----ufdsol Sr_sol S2ds--bPMg,j)f __DIM ==WRITE(bPMg,'(A)' ) 'erences : ! ! Revis'f __DIM ==----- wr-- p(co.rn(k,----ufdsol Sr_sol S2ds--bPMg,j)f __DIM ==WRITE(bPMg,'(A,2I4)' ) 'Origin--__DIM ==',field_topoi I-bPM._i ---- ! ------- wr-- p(co.rn(k,----ufdsol Sr_sol S2ds--bPMg,j)f __DIM ==WRITE(bPMg,'(A,2I4)' ) 'X Penci- _DIM ==',-topo_i -xpen, bPM._i -xpen ! ------- wr-- p(co.rn(k,----ufdsol Sr_sol S2ds--bPMg,j)f __DIM ==WRITE(bPMg,'(A,2I4)' ) 'X Penci- C lex',-topo_i -xpen, info bPM._i -xpen_ lex------- ------- wr-- p(co.rn(k,----ufdsol Sr_sol S2ds--bPMg,j)f __DIM ==WRITE(bPMg,'(A,2I4)' ) 'Y Penci- C lex',-topo_i -ypen, bPM._i -ypen ! ------- wr-- p(co.rn(k,----ufdsol Sr_sol S2ds--bPMg,j)f __DIMEND-Fh FZ ! Remarks : ! ! References : ! ! Revisions D tom-----dn-Licexpenci- ! ! Remarks : ! ! References : ! ! Revisions IF(.NOT.Its_xpenci-_topoF #elif __DIM ==assign =|---upcenm_assign_nts onal------- xpenci- d tom---t! Di------- d tom- =|---upcenm_d tom-_xpenci- ! ------- mktopo(topo_i -xpen,bPM._i -xpen,xp,N ! ,d tom-,assign, info bin_phyuI_ax_phyu,bca s,ghost---:,cos ,Nm, info ----,niors) ! ------- m_L i---(topo_i -xpen,bPM._i -xpen,Nm,sia ,n--- , info o baxn--- ,sior mot,nior mot-------p !Modu --topo_i s_tmpp)--=-field_topoi __DIM ==topo_i s_tmpp2--=-topo_i -xpenf __DIM ==bPM._i s_tmpp)-==-bPM._i ---- ! --bPM._i s_tmpp2-==-bPM._i -xpenf ocessor IM FIELDp ! ------- fdsol Sr_ma (DATA_fv,ptopo_i s_tmp,-bPM._i s_tmp, ------ #march= IM VFIELDp ! ------- fdsol Sr_ma (DATA_fv,da_wfv,ptopo_i s_tmp,-bPM._i s_tmp,------ #march', topo_i s_tmpp)--=-topo_i -xpenf __DIM ==topo_i s_tmpp2--=-topo_i -ypenf __DIM ==bPM._i _--- FFFF=|f_bPM.%IDgFFFFFFEND-Fh FZ ! Remarks : ! ! References : ! ! Revisions Allocate lex e hoy FZ ! Remarks : ! ! References : ! ! Revisions yhbax =|0pons DOFi1,Nf_topo%nior motgFFFFFFFFFid ==|f_topo%sior mot(i-------CFFFIF (f_bPM.%nno sP(2,sd -=.GT. yhbaxF #elif __DIM == yhbax =|f_bPM.%nno sP(2,sd -f __DIM ==END-Fh FENDOch ocessor IM FIELDp ! da_wDATA_fv_ p)-=CNm_ 1)-p ! da_wDATA_fv_ p2-=Cyhbax Fh Fda_wDATA_fv_ p3)=|f_topo%nior motg #march= IM VFIELDp ! da_wDATA_fv_ p)-=Cda_wfv- ! da_wDATA_fv_ p2-=CNm_ 1)-p ! da_wDATA_fv_ p3-=Cyhbax Fh Fda_wDATA_fv_ p4)=|f_topo%nior motg #marc Fh Fiopt =|---upcenm_alloc_f-------------- alloc(DATA_fv_ ,Fda_wDATA_fv_ , iopt,i----------RIF (__2DD.NE. 0F #elif __DIM == __2DD pm_al-f-- - ! --n----- pm_al( pm__alloc,----ufdsol Sr_sol S2ds-- info '--- Fe hoy',__LINE__------------R GOTO 9999------REND-F----Rh FZ ! Remarks : ! ! References : ! ! Revisions FT - Trn(t m s of Licex-direc! Di-------Z ! Remarks : ! ! References : ! ! Revisions iopt =|---upcenm_alloc_f---------da_p)-=2-------da_p2-=f_topo%niors------------ alloc(n--- ,da_,iopt,i----------RIF (__2DD.NE. 0F #elif __DIM ==__2DD pm_al-f-- - ! ------- pm_al( pm__alloc,----ufdsol Sr_sol S2ds-- info 'n--- Fe hoy',__LINE__------------R GOTO 9999------REND-F------Rn--- F=|f_bPM.%nno sPNESS FODO k=1,f_topo%nior motgFFFFFFFFFid ==|f_topo%sior mot(k)p ! -------- alloc(--- _ic,Rn--- (:,sd -,|---upcenm_alloc_f--, ------ ! --IF (__2DD.NE. 0F #elif __DIM == = __2DD pm_al-f-- - ! --n-n----- pm_al( pm__alloc,----ufdsol Sr_sol S2ds-- info '--- _icea hoy',__LINE__------------R GOTO 9999------R END-Fh arcch= IM VFIELD---R ------R DO n=1,da_wfv- _march', --R DO i1,N n--- (1,sd -f __DIM ==--R DO j1,N n--- (2,sd -f arcch= IM FIELDp ! -------------- _ic(i,j--=-pDATA_fvp,jSTk-- #march= IM VFIELDp ! -------------- _ic(i,j--=-pDATA_fvpn,,jSTk-- #march', ENDOch', ENDOch#arch= SE D #ifINITp', ----- fdsol Sr_fft_A_( --- _ic,Rn--- (:,sd -,|FFT_x,------- #mstribute i ----- antl_fft_ANT _( --- _ic,Rn--- (:,sd -,|FFT_x,------- #march', iopt =|---upcenm_de lloc ENDIF ------ alloc(--- _ic,Rn--- (:,sd -,|iopt, ------ ! -- DO i1,N n--- (1,sd -f __DIM ==--R DO j1,N n--- (2,sd -f arcch= IM FIELDp ! -----------DATA_fv_ p,jSTk- =|FFT_x(i,j-- #march= IM VFIELDp ! -----------DATA_fv_ pn,,jSTk- =|FFT_x(i,j-- #march', ENDOch', ENDOch ENDOch#arch= IM VFIELDp ! ENDOch##marc F-Rh FZ ! Remarks : ! ! References : ! ! Revisions D tom----- lex dn-Licexpenci- ! ! Remarks : ! ! References : ! ! Revisions ----- m_L _L .(topo_i -xpen,bPM._i -xpen_ lex,Nm_ ,ns info o sia -xpen_ lexNn--- -xpen_ lex------------RZ ! Remarks : ! ! References : ! ! Revisions D tom-----dn-Liceypenci- ! ! Remarks : ! ! References : ! ! Revisions d tom- =|---upcenm_d tom-_ypenci- ! ----- mktopo(topo_i -ypen,bPM._i _ypen,xp,N ! ,d tom-,assign, info o bin_phyuI_ax_phyu,bca s,ghost---:,cos ,Nm, info o ----,niors) ! ----- m_L i---(topo_i -ypen,bPM._i _ypen,Nm,sia _ypen,n--- , info o baxn--- ,sior mot,nior mot-------p------RZ ! Remarks : ! ! References : ! ! Revisions Trn(t-----x-direc! Di. y-direc! Di-------Z ! Remarks : ! ! References : ! ! Revisions bPM._i s_tmpp)-==-bPM._i -xpen_ lex-------bPM._i s_tmpp2-==-bPM._i -ypenf oceor IM FIELDp ! C---- fdsol Sr_ma (DATA_fv_ ,topo_i s_tmp,-bPM._i s_tmp, ------ #march= IM VFIELDp ! C---- fdsol Sr_ma (DATA_fv_ ,da_wfv,ptopo_i s_tmp,-bPM._i s_tmp,------- #march', DO k=1,f_topo%nior motgFFFFFFFFFid ==|f_topo%sior mot(k)p ! --da_p)-=2------- --da_p2-=id NESS FO iopt =|---upcenm_alloc_f--------- ------- alloc(n--- _trn(t,da_,iopt, ------ ! --n--- _trn(t(1,sd -=n--- (2,sd -f ! --n--- _trn(t(2,sd -=n--- (1,sd -f __DIM ==----- alloc(--- _ ,n--- _trn(t(:,sd -,iopt, ------#arch= IM VFIELDp ! DO n=1,da_wfv- _march', --R DO i1,N n--- (1,sd -f __DIM ==--R DO j1,N n--- (2,sd -f arch= IM FIELDp ! -------------- _ pj,i)=-DATA_fv_ p,jSTk-- #march= IM VFIELDp ! -------------- _ pj,i)=-DATA_fv_ pn,,jSTk-- #march', ENDOch', ENDOch Z ! Remarks : ! ! References : ! ! Revisions FT - Trn(t m s of Licey-direc! Di-------Z ! Remarks : ! ! References : ! ! Revisi#arch= SE D #ifINITp', ----- fdsol Sr_fft_A_(--- _ ,n--- _trn(t(:,sd -,FFT_xy------ - elre !Modu ----- antl_fft_ANT _(--- _ ,n--- _trn(t(:,sd -,FFT_xy------ - emarch', iopt =|---upcenm_de lloc ENDIF ----- alloc(--- _ ,n--- _trn(t(:,sd -,iopt, ------ Z ! Remarks : ! ! References : ! ! Revisions Sol SuPoissn=sEqus of - Z ! Remarks : ! ! References : ! ! Revisions ons trn(t-----sia . phyuiculdlengthgFFFFFFFFFFFFda_p)-=2------- -- --da_p2-=id NESS FO iopt =|---upcenm_alloc_f--------- -- ----- alloc(sia ,da_,iopt,i----------R i-a --1,sd -=sia _ypen(2,sd -f ! -- i-a --2,sd -=sia _ypen(1,sd -f __DIM ==--Rlength()-======Flength_phyu(2-f __DIM ==--Rlength(2-======Flength_phyu()- Nm_---ssn=p)-==-Nm_ 12--1:5ecwrrec!ify -1:) 20 ecwnven! Di------- Nm_---ssn=p2-==-Nm_ 1)- ----- fdsol Sr_---ssn=pFFT_xy--n--- _trn(t(1:2,sd -,|||||||| info o -R i-a --1:2,sd -,length,Nm_---ssn=, ------ ! -- iopt =|---upcenm_de lloc ENDIF ----- alloc(sia ,da_,iopt,i----------RZ ! Remarks : ! ! References : ! ! Revisions FT - Back _ Trn(t m s of Licey-direc! Di-------Z ! Remarks : ! ! References : ! ! Revisi#arch= SE D #ifINITp', ----- fdsol Sr_fft_bdpFFT_xy--n--- _trn(t(:,sd -,|--- _ ,----- - elre !Modu ----- antl_fft_back _pFFT_xy--n--- _trn(t(:,sd -,|--- _ ,----- - emarch', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifTrn(t-----y-direc! Di. x-direc! Di-------Z ! Remarks : ! ! References : ! ! Revisions DO i1,N n--- (1,sd -f __DIM ==--R DO j1,N n--- (2,sd -f arch= IM FIELDp ! -----------DATA_fv_ p,jSTk- =|--- _ pj,i)- #march= IM VFIELDp ! -----------DATA_fv_ pn,,jSTk- =|--- _ pj,i)- #march', ENDOch', ENDOch#arch= IM VFIELDp ! --ENDOch##marcNESS FO iopt =|---upcenm_de lloc ENDIF ----- alloc(--- _ ,-da_, iopt,i----------RENDOcndi#mapU Gdo oop o Sr k=1,f_topo%nior motgFFFFFFtopo_i FFFF=-topo_i s_tmpp)-f __DIMtopo_i s_tmpp)-=-topo_i s_tmpp2- topo_i s_tmpp2-=-topo_i -------bPM._i FFFF=-bPM._i s_tmpp)-h FbPM._i s_tmpp)-=|bPM._i s_tmpp2- bPM._i s_tmpp2-=|bPM._i f oceor IM FIELDp ! C---- fdsol Sr_ma (DATA_fv_ ,topo_i s_tmp,-bPM._i s_tmp, ------ #march= IM VFIELDp ! C---- fdsol Sr_ma (DATA_fv_ ,da_wfv,topo_i s_tmp,-bPM._i s_tmp,------- #march', DO k=1,f_topo%nior motgFFFFFFFFFid ==|f_topo%sior mot(k)p#arch= IM VFIELDp ! DO n=1,-da_wfv- _march', ! DO i1,N n--- -xpen_ lex(1,sd -f __DIM ==--R DO j1,N n--- -xpen_ lex(2,sd -f arch= IM FIELDp ! -----------FFT_x(i,j-=-DATA_fv_ p,jSTk-- #march= IM VFIELDp ! -----------FFT_x(i,j-=-DATA_fv_ pn,,jSTk-- #march', ENDOch', ENDOch Z ! Remarks : ! ! References : ! ! Revisions FT - Back _ Trn(t m s of Licey-direc! Di-------Z ! Remarks : ! ! References : ! ! Revisi#arch= SE D #ifINITp', ----- fdsol Sr_fft_bdpFFT_xNn--- -xpen_ lex(:,sd -,Re ult,----- - elre !Modu ----- antl_fft_back _pFFT_xNn--- -xpen_ lex(:,sd -,Re ult,----- - emarch', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endiCwrrec! Inundaey pro ! m ---: factNTe1/(Nx*Ny-=====pIF #endiSubtrace 1h f--0 ecwnven! Di-------Z ! Remarks : ! ! References : ! ! Revisions rN =|1/d ! ((Nm1)--1)*(N 12--1)-- ! -- DO i1,Nn--- -xpen_ lex(1,sd -f __DIM ==--R DO j1,Nn--- -xpen_ lex(2,sd -f arch= IM FIELDp ! -----------DATA_fvp,jSTk-=-Re ult(i,j-*rN- #march= IM VFIELDp ! -----------DATA_fvpn,,jSTk-=-Re ult(i,j-*rN- #march', ENDOch', ENDOch#arch= IM VFIELDp ! --ENDOch##marcNESS FOENDOcndi#mapU Gdo oop k=1,f_topo%nior motgFFFFFF & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endiMape origin--_topologyeU notGx-penci- topologygFFFFFF & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enIF(.NOT.Its_xpenci-_topoF #elif __DIM ==topo_i s_tmpp)--=-topo_i s_tmpp2- topo_i s_tmpp2--=-field_topoi __DIM ==bPM._i s_tmpp)-==-bPM._i -xpen __DIM ==bPM._i s_tmpp2-==-bPM._i ---- arch= IM FIELDp ! ------- fdsol Sr_ma (DATA_fv,ptopo_i s_tmp,-bPM._i s_tmp, ------ #march= IM VFIELDp ! ------- fdsol Sr_ma (DATA_fv, da_wfv,ptopo_i s_tmp,-bPM._i s_tmp,------- #march', END-F-gFFFFFF & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endiDe llocate memot,arallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Swpralleliopt =|---upcenm_de lloc ENDIF ----- alloc(DATA_fv_ ,Fda_wDATA_fv_ , iopt,i----------R----- alloc(n--- ,da_,iopt,i----------R----- alloc(n--- _trn(t,da_,iopt, ------ ! ----- alloc(--- _in,da_,iopt, ------ ! ----- alloc(FFT_xNda_,iopt, ------ ! ----- alloc(FFT_xyNda_,iopt, ------ ! ----- alloc(cos ,da_,iopt, ------ ! ----- alloc(sia ,da_,iopt, ------ ! ----- alloc(sia -xpen_ lex-da_,iopt, ------ ! ----- alloc(sia -ypen,da_,iopt, ------ ! ----- alloc(sia -trn(t,da_,iopt, ------ ! ----- alloc(n--- ,da_,iopt, ------ ! ----- alloc(n--- -xpen_ lex-da_,iopt, ------ ! ----- alloc(n--- _ypen,da_,iopt, ------ ! ----- alloc(n--- _trn(t,da_,iopt, ------ ! IF (__2DD.NE. 0F #elif __DIM == WRITE(bPMg,'(A)') 'cURPOSnotGde llocate memot,'f __DIM == __2DD pm_al- ENDIF IF----- pm_al( pm__de lloc,----ufdsol Sr_sol S2ds--bPMg,__LINE__- info o -R -----------R GOTO 9999------REND-F- emarch', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifR _h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpI9999 CONTINUE- ! ---------op -----ufdsol Sr_sol S2ds----------- ! RETURN processor SE D #ifINITprocessor IM FIELDprocessors !---------------CENDCISION ENufdsol Sr_sol S2i---2ds_ssh #march== __3D #if __KIND == __SINGLECENDCISION ENufdsol Sr_sol S2i---2ds_sd- #gmm_m _gmm_m ocessor IM VFIELDprocessors !---------------CENDCISION ENufdsol Sr_sol S2i---2ds_vsh #march== __3D #if __KIND == __SINGLECENDCISION ENufdsol Sr_sol S2i---2ds_vd- #gmm_m _gmm_m elre rocessor IM FIELDprocessors !---------------CENDCISION ENufdsol Sr_sol S2ds_ssh #march== __3D #if __KIND == __SINGLECENDCISION ENufdsol Sr_sol S2ds_sd- #gmm_m _gmm_m ocessor IM VFIELDprocessors !---------------CENDCISION ENufdsol Sr_sol S2ds_vsh #march== __3D #if __KIND == __SINGLECENDCISION ENufdsol Sr_sol S2ds_vd- #gmm_m _gmm_m egmm_mlib ENnumerics-r1036/src/ ENugmm_quadeq.inc0000644000175000017500000000376511616214647017637 0uia omaromar', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif TM = s), ) 20sol ---pa quadratic equs of TNESS FOR A PARTI INPUT: ------MK), REAL(pp3)HDI-coefs ---coefficialo : A PARTI coefsp3)*x**2 + coefsp2)*x + coefsp)-==-4 18:34:5e N PUT: -----MK), REAL(pp2)HDI-roots --- !wo-rootsTNESS FOR A PARTI & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif !-bgmm_quadeq.inc----------------------------------------------8:545--- ! $Log: ppm_module_data_fmm.f,v $ ! Revision 1.1.1.1 2083 1.74/024/27 01:06:1207- ! $LoCwnverge me tests- le- , )M libed up- d ptmze_d d (Shark)ral Publiche PPMaddes -struc ee llow fast (c ! s of TNESS FOR A PARTI ! Revisi2n 1.74/023610/71:48:273-- ! $LoRspherdodebug ------TNESS FOR A PARTI ! Revisi21 1.74/023610/71:37:7:3-- ! $Lo ------PMaeck-in. BEWARE:oNot testsmLicrpcense alyetSAIC Group (ETH Z & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endificense along with PPM. If not, ! see . ! ! P (ETH Z & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enIF (ABS(coefsp3)-=.GT. lmyepsF #elif __DIM == ainv =|1.0_MK/coefsp3)f __DIM == detFF=-ainv*ainvf __DIM == detFF=-0.25_MK*coefsp2)*coefsp2)*detf __DIM == detFF=-detF- coefsp)-*ainvf __DIM == IF (detF.GT. 0.0_MKF #elif __DIM == detF= SQRT(det-f __DIM ==--R rootsp)-==--0.5_MK*coefsp2)*ainvf __DIM == -R rootsp2-==-rootsp)-=+ detf __DIM == -R rootsp)-==-rootsp)-=- detf __DIM == ELSEf __DIM == rootsp)-==-bigf __DIM == -R rootsp2-==-bigf __DIM == END-Fh FELSEf __DIM == ! line equs of - == IF (ABS(coefsp2)-=.GT. lmyepsF #elif __DIM == rootsp)-==-0.0_MKf __DIM == -R rootsp2-==--coefsp)-/coefsp2)f __DIM == ELSEf __DIM == rootsp)-==-bigf __DIM == -R rootsp2-==-bigf __DIM == END-Fh FEND-Fhlib ENnumerics-r1036/src/ ENu !---pantl_fft_back _.f0000644000175000017500000000777511616214647022217 0uia omaromarroca sizeXLF @PROC WITNOHOT- emarch', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif DIM == :_DIM == -R ENu !---pantl_fft_back _h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endpIF #endifiur-----M == :_rich) !--- TM = A -source d ANTen trantlith Library want tITNESS FOR A PARTICoRsparks-M == :NESS FOR A PARTICoRspole met== :NESS FOR A PARTICoRs Revis == :NESS FOR & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif !-b !---pantl_fft_back _.f----------------------------------------------8988:3-- ! $Log: ppm_module_data_fmm.f,v $ ! Revision 1.1.1.1 208n 1.74/011/05 8:516:3 3-m aeb_NESS FOR--ar stHxlf ! r direc! ves 18:34:52 pchatela ! 71 1.74/02/266/07:30:1207- ! $LoFir mel Pft (cspitt---pata_old) !---s T -------nts ofac_NESS FOR--u---sTNESS FOR A PARTI & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endi! !------------------------------------------------------------------------- ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! n 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see . ! ! Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, SwpallelNESS FOR & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifD . typsParallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, SwprL . !--------- ! Copyr1prL . __KIND == __ ! Copyr2prL . !---------_CO--IEXpyr5prL . __KIND == ___CO--IEXpyr6ParallelMODULs !---pantl_fft_back _ f __DIM == Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich,f __DIM == ifD . nts ofac_e antl_fft_back _f __DIM == Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich,f __DIM ==-----FACE antl_fft_back _f __DIM ==lelMODULs PROC DURE antl_fft_back __2 sSINGLEC ==lelMODULs PROC DURE antl_fft_back __2 _f __DIM ==lelMODULs PROC DURE antl_fft_back __2 cf __DIM ==lelMODULs PROC DURE antl_fft_back __2 cc f __DIM ==lelMODULs PROC DURE antl_fft_back __3 sSINGLEC ==lelMODULs PROC DURE antl_fft_back __3 _f __DIM ==lelMODULs PROC DURE antl_fft_back __3 cf __DIM ==lelMODULs PROC DURE antl_fft_back __3 cc DIM ==lelENDC-----FACE f __DIM == Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich,f __DIM == if TM = AB -source f __DIM == Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich,f __DIM ==CONTAINS prL . = __3 !----------r TM = ABS(co.antl_fft_back __2 .f"-r TM = ABS(co.antl_fft_back __3 .f"-ruma size= __ prL . = __3 __KIND == __Sr TM = ABS(co.antl_fft_back __2 .f"-r TM = ABS(co.antl_fft_back __3 .f"-ruma size= __ prL . = __3 !---------_CO--IEX-r TM = ABS(co.antl_fft_back __2 .f"-r TM = ABS(co.antl_fft_back __3 .f"-ruma size= __ prL . = __3 __KIND == ___CO--IEX-r TM = ABS(co.antl_fft_back __2 .f"-r TM = ABS(co.antl_fft_back __3 .f"-ruma size= __ p ==lelENDCMODULs !---pantl_fft_back _ lib ENnumerics-r1036/src/ ENuantl_fft_ANT __3 .f0000644000175000017500000004315111616214647021112 0uia omaromarDIM == Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich,-isions Sub want t = :_DIM == -R - antl_fft_ANT __3 h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endpIF #endifiur-----M == :_rich) want t p ofo Fa teri YoTrn(t m an---p-------------- ! CoFTW_ icense,fir (x)ndimU L PubNESS FOR A PARTI Inpu I---- _icpm_k,-) (F) --- h n) trn(t m ed-------------- ! Coooooooooooooooo A PARTI Inpu /------ I-da_(:- (I) ---: U Gd-- ! $ A PARTI O----- I---- _---pm_k,-) (F) trn(t m edr--- !Modu!ooooooooooooooooo__2DDDDDDDDDDDDD(I) r _ ia tus. =0eU no pm_alTNESS FOR A PARTICoRsparks-M == :--------------- ! Copyr---- ! Coooooooooooooooo A PARTI Rspole met== :NESS FOR A PARTICoRs Revis == :NESS FOR & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif !-bantl_fft_ANT __3 .f----------------------------------------------898813-- ! $Log: ppm_module_data_fmm.f,v $ ! Revision 1.1.1.1 20816-----6/09/04 8:534:59 - chatel !Modu!ooFixet=e PPM libupsh !it ! HANT !Modu!oore006/0-1-0 ! Revision 1.1.1.1 20815 1.74/021--- 12534:513-- ! $Lofixed typoI-iiign_fft_Afth iiign_fftTNESS FOR A PARTI ! Revisi214 1.74/011/0---1:07:36--hiebm_m ! $LoRspherdo__NEED4SPEED, exMaddes - XF90y zezATHKEISANNESS FO! (fftt=ere.f,v $ specificSnotG ! r specificich), MOSAIC Grou ! Revisi213 1.74/010021 16:09:13 1- ! $LoRsplac_d-----M !-bkind_double)-DI-t4y of t----MK),-t0TNESS FOR A PARTI ! Revisi21n 1.74/008/27 14:03:353-m aeb_NESS FOR-- TM = sd-c---sh ata_advanc_d-fftw nts ofac_.-----------Theed are.stptioonly anyd----------arch=NEED4SPEED n .P. SPURPOSn) Maddes -icense,ne fu eTNESS FOR A PARTI ! Revisi211 1.74/008/26----47:25--hiebm_m ! $Loinsert_d rrec! Di.e_data_la alories 18:34:52 pchatela ! 710 1.74/008/25/07:54:15--hiebm_m ! $Lofixed memot, 006k 18:34:52 pchatela ! 79 1.74/008/23 12530:02--hiebm_m ! $LoadjustsmLfieldq m s e ecwnven! Di-------Z2 pchatela ! 78 1.74/02/266/08:12552--hiebm_m ! $Load sd-SX MathKeisan- Ts ofac_e(NECich), MOSAIC Grou ! Revisi27 1.74/02/266/07:42533 1- ! $LoCaddes - -------nts ofac_) !---s e PPadaptsmL---uUSE ia tetalo TNESS FOR A PARTI ! Revisi26 1.74/022/25/-1:51545--hiebm_m ! $Lobug fix icea hoy ---:NESS FOR A PARTI ! Revisi25 1.74/022/19 15:43:03 walGNU ! $LoCaddes - __OCO--IEX- CO--IEXMK),TNESS FOR A PARTI ! Revisi24 1.74/022/11 16:31:7:3-- ! $LoCaddes -icM = ABe_dfftw._dfrom ppf TM = AB o f90yINCLUDETNESS FOR A PARTI ! Revisi23 1.74/022/11 15:29:5:3-- ! $LoSome heavy-cosmetics: head (c) 2 s - , ) TM = A merge, )Mon! nus of - Z Madracem_m pherdo rop (c lum=, --dalos of Lfixed, blank lines e P- Z spacts icea uotalo moth) spherd,ptoo oo--plines icelog wrapp.P.- Z Bugfix: aguotalo are.nowPMaeckrdoBEFOREdatay are.assignrdo Nx_ic..TNESS FOR A PARTI ! Revisi2n 1.74/022/11 1--83:23 -hiebm_m ! $LoMaddes -aguotalo ) TM = Ad test f Lic2DD ) TM = Ad !-bn ..h------------short_nrdolines 80 Madracem_m, exM = Ad !---pbPM.------------ TM = Ad fftw3.fNESS FOR A PARTI & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endi! !------------------------------------------------------------------------- ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! n 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see . ! ! Parallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Swprocessors !---------------CISION ENuantl_fft_ANT __3 s(--- _in,da_,--- _---,------ #march== __3D #if __KIND == __SINGLECISION ENuantl_fft_ANT __3 d(--- _in,da_,--- _---,------ #march== __3D #if !---------_CO--IEX-INGLECISION ENuantl_fft_ANT __3 c(--- _in,da_,--- _---,------ #march== __3D #if __KIND == ___CO--IEX-INGLECISION ENuantl_fft_ANT __3 cc(--- _in,da_,--- _---,------ #march', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif TM = sParallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Swpr TM = ABS(co.n ..h"h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif ! ! Remarks : ! ! References : ! ! Revisions USE !---p--- !ModuUSE !---p----ong !ModuUSE !---p----oop !ModuUSE !---p ENDIF USE !---p lloc ENDIF I--IICIT NONEprocessors !--------- |sors !---------_CO--IEXp ENDIF INTEGER,ANY AMETER-DI-MKD kind_------- #march== __3D #if __KIND == __ |sors __KIND == ___CO--IEXp ENDIF INTEGER,ANY AMETER-DI-MKD kind_double- #march', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifFTW_ icM = Aarallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Swproca si zeFTW_DIF #enINCLUDE "fftw3.f"- #march', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifAguotalo h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endiinpu --- arcssors !--------- |ch== __3D #if __KIND == __SINGLEC----MK), REAL(ppm_k,-) D )INTENT(I- )-DI---- _in- #march== __3D #if !---------_CO--IEX |ch== __3D #if __KIND == ___CO--IEX-INGLECCO--IEXMK), REAL(ppm_k,-) )INTENT(I- )-DI---- _in- #march', ---: U Ge hoy FINTEGER,A REAL(pp3)HHHHHHHHHHH )INTENT(I-N )-DI-da_h', ------ --- , fastHANeri Yotrn(t m ed-------CO--IEXMK), REAL(ppm_k,-) HH )PO-----HHHHHHH:I---- _--- FINTEGER )INTENT(e N )-DI-----h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifLoculdariab ! h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enditimU ! ----MK),--------------------------------DI-t4pIF #endictertm_m ! INTEGER --------DI-,jSTk,iopth', ---: U G !--- _ice ! INTEGER --------DI-Nx_ic, Ny_ic, Nz_in-', ---: U G !--- _M is ! INTEGER --------DI-Nx_---, Ny_---, Nz_--- roca sizeFTW_DIF #en!fFTW_ P ! ! INTEGER*8 --------DI-P ! ! INTEGER --------DI-mb 3 ofd mbrn(k,-mb n 3 ,-mb embed-------INTEGER --------DI-mboembed,-mbhowmhe ,-mbodmotg #marc roca sizezATHKEISANNESS FO! zATHKEISANdariab ! ANTAMathKeisan-FTWm ! INTEGER --------DI-,iign_fft,isys arch== __3D #if !---------_CO--IEX |ch== __3D #if __KIND == ___CO--IEX-INGLECINTEGER --------DI-,ncx,---cy- #march', scul: U G !trn(t m s of ! ----MK),--------------------------------DI-scul:_fftNESS FO! work---p-oorageSINGLEC----MK), REAL(ppm),PO-----HHHHHHH---DI-tb ! , workpIF #endit -s--: U G !work---p-oorageSINGLECINTEGER,A REAL(pp1,-------------------DI-da__tb ! , da__workp #march', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifExs onal h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swph', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif T-----isAarallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Swprallel---------o --' ENuantl_fft_ANT __3 ----------- arcs!(n .P(zeFTW_) |cn .P(zezATHKEISAN)-- ! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifE -arcFT f,v $ support notGavailb ! - ! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #en__2DD pm_al- arna sizeFTW_DIF #en----- pm_al( pm__nofftw,' ENuantl_fft_ANT __3 --|| info o ' ! wasG ! d ! PPM isfftw support',__LINE__------- #march arna sizezATHKEISANNESS FO----- pm_al( pm__noMathKeisan,' ENuantl_fft_ANT __3 --|| info o ' ! wasG ! d ! PPM iszATHKEISANdsupport',__LINE__------- #marchESS FOGOTO 9999ESS FO- elre !Modu & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifCaeck-aguotalo !Modu & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enIF p(co.Lebug .GT. 0F #elif __DIM ==nIF pSIZE(da_,1,-.LT. 3F #elif __DIM == __2DD pm_al- ENDIF IFS FO----- pm_al( pm__aguotalo,' ENuantl_fft_ANT __3 --|| info o 'da_ mustHbe at 006s s--: 3',__LINE__------------R GOTO 9999------R END-Fh F ==nIF pda_p)--.LE. 0F #elif __DIM == = __2DD pm_al- ENDIF IFS FO----- pm_al( pm__aguotalo,' ENuantl_fft_ANT __3 --|| info o 'bPM. s--::Fda_p)- mustHbe >0',__LINE__------------R GOTO 9999------R END-Fh F ==nIF pda_p2--.LE. 0F #elif __DIM == = __2DD pm_al- ENDIF IFS FO----- pm_al( pm__aguotalo,' ENuantl_fft_ANT __3 --|| info o 'bPM. s--::Fda_p2- mustHbe >0',__LINE__------------R GOTO 9999------R END-Fh F ==nIF pda_p3--.LE. 0F #elif __DIM == = __2DD pm_al- ENDIF IFS FO----- pm_al( pm__aguotalo,' ENuantl_fft_ANT __3 --|| info o 'bPM. s--::Fda_p3- mustHbe >0' ,__LINE__------------R GOTO 9999------R END-Fh FEND-Fh FZh f--0 -cwnven! Di-------Nx_ic=da_p)--1-------Ny_ic=da_p2)f __DIMNz_in=da_p3-h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifAllocate re ult e hoy FZ ! Remarks : ! ! References : ! ! Revisi arcssors !--------- |ch== __3D #if __KIND == __SINGLECNx_---==-Nx_ic/2 + 1- #march== __3D #if !---------_CO--IEX |ch== __3D #if __KIND == ___CO--IEX-INGLECNx_---==-Nx_icNGLEC- #marchESS FONy_---==-Ny_in-', Nz_---==-Nz_in- arcssors !--------- |ch== __3D #if __KIND == __SINGLECda_p)- =CNx_---- #march== __3D #if !---------_CO--IEX |ch== __3D #if __KIND == ___CO--IEX-INGLECda_p)- =CNx_---+1 FZh f--0 -cwnven! Di- #marchESS FOda_p2- =ONy_---hESS FOda_p3)==-Nz_---hESS FO----- alloc(--- _---,da_,---upcenm_alloc_f--,i----------RIF (__2DD.NE. 0F #elif __DIM == __2DD pm_al-f-- - ! --n----- pm_al( pm__alloc,----uantl_fft_ANT __3 --|| info 'Afthre ult DATA_OUT',__LINE__------------R GOTO 9999------REND-Fh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifFTW - Trn(t m Licex-direc! Di-------Z ! Remarks : ! ! References : ! ! Revisions & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifNECneral Pub- UseAMathKeisan-L,v $ ! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swproca sizezATHKEISANNESS FO! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifAllocate work---p-oorageSINGLEC! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enda__tb ! D 2*Nx_icN+ 64hESS FO----- alloc(tb ! ,da__tb ! ,---upcenm_alloc_f--,i----------RIF (__2DD.NE. 0F #elif __DIM == __2DD pm_al-f-- - ! --n----- pm_al( pm__alloc,----uantl_fft_ANT __ds-- info 'tb ! DnotGallocated',__LINE__------------R GOTO 9999------REND-Fh', da__workD 4*Nx_ichESS FO----- alloc(work,da__work,---upcenm_alloc_f--,i----------RIF (__2DD.NE. 0F #elif __DIM == __2DD pm_al-f-- - ! --n----- pm_al( pm__alloc,----uantl_fft_ANT __ds-- info 'workDnotGallocated',__LINE__------------R GOTO 9999------REND-Fh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif T-----izeSINGLEC! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enscul:_fft =|1pIF #en_iign_fft==-4 18:34:j----R =|1pIF #enk----R =|1processors !---------------C------scfft(,iign_fft,-Nx_ic, scul:_fft,---- _icp1jSTk-,| info o -R --- _---p1jSTk-,|tb ! , work, isys-- #march== __3D #if __KIND == __SINGLEC------dzfft(,iign_fft,-Nx_ic, scul:_fft,---- _icp1jSTk-,| info o -R --- _---p1jSTk-,|tb ! , work, isys-- #march== __3D #if !---------_CO--IEX-INGLEC,ncx =|1pIF #en_ncy =|1pIF #en------cfft(,iign_fft,-Nx_ic, scul:_fft,---- _icp1jSTk-,|,ncx,- info o --- _---p1jSTk-,|_ncy,|tb ! , da__tb ! p)-,- info o work, da__workp)-,isys-- #march== __3D #if __KIND == ___CO--IEX-INGLEC,ncx =|1pIF #en_ncy =|1pIF #en------zfft(,iign_fft,-Nx_ic, scul:_fft,---- _icp1jSTk-,|,ncx,- info o --- _---p1jSTk-,|_ncy,|tb ! , da__tb ! p)-,- info o work, da__workp)-,isys-- #march', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifFNT _fFTW - ! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #en_iign_fft==--1-------DO k=1,Nz_in-', DO j1,NNy_in-rocessors !---------------CIF #en------scfft(,iign_fft,-Nx_ic, scul:_fft,---- _icp1jSTk-,| info o -R --- _---p1jSTk-,|tb ! , work, isys-- #march== __3D #if __KIND == __SINGLECIF #en------dzfft(,iign_fft,-Nx_ic, scul:_fft,---- _icp1jSTk-,| info o -R --- _---p1jSTk-,|tb ! , work, isys-- #march== __3D #if !---------_CO--IEX-INGLECIF #en------cfft(,iign_fft,-Nx_ic, scul:_fft,---- _icp1jSTk-,|,ncx,- info o --- _---p1jSTk-,|_ncy,|tb ! , da__tb ! p)-,- info o work, da__workp)-,isys-- #march== __3D #if __KIND == ___CO--IEX-INGLECIF #en------zfft(,iign_fft,-Nx_ic, scul:_fft,---- _icp1jSTk-,|,ncx,- info o --- _---p1jSTk-,|_ncy,|tb ! , da__tb ! p)-,- info o work, da__workp)-,isys-- #march', FOENDOcnnnnnn FOENDOch', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifDe llocate Memot,arallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Swprallel----- alloc(tb ! ,da__tb ! ,---upcenm_de lloc,------ ! ----- alloc(work,da__work,---upcenm_de lloc,------ elre !Modu & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifFTW_ eral PubANTALINUX,..TNESS FOR & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enMBRank =|1pIF #enMBHowmhe ==-Ny_in*Nz_in-', MBiEmbed ==--1-------MBoEmbed ==--1-------MBI3 ofd =|1pIF #enMBiDist =|UBOUND(--- _in, )-h FMBoDist =|UBOUND(--- _---,1)processors !---------------C-----sfftw_plan_mhe _dft_r2c(P !,nMBRank,Nx_ic, MBHowmhe ,- in info--- _icp1j1j1----BiEmbed,MBI3 ofd ,MBiDist,- in info--- _---p1j1j1--MBoEmbed,MBI3 ofd ,MBoDist,FFTW_ESTIzATE)------C-----sfftw_execute(P !)------C-----sfftw_de3 ooy_plan(P !)- #march== __3D #if __KIND == __SINGLEC-----dfftw_plan_mhe _dft_r2c(P !,nMBRank,Nx_ic, MBHowmhe ,- in info--- _icp1j1j1----BiEmbed,MBI3 ofd ,MBiDist,- in info--- _---p1j1j1--MBoEmbed,MBI3 ofd ,MBoDist,FFTW_ESTIzATE)------C-----dfftw_execute(P !)------C-----dfftw_de3 ooy_plan(P !)- #march== __3D #if !---------_CO--IEX-INGLEC-----sfftw_plan_mhe _dft(P !,nMBRank,Nx_ic, MBHowmhe ,- in info--- _icp1j1j1----BiEmbed,MBI3 ofd ,MBiDist,- in info--- _---p1j1j1--MBoEmbed,MBI3 ofd ,MBoDist,- in infoFFTW_FORWARD, FFTW_ESTIzATE)------C-----sfftw_execute(P !)------C-----sfftw_de3 ooy_plan(P !)- #march== __3D #if __KIND == ___CO--IEX-INGLEC-----dfftw_plan_mhe _dft(P !,nMBRank,Nx_ic, MBHowmhe ,- in info--- _icp1j1j1----BiEmbed,MBI3 ofd ,MBiDist,- in info--- _---p1j1j1--MBoEmbed,MBI3 ofd ,MBoDist,- in infoFFTW_FORWARD, FFTW_ESTIzATE)------C-----dfftw_execute(P !)------C-----dfftw_de3 ooy_plan(P !)- #gmm_m _gmm_m egmm_ arch== __3D #if !---------_CO--IEX |ch== __3D #if __KIND == ___CO--IEX-INGLEC & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifC! GNmargiceno)Mon m L of the ecwnven! Di-------Z ! Remarks : ! ! References : ! ! Revisions DO j1,NNy_---hESS FO --DO k=1,Nz_---hESS FO -- --- _---pda_p)-jSTk- =|--- _---p1jSTk-h', FOENDOc FOENDOc FO- emarch', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifR _h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpI9999 CONTINUE- ! ---------op -----uantl_fft_ANT __3 ----------- ! RETURN rocessors !---------------CENDCISION ENuantl_fft_ANT __3 sh #march== __3D #if __KIND == __SINGLECENDCISION ENuantl_fft_ANT __3 d- #march== __3D #if !---------_CO--IEX-INGLECENDCISION ENuantl_fft_ANT __3 c- #march== __3D #if __KIND == ___CO--IEX-INGLECENDCISION ENuantl_fft_ANT __3 ccm egmm_mlib ENnumerics-r1036/src/ ENugmm_cpt.f0000644000175000017500000004370311616214647016615 0uia omaromar', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifSub want t = :_DIM == -R - ENugmm_cpth', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endi! !------------------------------------------------------------------------- ! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ! Center for Fluid Dynamics (DTU) ! ! ! This file is part of the Parallel Particle Mesh Library (PPM). ! ! PPM is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License ! as published by the Free Software Foundation, either ! n 3 of the License, or (at your option) any later ! version. ! ! PPM is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! and the GNU Lesser General Public License along with PPM. If not, ! see . ! ! P', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swprocesssor IM 2Dprocesssors !---------------CISION ENugmm_cpt_2 s(f--- ,tol,npts,ipts,cloLest- info o ----,chi)- #marcch== __3D #if __KIND == __SINGLECISION ENugmm_cpt_2 d(f--- ,tol,npts,ipts,cloLest- info o ----,chi)- #gmm_ - #marcch= IM 3Dprocesssors !---------------CISION ENugmm_cpt_3 s(f--- ,tol,npts,ipts,cloLest- info o ----,chi)- #marcch== __3D #if __KIND == __SINGLECISION ENugmm_cpt_3 d(f--- ,tol,npts,ipts,cloLest- info o ----,chi)- #gmm_ emarch', !!_rich) want t p ofo loLest point!trn(t m .fFNT each grCSEpointh', !!_adjacalo ata_nts ofac_, ata_ loLest point!ON ata_nts ofac_ h', !!_r _.P. ENugmm_i--- mustHbe c---rdoBEFOREdatch) want t is icvok.P.- Z & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swpnus#endif TM = sParallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Swpr TM = ABS(co.n ..h"h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif - ! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enUSE !---p--- !ModupIF #enUSE !---p--- ugmmpIF #enUSE !---pgmm_kickoffpIF #enUSE !---p----ong !ModuUSE !---p----oop !ModuUSE !---p ENDIF USE !---p lloc ENDIF USE !---ptypsn ENDIF USE !---pantl_qsog !ModuI--IICIT NONEprocesssors !--------- |sors #if !---------_CO--IEX-INGLECINTEGER,ANY AMETER-DI-MKD kind_------- #mseSINGLECINTEGER,ANY AMETER-DI-MKD kind_double- #march', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifAguotalo h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swp ocessor IM 2Dp', ----MK), REAL(ppm_k,-) DH )PO-----HHHHHHHHHHHHHDI-f--- !Modu!!!_L dil|--- . Rank 3 (ANTA2D scul fields)ral Publi!!_Imarces: (,jST[k],i---). Eundy o-crosn---pis ics opretsmL-s e al Publi!!_nts ofac_.T Aghosts--: U G1 nee Ad Pub---usi A wh mustHbeal Publi!!_, d ! PPpata_old)l dil|func! Di.value f Licput!!_Only scul f--- !Modu!!!_support.P.- ----MK), REAL(ppm_k,-,-) HH )INTENT(I-, OPTL(pALDI-chi !Modu!!!_Rank 4 (2d)Lfieldqspecify---pata_positevis U GenergrCSEnodtITNESS FOR!!_1stH--dax: 1..(co.nim, atan ,jST[k],i---. OPTL(pAL. Uni m LgrCSE h', !!_assu edroceabsalo. Ghostlaym_m s--: >=1 mustHbe pre-, d.- #march= IM 3Dp ----MK), REAL(ppm_k,-,-) HH )PO-----HHHHHHHHHHHHHDI-f--- !Modu!!!_L dil|--- . Rank 4 (ANTA3D scul fields).al Publi!!_Imarces: (,jST[k],i---). Eundy o-crosn---pis ics opretsmL-s e al Publi!!_nts ofac_.T Aghosts--: U G1 nee Ad Pub---usi A wh mustHbeal Publi!!_, d ! PPpata_old)l dil|func! Di.value f Licput!!_Only scul f--- !Modu!!!_support.P.- ----MK), REAL(ppm_k,-,-,-) )INTENT(I-, OPTL(pALDI-chi !Modu!!!_Rank 5 (3d)Lfieldqspecify---pata_positevis U GenergrCSEnodtITNESS FOR!!_1stH--dax: 1..(co.nim, atan ,jST[k],i---. OPTL(pAL. Uni m LgrCSE h', !!_assu edroceabsalo. Ghostlaym_m s--: >=1 mustHbe pre-, d.- #march', INTEGER REAL(ppm_k,------- )PO-----HHHHHHHHHHHHHDI-iptsh', !!_PPM. imarces U Genese points._1stH--dax: ,jST(k),i--- (loculd--- ID);h', !!_2nd: 1...npts. Wption) allocatedy ch) want t.- ----MK), REAL(ppm_k,------- )PO-----HHHHHHHHHHHHHDI- loLest !Modu!!!_Locatevis U Gener loLest points!ON ata_nts ofac_._1stH--dax: x,y,(z)ral Publi!!_2nd: 1...npts. Wption) allocatedy ch) want t.- ----MK), )INTENT(I- )-HHHHHHDI-tol !Modu!!!_Re s ovAB olhou me ANTen trde! .P n 3 u me ata_nts ofac_TNESS FOR!!_1E-3 a gooPPMaoic_._ThAB olhou me is ic multiples U GgrCSEspac---ITNESS FOINTEGER )INTENT(e N )-HHHHHHDI-i---h', !!_Re _ ia tus. 0 upf Lsuccesm ! INTEGER )INTENT(e N )-HHHHHHDI-nptsh', !!_Number U Gunique grCSEpoints_adjacalo ata_nts ofac_.- Z & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swpnus#endifLoculdariab ! h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enINTEGER -DI-,jiopt,Nt,i---pIF #enINTEGER -DI-n1,n2,n3,j---,prevpIF #enINTEGER REAL(pp2)H -DI-ldu- ----MK), REAL(ppm_k, )PO-----HDI- lotmp- ----MK), --DI-t4,x,y,z,xx,yy,zz,dx,dy,dz- ----MK), --DI-s,sprev,thrPM.- LOGICAL -DI-lokpIF #enTYPE( t_oopo)- )PO-----HHHDI-topopIF #enTYPE( t_equipbPM.),)PO-----HHHDI-mPM.- & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif T-----isA h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #en---------o --' ENugmm_cpt----------- ! topo => topo(gmm_topoid)%t !ModubPM. => topo%bPM.(gmm_bPM.id) rocessors !---------------C lotmp => gmm_cloLh #march== __3D #if __KIND == __SINGLEC lotmp => gmm_clod- #march', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifCaeck-aguotalo !Modu & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enIF p(co.Lebug .GT. 0F #elif __DIM ==nIF p.NOT. ENuiT-----izedF #elif __DIM == = __2DD pm_al- ENDIF IFS FO----- pm_al( pm__ noiT--,' ENugmm_cpt--|| info o 'P006/0 c--- ENuiT--,fir!',__LINE__------------R GOTO 9999------R END-Fh F ==nIF p ol-.LE. 0.0_MKF #elif __DIM == __2DD pm_al- ENDIF IFS FO----- pm_al( pm__aguotalo,' ENugmm_cpt--|| info o ' olhou me mustHbe >0!',__LINE__------------R GOTO 9999------R END-Fh ocessor IM 3Dp ==nIF pSIZE(f--- ,4,-.LT. topo%nsor motF #elif __DIM == __2DD pm_al- ENDIF IFS FO----- pm_al( pm__aguotalo,' ENugmm_cpt--|| info o 'fieldq--- hANTesome ---- is misn---',__LINE__------------R GOTO 9999------R END-Fh F ==nIF pUBOUND(f--- ,1,-.LT. maxxhiF #elif __DIM == __2DD pm_al- ENDIF IFS FO----- pm_al( pm__aguotalo,' ENugmm_cpt--|| info o 'xndimU L Pube_dfieldq--- hdoe notGmat mPM.',__LINE__------------R GOTO 9999------R END-Fh F ==nIF pUBOUND(f--- ,2,-.LT. maxyhiF #elif __DIM == __2DD pm_al- ENDIF IFS FO----- pm_al( pm__aguotalo,' ENugmm_cpt--|| info o 'yndimU L Pube_dfieldq--- hdoe notGmat mPM.',__LINE__------------R GOTO 9999------R END-Fh F ==nIF pUBOUND(f--- ,3,-.LT. maxzhiF #elif __DIM == __2DD pm_al- ENDIF IFS FO----- pm_al( pm__aguotalo,' ENugmm_cpt--|| info o 'zndimU L Pube_dfieldq--- hdoe notGmat mPM.',__LINE__------------R GOTO 9999------R END-Fh #march= IM 2Dp ==nIF pSIZE(f--- ,3,-.LT. topo%nsor motF #elif __DIM == __2DD pm_al- ENDIF IFS FO----- pm_al( pm__aguotalo,' ENugmm_cpt--|| info o 'fieldq--- hANTesome ---- is misn---',__LINE__------------R GOTO 9999------R END-Fh F ==nIF pUBOUND(f--- ,1,-.LT. maxxhiF #elif __DIM == __2DD pm_al- ENDIF IFS FO----- pm_al( pm__aguotalo,' ENugmm_cpt--|| info o 'xndimU L Pube_dfieldq--- hdoe notGmat mPM.',__LINE__------------R GOTO 9999------R END-Fh F ==nIF pUBOUND(f--- ,2,-.LT. maxyhiF #elif __DIM == __2DD pm_al- ENDIF IFS FO----- pm_al( pm__aguotalo,' ENugmm_cpt--|| info o 'yndimU L Pube_dfieldq--- hdoe notGmat mPM.',__LINE__------------R GOTO 9999------R END-Fh #march', END-F-----R ! (co.Lebug ANTea uotalo Maeckh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifFindubPM. spac--- !Modu & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enIF p(co.kind .EQ. kind_------F #elif __DIM == dx =|(topo%bax_physsp)--topo%bin_physsp)-)/ || info o ----MbPM.%Nmp)--1, kind_------Ff __DIM == dy =|(topo%bax_physsp2--topo%bin_physsp2-)/ | info o ----MbPM.%Nmp2--1, kind_------Ff __DIM == IF p(co.Lim .GT. 2F #elif __DIM == dz =|(topo%bax_physsp3--topo%bin_physsp3-)/ info o ----MbPM.%Nmp3--1, inf info o kind_------Ff __DIM == END-Fh FELSEf __DIM == dx =|(topo%bax_physsp)--topo%bin_physsp)-)/ || info o ----MbPM.%Nmp)--1, kind_double)f __DIM == dy =|(topo%bax_physsp2--topo%bin_physsp2-)/ | info o ----MbPM.%Nmp2--1, kind_double)f __DIM == IF p(co.Lim .GT. 2F #elif __DIM == dz =|(topo%bax_physsp3--topo%bin_physsp3-)/ info o ----MbPM.%Nmp3--1, inf info o kind_double)f __DIM == END-Fh FEND-Fh FZ & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifGet non-unique loLest points. We_assu e(at yoata_largest fccur--- !Modu .values ic f--- are.outsi A U Genernam_aw banP.- Z & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swpnus#enN- =--1_DIM == ! 006ve f--- untoucdifyl PublicthrPM.==-4.99_MK*MAXV--MABS(f--- )-- ! IF pPRESENT(chi)F #elif __DIM == ----- gmm_kickoff(f--- ,tol,thrPM.-----,Nt,iptstmp, lotmp,chi=chi)- FELSEf __DIM == ----- gmm_kickoff(f--- ,tol,thrPM.-----,Nt,iptstmp, lotmp)h FEND-Fh FIF (__2DD.NE. ---upcenm_succesmF #elif __DIM == __2DD pm_al- ENDIF IF----- pm_al( pm__---_fa! d,' ENugmm_cpt--|| info o 'So ----pGMM fa! d.',__LINE__------------R GOTO 9999------REND-Fh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifHas mPM. coordinates ke,arallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, SwprallelioptD pcenm_alloc_f--prallelldup)- =CN-hESS FO----- alloc(ke,,ldujiopt,i----------RIF (__2DD.NE. 0F #elif __DIM == __2DD pm_al-f-- - ! --n----- pm_al( pm__alloc,----ugmm_cpt--|||||||| info o 'sog ke, KEY',__LINE__------------R GOTO 9999------REND-Fh', n1D maxxhih', n2D maxxhi*maxyhih', n3D n2*maxzhih', DO i=1,N-hESS FO -- ke,(i- =Ciptstmp(1,i- + (_ptstmp(2,i--1)*n1D+ (_ptstmp(3,i--1)*n2h ocessor IM 3Dp ==nke,(i- =Cke,(i- + (_ptstmp(4,i--1)*n3h #march', ENDOch', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifSog h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #en----- ENuantl_qsog (ke,,idx,i----------RIF (__2DD.NE. ---upcenm_succesmF #elif __DIM == __2DD pm_al- ENDIF IF----- pm_al( pm__---_fa! d,' ENugmm_cpt--|| info o 'So ----pfa! d.',__LINE__------------R GOTO 9999------REND-Fh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifFinduenernumber U Gunique points_h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #ennpts==-4 18:34:prev==--1-------DO i=1,N-hESS FO -- IF (ke,(idx(i)F .NE. -revF #elif __DIM == npts==-npts=+|1pIF #ennnnnnnnnprev==-ke,(idx(i)Ff __DIM == END-Fh FENDOch', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifAllocate memot, ANTeunique CPTarallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, SwprallelioptD pcenm_alloc_f--prallelldup)- =C(co.Limprallelldup2- =Onptsh', ----- alloc(cloLest-ldujiopt,i----------RIF (__2DD.NE. 0F #elif __DIM == __2DD pm_al-f-- - ! --n----- pm_al( pm__alloc,----ugmm_cpt--|||||||| info o ' loLest point!trn(t m CLOSEST',__LINE__------------R GOTO 9999------REND-Fh', ldup)- =C(co.Lim+1prallelldup2- =Onptsh', ----- alloc(ipts,ldujiopt,i----------RIF (__2DD.NE. 0F #elif __DIM == __2DD pm_al-f-- - ! --n----- pm_al( pm__alloc,----ugmm_cpt--|||||||| info o ' loLest point!trn(t m CLOSEST',__LINE__------------R GOTO 9999------REND-Fh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifStILITunique CPTarallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Swprallelnpts==-4 18:34:prev==--1- ocessor IM 3Dp DO i=1,N-hESS FO -- IF (ke,(idx(i)F .NE. -revF #elif __DIM == npts==-npts=+|1pIF #ennnnnnnnnipts(1,npts- =Ciptstmp(1,idx(i)Ff __DIM == nnnnipts(2,npts- =Ciptstmp(2,idx(i)Ff __DIM == nnnnipts(3,npts- =Ciptstmp(3,idx(i)Ff __DIM == nnnnipts(4,npts- =Ciptstmp(4,idx(i)Ff __DIM == nnnnprev===-ke,(idx(i)Ff __DIM == sprev==-HUGE(sprevFf __DIM == END-Fh Fnnnni--- =nipts(4,npts-h Fnnnnj--- =ntopo%isor mot(i---)hESS FO -- IF (PRESENT(chi)F #elif __DIM == x =|chi(1,ipts(1,npts-,ipts(2,npts-,ipts(3,npts-,i---)hESS FO -- y =|chi(2,ipts(1,npts-,ipts(2,npts-,ipts(3,npts-,i---)hESS FO -- z =|chi(3,ipts(1,npts-,ipts(2,npts-,ipts(3,npts-,i---)hESS FO -- ELSEf __DIM == -- IF ((co.kind .EQ. kind_------F #elif __DIM == == x =|topo%bin_----p1jS---) + (_pts(1,npts--1)*dxf __DIM == == y =|topo%bin_----p2jS---)+ (_pts(2,npts--1)*dyf __DIM == == z =|topo%bin_----p3jS---)+ (_pts(3,npts--1)*dzf __DIM == == ELSEf __DIM == -- x =|topo%bin_---dp1jS---) + (_pts(1,npts--1)*dxf __DIM == == y =|topo%bin_---dp2jS---) + (_pts(2,npts--1)*dyf __DIM == == z =|topo%bin_---dp3jS---) + (_pts(3,npts--1)*dzf __DIM == == END-Fh FnnnnEND-Fh Fnnnnxx =|clotmp(1,idx(i)Ff __DIM == yy =|clotmp(2,idx(i)Ff __DIM == zz =|clotmp(3,idx(i)Ff __DIM == s===-(xx-x)*(xx-x) + (yy-y)*(yy-y) + (zz-z)*(zz-z)hESS FO -- IF (s-.LT. s-revF #elif __DIM == loLest(1,npts- =Cxxf __DIM == == loLest(2,npts- =Cyyf __DIM == == loLest(3,npts- =Czzf __DIM == == sprev==-sh FnnnnEND-Fh FENDOch #march= IM 2Dp DO i=1,N-hESS FO -- IF (ke,(idx(i)F .NE. -revF #elif __DIM == npts==-npts=+|1pIF #ennnnnnnnnipts(1,npts- =Ciptstmp(1,idx(i)Ff __DIM == nnnnipts(2,npts- =Ciptstmp(2,idx(i)Ff __DIM == nnnnipts(3,npts- =Ciptstmp(3,idx(i)Ff __DIM == nnnnprev===-ke,(idx(i)Ff __DIM == sprev==-HUGE(sprevFf __DIM == END-Fh Fnnnni--- =nipts(3,npts-h Fnnnnj--- =ntopo%isor mot(i---)hESS FO -- IF (PRESENT(chi)F #elif __DIM == x =|chi(1,ipts(1,npts-,ipts(2,npts-,i---)hESS FO -- y =|chi(2,ipts(1,npts-,ipts(2,npts-,i---)hESS FO -- ELSEf __DIM == -- IF ((co.kind .EQ. kind_------F #elif __DIM == == x =|topo%bin_----p1jS---) + (_pts(1,npts--1)*dxf __DIM == == y =|topo%bin_----p2jS---)+ (_pts(2,npts--1)*dyf __DIM == == ELSEf __DIM == -- x =|topo%bin_---dp1jS---) + (_pts(1,npts--1)*dxf __DIM == == y =|topo%bin_---dp2jS---) + (_pts(2,npts--1)*dyf __DIM == == END-Fh FnnnnEND-Fh Fnnnnxx =|clotmp(1,idx(i)Ff __DIM == yy =|clotmp(2,idx(i)Ff __DIM == s===-(xx-x)*(xx-x) + (yy-y)*(yy-y)hESS FO -- IF (s-.LT. s-revF #elif __DIM == loLest(1,npts- =Cxxf __DIM == == loLest(2,npts- =Cyyf __DIM == == sprev==-sh FnnnnEND-Fh FENDOch #march', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifF it temp memot,arallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, SwprallelioptD pcenm_de lloch', ----- alloc(iptstmp,ldujiopt,i----------RIF (__2DD.NE. 0F #elif __DIM == __2DD pm_al- ENDIF IF----- pm_al( pm__alloc,----ugmm_cpt--|||||||| info o 'temponot, point! mot IPTSTMP',__LINE__------------REND-Fh F----- alloc(clotmp,ldujiopt,i----------RIF (__2DD.NE. 0F #elif __DIM == __2DD pm_al- ENDIF IF----- pm_al( pm__alloc,----ugmm_cpt--|||||||| info o 'temponot, loLest points!CLOTMP',__LINE__------------REND-Fhrocessors !---------------CNULLIFY(gmm_cloL)- #march== __3D #if __KIND == __SINGLECNULLIFY(gmm_clod-- #march', ----- alloc(idx,ldujiopt,i----------RIF (__2DD.NE. 0F #elif __DIM == __2DD pm_al- ENDIF IF----- pm_al( pm__alloc,----ugmm_cpt--|||||||| info o 'PermutateviH--dax IDX',__LINE__------------REND-Fh F----- alloc(ke,,ldujiopt,i----------RIF (__2DD.NE. 0F #elif __DIM == __2DD pm_al- ENDIF IF----- pm_al( pm__alloc,----ugmm_cpt--|||||||| info o 'sog ke, KEY',__LINE__------------REND-Fh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifRe _ h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpI9999 CONTINUE- ! ---------op -----ugmm_cpt----------- ! RETURN processsor IM 2Dprocesssors !---------------CENDCISION ENugmm_cpt_2 s- #marcch== __3D #if __KIND == __SINGLECENDCISION ENugmm_cpt_2 d- #gmm_ emarcch= IM 3Dprocesssors !---------------CENDCISION ENugmm_cpt_3 s- #marcch== __3D #if __KIND == __SINGLECENDCISION ENugmm_cpt_3 d- #gmm_ egmm_mlib ENnumerics-r1036/src/ ENugmm_slvextn.inc0000644000175000017500000003662711616214647020065 0uia omaromar', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif TM = s), ANTede! ---p solv---pata_line equs of ! difANTeog hogonal extU L Pubun---pupwind mm_ferences ic ata_unknow ! difAuncitPub-nd cght (ed mm_ferences ANTen trl dil|func! Dir General Public L INPUT:_DIINTEGER DI-,jSTk -- Point!to solv ANT Public L INTEGER DI-or. -- Desi(ed or. of FD scheme Public L ----MK), PO-----HDI-dta -- --- !Modu!L ----MK), PO-----HDI-fdta -- l dil|func! Di !Modu!L N PUT:_D----MK),DI-valijk -- Compthe Lvalue ANTepoint!,jSTk General Public & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif$Log: ENugmm_slvextn.inc,v $pIF #endifReviL Pub1.1.1.1 2007/07/13 10:18:55= _vospIF #endifCBLneral Pub PM f,v $ General Public L ReviL Pub1.4 2005/07/25 00:31:10= _vospIF #endifbugfix: ,-dax pm_als ic jacobian), x.P.- Z Public L ReviL Pub1.3 2005/07/14 19:58:16= _vospIF #endifAd Ad OPTL(pALea uotalo MaiHANTABPM. nodt_positevis ic n 3 ort.PpIF #endif(mappedF BPM.es.fFNT use ! PPpAGMHANTAexample.- Z Public L ReviL Pub1.2 2005/05/24 23:24:44= _vospIF #endifAd Ad Maecks ANTeuniT-----ized.values ic ener ght (ed mm_ferencespIF #endifto avoid float oeraflows ic M). resolv d regevis._rich) apIF #endiftechniculd, xL-s enerre ult optiostption) wrcopyi Lsuch caLes..TNESS FORpIF #endifReviL Pub1.1 2005/05/10=04:41:16= _vospIF #endifNewl, reatedydur--- !--arizateviH ENugmm_march. March--- !Modu .-nd og hogonal extU deviHare.nowyi Lsepcente rwant ts ANTefast ( !Modu . ! a! Dir General Public & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endificense along with PPM. If not, ! see . ! ! P', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swp Public & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifDe! . s! cheParallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Swpr TM = ABS(co.gmm_s! cheP.inc"p Public & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifRead)l dil|func! Diarallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Swpr TM = ABS(co.gmm_getfdta.inc"p Public & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifRead)value Aunc! Diarallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Swpr TM = ABS(co.gmm_getdta.inc"p Public & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifCompthepupwind fiT--e mm_ferences approprintepIF #endifor. .--------------alpha(1:3) x,y(,z). efs U Generunknow ! ic n- !Modu!L beta(1:3) x,y(,z). efs U Genercvistant!t ic n- !Modu!L gphi(1:3) x,y(,z).gradialo U Generl dil|func! Di. Public & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enalpha==-4.0_MKpIF #enbeta ==-4.0_MKpIF #engphi ==-4.0_MKp Public & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif Sw X DIND T __SINGLEC & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endiUseAupwind mmrec! Di ic l dil|func! DiarallelIF (MABS(phi(-1j1-,-.LT. ABS(phi(0j1-,,-.OR. (psi(1,1,-.GT. hsave)F #elif __DIM == i1==--1------- == i2D -2------- == i3D -3SINGLECELSEf __DIM == i1==-1------- == i2D 2------- == i3D 3SINGLECEND-Fh FIF (sx(i1,-.GT. 0F #elif __DIM == & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichf __DIM == ifFirst fr. icex direc! Di------- == & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichf __DIM == alpha(1)==--1.0_MKpIF #en #enbeta(1)=D si(i1,1,hESS FO -- IF (sx(i2,-.GT. 0F #elif __DIM == == & & 'point status array GMM_STATE2D',__L! CH-8092 Zuf __DIM == == Secvid fr. icex direc! Di------- == == & & 'point status array GMM_STATE2D',__L! CH-8092 Zuf __DIM == == alpha(1)==-alpha(1)=--4.5_MKpIF #en #en #enbeta(1)=D beta(1)=+ si(i1,1,=--4.5_MK* si(i2,1,hESS FO -- -- IF (sx(i3,-.GT. 0F #elif __DIM == == == & & 'point status array GMM_STATE2D',__L! CH-809f __DIM == == == _ricrd fr. icenegs ovABx direc! Di------- == == == & & 'point status array GMM_STATE2D',__L! CH-809f __DIM == == == alpha(1)==-alpha(1)=--oneticrdf __DIM == == == beta(1)=D beta(1)+ si(i1,1,- si(i2,1,+oneticrd* si(i3,1,hESS FO -- -- END-Fh FnnnnEND-Fh FEND-Fh------RIF (_1-.LT. 0F #eli f __DIM == alpha(1)==--alpha(1)*dxinvpIF #en #enbeta(1)=D -beta(1)*dxinvpIF #enELSEf __DIM == alpha(1)==-alpha(1)*dxinvpIF #en #enbeta(1)=D beta(1)*dxinvpIF #enEND-Fh------R & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif Sw Y DIND T __SINGLEC & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endiUseAupwind mmrec! DiarallelIF (MABS(phi(-1j2-,-.LT. ABS(phi(0j2-,,-.OR. (psi(1,2,-.GT. hsave)F #elif __DIM == i1==--1------- == i2D -2------- == i3D -3SINGLECELSEf __DIM == i1==-1------- == i2D 2------- == i3D 3SINGLECEND-Fh FIF (sy(i1,-.GT. 0F #elif __DIM == & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichf __DIM == ifFirst fr. icey direc! Di------- == & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichf __DIM == alpha(2)==--1.0_MKpIF #en #enbeta(2)=D si(i1,2,hESS FO -- IF (sy(i2,-.GT. 0F #elif __DIM == == & & 'point status array GMM_STATE2D',__L! CH-8092 Zuf __DIM == == Secvid fr. icey direc! Di------- == == & & 'point status array GMM_STATE2D',__L! CH-8092 Zuf __DIM == == alpha(2)==-alpha(2)=--4.5_MKpIF #en #en #enbeta(2)=D beta(2)=+ si(i1,2,=--4.5_MK* si(i2,2,hESS FO -- -- IF (sy(i3,-.GT. 0F #elif __DIM == == == & & 'point status array GMM_STATE2D',__L! CH-809f __DIM == == == _ricrd fr. icey direc! Di------- == == == & & 'point status array GMM_STATE2D',__L! CH-809f __DIM == == == alpha(2)==-alpha(2)=--oneticrdf __DIM == == == beta(2)=D beta(2)+ si(i1,2,- si(i2,2,+oneticrd* si(i3,2,hESS FO -- -- END-Fh FnnnnEND-Fh FEND-Fh------RIF (_1-.LT. 0F #elif __DIM == alpha(2)==--alpha(2)*dyinvpIF #en #enbeta(2)=D -beta(2)*dyinvpIF #enELSEf __DIM == alpha(2)==-alpha(2)*dyinvpIF #en #enbeta(2)=D beta(2)*dyinvpIF #enEND-Fh-rocesssor IM 3Dp & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif Sw Z DIND T __SINGLEC & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endiUseAupwind mmrec! DiarallelIF (MABS(phi(-1j3-,-.LT. ABS(phi(0j3-,,-.OR. (psi(1,3,-.GT. hsave)F #elif __DIM == i1==--1------- == i2D -2------- == i3D -3SINGLECELSEf __DIM == i1==-1------- == i2D 2------- == i3D 3SINGLECEND-Fh FIF (sz(i1,-.GT. 0F #elif __DIM == & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichf __DIM == ifFirst fr. icez direc! Di------- == & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichf __DIM == alpha(3)==--1.0_MKpIF #en #enbeta(3)=D si(i1,3,hESS FO -- IF (sz(i2,-.GT. 0F #elif __DIM == == & & 'point status array GMM_STATE2D',__L! CH-8092 Zuf __DIM == == Secvid fr. icez direc! Di------- == == & & 'point status array GMM_STATE2D',__L! CH-8092 Zuf __DIM == == alpha(3)==-alpha(3)=--4.5_MKpIF #en #en #enbeta(3)=D beta(3)=+ si(i1,3,=--4.5_MK* si(i2,3,hESS FO -- -- IF (sz(i3,-.GT. 0F #elif __DIM == == == & & 'point status array GMM_STATE2D',__L! CH-809f __DIM == == == _ricrd fr. icez direc! Di------- == == == & & 'point status array GMM_STATE2D',__L! CH-809f __DIM == == == alpha(3)==-alpha(3)=--oneticrdf __DIM == == == beta(3)=D beta(3)+ si(i1,3,- si(i2,3,+oneticrd* si(i3,3,hESS FO -- -- END-Fh FnnnnEND-Fh FEND-Fh------RIF (_1-.LT. 0F #elif __DIM == alpha(3)==--alpha(3)*dzinvpIF #en #enbeta(3)=D -beta(3)*dzinvpIF #enELSEf __DIM == alpha(3)==-alpha(3)*dzinvpIF #en #enbeta(3)=D beta(3)*dzinvpIF #enEND-Fh #marchp & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifCompthepenergradialo U Generl dil|func! Di.un---p ght (edpIF #endifmm_ferences. h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enIF (fr. .EQ. pcenm_fr. _1F #elif __DIM ==nIF pABS(phi(-1j1-,.LT.hsave .AND. ABS(phi(1j1-,.LT.hsaveF #elif __DIM == == gphi(1- =C(hi(1j1--phi(-1j1-f __DIM == == gphi(1- =Cgphi(1-*dxihalfh FnnnnEND-Fh F ==nIF pABS(phi(-1j2-,.LT.hsave .AND. ABS(phi(1j2-,.LT.hsaveF #elif __DIM == == gphi(2- =C(hi(1j2--phi(-1j2,hESS FO -- -- gphi(2- =Cgphi(2-*dyihalfh FnnnnEND-Fh ocessor IM 3Dp ==nIF pABS(phi(-1j3-,.LT.hsave .AND. ABS(phi(1j3-,.LT.hsaveF #elif __DIM == == gphi(3- =C(hi(1j3--phi(-1j3,hESS FO -- -- gphi(3- =Cgphi(3-*dzihalfh FnnnnEND-Fh #march', ELSEIF (fr. .EQ. pcenm_fr. _2F #elif __DIM == IF pABS(phi(-1j1-,.LT.hsave .AND. ABS(phi(1j1-,.LT.hsaveF #elif __DIM == == gphi(1- =C(hi(1j1--phi(-1j1-f __DIM == == gphi(1- =Cgphi(1-*dxihalfh FnnnnEND-Fh F ==nIF pABS(phi(-1j2-,.LT.hsave .AND. ABS(phi(1j2-,.LT.hsaveF #elif __DIM == == gphi(2- =C(hi(1j2--phi(-1j2,hESS FO -- -- gphi(2- =Cgphi(2-*dyihalfh FnnnnEND-Fh ocessor IM 3Dp ==nIF pABS(phi(-1j3-,.LT.hsave .AND. ABS(phi(1j3-,.LT.hsaveF #elif __DIM == == gphi(3- =C(hi(1j3--phi(-1j3,hESS FO -- -- gphi(3- =Cgphi(3-*dzihalfh FnnnnEND-Fh #march', ELSEp ==nIF pABS(phi(-2j1-,.LT.hsave .AND. ABS(phi(-1j1-,.LT.hsave .AND. | info o ABS(phi(1j1-,.LT.hsave .AND. ABS(phi(2j1-,.LT.hsaveF #elif __DIM == == gphi(1- =C(hi(-2j1--8.0_MK*phi(-1j1-+8.0_MK*phi(1j1--phi(2,1,hESS FO -- -- gphi(1- =Cgphi(1-*dxitwelveh FnnnnEND-Fh F ==nIF pABS(phi(-2j2-,.LT.hsave .AND. ABS(phi(-1j2-,.LT.hsave .AND. | info o ABS(phi(1j2-,.LT.hsave .AND. ABS(phi(2j2-,.LT.hsaveF #elif __DIM == == gphi(2- =C(hi(-2j2--8.0_MK*phi(-1j2-+8.0_MK*phi(1j2--phi(2,2,hESS FO -- -- gphi(2- =Cgphi(2-*dyitwelveh FnnnnEND-Fh ocessor IM 3Dp ==nIF pABS(phi(-2j3-,.LT.hsave .AND. ABS(phi(-1j3-,.LT.hsave .AND. | info o ABS(phi(1j3-,.LT.hsave .AND. ABS(phi(2j3-,.LT.hsaveF #elif __DIM == == gphi(3- =C(hi(-2j3--8.0_MK*phi(-1j3-+8.0_MK*phi(1j3--phi(2,3,hESS FO -- -- gphi(3- =Cgphi(3-*dzitwelveh FnnnnEND-Fh #march', END-Fhp & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifCompthep efficients ANTen trline equs of ANT Public L n trvalue at (,jSTk-h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swp ocessor IM 3Dp IF (PRESENT(chi)F #elif __DIM == & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichf __DIM == ifIf weSE. Sea non-uni m BPM.,. thepenerJacobianf __DIM == & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichfr TM = ABS(co.gmm_jacobian.inc"p __DIM == & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichf __DIM == ifGradC(hi icephysiculdspacep __DIM == & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichf __DIM == gpp(1- =Cjac(1j1-*gphi(1- +Cjac(2j1-*gphi(2- +Cjac(3j1-*gphi(3,hESS FO -- gpp(2- =Cjac(1j2-*gphi(1- +Cjac(2j2-*gphi(2- +Cjac(3j2-*gphi(3,hESS FO -- gpp(3- =Cjac(1j3-*gphi(1- +Cjac(2j3-*gphi(2- +Cjac(3j3-*gphi(3,hESS FO -- & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichf __DIM == ifDe! . n trline equs of ANTGenerunknow nodthESS FO -- & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichf __DIM == ix**0!t f __DIM == efs(1- =CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC info o gpp(1-*(jac(1j1-*beta(1)+jac(2j1-*beta(2)+jac(3j1-*beta(3)- +C info o gpp(2-*(jac(1j2-*beta(1)+jac(2j2-*beta(2)+jac(3j2-*beta(3)- +C info o gpp(3-*(jac(1j3-*beta(1)+jac(2j3-*beta(2)+jac(3j3-*beta(3)-p ==nIF(PRESENT(speed)F #elif __DIM == efs(1- =C efs(1- -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCC info o 1.0_MK/(speed(,jSTkjS---)*speed(,jSTkjS---))hESS FO -- ELSEf __DIM == -- efs(1- =C efs(1- -Crhscsth FnnnnEND-Fhf __DIM == ix**1!t f __DIM == efs(3- =CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC info o gpp(1-*(jac(1j1-*alpha(1)+jac(2j1-*alpha(2)+jac(3j1-*alpha(3))+C info o gpp(2-*(jac(1j2-*alpha(1)+jac(2j2-*alpha(2)+jac(3j2-*alpha(3))+C info o gpp(3-*(jac(1j3-*alpha(1)+jac(2j3-*alpha(2)+jac(3j3-*alpha(3))h', ELSEp ==n & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichf __DIM == ifUni m BPM.hESS FO -- & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichf __DIM == ix**0!t f __DIM == efs(1- =C(beta(1)*gphi(1-)+(beta(2)*gphi(2-)+(beta(3-*gphi(3,-p ==nIF(PRESENT(speed)F #elif __DIM == efs(1- =C efs(1- -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCC info o 1.0_MK/(speed(,jSTkjS---)*speed(,jSTkjS---))hESS FO -- ELSEf __DIM == -- efs(1- =C efs(1- -Crhscsth FnnnnEND-Fhf __DIM == ix**1!t f __DIM == efs(3- =C(alpha(1)*gphi(1-)+(alpha(2)*gphi(2-)+(alpha(3)*gphi(3,-p END-Fh #march= IM 2Dp IF (PRESENT(chi)F #elif __DIM == & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichf __DIM == ifIf weSE. Sea non-uni m BPM.,. thepenerJacobianf __DIM == & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichfr TM = ABS(co.gmm_jacobian.inc"p __DIM == & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichf __DIM == ifGradC(hi icephysiculdspacep __DIM == & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichf __DIM == gpp(1- =Cjac(1j1-*gphi(1- +Cjac(2j1-*gphi(2-hESS FO -- gpp(2- =Cjac(1j2-*gphi(1- +Cjac(2j2-*gphi(2-hESS FO -- & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichf __DIM == ifDe! . n trline equs of ANTGenerunknow nodthESS FO -- & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichf __DIM == ix**0!t f __DIM == efs(1- =CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC info o gpp(1-*(jac(1j1-*beta(1)+jac(2j1-*beta(2)- +C info o gpp(2-*(jac(1j2-*beta(1)+jac(2j2-*beta(2)-p ==nIF(PRESENT(speed)F #elif __DIM == efs(1- =C efs(1- -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCC info o 1.0_MK/(speed(,jSTS---)*speed(,jSTS---))hESS FO -- ELSEf __DIM == -- efs(1- =C efs(1- -Crhscsth FnnnnEND-Fhf __DIM == ix**1!t f __DIM == efs(3- =CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC info o gpp(1-*(jac(1j1-*alpha(1)+jac(2j1-*alpha(2))+C info o gpp(2-*(jac(1j2-*alpha(1)+jac(2j2-*alpha(2))h', ELSEp ==n & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichf __DIM == ifUni m BPM.hESS FO -- & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichf __DIM == ix**0!t f __DIM == efs(1- =C(beta(1)*gphi(1-)+(beta(2)*gphi(2-)p ==nIF(PRESENT(speed)F #elif __DIM == efs(1- =C efs(1- -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCC info o 1.0_MK/(speed(,jSTS---)*speed(,jSTS---))hESS FO -- ELSEf __DIM == -- efs(1- =C efs(1- -Crhscsth FnnnnEND-Fhf __DIM == ix**1!t fIM == -- efs(3- =C(alpha(1)*gphi(1-)+(alpha(2)*gphi(2-)p END-Fh #march', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifSolv ANTGenerunknow nodtrvalueh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enIF pABS( efs(3-,-.GT. lmyepmF #elif __DIM == valijk = - efs(1-/ efs(3-h', ELSEp ==nvalijk = bigp END-Fhmlib ENnumerics-r1036/src/ ENugmm_extU d.f0000644000175000017500000006754511616214647017330 0uia omaromar', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifSubrwant t#en:CCCCCCCCCCCCCCCCCC ENugmm_extU dh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endiCopyright (c) 2010 CSE Lab (ttp:/. ), MOSAICfGroup (ttp:/. ), pIF #endifffffffffffffffffffCght ( ANTGFluid Dynamics (DTU-h', h', h', _rich), ch)paro U Genericense along with PPM. If not, TNESS FORpIF #endi PM ch), it software: you can ren 3 ribthepit.-nd/NTABoarc Generalpit.M). Genert s U GenerGNU Less GGeneens Por mc IfcensA h', L-s por mohedy efF it Software FoM).s of , ei er h', Leral Pub3 U GenerIfcensA, NTA(at your op of ).-ny later h', Leral PuTNESS FORpIF #endi PM ch)n 3 ribthed ic enerhope(at yoit optiobe usefulral Publi bth WITHOUT ANY WARRANTY; ! PPwan evec enerimpli d !arranty U al Publi MERCHANTABILITY NTAFITNESS FOR A PARTICULAR PURPOSE. Se. n tal Publi GNU Geneens Por mc IfcensA ANTABILITdetailsTNESS FORpIF #endiYou sPwaldSE. Sereceiv d a py U GenerGNU Geneens Por mc IfcensAh', L-nduenerGNU Less GGeneens Por mc IfcensA alcopy! PPp PM.fIf notral Publi se. TNESS FORpIF #endi cense along with PPM. If not, ! see . ! ! P', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swprocesssors CKOFF YESprocesssor IM 2DprocesssorTYPE FIELDprocesssors !---------------CISION ENugmm_extU d_2d_ksca_s(ivalue,f--- ,u--- ,tol,CC info o width,fr. -----,chi,MaxIter)- #marcch== __3D #if __KIND == __SINGLECISION ENugmm_extU d_2d_ksca_d(ivalue,f--- ,u--- ,tol,CC info o width,fr. -----,chi,MaxIter)- #gmm_ emarcch=TYPE VFIELDprocesssors !---------------CISION ENugmm_extU d_2d_kvec_s(ivalue,f--- ,u--- ,ld ,tol,C info o width,fr. -----,chi,MaxIter)- #marcch== __3D #if __KIND == __SINGLECISION ENugmm_extU d_2d_kvec_d(ivalue,f--- ,u--- ,ld ,tol,C info o width,fr. -----,chi,MaxIter)- #gmm_ egmm_ emarcch= IM 3DprocesssorTYPE FIELDprocesssors !---------------CISION ENugmm_extU d_3d_ksca_s(ivalue,f--- ,u--- ,tol,CCCC info o width,fr. -----,chi,MaxIter)- #marcch== __3D #if __KIND == __SINGLECISION ENugmm_extU d_3d_ksca_d(ivalue,f--- ,u--- ,tol,CCCC info o width,fr. -----,chi,MaxIter)- #gmm_ emarcch=TYPE VFIELDprocesssors !---------------CISION ENugmm_extU d_3d_kvec_s(ivalue,f--- ,u--- ,ld ,CCCC info o tol,width,fr. -----,chi,MaxIter)- #marcch== __3D #if __KIND == __SINGLECISION ENugmm_extU d_3d_kvec_d(ivalue,f--- ,u--- ,ld ,CCCC info o tol,width,fr. -----,chi,MaxIter)- #gmm_ egmm_ emarch #marcch== CKOFF NOprocesssor IM 2DprocesssorTYPE FIELDprocesssors !---------------CISION ENugmm_extU d_2d_tsca_s(ivalue,f--- ,u--- ,tol,CC info o width,fr. -----,chi,MaxIter)- #marcch== __3D #if __KIND == __SINGLECISION ENugmm_extU d_2d_tsca_d(ivalue,f--- ,u--- ,tol,CC info o width,fr. -----,chi,MaxIter)- #gmm_ emarcch=TYPE VFIELDprocesssors !---------------CISION ENugmm_extU d_2d_tvec_s(ivalue,f--- ,u--- ,ld ,tol,C info o width,fr. -----,chi,MaxIter)- #marcch== __3D #if __KIND == __SINGLECISION ENugmm_extU d_2d_tvec_d(ivalue,f--- ,u--- ,ld ,tol,C info o width,fr. -----,chi,MaxIter)- #gmm_ egmm_ emarcch= IM 3DprocesssorTYPE FIELDprocesssors !---------------CISION ENugmm_extU d_3d_tsca_s(ivalue,f--- ,u--- ,tol,CCCC info o width,fr. -----,chi,MaxIter)- #marcch== __3D #if __KIND == __SINGLECISION ENugmm_extU d_3d_tsca_d(ivalue,f--- ,u--- ,tol,CCCC info o width,fr. -----,chi,MaxIter)- #gmm_ emarcch=TYPE VFIELDprocesssors !---------------CISION ENugmm_extU d_3d_tvec_s(ivalue,f--- ,u--- ,ld ,CCCC info o tol,width,fr. -----,chi,MaxIter)- #marcch== __3D #if __KIND == __SINGLECISION ENugmm_extU d_3d_tvec_d(ivalue,f--- ,u--- ,ld ,CCCC info o tol,width,fr. -----,chi,MaxIter)- #gmm_ egmm_ emarch #march', ! _rich)rwant t#extU ds a func! Di.deft td oc eneriht (facefto enerwholeh', ! _b-nd onrwh Generl dil|func! Di.ch)neft td._rie extU L Pubch)noneh', ! _such at yoata_gradialo U Generfunc! Di.ch)perp#marc--arfto eneh', ! _gradialo U Generl dil|func! Di. ENugmm_iT-- mustobe cnse d BEFOREh', ! _tich)rwant t#ch) nvokeP.- Z & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swpnus#endif TM = sParallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Swpr TM = ABS(co.neft t.h"- Z & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swpnus#endifM !--es_h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enUS ENu !--e_--- !ModuUS ENu !--e_numerics_--- !ModuUS ENu !--e_--- ugmm !ModuUS ENu !--e_gmm_iT-- !ModuUS ENu !--e_gmm_cp- !ModuUS ENu !--e_gmm_march !ModuUS ENu !--e_gmm_ft --ize !ModuUS ENu !--e_----ong !ModuUS ENu !--e_----oop !ModuUS ENu !--e_ ENDIF US ENu !--e_ lloch', US ENu !--e_typenefpIF #enIMPLICIT NONEprocesssors !--------- |sors !---------_COMPLEXpIF #enINTEGER, PARAME---HDI-MKD kind_------- #msAh', INTEGER, PARAME---HDI-MKD kind_doubleh #march', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifA uotalosF #enP', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swprocessor IM 2Dprocessors CKOFF YESprocessors !---------------C-----FACEp ==nFUN T __ ivalue(x,y------------R ----Ms (1.0E0)),C----NT(IN)---R DI-x,y------R ----Ms (1.0E0)) DI-,valueh', INTEGER, ----NT(N ) DI-,---h FnnnnENDnFUN T __ ivaluep ENDC-----FACEp #march== __3D #if __KIND == __SINGLEC-----FACEp ==nFUN T __ ivalue(x,y------------R ----Ms (1.0D0)),C----NT(IN)---R DI-x,y------R ----Ms (1.0D0)) DI-,valueh', INTEGER, ----NT(N ) DI-,---h FnnnnENDnFUN T __ ivaluep ENDC-----FACEp #march #msAh', ----MK), ,C----NT(IN ) DI-,valueh', ! _A (F) sca-arfvalue neft ---p cutoff. Points loLerfto eneriht (faceh', ! _tian_tich)cutoff optiobe kept!to iT-----ize enermarch---._rie cp-#chh', ! _skipped ic ench)case.p #march ocessorTYPE FIELDp', ----MK),, IMEN= __(:,:,:) ,CPO-----H DI-u--- p #march=TYPE VFIELDp', ----MK),, IMEN= __(:,:,:,:) ,CPO-----H DI-u--- p INTEGER ,C----NT(IN ) DI-ld h', ! _Onlynpresalo ANTAvectNTeu--- . GivesGenerl ngth U Generl adi-- !Modu ! _dimU L PubU Gu--- . AtioeletalosFoptiobe equsllynextU deP.- #march', ----MK),, IMEN= __(:,:,:) ,CPO-----H DI-f--- !Modu!! _L dil|func! Di.--- . Needs be.deft td ic arnam_aw banP U al Publi! _specific width aroM). eneriht (face._rie zerorl dil|ch) nt (pret.PpIF #end! _t be.eneriht (face._Always a sca-arffield._rHIS NEEDS TO BEpIF #end! _PROPERLY ALLOCATED __ INPUT,C--CLUD GHOST LAYERS OF SIZEfor. .p', ----MK),, IMEN= __(:,:,:,:) ,C----NT(IN),OPTL(pALDI-chih', d! _rank 4 (2d)ffield_specify---pata_positevis U Geneh', ! _grid nodts. 1sto,-dax: 1..(co.Lim,Genen!,jST[k],i---. OPTL(pAL.h', ! _Uni m grid assotad f absalo. Ghostlayers U Gsize >=1 musth', ! _benpre-fise d.h #march= IM 3Dprocessors CKOFF YESprocessors !---------------C-----FACEp ==nFUN T __ ivalue(x,y-z------------R ----Ms (1.0E0)),C----NT(IN)---R DI-x,y,zf __DIM == == ----Ms (1.0E0)) DI-,valueh', INTEGER, ----NT(N ) DI-,---h FnnnnENDnFUN T __ ivaluep ENDC-----FACEp #march== __3D #if __KIND == __SINGLEC-----FACEp ==nFUN T __ ivalue(x,y-z------------R ----Ms (1.0D0)),C----NT(IN)---R DI-x,y,zf __DIM == == ----Ms (1.0D0)) DI-,valueh', INTEGER, ----NT(N ) DI-,---h FnnnnENDnFUN T __ ivaluep ENDC-----FACEp #march ! _Func! Di.pointerfto enerfunc! Di. th---pata_value U Generfunc! Dih ! _oc eneriht (face: (F) ivalue(x,y[,z])_rie func! Di.may assota at yh', ! _tie point (x,y[,z])_ oc eneriht (face.h #msAh', ----MK), ,C----NT(IN ) DI-,valueh', ! _A (F) sca-arfvalue neft ---p cutoff. Points loLerfto eneriht (faceh', ! _tian_tich)cutoff optiobe kept!to iT-----ize enermarch---._rie cp-#chh', ! _skipped ic ench)case.p #march ocessorTYPE FIELDp', ----MK),, IMEN= __(:,:,:,:) ,CPO-----H DI-u--- p ! _Field_U Generfunc! Di.t be.extU deP,.deft td ic enersata nam_awh', ! _b-nd asGenerl dil|func! Di. Values outside ench)b-nd arerset!toh', ! _HUGE._rich)has be.allocated properfsize TM . ghost layersh ! _o Gsize or. !fIf ,value arfunc! Di.pointer,-u--- optiobeh ! _ let.lynreplaced.fIf ,value arsca-ar,_tie points loLerftoh', ! _tie iht (faceftian_tich)sca-arfarerkept!uncianged.fCan_be.aAvectNTh ! _or a sca-arffield._If vectNT,-ld mustobe given.p #march=TYPE VFIELDp', ----MK),, IMEN= __(:,:,:,:,:) ,CPO-----H DI-u--- p ! _Field_U Generfunc! Di.t be.extU deP,.deft td ic enersata nam_awh', ! _b-nd asGenerl dil|func! Di. Values outside ench)b-nd arerset!toh', ! _HUGE._rich)has be.allocated properfsize TM . ghost layersh ! _o Gsize or. !fIf ,value arfunc! Di.pointer,-u--- optiobeh ! _ let.lynreplaced.fIf ,value arsca-ar,_tie points loLerftoh', ! _tie iht (faceftian_tich)sca-arfarerkept!uncianged.fCan_be.aAvectNTh ! _or a sca-arffield._If vectNT,-ld mustobe given.p INTEGER ,C----NT(IN ) DI-ld h', ! _Onlynpresalo ANTAvectNTeu--- . GivesGenerl ngth U Generl adi-- !Modu ! _dimU L PubU Gu--- . AtioeletalosFoptiobe equsllynextU deP.- #march', ----MK),, IMEN= __(:,:,:,:) ,CPO-----H DI-f--- !Modu!! _L dil|func! Di.--- . Needs be.deft td ic arnam_aw banP U al Publi! _specific width aroM). eneriht (face._rie zerorl dil|ch) nt (pret.PpIF #end! _t be.eneriht (face._Always a sca-arffield._rHIS NEEDS TO BEpIF #end! _PROPERLY ALLOCATED __ INPUT,C--CLUD GHOST LAYERS OF SIZEfor. .p', ----MK),, IMEN= __(:,:,:,:,:) ,C----NT(IN),OPTL(pALDI-chih', d! _rank 5 (3d)ffield_specify---pata_positevis U Geneh', ! _grid nodts. 1sto,-dax: 1..(co.Lim,Genen!,jST[k],i---. OPTL(pAL.h', ! _Uni m grid assotad f absalo. Ghostlayers U Gsize >=1 musth', ! _benpre-fise d.h #march', INTEGER ,C----NT(IN ) DI-or. h', ! _Desi(ed or. of enermethod._One U :h', ! h', ! _* pcenm_fr. _1h', ! _* pcenm_fr. _2h', ! _* pcenm_fr. _3p', ----MK), ,C----NT(IN ) DI-tolh', ! _Rels ovABtoleranc ANTGenerde! ed mmstancefto eneriht (face.h', ! _1E-3 argood Maoice._rie toleranc ch) n multiples grid spac---sp', ----MK), ,C----NT(IN ) DI-widthh', ! _Width of enernam_aw banP t be.productd oc each side of eneriht (face.h', INTEGER ,C----NT(L N ) DI-,---h F ! _Re _ status. 0 upo Lsuccessh', INTEGER , OPTL(pALe ,C----NT(IN ) DI-MaxIterh', ! _OPTL(pALea uotalo specify---pata_maximum numb of allow.PpIF #end! _iters of s._rich)can_be.useful sinc cyc mc dep#maency ic enepIF #end! _GMM algorithmh)cwaldScause ,--iT--e loops._Ic each iters of at l asth', ! _one point ch)compthe .- Z & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swpnus#endifLoculdvariab-es_h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enINTEGER DI-,---,npts,MaxItpIF #enINTEGER DI-,jSTkjppIF #enINTEGER DI-,opt,S---,id p INTEGER , IMEN= __(4, DI-ldl,ldup', ----MK), DI-t0,x,y-z-bigp LOGICALe DI-lokp', ----MK),, IMEN= __(:,:),CPO-----H DI-cloLestp', TYPE( t_topo)-||||||||CPO-----H DI-topop', TYPE( t_equi_BPM.)-||||PO-----H DI-BPM.h ocessorTYPE VFIELDprocessh= IM 2Dp ----MK),, IMEN= __(:,:,: ) PO-----HDI-ext_wrkh #march= IM 3Dp ----MK),, IMEN= __(:,:,:,:),CPO-----HDI-ext_wrkh #march #march', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif T-----isA h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #en---------oart-----ugmm_extU d----------- ! big =_HUGE(big-- ! topo => topo(gmm_topoid)%tp', BPM. => topo%bPM.(gmm_bPM.id)h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifSet.pointerParallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, Swpr cessors !---------------C loLest => gmm_cloL2p #march== __3D #if __KIND == __SINGLEC loLest => gmm_clod2p #march ocessorTYPE VFIELDprocessh= IM 2Dpr cessors !---------------Cext_wrk => ext_wrk_2 s- #march== __3D #if __KIND == __SINGLECext_wrk => ext_wrk_2 d emarch #march= IM 3Dprocessors !---------------Cext_wrk => ext_wrk_3 s- #march== __3D #if __KIND == __SINGLECext_wrk => ext_wrk_3 d emarch #march #march', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifCaeckea uotaloParallel Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, SwprallelIF p(co.nebug-.GT. 0F #elif __DIM == IF p.NOT. ENuiT-----izedF #elif __DIM == __2DD pm_al- ENDIF IF #en----- pm_al( pm__ noiT--,----ugmm_extU d--CC info o 'Pl ase cnse ENuiT--ffirst!',__LINE__------------RRRRRRRRRGOTO 9999h FnnnnEND-Fh F ==nIF ptol .LE. 0.0_MKF #elif __DIM == __2DD pm_al- ENDIF IF #en----- pm_al( pm__a uotalo,----ugmm_extU d--CC info o 'toleranc mustobe >0!',__LINE__------------RRRRRRRRRGOTO 9999h FnnnnEND-Fh F ==nIF pwidth .LE. 0.0_MKF #elif __DIM == __2DD pm_al- ENDIF IF #en----- pm_al( pm__a uotalo,----ugmm_extU d--CC info o 'width mustobe >0!',__LINE__------------RRRRRRRRRGOTO 9999h FnnnnEND-Fh ocessorTYPE VFIELDp F ==nIF pld .LT. 1F #elif __DIM ==n __2DD pm_al- ENDIF IF #en----- pm_al( pm__a uotalo,----ugmm_extU d--CC info o 'ld mustobe >=1 ANTAvectNTe--- ',__LINE__------------RRRRRRRRRGOTO 9999h FnnnnEND-Fh #march', END-F Fnnnn! (co.nebug-ANTAa uotalo Maeck processors CKOFF YESp Fnnnn!Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, SwpralleldifCloLest point trans m f A--- !Modu!Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, SwprallelIF (PRESENT(chi)F #elif __DIM == ----- gmm_cp-(f--- ,tol,npts,iptstmp2, loLest-----,chi-h', ELSEp ==n----- gmm_cp-(f--- ,tol,npts,iptstmp2, loLest-----)p END-FhrallelIF (__2DD.NE. pcenm_successF #elif __DIM == i_2DD pm_al- ENDIF IF----- pm_al( pm__---_failed,----ugmm_extU d--CC info o 'CloLest point trans m failed.',__LINE__------------RRRRRGOTO 9999h FEND-Fhrallel & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifAllocate-u--- p & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swpdiffff,optD pcenm_alloc_fitpdiffffldl(1- =C1 - ghostsize(1-pdiffffldl(2- =C1 - ghostsize(2-pdiffffldl(3- =C1 - ghostsize(3-pdiffffldl(4- =C1pdiffffldu(1- =Cmaxxhi + ghostsize(1-pdiffffldu(2- =Cmaxyhi + ghostsize(2-pdiffffldu(3- =Cmaxzhi + ghostsize(3-pdiffffldu(4- =Ctopo%nsor motpdiffff----- alloc(u--- ,ldl,ldu,,opt,------!allelIF (__2DD.NE. pcenm_successF #elifdiffffffffi_2DD pm_al-f-- lfdiffffffff----- pm_al( pm__alloc,----ugmm_extU d--CC inffdiffffo o 'func! Di.--- UDATA',__LINE__-------diffffffffGOTO 9999h! FEND-Fhrallelu--- =_HUGE(x)h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifAssigc each point tta_value U Gits loLest point oc enepIF #end riht (face.h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swp ocessor IM 3Dp DO p=1,nptsf __DIM == i =_iptstmp2(1,p-------RRRRRj =_iptstmp2(2,p-------RRRRRk =_iptstmp2(3,p-------RRRRR,--- =_iptstmp2(4,p-------RRRRRx =C loLest(1,p-------RRRRRy =C loLest(2,p-------RRRRRz =C loLest(3,p-- ocessorTYPE FIELDp', llelu--- (,jSTkj,---- =Civalue(x,y-z------- #march=TYPE VFIELDp', llelu--- (1,,jSTkj,---- =Civalue(x,y-z-------', llelDO ida=2,ld h', llelu--- (,da,,jSTkj,---- =Cu--- (1,,jSTkj,----h FnnnnENDDOh #march', ENDDOh #march= IM 2Dp DO p=1,nptsf __DIM == i =_iptstmp2(1,p-------RRRRRj =_iptstmp2(2,p-------RRRRR,--- =_iptstmp2(3,p-------RRRRRx =C loLest(1,p-------RRRRRy =C loLest(2,p-- ocessorTYPE FIELDp', llelu--- (,jST,---- =Civalue(x,y------- #march=TYPE VFIELDp', llelu--- (1,,jST,---- =Civalue(x,y-------', llelDO ida=2,ld h', llelu--- (,da,,jST,---- =Cu--- (1,,jST,----h FnnnnENDDOh #march', ENDDOh #march', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifDeallocateh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #en,optD pcenm_de lloch', ----- alloc( loLest-ldu,,opt,------', IF (__2DD.NE. pcenm_successF #elif __DIM == i_2DD pm_al- ENDIF IF----- pm_al( pm__de lloc,----ugmm_extU d--CC inffC infDIF IF' loLest points locatevis CLOSEST',__LINE__------------REND-Fh ocessors !---------------CNULLIFY(gmm_cloL2)- #march== __3D #if __KIND == __SINGLECNULLIFY(gmm_clod2)h #march', ----- alloc(iptstmp2,ldu,,opt,------', IF (__2DD.NE. pcenm_successF #elif __DIM == i_2DD pm_al- ENDIF IF----- pm_al( pm__de lloc,----ugmm_extU d--CC inffC infDIF IF' loLe BPM. points IPTS',__LINE__------------REND-Fh #march== CKOFF NOp', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifAdd ghost layers t field_arcneede P', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swpdiffff,optD pcenm_alloc_grow_presarvepdiffffldl(1- =C1 - ghostsize(1-pdiffffldl(2- =C1 - ghostsize(2-pdiffffldl(3- =C1 - ghostsize(3-pdiffffldl(4- =C1pdiffffldu(1- =Cmaxxhi + ghostsize(1-pdiffffldu(2- =Cmaxyhi + ghostsize(2-pdiffffldu(3- =Cmaxzhi + ghostsize(3-pdiffffldu(4- =Ctopo%nsor motpdiffff----- alloc(u--- ,ldu,,opt,------!allelIF (__2DD.NE. pcenm_successF #elifdiffffffffi_2DD pm_al-f-- lfdiffffffff----- pm_al( pm__alloc,----ugmm_extU d--CC inffdiffffo o 'func! Di.--- UDATA',__LINE__-------diffffffffGOTO 9999h! FEND-Fhrallel & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifNuke points far er from_tie iht (faceftian_,valueh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swp ocessor IM 3Dp DO ,---=1,topo%nsor motpENDIF IFj--- =_topo%isor mot(,----h FnnnnDO k=1,BPM.%nnodts(3,j----h FnnnnnnnnDO j=1,BPM.%nnodts(2,j----h Fnnnnnnnn DO ,=1,BPM.%nnodts(1,j----h Fnnnnnnnn llelIF (ABS(f--- (,jSTkj,----,-.GT. ,valueF #elif ocessorTYPE VFIELDp F ==n Fnnnnnnnn DO ,da=1,ld h', llelllllllllllllllllu--- (,da,,jSTkj,---- =Cbigp ENDDOh #march=TYPE FIELDp', llelllllllllllllllllu--- (,jSTkj,---- =Cbigp #march', END-Fh F ==n ENDDOh F ==n ENDDOh F ==n ENDDOh F ==nENDDOh #march= IM 2Dp DO ,---=1,topo%nsor motpENDIF IFj--- =_topo%isor mot(,----h FnnnnDO j=1,BPM.%nnodts(2,j----h FnnnnnnnnDO ,=1,BPM.%nnodts(1,j----h Fnnnnnnnn IF (ABS(f--- (,jST,----,-.GT. ,valueF #elif ocessorTYPE VFIELDp F ==n FnnnnnnnnDO ,da=1,ld h', llelllllllllllllu--- (,da,,jST,---- =Cbigp ENDDOh #march=TYPE FIELDp', llelllllllllllllu--- (,jST,---- =Cbigp #march', END-Fh F ==n ENDDOh F ==n ENDDOh F ==nENDDOh #march #march', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifCaeckeata_maximum numb of allow.P_iters of s !Modu!Particle Mesh Library (PPM) ! ETH Zurich ! CH-8092 Zurich, SwprallelIF (PRESENT(MaxIter)F #elif __DIM == MaxIt =CMaxIterh', ELSEp ==nMaxIt =CHUGE(MaxIt)p END-FhrallelZ & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swpnus#endifMarch----u--- p & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swp ocessorTYPE VFIELDp F & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifAllocate-workea rayp F & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #en,optD pcenm_alloc_fitpIF #enldl(1- =CLBOUND(u--- ,2-hESS FOldl(2- =CLBOUND(u--- ,3)p ocessor IM 3Dp ldl(3- =CLBOUND(u--- ,4)h #march', ldl(4- =C1p', ldu(1- =CUBOUND(u--- ,2-hESS FOldu(2- =CUBOUND(u--- ,3)p ocessor IM 3Dp ldu(3- =CUBOUND(u--- ,4)h #march', ldu(4- =Ctopo%nsor motp', ----- alloc(ext_wrk,ldl,ldu,,opt,------rallelIF (__2DD.NE. pcenm_successF #elif __DIM == i_2DD pm_al-f-- lf __DIM == ----- pm_al( pm__alloc,----ugmm_extU d--CC inffC inf_DIM == 'workememory EXT_WRK',__LINE__------------RRRRRGOTO 9999h FEND-Fhrallel & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifDo each vectNTe-imU L Pubsepcent.lynun---penerworkememoryhrallel & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enDO ,da=1,ld h ocessor IM 3Dp ==nDO ,---=1,ldu(4-h FnnnnnnnnDO k=ldl(3-,ldu(3-h Fnnnnnnnn DO j=ldl(2-,ldu(2-p F ==n FnnnnnnnnDO ,=ldl(1-,ldu(1-h', llelllllllllllllext_wrk(,jSTkj,---- =Cu--- (,da,,jSTkj,----p ENDDOh ENDDOh ENDDOh F ==n ENDDOh #march= IM 2Dp nnnnDO ,---=1,ldu(4-h FnnnnnnnnDO j=ldl(2-,ldu(2-p F ==n FnnnnDO ,=ldl(1-,ldu(1-h', llelllllllllext_wrk(,jST,---- =Cu--- (,da,,jST,----p ENDDOh ENDDOh F ==n ENDDOh #march', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichf __DIM == ifMarch !Modu & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichf __DIM == IF (PRESENT(chi)F #elif __DIM == ----- gmm_march(width,fr. -f--- ,0.0_MK,MaxIt-----, info o u--- =ext_wrk,chi=chi-h', ELSEf __DIM == -- ----- gmm_march(width,fr. -f--- ,0.0_MK,MaxIt-----, info o u--- =ext_wrk-h FnnnnEND-Fh F ==nIF p__2DD.NE. pcenm_successF #elif __DIM == __2DD pm_al- ENDIF IF #en----- pm_al( pm__---_failed,----ugmm_extU d--CC info o 'March----GMM failed.',__LINE__------------RRRRRRRRRGOTO 9999h FnnnnEND-Fhh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichf __DIM == ifrie ghostsize might E. Secianged ic enermarch---, dep#ma----Di------- == L n tror. of enermarch----algorithm.h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichf __DIM == ldl(1- =CMAX(ldl(1-,LBOUND(ext_wrk,1))hESS FO -- ldl(2- =CMAX(ldl(2-,LBOUND(ext_wrk,2-)p ocessor IM 3Dp ==nldl(3- =CMAX(ldl(3-,LBOUND(ext_wrk,3,-p #march', ldu(1- =CMIN(ldu(1-,UBOUND(ext_wrk,1))hESS FO -- ldu(2- =CMIN(ldu(2-,UBOUND(ext_wrk,2-)p ocessor IM 3Dp ==nldu(3- =CMIN(ldu(3-,UBOUND(ext_wrk,3,-p #march', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichf __DIM == ifCopy resulth)b-ckh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichf ocessor IM 3Dp ==nDO ,---=1,ldu(4-h FnnnnnnnnDO k=ldl(3-,ldu(3-h Fnnnnnnnn DO j=ldl(2-,ldu(2-p F ==n FnnnnnnnnDO ,=ldl(1-,ldu(1-h', llelllllllllllllu--- (,da,,jSTkj,---- =Cext_wrk(,jSTkj,----p ENDDOh ENDDOh ENDDOh F ==n ENDDOh #march= IM 2Dp nnnnDO ,---=1,ldu(4-h FnnnnnnnnDO j=ldl(2-,ldu(2-p F ==n FnnnnDO ,=ldl(1-,ldu(1-h', llelllllllllu--- (,da,,jST,---- =Cext_wrk(,jST,----p ENDDOh ENDDOh F ==n ENDDOh #march', ENDDO ! id p & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifF it workememoryhrallel & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #en,optD pcenm_de lloch', ----- alloc(ext_wrk,ldl,ldu,,opt,------rallelIF (__2DD.NE. pcenm_successF #elif __DIM == i_2DD pm_al- ENDIF IF----- pm_al( pm__de lloc,----ugmm_extU d--CC inffC infDIF IF'workememory EXT_WRK',__LINE__------------REND-Fh ocessorTYPE VFIELDprocessh= IM 2Dpr cessors !---------------CNULLIFY(ext_wrk_2 s)- #march== __3D #if __KIND == __SINGLECNULLIFY(ext_wrk_2 d) emarch #march= IM 3Dprocessors !---------------CNULLIFY(ext_wrk_3 s)- #march== __3D #if __KIND == __SINGLECNULLIFY(ext_wrk_3 d) emarch #march #march #march=TYPE FIELDp', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifDo sca-arfmarch----directlyhrallel & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enIF (PRESENT(chi)F #elif __DIM == ----- gmm_march(width,fr. -f--- ,0.0_MK,MaxIt-----, nffC infDIF IFu--- =u--- ,chi=chi-h', ELSEp ==n----- gmm_march(width,fr. -f--- ,0.0_MK,MaxIt-----,u--- =u--- )p END-FhrallelIF (__2DD.NE. pcenm_successF #elif __DIM == i_2DD pm_al- ENDIF IF----- pm_al( pm__---_failed,----ugmm_extU d--CC info o 'March----GMM failed.',__LINE__------------RRRRRGOTO 9999h FEND-Fh #march', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifRe _ h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpI9999 CONTINUEh', ---------oop-----ugmm_extU d----------- ! RETURif ocesssors CKOFF YESprocesssh= IM 2Dpr cessch=TYPE FIELDprocesssors !---------------CENDCISION ENugmm_extU d_2d_ksca_s- #marcch== __3D #if __KIND == __SINGLECENDCISION ENugmm_extU d_2d_ksca_d emarc emarcch=TYPE VFIELDprocesssors !---------------CENDCISION ENugmm_extU d_2d_kvec_s- #marcch== __3D #if __KIND == __SINGLECENDCISION ENugmm_extU d_2d_kvec_d- #gmm_ egmm_ emarcch= IM 3DprocesssorTYPE FIELDprocesssors !---------------CENDCISION ENugmm_extU d_3d_ksca_s- #marcch== __3D #if __KIND == __SINGLECENDCISION ENugmm_extU d_3d_ksca_d emarc emarcch=TYPE VFIELDprocesssors !---------------CENDCISION ENugmm_extU d_3d_kvec_s- #marcch== __3D #if __KIND == __SINGLECENDCISION ENugmm_extU d_3d_kvec_d- #gmm_ egmm_ emarch #marcch== CKOFF NOprocesssor IM 2DprocesssorTYPE FIELDprocesssors !---------------CENDCISION ENugmm_extU d_2d_tsca_s- #marcch== __3D #if __KIND == __SINGLECENDCISION ENugmm_extU d_2d_tsca_d emarc emarcch=TYPE VFIELDprocesssors !---------------CENDCISION ENugmm_extU d_2d_tvec_s- #marcch== __3D #if __KIND == __SINGLECENDCISION ENugmm_extU d_2d_tvec_d- #gmm_ egmm_ emarcch= IM 3DprocesssorTYPE FIELDprocesssors !---------------CENDCISION ENugmm_extU d_3d_tsca_s- #marcch== __3D #if __KIND == __SINGLECENDCISION ENugmm_extU d_3d_tsca_d emarc emarcch=TYPE VFIELDprocesssors !---------------CENDCISION ENugmm_extU d_3d_tvec_s- #marcch== __3D #if __KIND == __SINGLECENDCISION ENugmm_extU d_3d_tvec_d- #gmm_ egmm_ emarch #marchlib ENnumerics-r1036/src/ ENuhamjac_reiT--_2d.f0000644000175000017500000001573711616214647020357 0uia omaromar', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif ifSubrwant t#en:CCCCCCCCCCCCCCCCC ENuhamjac_reiT--_2dh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif pIF #endiffffPurpoLe :fSolv Hamilton-Jacobi-ANTAGowas reiT--pIF #endiffff pIF #endiffffInputCCCCCCCC: pIF #endifffffffffffffffffffpIF #endiffffInput/OutputC: pIF #endifffffffffffffffffffpIF #endiffffOutputCCCCCCC: pIF #endifffffpIF #endiffffRemarksCCCCCC: pIF #endifffffffffffffffffffpIF #endiffffpIF #endiffffReferencesCCC:pIF #endiffffpIF #endiffffRevisevis CCC:pIF #end & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif $Log:C ENuhamjac_reiT--_2d.f,v $pIF #endiffffRevisevi 1.1.1.1 2006/07/25 15:18:19 BPnahelpIF #endiffffiT-----rimpog !Modu!pIF #endiffffRevisevi 1.1 2005/07/25 00:34:02ffivospIF #endiffffIn-----rMaeck-iuTNESS FORpIF #end & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif cense along with PPM. If not, ! see . ! ! P', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swp processorMODE CAprocessors !---------------CISION ENuhamjac_reiT--_2ds (phi, trgt, tol,_maxstep,C innnnnnnfo o topo_id, BPM._id, ghostsize, ------ #march== __3D #if __KIND == __SINGLECISION ENuhamjac_reiT--_2dd (phi, trgt, tol,_maxstep,C innnnnnnfo o topo_id, BPM._id, ghostsize, ------ #march #march=MODE VECh #m_al VECTOR NOTnIMPLEMENTED - #march innnnUS ENu !--e_--- !ModuffpIF #enduUS ENu !--e_ ENDIF duUS ENu !--e_write ENDIF duUS ENu !--e_----ong !ModuF US ENu !--e_ lloch', duUS ENu !--e_----oop !ModuduUS ENu !--e_map !ModuduUS ENu !--e_map_field_ghost !ModuduUS ENu !--e_typenefpIF #enenIMPLICIT NONEpprocesssors !---------------CenINTEGER, PARAME---HDI-MKD kind_------- #marcch== __3D #if __KIND == __!ModuffpIF #enduINTEGER, PARAME---HDI-MKD kind_doubleh #marchpIF #endu & & 'point status array GMM_STATE2D',__LpIF #endu ifA uotalospIF #endu & & 'point status array GMM_STATE2D',__LpIF #endu----MK),, IMEN= __(:,:,: ) PO-----HDI-phih', INTEGER, ----NT(in, DI-topo_id, BPM._idh', INTEGER, IMEN= __(2), ----NT(in, DI-ghostsizeh', INTEGER, ----NT(inwan, DI-,---h FnnINTEGER, ----NT(in, DI-maxsteppIF #endu----Mmk), ----NT(in, DI-tol, trgthpIF #endu & & 'point status array GMM_STATE2D',__LpIF #endu ifAliasespIF #endu & & 'point status array GMM_STATE2D',__LpIF #enduINTEGER, IMEN= __(:),CPO-----H DI-,--- motpENDIF ----Mmk), IMEN= __(:,:,: ) PO-----HDI-tphih', INTEGER DI-nsor motpENDIF INTEGER, IMEN= __(:,:),CPO-----H DI-n--- !ModuffINTEGER DI-topoid,bPM.idpIF #endu----MK),, IMEN= __(:),CPO-----H DI-min_phys,_max_physpIF #enduTYPE( t_topo)-||||||PO-----H DI-topop', TYPE( t_equi_BPM.)-|PO-----H DI-BPM.hH pIF #endu & & 'point status array GMM_STATE2D',__LpIF #endu ifstandardfstuffpIF #endu & & 'point status array GMM_STATE2D',__LpIF #enduINTEGER DI-,---,,--- ,,jSTkjmaptype,,-tep,,optpIF #enduINTEGER DI-ldl(3-,nldu(3-,-n--- _max(2-p F =----Mmk) DI-len_phys(2-p F =----Mmk) DI-t0, resp F =CHARAC---(len=256) DI-BsghpIF #endu---------oart-----uhamjac_reiT--_2d----------- ! pIF #endu & & 'point status array GMM_STATE2D',__LpIF #endu ifGet enermeM. --- !Moduff & & 'point status array GMM_STATE2D',__LpIF #endutopo => topo(topo_id)%tp', BPM. => topo%bPM.(BPM._id)p', BPM.id =CmPM.%IDp nnnsor mot =Ctopo%nsor motp', -n--- -=> BPM.%nnodtsp', -isor mot =>_topo%isor motprocesssors !---------------Cenmin_phys => topo%bin_physsp', -max_phys => topo%bax_physs- #marcch== __3D #if __KIND == __ ! pIF #endumin_phys => topo%bin_physdp', -max_phys => topo%bax_physdh #marchpIF #endu & & 'point status array GMM_STATE2D',__LpIF #endu ifRATL(pALE Thu May 26 20:51:19 PDT 2005:pIF #endu ifloop-ghostmap doit. easy.pIF #endu & & 'point status array GMM_STATE2D',__LphpIF #endu & & 'point status array GMM_STATE2D',__LpIF #endu ifallocate tempogot, -ooragepIF #endu & & 'point status array GMM_STATE2D',__LpIF #enduldl(1:2- =C1 - ghostsize(1:2-;fldl(3- =C1p', -n--- _max(1- =CMAXV--Mn--- (1,1:nsor mot))hESS FO -n--- _max(2- =CMAXV--Mn--- (2,1:nsor mot))hESS FO -ldu(1- -=-n--- _max(1- + ghostsize(1-pESS FO -ldu(2- -=-n--- _max(2) + ghostsize(2-pESS FO -ldu(3- -=-nsor motp', -,optD -= pcenm_alloc_fitpIF #en ----- alloc(tphi,ldl,ldu,,opt,------rallelelIF(__2D.NE.0F #elif __DIM == i_2DD pm_al-f-- lf __DIM == ----- pm_al( pm__alloc,----uhamjac_reiT--_2d--C innnnnnnnnnnnfo o 'temp -oorage-ANTAhamjac',__LINE__------------RRRRRRGOTO 9999h FnnENDC-FphpIF #endu & COMMENT Thu May 26 21:05:23 PDT 2005:ifsi le e--eTAhere, do TVDp nnDO ,-tep=1,BaxsteppIF #endundu & map ata_gowasf __DIM == ----- map_field_ghost_get(topo_id,BPM._id,ghostsize,-----------RRRRRR----- map_field_puM.(topo_id,BPM._id,phi,-----------RRRRRR----- map_field_s#ma(-----------RRRRRR----- map_field_pop(topo_id,BPM._id,phi,ghostsize,-----------RRRRRR------RRRRRR----- hamjac_reiT--_step(phi,tphi,trgt,res,topo_id,BPM._id innnnnnnnnnnnf, innnnnnnnnnnn ghostsize,-----------RRRRRRDO ,---=1,nsor motpENDIF IFFFFFisor =Cisor mot(,----h FnnnnRRRRDO j=1,n--- (2,isor );DO ,=1,n--- (1,isor ) innnnnnnnnnnn-phi(,jST,---- =Ctphi(,jST,---- innnnnnnnnnENDCDO;nENDCDO innnnnnnnnnENDCDO innnnnnnnnnWRITE(Bsg,*) 'iters of #',,-tep,' res=',resp F = elIF(MOD(,-tep,10).EQ.0F ----- write( Rank,----uhamjac',Bsg,-----------RRRRRR------RRRRRRIF(res.LT.tol)RGOTO 666h FnnENDCDO p', -,_2DD pm_al-warni-- !Modu ----- pm_al( pm__converge,----uhamjac_reiT--_2d--C innnnnnnnnfo o 'failed t reach oarget residual',__LINE__------- 666odu -ONTINUEhp', -,optD pcenm_de lloch', ----- alloc(tphi,ldl,ldu,,opt,------rallelelIF(__2D.NE.0F #elif __DIM == i_2DD pm_al- ENDIF IF ----- pm_al( pm__de lloc,----uhamjac_reiT--_2d--C innnnnnnnnnnnfo o 'temp -oorage-ANTAhamjac not freed',__LINE__------------RRRRRRGOTO 9999h FnnENDC-Fphp9999 u -ONTINUEhIF IF ---------oop-----uhamjac_reiT--_2d-----------processors !---------------CENDCISION ENuhamjac_reiT--_2ds - #march== __3D #if __KIND == __SINGLECENDCISION ENuhamjac_reiT--_2dd - #march - ! pIF #endu p- ! pIF #endu hlib ENnumerics-r1036/src/ ENufdsolv r_ft --ize.f0000644000175000017500000001442411616214647020672 0uia omaromar #endu & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifSubrwant t#en:CCCCCCCCCCCCCCCC ENufdsolv r_ft --izepIF #end & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endpIF #endifPurpoLe :f ! see TNESS FORpIF #endfPcense along with PPM. If not, ! see . ! ! PpIF #end & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enISION ENufdsolv r_ft --ize(-----------R & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif Tcludtsp', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swp oTcludt " ENudeft t.h"------R & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifM !--esp', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwppIF #endUS ENu !--e_----ong !ModuFUS ENu !--e_----oop !ModudUS ENu !--e_write ENDIF dUS ENu !--e_ ENDIF dUS ENu !--e_ lloch', dUS ENu !--e_--- ufieldsolv r h - ! IMPLICIT NONEp-----R & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifFFTW oTcludtp', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swp ofdefssorFFTW- ! I-CLUDE "fftw3.f"h #march', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifA uotalosF #enh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enINTEGER ,C----NT(L N ) DI-,---h F & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifLoculdVariab-esh F & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #en----M kind_double) DI-t0pIF #enINTEGER, IMEN= __(3) DI-ld h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif T-----isAh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #en---------oart-----ufdsolv r_ft --ize----------- ! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifDeallocate PPmoryhrallel & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swp ofdefsorFFTW- ! ------fftw_dtstroy_plan(Planufd_s)- ! ------fftw_dtstroy_plan(Planufd_c_y)- ! ------fftw_dtstroy_plan(Planufd_c_z)- ! ------fftw_dtstroy_plan(Planubd_s)- ! ------fftw_dtstroy_plan(Planubd_c_y)- ! ------fftw_dtstroy_plan(Planubd_c_z)- ! ------fftw_dtstroy_plan(Planuslabufd_s)- ! ------fftw_dtstroy_plan(Planuslabubd_s)- ! -----dfftw_dtstroy_plan(Planufd_d)- ! -----dfftw_dtstroy_plan(Planufd_cc_y)- ! -----dfftw_dtstroy_plan(Planufd_cc_z)- ! -----dfftw_dtstroy_plan(Planubd_d)- ! -----dfftw_dtstroy_plan(Planubd_cc_y)- ! -----dfftw_dtstroy_plan(Planubd_cc_z)- ! -----dfftw_dtstroy_plan(Planuslabufd_d)- ! -----dfftw_dtstroy_plan(Planuslabubd_d) emarchp ofdefsorMATHKEISA_SINGLEC,optD pcenm_de lloch- ! ----- alloc(tab-eufd_s,ld ,,opt,------rallel----- alloc(tab-eufd_d,ld ,,opt,------rallel----- alloc(tab-eufd_c_y,ld ,,opt,------rallel----- alloc(tab-eufd_cc_y,ld ,,opt,------rallel----- alloc(tab-eufd_c_z,ld ,,opt,------rallel----- alloc(tab-eufd_cc_z,ld ,,opt,------rallel----- alloc(tab-eubd_s,ld ,,opt,------rallel----- alloc(tab-eubd_d,ld ,,opt,------rallel----- alloc(tab-eubd_c_y,ld ,,opt,------rallel----- alloc(tab-eubd_cc_y,ld ,,opt,------rallel----- alloc(tab-eubd_c_z,ld ,,opt,------rallel----- alloc(tab-eubd_cc_z,ld ,,opt,------pIF #enIF (__2DD.NE. 0F #elif __DIM == WRITE(Besg,'(A)') 'cwaldSnot deallocate memory'f __DIM == i_2DD pm_al- ENDIF IF----- pm_al( pm__de lloc,----ufdsolv r_ft --ize--Besg,__LINE__- info o -----------RRRRRGOTO 9999h FEND-Fh #march'9999 CONTINUEh', ---------oop-----ufdsolv r_ft --ize----------- ! RETURifh FENDnISION ENufdsolv r_ft --izehlib ENnumerics-r1036/src/ ENu !--e_gmm.f0000644000175000017500000000345711616214647017316 0uia omaromar F & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifM !--e--RRRRR:CCCCCCCCCCCCCCCCC ENu !--e_gmm- ! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endpIF #endifPurpoLe :frich) !--e contains-all user-cnseab-e rwant tspIF #endiffffffffffffffffneede fal ata_grwap march----metho .- ZffffffffffffffffpIF #endffRemarksCCCCCC:NESS FORpIF #endffReferencesCCC:pIF #endpIF #endffRevisevis CCC:pIF #end & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif$Log:C ENu !--e_gmm.f,v $pIF #endifRevisevi 1.1.1.1 2007/07/13 10:18:58ffivospIF #endifCBL v rL PubU Gata_PPM lf not,pIF #endpIF #endffRevisevi 1.3 2005/03/12 04:08:36ffivospIF #endifMisc bug-AixesTNESS FORpIF #endffRevisevi 1.2 2005/03/11 04:17:59 uivospIF #endifAdde ENugmm_extU d a). ENugmm_reiT-----izeTNESS FORpIF #endffRevisevi 1.1 2005/03/10 01:37:16ffivospIF #endifIn-----rMaeck-iuT BEWARE: Not ttsted ic pcense alyetdpIF #endpIF #end & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifPeense along with PPM. If not, ! see . ! ! P', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swp ', MODULEC ENu !--e_gmm-------RRRR & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,------RRRR _PPM m !--esp', RRR & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,------RRRRUS ENu !--e_gmm_iT--pIF #enRRRUS ENu !--e_gmm_kickoffpIF #enduRUS ENu !--e_gmm_march !Modu US ENu !--e_gmm_cp-pIF #enRRRUS ENu !--e_gmm_reiT-----izepIF #enRRRUS ENu !--e_gmm_extU dpIF #enRRRUS ENu !--e_gmm_ft --izepIF #en ffpIF #enENDnMODULEC ENu !--e_gmm-lib ENnumerics-r1036/src/ ENufmm_expciange.f0000644000175000017500000005530511616214647017771 0uia omaromarIF #end & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifSubrwant t#en:CCCCCCCCCCCCCCC ENufmm_expciange- ! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endpIF #endifPurpoLe :frich)rwant t#exciangeh)ata_expa L Pubcoefffcents,pIF #endfffffffffffffffffata_radius a). enercenterofboxesCbetween all processortspIF #endiffffffffffffffffby all to all communicatevin ffpIF #enZffffffffffffffffpIF #end ! see TNESS FORpIF #endfPcense along with PPM. If not, ! see . ! ! PpIF #end & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swprocess(ors !--------- &&ch= IM FIELD ! see ISION ENufmm_expciange_s_sf(prec,------ #marc(h== __3D #if __KIND == __ &&ch= IM FIELD ! see ISION ENufmm_expciange_d_sf(prec,------ #marc(h== __3D #if !--------- &&ch= IM VFIELD ! see ISION ENufmm_expciange_s_vf(ld ,prec,------ #marc(h== __3D #if __KIND == __ &&ch= IM VFIELD ! see ISION ENufmm_expciange_d_vf(ld ,prec,------ #march', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifM !--esnh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enUS ENu !--e_--- !ModuUS ENu !--e_--- ufmm- ! US ENu !--e_typenefpIF #enUS ENu !--e_----ong !ModuUS ENu !--e_----oop !ModuUS ENu !--e_ ENDIF US ENu !--e_ lloch', IMPLICIT NONEp-----R & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif Tcludtsp', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swp oTcludt " ENudeft t.h"- ofdefsorMPIh', I-CLUDE 'mpif.h'- #march', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifPrecisevipIF #end & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Sw processsors !---------------CINTEGER, PARAME---HDI-MKD kind_------- #msAh', INTEGER, PARAME---HDI-MKD kind_doubleh #march', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifA uotalosF #enh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swprocessh= IM VFIELDp FINTEGER ,C----NT(I_ !) DI-ld h egmm_ F #enh', ----MK), ,C----NT(I_ !) DI-precp FINTEGER ,C----NT(L N ) DI-,---h F & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifLoculdvariab-esnh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #en auxiliot, variab-esh FINTEGER DI-,jSTkj,---,m,n,lh FINTEGER DI-ns#ma,nrecv,boxpIF #enINTEGER DI-s#marank,recvrankpIF #enINTEGER DI-ns#maexp,nrecvexppIF #enINTEGER DI-ns#maraa,nrecvraapIF #enINTEGER DI-ns#macen,nrecvcenh FINTEGER DI-,opt,level,cnt, topoidh FINTEGER DI-tag2,isoa!h', INTEGER, IMEN= __(1, DI-ldu1h', INTEGER, IMEN= __(2, DI-ldu2h', INTEGER, IMEN= __(3) DI-ldu3h', INTEGER, IMEN= __(4) DI-ldu4 h', ----MK), DI-t0pIF #enTYPE( t_topo)-|PO-----H DI-topop', ! pcense aisa! Dih ofdefsorMPIh', I-TEGER, IMEN= __(MPI_STATUS ZE) DI-sa tush #march', fmm h', ----MK),, IMEN= __(: ) PO-----HDI-radius,recvrad,s#maraah', ----MK),, IMEN= __(:,:),C PO-----HDI-recvcen,s#macen,centerofbox processh= IM FIELD h', COMPLEXMK),, IMEN= __(:,:,:),PO-----HDI-expa L Pu,recvexp,s#maexp- #msAh', COMPLEXMK),, IMEN= __(:,:,:,:),PO-----HDI-expa L Pu,recvexp,s#maexp- #march', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifExternalsnh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enp-----R & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif T-----isAnp-----R & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #en---------oart-----ufmm_expciange----------- ! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifpointe---tofcorrectdvariab-esn(------/double-- ! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swprocessors !----------rocessh= IM FIELD- ! expa L Pub -=> expa L Pu_s_sf- #msAh', expa L Pub -=> expa L Pu_s_v_ F #e- #march', centerofbox => centerofbox_sh Fradius => radius_s- #msAhrocessh= IM FIELD- ! expa L Pub -=> expa L Pu_d_sf- #msAh', expa L Pub -=> expa L Pu_d_v_ F #e- #march', centerofbox => centerofbox_dh Fradius => radius_dh #march', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifAllocate memory fal ata_s#ma motpENDIF & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #en,optD pcenm_alloc_fitpIF #en ns#ma motD nprocpIF #en nrecv motD nprocpIF #enldu1(1, =n ns#ma motpIF #en----- alloc( is#ma mot,ldu1,,opt,------rallelIF (__2DD.NE. 0F #elif __DIM == i_2DD pm_al-f-- lf __DIM == ----- pm_al( pm__alloc,----ufmm_expciange--M == innnnnnfo o 's#ma motDPPM_ISENDLIST',__LINE__------------RRRRRGOTO 9999h FEND-FhIF #en----- alloc( irecv mot,ldu1,,opt,------rallelIF (__2DD.NE. 0F #elif __DIM == i_2DD pm_al-f-- lf __DIM == ----- pm_al( pm__alloc,----ufmm_expciange--M == innnnnnfo o 'receive motDPPM_I---VLIST',__LINE__------------RRRRRGOTO 9999h FEND-FhIF #entag2 =n200h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifcompthe-top levelCtopologyhrallel & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swp ofdefs VECTORhrallelDO ,=1,nlevel------RRRIF (nbpl(i) .GE. nprocF #elif __DIM == levelC= ih', END-FhIF #enENDDOh #msAh', DO ,=1,nlevel------RRRIF (nbpl(i) .GE. nprocF #elif __DIM == levelC= ih', #enEXITh', END-FhIF #enENDDOh #march', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif Compthe-ns#maexp,ns#macen,ns#maraa (nr U Gexp.,cen.,raa.-tofba_s#mt-- ! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enns#maexpC= 0h', DO ,=level,nlevel------RRR topoid =Ctopoid mot(i)------RRR topo =n topo(topoid)%tp------RRR ns#maexpC= ns#maexpC+Ctopo%nsor motp', --ns#macenC= ns#maexpp', --ns#maraa = ns#maexpp', ENDDOh F ==n & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif Set up own mots fal s#mai---tofo er processorsh F & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #en! expa L Puprocessh= IM FIELD pIF #enldu3(1- =Cns#maexpp', ldu3(2- =Cfr. +1p', ldu3(3- =C2*fr. +1p', ----- alloc(s#maexp,ldu3,,opt,------ #msAh', ldu4(1- =Cld h', ldu4(2- =Cns#maexpp', ldu4(3- =Cfr. +1p', ldu4(4) =C2*fr. +1p', ----- alloc(s#maexp,ldu4,,opt,------ #gmm_ ', IF (__2DD.NE. 0F #elif __DIM ==i_2DD pm_al-f-- lf __DIM ==----- pm_al( pm__alloc,----ufmm_expciange--M innfo o '#m_al allocati---s#maexp',__LINE__------------RGOTO 9999h FEND-F h', centerofboxpIF #enldu2(1- =C3pIF #enldu2(2- =Cns#macenh F----- alloc(s#macen,ldu2,,opt,------rallelIF (__2DD.NE. 0F #elif __DIM ==i_2DD pm_al-f-- lf __DIM ==----- pm_al( pm__alloc,----ufmm_expciange--M innfo o '#m_al allocati---s#macen',__LINE__------------RGOTO 9999h FEND-F h', radiuspIF #enldu1(1, =-ns#maraah F----- alloc(s#marad,ldu1,,opt,------rallel-rallelIF (__2DD.NE. 0F #elif __DIM ==i_2DD pm_al-f-- lf __DIM ==----- pm_al( pm__alloc,----ufmm_expciange--M innfo o '#m_al allocati---s#marad',__LINE__------------RGOTO 9999h FEND-F h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #en! floop-ov r levels U Geree- ! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #encntC= 0h', DO ,=level,nlevel------RRR topoid =Ctopoid mot(i)------RRR topo =n topo(topoid)%tp------RRR & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,------RRRR _floop-ov r loculd---- a). -oore ic s#maexp,s#macen,s#maraah FRR & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,- RDO j=1,topo%nsor motp FRR box =n boxid(topo%isor mot(j),i)------RRR #encntC= cntC+ 1processssssssh= IM FIELD- DO n=1,ldu3(2-------RRR #en DO m=1,ldu3(3) innnnnnnnnnnn- s#maexp(cnt,n,m, =-expa L Pu(box,n-1,m-fr. -1, innnnnnnnnnnENDDOh F ==nnnnnnnENDDOh #msAh', #en DO n=1,ldu4(2-------RRR #en DO m=1,ldu4(3) innnnnnnnnnnn- DO l=1,ldu4(1) innnnnnnnnnnn- n- s#maexp(l,cnt,n,m, =-expa L Pu(l,box,n-1,m-fr. -1, innnnnnnnnnnnnnENDDOh F ==nnnnnnnnnnENDDOh F ==nnnnnnnENDDOh #march', #en DO n=1,3h F ==nnnnnnnnnns#macen(n,cnt- -=-centerofbox(n,box)h F ==nnnnnnnENDDOh==nnnnnnnnnns#maraa(cnt- - -=-radius(box)h F ==nnnnENDDOh==nnnnENDDOh F ==n & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif IT-----ize-s#marank, recvrank,n ns#ma mot,n nrecv moth F ==n & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #ens#marank=nnnnnnnnnn=n rank=-C1p', recvrank=nnnnnnnnnn=n rank=+C1p', ns#ma motDnnnnn=n0p', nrecv motDnnnnn=n0p', d & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifSinceCwe-skip ata_loculdprocessor entirely, --cretalo ata_pointers Unce ! see < & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #ens#marank=nnnnnnnnnnnnnnnnnnnn=ns#marank=+C1p', recvrank=nnnnnnnnnnnnnnnnnnnn=nrecvrank=-C1p', ns#ma motDnnnnnnnnnnnnnnn=n ns#ma motD+C1p', is#ma mot( ns#ma mot)n=ns#marankp', nrecv motDnnnnnnnnnnnnnnn=n nrecv motD+C1p', irecv mot( nrecv mot)n=nrecvrankp', d & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifLoop-ov r all processorsfbth skip ata_processor itselch', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enDO ,=2, nprocp & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,------RRRR _compthe-thecnext_processorh FRR & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,- Rs#marank==ns#marank=+C1p', elIF (s#marank.GT. nproc-1, s#marank==ns#marank=- nproc innnnnrecvrank==nrecvrank=-C1p', elIF (recvrank.LT.nnnnnnnnnn0F recvrank==nrecvrank=+ nproc & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,------RRRR _Soore ata_processor to whichCwe-optios#ma toh FRR & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,- R ns#ma motDnnnnnnnnnnnnnnn=n ns#ma motD+C1 innnnn is#ma mot( ns#ma mot)n=ns#marankp', RR & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,------RRRR _Soore ata_processor to whichCwe-optiorecv fromh FRR & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,- R nrecv motDnnnnnnnnnnnnnnn=n nrecv motD+C1 innnnn irecv mot( nrecv mot)n=nrecvrankp & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,------RRRR _reset)counterfANTAnr U Gexp.coeff.,raa,centers-tofba_receivedh FRR & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,- RnrecvexpDnnnnnnnnnnnnnnnnnnnn=n0h FRR nrecvcenDnnnnnnnnnnnnnnnnnnnn=n0h FRR nrecvraa nnnnnnnnnnnnnnnnnnnn=n0h & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,------RRRR _loop-ov r all topologies a). caeck all ---- p', RR & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,------RRRRDO j=level,nlevel------RRR R topoid =Ctopoid mot(j)------RRR R topo =n topo(topoid)%tp------RRR RRDO ,---=1,topo%nsorsp F = elRR & & 'point status array GMM_STATE2D',__L! CH-8092 Zup F = elRR Caeck i Geneyfbalo---tofata_processor from wherecwe-optiop F = elRR receive --- !Moduff elRR & & 'point status array GMM_STATE2D',__L! CH-8092 Zup F = elRR IF (topo%sor2proc(,---- .EQ.nrecvrankF #elif __DIM == elRR & & 'point status array GMM_STATE2D',__L! CH-8092f __DIM == elRR _If yes, --crease)counterfANTAcorrectdallocativipIF #en == elRR & & 'point status array GMM_STATE2D',__L! CH-8092f __DIM == elRR nrecvexpD= nrecvexpD+C1p', el elRR nrecvcenC= nrecvcenC+C1p', el elRR nrecvraa = nrecvraa +C1p', el elELSEf __DIM == elRR & & 'point status array GMM_STATE2D',__L! CH-8092f __DIM == elRR _optiobe excianged in a)o er roM).f __DIM == elRR & & 'point status array GMM_STATE2D',__L! CH-8092f __DIM == elEND-F h', elENDDOh==nnnnnnnENDDOh & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,------RRRR _Allocate our recv-a rays, exp.,raa., centers-tofba_receivedh FRR & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,- FRR ,optD pcenm_alloc_fitp n! expa L Puprocess ssh= IM FIELD- ! enldu3(1- =CnrecvexppIF #en ldu3(2- =Cfr. +1p', ldu3(3- =C2*fr. +1p', F----- alloc(recvexp,ldu3,,opt,------ #msAh ldu4(1- =Cld h', ldu4(2- =CnrecvexppIF #en ldu4(3- =Cfr. +1p', ldu4(4) =C2*fr. +1p', F----- alloc(recvexp,ldu4,,opt,------ #gmm_p', elIF (__2DD.NE. 0F #elif __DIM == i_2DD pm_al-f-- lf __DIM == =----- pm_al( pm__alloc,----ufmm_expciange--M inn nnfo o '#m_al allocati---recvexp',__LINE__------------RRRRGOTO 9999h Fnn END-Fh centerofboxpIF #en enldu2(1- =C3pIF #en enldu2(2- =Cnrecvcenh F F----- alloc(recvcen,ldu2,,opt,------rallel elIF (__2DD.NE. 0F #elif __DIM == i_2DD pm_al-f-- lf __DIM == =----- pm_al( pm__alloc,----ufmm_expciange--M inn nnfo o '#m_al allocati---recvcen',__LINE__------------RRRRGOTO 9999h Fnn END-Fh radiuspIF #en enldu1(1, =-nrecvraapIF #en F----- alloc(recvrad,ldu1,,opt,------rallel elIF (__2DD.NE. 0F #elif __DIM == i_2DD pm_al-f-- lf __DIM == =----- pm_al( pm__alloc,----ufmm_expciange--M inn nnfo o '#m_al allocati---recvrad',__LINE__------------RRRRGOTO 9999h Fnn END-Fh Fnn & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,------RRRR _receive ata_expa L Pusp', RRR & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,- -ns#ma =Cns#maexp*(fr. +1)*(2*fr. +1-------RRRRnrecv =Cnrecvexp*(fr. +1)*(2*fr. +1-- ofdefs sorMPIhrocess ssh=s !---------------Cen=-----MPI_S#maRecv(s#maexp,ns#ma,MPI_COMPLEX,s#marank,tag2,M inn nnfo o recvexp,nrecv,MPI_COMPLEX,recvrank,tag2,M inn nnfo o ---ucomm,ia tus,------ #msAh', en=-----MPI_S#maRecv(s#maexp,ns#ma,MPI_ __KCOMPLEX,s#marank,tag2, inn nnfo o recvexp,nrecv,MPI_ __KCOMPLEX,recvrank,tag2, inn nnfo o ---ucomm,ia tus,------ #gmm_p #gmm_p', el & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,------RRRR _receive ata_centersp', RRR & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,- -ns#ma =Cns#macen*3------RRRRnrecv =Cnrecvcen*3- ofdefs sorMPIh', en=-----MPI_S#maRecv(s#macen,ns#ma, mpi kind,s#marank,tag2,M inn nnfo o recvcen,nrecv, mpi kind,recvrank,tag2,M inn nnfo o ---ucomm,ia tus,------ #gmm_p', el & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,------RRRR _receive ata_radiuspIF #en en & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, - -ns#ma =Cns#maraapIF #en Fnrecv =Cnrecvraap ofdefsorMPIh', en=-----MPI_S#maRecv(s#maraa,ns#ma, mpi kind,s#marank,tag2, inn nnfo o recvraa,nrecv, mpi kind,recvrank,tag2, inn nnfo o ---ucomm,ia tus,------ #gmm_p', el & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,------RRRR _soore ata_received --- !Moduff _loop-ov r all topologies a). caeck all ----p', el & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,------RRRRcntC= 0h', RRDO j=level,nlevel------RRR R topoid =Ctopoid mot(j)------RRR R topo =n topo(topoid)%tp-----RRR R DO ,---=1,topo%nsorsp F = elRR & & 'point status array GMM_STATE2D',__L! CH-8092 Zup F = elRR Caeck i Gene ---fbalo--s-tofata_processor from wherecwe-p F = elRR received --- !Moduff elRR & & 'point status array GMM_STATE2D',__L! CH-8092 Zup elRR IF (topo%sor2proc(,---- .EQ.nrecvrankF #elif box =n boxid(,---,j)- & & 'point status array GMM_STATE2D',__L! CH-8092f __DIM == elRR _If yes, sooref __DIM == elRR & & 'point status array GMM_STATE2D',__L! CH-8092f __DIM == elRR cntC= cntC+ 1processsssssssssssh= IM FIELD- ! en-RRR R DO n=1,ldu3(2-------RRR #en R R DO m=1,ldu3(3) innnnnnnnnnnn- expa L Pu(box,n-1,m-fr. -1, = recvexp(cnt,n,m, innnnnnnnnnnn- ENDDOh F ==nnnnnnnnnnnnENDDOh #msAh', #en R R DO n=1,ldu4(2-------RRR #en R R DO m=1,ldu4(3) innnnnnnnnnnn- R R DO l=1,ldu4(1) innnnnnnnnnnn- n- expa L Pu(l,box,n-1,m-fr. -1, = recvexp(l,cnt,n,m, innnnnnnnnnnn- n- ENDDOh F ==nnnnnnnnnnnn ENDDOh F ==nnnnnnnnnnnnENDDOh #march', #en R R DO n=1,3h F ==nnnnnnnnnnnnnnncenterofbox(n,box) = recvcen(n,cnt-h F ==nnnnnnnnnnnnENDDOh F ==nnnnnnnnnnnnradius(box)nnnnnnnn=nrecvraa(cnt-f __DIM == elEND-Fh', elENDDOh==nnnnnnnENDDOhnnnnnnENDDOn! ema oop-ov r nprocpIF #en & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifDeallocate ata_memory fal ata_ motspIF #en & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #en,optD pcenm_de llochIF #enldu3(1- =C0hIF #enldu3(2- =C0hIF #enldu3(3- =C0hIF #enisoa! nn=n0h F----- alloc(recvexp,ldu3,,opt,------IF #enisoa! =nisoa! +-,---h F----- alloc(recvcen,ldu3,,opt,------IF #enisoa! =nisoa! +-,---h F----- alloc(recvrad,ldu3,,opt,------IF #enisoa! =nisoa! +-,---h FIF (_soa!.NE.0F #elif __DIM ==i_2DD pm_al- ENDIF I----- pm_al( pm__de lloc,----ufmm_expciange--M == innnnnfo o 'recvexp',__LINE__------------REND-Fh', isoa! nn=n0h F----- alloc(s#maexp,ldu3,,opt,------IF #enisoa! =nisoa! +-,---h F----- alloc(s#macen,ldu3,,opt,------IF #enisoa! =nisoa! +-,---h F----- alloc(s#marad,ldu3,,opt,------IF #enisoa! =nisoa! +-,---h FIF (_soa!.NE.0F #elif __DIM ==i_2DD pm_al- ENDIF I----- pm_al( pm__de lloc,----ufmm_expciange--M == innnnnfo o 's#maexp',__LINE__------------REND-Fh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifRe _ h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpI9999 CONTINUEh', ---------oop-----ufmm_expciange----------- ! RETURifhrocess(ors !--------- &&ch= IM FIELD ! see ENDnISION ENufmm_expciange_s_sf- #marc(h== __3D #if __KIND == __ &&ch= IM FIELD ! see ENDnISION ENufmm_expciange_d_sf- #marc(h== __3D #if !--------- &&ch= IM VFIELD ! see ENDnISION ENufmm_expciange_s_vf- #marc(h== __3D #if __KIND == __ &&ch= IM VFIELD ! see ENDnISION ENufmm_expciange_d_vf- #marchlib ENnumerics-r1036/src/ ENugmm_slvupwnd.inc0000644000175000017500000003356411616214647020241 0uia omaromar', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif Tcludt)file-fal de! t i---a). -olvi---tta_quaaratic equa! Dih us----upwi). fiT--e-differencesTNESS FORpIF #endffINPUT:CCCINTEGER DI-,jSTk -- Point-tofsolv -ANTpIF #endfffffffffffINTEGER DI-fr. -- Desired fr. of FD sMaemepIF #endiffffffffff----MK),, PO-----HDI-d- -- --- !Modudiffffffffff----MK),, PO-----HDI-fd- -- levelCfunc! Dih N PUT:CC----MK),DI-valijk -- Compthed-value-fal point-,jSTkNESS FORpIF #end & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif$Log:C ENugmm_slvupwnd.inc,v $pIF #endifRevisevi 1.1.1.1 2007/07/13 10:18:55ffivospIF #endifCBL v rL PubU Gata_PPM lf not,pIF #endpIF #endffRevisevi 1.7 2005/07/25 00:31:09 uivospIF #endifbugfix: icdex #m_als in jacobian-AixedTNESS FORpIF #endffRevisevi 1.6 2005/07/14 19:58:16ffivospIF #endifAdde OPT __AL a uotalo chi fal BPM. node positevis in mmstorttdarallel EC(mapped) BPM.esT Fal use-withfAGM fal exampleTNESS FORpIF #endffRevisevi 1.5 2005/05/10 04:48:47ffivospIF #endifSplit march----a). extU sevi rwant ts fal fasterfcompila! Di,pIF #endifSharked extU sevi rwant ts, moved all iT-----izatevintofgmm_iT--, ! P', ffcode cosmeticsTNESS FORpIF #endffRevisevi 1.4 2005/04/27 01:06:13 fivospIF #endifConv rgenceCttstsfcomple! d, cleaned upfcode, optmized code (Shark),pIF #endifa). caanged struc e to allow fasterfcompila! DiTNESS FORpIF #endffRevisevi 1.3 2005/03/16 06:20:09 uivospIF #endifSeversalbugfixesT 1ot Ur. v rL Pubisfnow ttsted. Moved all la uepIF #endif--- tofata_ !--eTNESS FORpIF #endffRevisevi 1.2 2005/03/11 04:17:01 uivospIF #endifAdde ossiblity to fal velocity extU sevi a). eofget backpIF #endifata_clostst point-transfalmTNESS FORpIF #endffRevisevi 1.1 2005/03/10 01:37:18ffivospIF #endifIn-----rMaeck-iuT BEWARE: Not ttsted ic pcense alyetdpIF #endpIF #end & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifPcense along with PPM. If not, ! see . ! ! P', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swp ', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifDe! t t#s! Maesp', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swp oTcludt " ENugmm_s! Maes.inc"p ', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifRea. enerlevelCset)--- !Modud & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swp oTcludt " ENugmm_getfd- .inc"p ', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifCompthe-upwi). fiT--e-differencespof appropriate ! see TNESS FORpIF #endfPcense along with PPM. If not, ! see . ! ! P- ! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swprocessors !---------------CISION ENubem_quaar--e_s(qp,qw,r--e,------ #marcor= __3D #if __KIND == __------CISION ENubem_quaar--e_d(qp,qw,r--e,------ #march', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif Tcludtsp', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swp oTcludt " ENudefiTe.h"h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifM !--esh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enUSE- m !--e_--- !ModuUSE- m !--e_bem_quaar--e_npoints ! see USE- m !--e_numerics_--- !ModuUSE- m !--e_ ENDIF USE- m !--e_----ong ENDIF USE- m !--e_----ooppIF #enIMPLICIT NONEh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifType-kind- ! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swprocessors !---------------CINTEGER, PARAME---HDI-MKD kind_s---le- #marcor= __3D #if __KIND == __------CINTEGER, PARAME---HDI-MKD kind_double- #march', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifA uotalosfffffh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #en----MK),, DIMEN= __(:,:,, PO-----HHHHHHH:: qppIF #en----MK),, DIMEN= __(:) , PO-----HHHHHHH:: qw------CINTEGER ,CINTENT(IN )HDI-r--e ', INTEGER ,CINTENT( N )HDI-,---h Fd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifLoculdvariab-esFh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #en----MK), DI-temppIF #en----MK), DI-a1, a2, b1, b2, c1, c2, c3, w1, w2, w3 ', INTEGER DI-nqppIF #en----MK), DI-t0p', d & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifExternalsFh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swph', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endif T-----ise ! see < & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #en---------ong -----ubem_quaar--e----------- ! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifCaeck a uotalos- ! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enIF ( ENudebug .GT. 0F #elif __DIM ==----- bem_quaar--e_npoints(r--e,nqp,------rallel elIF (nqp .EQ.n0F #elif __DIM == i_2DD pm_al- ENDIF I =----- pm_al( pm__a uotalo,----ubem_quaar--e-- nn info o 'Unknown quaarat e r--e--__LINE__------------RRRR RRGOTO 9999h Fnn END-Fh Fnn IF (SIZE(qp,2) .LT.nnqpF #elif __DIM == i_2DD pm_al-f-- lf __DIM == =----- pm_al( pm__a uotalo,----ubem_quaar--e-- nn info o 'QPfa ray not big enough--__LINE__------------RRRR RRGOTO 9999h Fnn END-Fh Fnn IF (SIZE(qw,1) .LT.nnqpF #elif __DIM == i_2DD pm_al-f-- lf __DIM == =----- pm_al( pm__a uotalo,----ubem_quaar--e-- nn info o 'QWfa ray not big enough--__LINE__------------RRRR RRGOTO 9999h Fnn END-Fh FEND-Fh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifFill iT ata_quaarat e points accordin--tofata_r--e ', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enSELECT=--SE-(r--e)pIF #en--SE-( pcenm_bem_quaar--e_center-------RRRRqp(1:2,1)G= (/ 1.0/3.0, 1.0/3.0 /-------RRRRqw(1, = 1.0pIF #en--SE-( pcenm_bem_quaar--e_nodes-------RRRRqp(1:2,1)G= (/ 0.0, 0.0 /-------RRRRqp(1:2,2)G= (/ 1.0, 0.0 /-------RRRRqp(1:2,3)G= (/ 0.0, 1.0 /-------RRRRqw(:, = 1.0 / 3.0pIF #en--SE-( pcenm_bem_quaar--e_edges-------RRRRqp(1:2,1)G= (/ 0.0, 0.5 /-------RRRRqp(1:2,2)G= (/ 0.5, 0.5 /-------RRRRqp(1:2,3)G= (/ 0.5, 0.0 /-------RRRRqw(:, = 1.0 / 3.0pIF #en--SE-( pcenm_bem_quaar--e_cne-------RRRRqp(1:2,1)G= (/ 0.0, 0.0 /-------RRRRqp(1:2,2)G= (/ 1.0, 0.0 /-------RRRRqp(1:2,3)G= (/ 0.0, 1.0 /-------RRRRqp(1:2,4)G= (/ 0.0, 0.5 /-------RRRRqp(1:2,5)G= (/ 0.5, 0.5 /-------RRRRqp(1:2,6)G= (/ 0.5, 0.0 /-------RRRRqp(1:2,7)G= (/ 1.0/3.0, 1.0/3.0 /-------RRRRqw(1:3) = 1.0 / 20.0------RRRRqw(4:6) = 2.0 / 15.0------RRRRqw(7, = 27.0 / 60.0 pIF #en--SE-( pcenm_bem_quaar--e_stroua, pcenm_bem_quaar--e_hammer7, ------RRRRdifStroua T2:5-1p', eltemp = SQRT(15.0_K),------RRRRqp(1:2,1)G= (/ 1.0/3.0, 1.0/3.0 /-------RRRRqp(1:2,2)G= (/ (9.0 + 2.0*temp) / 21.0, (6.0 - eltemp) / 21.0 /-------RRRRqp(1:2,3)G= (/ (6.0 - eltemp) / 21.0, (9.0 + 2.0*temp) / 21.0 /-------RRRRqp(1:2,4)G= (/ (6.0 - eltemp) / 21.0, (6.0 - eltemp) / 21.0 /-------RRRRqp(1:2,5)G= (/ (9.0 - 2.0*temp) / 21.0, (6.0 + eltemp) / 21.0 /-------RRRRqp(1:2,6)G= (/ (6.0 + eltemp) / 21.0, (9.0 - 2.0*temp) / 21.0 /-------RRRRqp(1:2,7)G= (/ (6.0 + eltemp) / 21.0, (6.0 + eltemp) / 21.0 /-------RRRRqw(1, = 9.0 / 40.0------RRRRqw(2:4) = (155.0 - temp) / 1200.0------RRRRqw(5:7) = (155.0 + temp) / 1200.0------R--SE-( pcenm_bem_quaar--e_hammer3,------RRRRqp(1:2,1)G= (/ 2.0/3.0, 1.0/6.0 /-------RRRRqp(1:2,2)G= (/ 1.0/6.0, 1.0/6.0 /-------RRRRqp(1:2,3)G= (/ 1.0/6.0, 2.0/3.0 /-------RRRRqw(:, = 1.0 / 3.0pIF #en--SE-( pcenm_bem_quaar--e_hammer4,------RRRRqp(1:2,1)G= (/ 1.0/3.0, 1.0/3.0 /-------RRRRqp(1:2,2)G= (/ 0.2, 0.2 /-------RRRRqp(1:2,3)G= (/ 0.6, 0.2 /-------RRRRqp(1:2,4)G= (/ 0.2, 0.6 /-------RRRRqw(1, = -27.0/48.0------RRRRqw(2:4) = 25.0/48.0------R--SE-( pcenm_bem_quaar--e_hammer12-------RRR a1=0.873821971016996_K); a2=0.063089014491502_MKpIF #en #eb1=0.501426509658179_K); b2=0.249286745170910_MKpIF #en #ec1=0.636502499121399_K); c2=0.310352451033785_K); c3=0.053145049844816_MKpIF #en #ew1=0.050844906370207_K); w2=0.116786275726379_K); w3=0.082851075618374_MKpIF #en #eqp(1:2,1)G= (/ a1, a2 /-------RRRRqp(1:2,2)G= (/ a2, a1 /-------RRRRqp(1:2,3)G= (/ a2, a2 /-------RRRRqp(1:2,4)G= (/ b1, b2 /-------RRRRqp(1:2,5)G= (/ b2, b1 /-------RRRRqp(1:2,6)G= (/ b2, b2 /-------RRRRqp(1:2,7)G= (/ c1, c2 /-------RRRRqp(1:2,8)G= (/ c1, c3 /-------RRRRqp(1:2,9)G= (/ c2, c1 /-------RRRRqp(1:2,10)= (/ c2, c3 /-------RRRRqp(1:2,11)= (/ c3, c1 /-------RRRRqp(1:2,12)= (/ c3, c2 /-------RRRRqw(1:3) = w1------RRRRqw(3:6) = w2------RRRRqw(7:12, = w3 ', --SE-DEFAULT------RRRRi_2DD pm_al- ENDIF I----- pm_al( pm__a uotalo,----ubem_quaar--e-- nn info o 'Unknown quaarat e r--e--__LINE__------------RRRRGOTO 9999h FENDnIELECTh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifRe _ h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpI9999 CONTINUEh', ---------oop-----ubem_quaar--e----------- ! RETURifhrocessors !---------------CENDnISION ENubem_quaar--e_s- #marcor= __3D #if __KIND == __------CENDnISION ENubem_quaar--e_d- #marchlib ENnumerics-r1036/src/ ENugmm_iT--Tf0000644000175000017500000001762211616214647016773 0uia omaromar', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifSubrwant t#en: ENugmm_iT--h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endiCopyright (c) 2010 CSE-Lab (ttp:/. ), MOSAIC Grwap (ttp:/. ), ! see TNESS FORpIF #endfPcense along with PPM. If not, ! see . ! ! P', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enISION ENugmm_iT--(field_topoid,BPM.id,Nest,prec------- ! !- topo(field_topoid)%t !ModuBPM. =>-topo%BPM.(gmm_BPM.id-- ! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifCaeck a uotalos- ! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enIF ( ENudebug .GT. 0F #elif __DIM ==nIF (.NOT. ENuiT-----izedF #elif __DIM == == i_2DD pm_al- ENDIF I = I----- pm_al( pm__ noiT--,----ugmm_iT----nn info o 'Please i ll ENuiT-- firot!--__LINE__------------RRRR RRRRGOTO 9999h Fnn nEND-Fh', e----- Maeck_BPM.id(field_topoid,BPM.id,lok------------RRRR IF (.NOT. lokF #elif __DIM == == i_2DD pm_al- ENDIF I = I----- pm_al( pm__a uotalo,----ugmm_iT----nn info o 'BPM.id wan U Grange--__LINE__------------RRRR RRRRGOTO 9999h Fnn nEND-Fh', eIF (Nest .LT.n1F #elif __DIM == == i_2DD pm_al- ENDIF I = I----- pm_al( pm__a uotalo,----ugmm_iT----nn info o 'Nest muiafba_>0!--__LINE__------------RRRR RRRRGOTO 9999h Fnn nEND-Fh', eIF ((prec.NE. kind_s---le).AND.(prec.NE. kind_double)F #elif __DIM == == i_2DD pm_al- ENDIF I = I----- pm_al( pm__a uotalo,----ugmm_iT----nn info o 'Ise guldpreciL Pubspecifiec!--__LINE__------------RRRR RRRRGOTO 9999h Fnn nEND-Fh', END-Fh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifNullify ata_pointers-to allow prop icquiry U GASSOCIATED ia tus.h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enNULLIFY(gmm_ipos-------RNULLIFY(gmm_phis-------RNULLIFY(gmm_phid-------RNULLIFY(gmm_-a te2d-------RNULLIFY(gmm_-a te3d-- ! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifAllocatebsparse-workbspacehstruc e- ! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #engmm_l-izD Nest !Modu,optD pcenm_ lloc_f--h', ldu(1)n=ngmm_l-izpIF #enIF ( rec .EQ.n ENukind_double)H#elif __DIM == ----- lloc(gmm_phid,ldu,,opt,-----------RELSEf __DIM == ----- lloc(gmm_phis,ldu,,opt,-----------REND-Fh', IF (i_2DD.NE. 0F #elif __DIM ==ni_2DD pm_al-f-- lf __DIM == ----- pm_al( pm__alloc,----ugmm_iT----nn nn info o 'sparse---- valuesfGMM_PHI--__LINE__------------RRRR GOTO 9999h FEND-Fh', ldu(1)n=n ENudim +n1p', ldu(2)n=ngmm_l-izpIF #en----- lloc(gmm_ipos,ldu,,opt,-----------RIF (i_2DD.NE. 0F #elif __DIM ==ni_2DD pm_al-f-- lf __DIM == ----- pm_al( pm__alloc,----ugmm_iT----nn nn info o 'sparse---- locatevisfGMM_IPOS--__LINE__------------RRRR GOTO 9999h FEND-Fh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifTranslate-BPM.id-to interisalnumber--- andGstore-ith', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwppIF #engmm_BPM.id-=-BPM.%ID- ! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifDe! t t#max extU n U GBPM. infa)yr---pIF #en & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enmaxxhi-=-0pIF #enmaxyhi-=-0pIF #enmaxzhi-=-0pIF #enDO i=1,topo%nsor motp', --ni----=-topo%isor mot(i-------RRRR IF (BPM.%nnodes(1,i---).GT.maxxhi)n info o maxxhi-=-BPM.%nnodes(1,i---)------RRRR IF (BPM.%nnodes(2,i---).GT.maxyhi)n info o maxyhi-=-BPM.%nnodes(2,i---)------RRRR IF ( ENudim .GT. 2F #eli f __DIM == RR IF (BPM.%nnodes(3,i---).GT.maxzhi) info o maxzhi-=-BPM.%nnodes(3,i---)h Fnn nEND-Fh', ENDDO- ! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifMemory incretaloGstep -ize - ! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #enincr-=-MAX(maxxhi,maxyhi,maxzhi)pIF #enincr-=-10*incr*incr- ! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpIF #endifRe _ h', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, SwpI9999 CONTINUEh', ---------oop-----ugmm_iT------------- ! RETURifh', ENDnISION ENugmm_iT--hlib ENnumerics-r1036/src/ ENumg_iT--Tf0000644000175000017500000014176711616214647016626 0uia omaromar ', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Sh FndifSubrwant t#en: ENumg_iT-- ', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Sh Fndh FndifPurposeIF #en: This rwant t#iT-----izesGene solv rfANTAh Fndiffffffffffffffff2D andG3D problemsh Fndh FndifInpthffffffff: equa! Di-ff(I)ff: = __3OF EQUAT--- TO BE SOLVED h FndiffffffffffffffffffffffffffffffffffffFOR #el MOMENT ONLY PO-SSONh Fndifffffffffffffffffighost-ize (I)ff: GHOSTSIZE h Fndiffffffffffffffffffffffffffffffffffh Fndifffffffffffffffffsmoot er ff(I)ff: NOW GAUSS-SEIDELh Fndh Fndifffffffffffffffff[lda]fffff(I)fff: LEADING DIMEN= __, ONLY TO BEh FndifffffffffffffffffffffffffffffffffffGIVli FOR VECTOR --SESh Fndifffffffffffffffh Fndifffffffffffffffffibcdeffffff(I)ff: ARRAY3OF BOUNDARY CONDIT--- h Fndh Fndh Fndifffffffffffffffffbcvalue-nn(F)fff: ARRAY3WHERE #el VALUES3OF #el BCh FndifffffffffffffffffffffffffffffffffffARE STORED.IN --SE-OF PERIODIC h FndifffffffffffffffffffffffffffffffffffJUSTfGIVl ANY = __3OF VALUEh Fndh Fndiffffffffffffffffflimlevffff(I)fff :Number U Glevels-that ene useTAh Fndifffffffffffffffffffffffffffffffffffwants to coarse.h Fndifffffffffffffffh Fndifffffffffffffffffwcyc-effff(L)fff : TRUE-i Gene useTAwants W-cyc-e.h FndifffffffffffffffffffffffffffffffffffO#elRWISE-FALSEf __DIM diffffffffffffffffflpr--tffff(L)fff : TRUE-IF YOU WANT TO DUMP N h FndiffffffffffffffffffffffffffffffffffffINFORMAT---------Cndifffffffffffffffffh Fndiffffffffffffffffffomegafffff(F)ffff: relaxa! Di- cenmeterfANTASORh Fndh Fndifh FndifInpth/wanpthf: ffffh Fndh FndifOanpthfffffff: i_2DDfff ff(I)fre _ ia tus. 0 upDi-success.h Fndh FndifRemarksffffff: PLEASE-PAY3ATTENT--- THATfIN ORDER TO DIVIDEfh FndifffffffffffffffffFUR#elR A MESH IT SHOULD BE DIVISIBLE WITH 2.h FndifffffffffffffffffIF YOU WANT TO SOLVE DIFFERENT EQUAT---Sfh Fndifffffffffffffffff#el WHOLE MACH RY SHOULD BE ----ED TWICE.h FndifffffffffffffffffALSOf#el SOLVER IS NOW PROGRAMMED FOR #el PO-SSONh FndifffffffffffffffffPROBLEM. A FUTURE IMPROVEMENT WOULD BEh Fndifffffffffffffffff#O USE-A GE RAL STENCIL.ffffffh Fndh FndifReferencespff:NESS FOndh FndifRevisevisffff:NESS FO & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Sh Fndif$Log:C ENumg_iT--Tf,v $pIF #enndifRevisevi 1.1.1.1 2007/07/13 10:18:56ffivospIF #enndifCBL v rL PubU Gata_PPM lf not,pIF #enndh FndifRevisevi 1.17 2006/09/26 16:01:22ffivospIF #enndifFixed wrongly-indented CPP direc! ves. Remember: atay E. Seto -ong -inpIF #enndifCol 1, ot erwise it doespnot compil -Di-certat systems. In fact,-thispIF #enndifcode_did NOT compil -as itfoas!dh Fndh FndifRevisevi 1.16 2006/09/05 08:01:27 chatel pIF #enndifProp sc--ingfANTA---- comparisvispIF #enndifAdde m !--e_ llocntof decomp_boxspl-- ', h FndifRevisevi 1.15 2006/07/21 11:30:54ffkots--iepIF #enndifFRIDAY ', h FndifRevisevi 1.13 2006/06/08 08:38:18ffkots--iepIF #enndifCosmetics ', h FndifRevisevi 1.12 2006/06/08 08:27:37ffkots--iepIF #enndifcaanged bcvalue-to -uppog -different BCs-Di-ene snme face_bth different ---pIF #en h FndifRevisevi 1.8 2006/05/15 14:44:26 fkots--iepIF #enndifcosmetics ', h FndifRevisevi 1.7 2006/02/03 09:34:03ffivospIF #enndifFixed bug 00015:C ENu----_bcfoashonly allocated andGstoredFfal atapIF #enndifloculd---- ic eopo_store. Seversalmappingfrwant ts however need atapIF #enndifi_2DDabwan ll (global)d----.h FndifCaanged ----_bcftofhol. nowGene GLOBA-----id andGadjusted allh Fndifoccurrences.h Fndh FndifRevisevi 1.6 2005/12/08 12:43:16 fkots--iepIF #enndifcomm---ngfdirichle- ', h FndifRevisevi 1.5 2005/01/04 09:47:45 fkots--iepIF #enndifghost-ize=2Ffal sc--ar case ', h FndifRevisevi 1.4 2004/10/29 15:59:14ffkots--iepIF #enndifRED BLACKASOR FOR 3d v c case. 2dGoptiosoDi-ANllow.h Fndh FndifRevisevi 1.3 2004/09/28 14:04:49ffkots--iepIF #enndifCaanges cvicer i---4th Ur. fiT--e differences ', h FndifRevisevi 1.2 2004/09/23 09:38:30ffkots--iepIF #enndifadde detatls ic ene hea. ', h FndifRevisevi 1.1 2004/09/22 18:27:09ffkots--iepIF #enndifMG new v rL Pu ', h Fnd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Sh FndifPcense along with PPM. If not, ! see ndifInstitute U GComptha! DisalScialcepIF #enndifttp:/entrum, Hirschengraben 84pIF #enndifCcenses/>. ! ! P', nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Sh#arcor IM SFIELDh#arcorMESHr IM 2D-#arcor= __3D #if !---------------CnISION ENumg_iT--_2d_sc-_s(eopo_id,equa! Di,ighost-ize,smoot er,ibcdef,&f __DIMfo o bcvalue,BPM._id,limlev,wcyc-e,lpr--t,omega,------ #marccor= __3D #if __KIND == __------CnISION ENumg_iT--_2d_sc-_d(eopo_id,equa! Di,ighost-ize,smoot er,ibcdef,&f __DIMfo o bcvalue,BPM._id,limlev,wcyc-e,lpr--t,omega,------ #march #marccorMESHr IM 3Dhrocesscor= __3D #if !---------------CnISION ENumg_iT--_3d_sc-_s(eopo_id,equa! Di,ighost-ize,smoot er,ibcdef,&f __DIMfo o bcvalue,BPM._id,limlev,wcyc-e,lpr--t,omega,------ #marccor= __3D #if __KIND == __------CnISION ENumg_iT--_3d_sc-_d(eopo_id,equa! Di,ighost-ize,smoot er,ibcdef,&f __DIMfo o bcvalue,BPM._id,limlev,wcyc-e,lpr--t,omega,------ #march #march #marcor IM VFIELDh#arcorMESHr IM 2D-#arcor= __3D #if !---------------CnISION ENumg_iT--_2d_v c_s(eopo_id,equa! Di,ighost-ize,smoot er,lda,ibcdef,&f __DIMfo o bcvalue,BPM._id,limlev,wcyc-e,lpr--t,omega,------ #marccor= __3D #if __KIND == __------CnISION ENumg_iT--_2d_v c_d(eopo_id,equa! Di,ighost-ize,smoot er,lda,ibcdef,&f __DIMfo obcvalue,BPM._id,limlev,wcyc-e,lpr--t,omega,------ #march #marccorMESHr IM 3Dhrocesscor= __3D #if !---------------CnISION ENumg_iT--_3d_v c_s(eopo_id,equa! Di,ighost-ize,smoot er,lda,ibcdef,&f __DIMfo o bcvalue,BPM._id,limlev,wcyc-e,lpr--t,omega,------ #marccor= __3D #if __KIND == __------CnISION ENumg_iT--_3d_v c_d(eopo_id,equa! Di,ighost-ize,smoot er,lda,ibcdef,&f __DIMfo o bcvalue,BPM._id,limlev,wcyc-e,lpr--t,omega,------ #march #march #march', nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,h', ndif Tcludtsp', nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,h oTcludt " ENudefiTe.h"h', nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,h', ndifM !--es ! see nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,h', nUSE- m !--e_--- !Modu nUSE- m !--e_--- umg !Modu nUSE- m !--e_mg_ llochIF #en nUSE- m !--e_ llochIF #en nUSE- m !--e_ ENDIF IUSE- m !--e_wr--e !Modu nUSE- m !--e_mPM.p __DIM ==USE- m !--e_----ong ENDIF ==USE- m !--e_----ooppIF #en ==USE- m !--e_typedef ENDIF F IMPLICIT NONEhrocesscor= __3D #if !---------------Cn-CINTEGER, PARAME---HDI-MKD kind_s---le- #mse------Cn-CINTEGER, PARAME---HDI-MKD kind_double- #march', nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,h', ndifA uotalosfffffh', nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,h', nINTEGER, INTENT(IN)nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnDI-equa! Dih', nINTEGER,DIMEN= __(:),INTENT(IN)nnnnnnnnnnnnnnnnnnnnDI-,ghost-izeh', nINTEGER, INTENT(IN)nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnDI-smoot erh#arcor IM VFIELDh', nINTEGER, INTENT(IN)nnnnnnnnnnnnnnnnnnnDI- ldaffh #march arcor IM SFIELDh#arcorMESHr IM 2D- ! nINTEGER,DIMEN= __(:)nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnDI-fibcdef- ! n----MK),,DIMEN= __(:,:,:)nnnnnnnnnnnnnnnnnnnnnnnnnnDI-fbcvalueh #marcorMESHr IM 3D- ! nINTEGER,DIMEN= __(:)nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnDI-fibcdef- ! n----MK),,DIMEN= __(:,:,:,:)nnnnnnnnnnnnnnnnnnnnnnnnDI-fbcvalueh #marcffh #marcor IM VFIELDh#arcorMESHr IM 2D- ! nINTEGER,DIMEN= __(:,:)nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnDI-fibcdef- ! n----MK),,DIMEN= __(:,:,:,:)nnnnnnnnnnnnnnnnnnnnnnnnnnDI-fbcvalueh #marcorMESHr IM 3D- ! nINTEGER,DIMEN= __(:,:)nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnDI-fibcdef- ! n----MK),,DIMEN= __(:,:,:,:,:)nnnnnnnnnnnnnnnnnnnnnnnnDI-fbcvalueh #marc- #march', nINTEGER, INTENT(IN)nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnDI-BPM._id,eopo_idh', nINTEGER,INTENT(IN)nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn DI-limlevh', nLOGICAL,INTENT(IN)nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn DI-wcyc-eh', nLOGICAL,INTENT(IN)nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn DI-lpr--t- ! n----MK),,INTENT(IN)nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnDI-omegah', nINTEGER, INTENT(N )HnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnDI-,---h F nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,h', ndifLoculdvariab-esFh', nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,h', n----MK), nnnnnnnnnnnnnnDI-t0h', n----MK), nnnnnnnnnnnnnnDI-lmyepsh', nINTEGERnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnDI-BPM.id,mlev,i----h', nINTEGERnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnDI-idomh', nINTEGERnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnDI- cou-t,ilda,ifaceh', nINTEGERnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnDI-i,j,kh', nINTEGERnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnDI-kkh', nTYPEM ENut_topo)-M == PO-----HHHnnnnDI-topop', TYPEM ENut_equi_BPM.,, PO-----HHHnnnnDI-mPM.p#arcorMESHr IM 2D- ! nINTEGERnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnDI-dir- #march', nINTEGERnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnDI---er1,--er2,ix,iyh', nINTEGERnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnDI--point,jpoint-h', nINTEGERnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnDI-newBPM.id,lBPM._idh', nINTEGERn, DIMEN= __(1, DI-ldu1h', nINTEGERn, DIMEN= __(2, DI-ldu2,ldl2 ,direch', nINTEGERn, DIMEN= __(3, DI-ldu3,ldl3 p#arcorMESHr IM 3D- ! nINTEGERnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnDI-dir1,dir2,jj,izpIF #en nINTEGERn, DIMEN= __(4, DI-ldu4,ldl4- #march', nINTEGERn, DIMEN= __( ENudim) DI-Nml - ! n----MK),, DIMEN= __( ENudim) DI-min_phys,max_phys- ! n----MK),, DIMEN= __( ENudim, topo(eopo_id)%t%nsors)n innnnnnnnnnfo o DI-min_sor,max_---pIF #en nINTEGERnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnDI--opt,topoid- arcor IM SFIELDh#arcorMESHr IM 2D-#arcor= __3D #if !---------------Cn TYPEMmg_field_2d_sc-_s,,DIMEN= __(:,:),PO-----HDI-mgfieldp #marcor= __3D #if __KIND == __------Cn TYPEMmg_field_2d_sc-_d,,DIMEN= __(:,:),PO-----HDI-mgfieldp #march #marcorMESHr IM 3D-#arcor= __3D #if !---------------Cn TYPEMmg_field_3d_sc-_s,,DIMEN= __(:,:),PO-----HDI-mgfieldp #marcor= __3D #if __KIND == __------Cn TYPEMmg_field_3d_sc-_d,,DIMEN= __(:,:),PO-----HDI-mgfieldp #march #march #marcor IM VFIELDh#arcorMESHr IM 2D-#arcor= __3D #if !---------------Cn TYPEMmg_field_2d_v c_s,,DIMEN= __(:,:),PO-----HDI-mgfieldp #marcor= __3D #if __KIND == __------Cn TYPEMmg_field_2d_v c_d,,DIMEN= __(:,:),PO-----HDI-mgfieldp #march #marcorMESHr IM 3D-#arcor= __3D #if !---------------Cn TYPEMmg_field_3d_v c_s,,DIMEN= __(:,:),PO-----HDI-mgfieldp #marcor= __3D #if __KIND == __------Cn TYPEMmg_field_3d_v c_d,,DIMEN= __(:,:),PO-----HDI-mgfieldp #march #march #march arcor IM SFIELDh#arcorMESHr IM 2D- ! ----MK),,DIMEN= __(:,:),PO-----HDI-tuc- ! ----MK),,DIMEN= __(:,:),PO-----HDI-terrh #marcorMESHr IM 3D- ! ----MK),,DIMEN= __(:,:,:),PO-----HDI-tuc- ! ----MK),,DIMEN= __(:,:,:),PO-----HDI-terrh #march #marcor IM VFIELDh#arcorMESHr IM 2D- ! ----MK),,DIMEN= __(:,:,:),PO-----HDI-tuc- ! ----MK),,DIMEN= __(:,:,:),PO-----HDI-terrh #marcorMESHr IM 3D- ! ----MK),,DIMEN= __(:,:,:,:),PO-----HDI-tuc- ! ----MK),,DIMEN= __(:,:,:,:),PO-----HDI-terrh #march #march', nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,h', ndifExternalsFh', nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,hh', nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,h', ndif T-----izeFh', nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,h', n---------ong -----umg_iT------------- ! nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,h', ndifCaeck a uotalos- ! nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,h', nenIF ( ENudebug.GT.0F #elif#arcor IM VFIELDh', nenIF (lda.LE.0F #elif __DIM == = i_2DD pm_al- ENDIF I = II----- pm_al( pm__a uotalo,----upoissumg_iT----nn innfo o 'ldafmuiafba_>0--__LINE__------------RRRR RRRRRGOTO 9999h Fnn nnEND-Fh #march', nEND-Fh', d & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,h', ndiDefiT--evinof-necessot, variab-esFandGallocatevinof-a raysp', nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,h orcor IM SFIELDh', nv cdim = 1h #marcor IM VFIELDh', nv cdim = ldah #march', nw_cyc-e=wcyc-eh', nl_pr--t=lpr--t-h', ntopoid-=-topo_idh', ntopo =>- topo(eopo_id)%th', nBPM. =>-topo%BPM.(BPM._id-------RRRRnsors -=-topo%nsor mot h', nBPM.id-=-BPM.%ID- ! nlBPM._id-=-BPM._id- arc scor= __3D #if !---------------Cmin_phys(:)=topo%Bin_physs(:)------Cmax_phys(:)=topo%Bax_physs(:)------Cmin_sor(:,:)=topo%Bin_sors(:,:)------Cmax_sor(:,:)=topo%Bax_sors(:,:)------C ffomega_s=omegah', nlmyeps=---umyepssfh #marccor= __3D #if __KIND == __------Cmin_phys(:)=topo%Bin_physd(:)------Cmax_phys(:)=topo%Bax_physd(:)------Cmin_sor(:,:)=topo%Bin_sord(:,:)------Cmax_sor(:,:)=topo%Bax_sord(:,:)------C ffomega_d=omegah', nlmyeps=---umyepsdfh #march arcorMESHr IM 2D- ! nNml(1)n=nBPM.%Nm(1) ! nNml(2)n=nBPM.%Nm(2)nh', nBaxlevf=nINT(log10(Nml(1)*Nml(2)*----M ENunproc,K),)/log10(2.0_K),--rallel elIF (Baxlev.GT.limlevF #elif __DIM == Baxlev=limlevh', nEND-F -#arcor= __3D #if !---------------Cn dx_sG= (max_phys(1)-min_phys(1,)/----M(Nml(1)-1),K),nh', ndy_sG= (max_phys(2)-min_phys(2,)/----M(Nml(2)-1),K),nh', nrdx2_s = 1.0_K)/(dx_s*dx_s)h', nrdy2_s = 1.0_K)/(dy_s*dy_s) p #marcor= __3D #if __KIND == __------Cn dx_dG= (max_phys(1)-min_phys(1,)/----M(Nml(1)-1),K),nh', ndy_dG= (max_phys(2)-min_phys(2,)/----M(Nml(2)-1),K),nhh', nrdx2_d = 1.0_K)/(dx_d*dx_d)h', nrdy2_d = 1.0_K)/(dy_d*dy_d,nhh #march #marcorMESHr IM 3D- ! nNml(1)n=nBPM.%Nm(1) ! nNml(2)n=nBPM.%Nm(2) ! nNml(3)n=nBPM.%Nm(3)nh', nBaxlevf=nINT(log10(Nml(1)*Nml(2)*Nml(3)*n innfo o ----M ENunproc,K),)/log10(2.0_K),---rallel elIF (Baxlev.GT.limlevF #elif __DIM == Baxlev=limlevh', nEND-F -#arcor= __3D #if !---------------Cn dx_sG= (max_phys(1)-min_phys(1,)/----M(Nml(1)-1),K),nh', ndy_sG= (max_phys(2)-min_phys(2,)/----M(Nml(2)-1),K),nh', ndz_sG= (max_phys(3)-min_phys(3,)/----M(Nml(3)-1),K),nh', nrdx2_s = 1.0_K)/(dx_s*dx_s)h', nrdy2_s = 1.0_K)/(dy_s*dy_s) p', nrdz2_s = 1.0_K)/(dz_s*dz_s)h #marcor= __3D #if __KIND == __------Cn dx_dG= (max_phys(1)-min_phys(1,)/----M(Nml(1)-1),K),nh', ndy_dG= (max_phys(2)-min_phys(2,)/----M(Nml(2)-1),K),nh', ndz_dG= (max_phys(3)-min_phys(3,)/----M(Nml(3)-1),K),nh', nrdx2_d = 1.0_K)/(dx_d*dx_d)h', nrdy2_d = 1.0_K)/(dy_d*dy_d,nh', nrdz2_d = 1.0_K)/(dz_d*dz_d-- #march #march orcor IM SFIELDh', n,optD pcenm_ lloc_f-- nh', nldu2(1)n=nnsorsh', nldu2(2)n=n2* ENudimh', n----- lloc(bcdef_sc-,ldu2,,opt,-----------R -RIF (i_2DD.NE. 0F #eli f __DIM == RRi_2DD pm_al-f-- lf __DIM == =----- pm_al( pm__alloc,----upoissumg_iT----nn innfo o 'BoM).at, comarotevis--__LINE__------------RRRR RRGOTO 9999h Fnn END-Fh Fnn bcdef_sc-(:,:)=0h', nDO isor=1,nsors ------RRRR idom=topo%isor mot(i---)h Fnn nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichh Fnn nd compareGene west boM).at,h Fnn nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichh Fnn nIF (ABS(min_sor(1,idom)-min_phys(1,) .LT.n innfo o lmyeps*(max_sor(1,idom)-min_sor(1,idom))F #elif __DIM == ==bcdef_sc-(i---,1)=ibcdef(1) ! n nEND-Fh', ed & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichh Fnn nd compareGene east boM).at,h Fnn nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichh Fnn nIF (ABS(max_sor(1,idom)-max_phys(1)) .LT.n innfo o lmyeps*(max_sor(1,idom)-min_sor(1,idom))F #elif __DIM == ==bcdef_sc-(i---,2)=ibcdef(2) ! n nEND-Fh', ed & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichh Fnn nd compareGene south boM).at,h Fnn nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichh Fnn nIF (ABS(min_sor(2,idom)-min_phys(2)) .LT.n innfo o lmyeps*(max_sor(2,idom)-min_sor(2,idom))F #elif __DIM == ==bcdef_sc-(i---,3)=ibcdef(3) ! n nEND-Fh', ed & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichh Fnn nd compareGene north boM).at,h Fnn nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichh Fnn nIF (ABS(max_sor(2,idom)-max_phys(2)) .LT.n innfo o lmyeps*(max_sor(2,idom)-min_sor(2,idom))F #elif __DIM == ==bcdef_sc-(i---,4)=ibcdef(4) ! n nEND-Fh', ed & & 'point status array GMM_STATE2D',__L! CH-8092 Zuh Fnn nd compareGene south boM).at,h Fnn nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichh#arcorMESHr IM 3D- ! nnIF (ABS(min_sor(3,idom)-min_phys(3)) .LT.n innfo o lmyeps*(max_sor(3,idom)-min_sor(3,idom))F #elif __DIM == ==bcdef_sc-(i---,5)=ibcdef(5) ! n nEND-Fh', ed & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichh Fnn nd compareGene north boM).at,h Fnn nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichh Fnn nIF (ABS(max_sor(3,idom)-max_phys(3)) .LT.n innfo o lmyeps*(max_sor(3,idom)-min_sor(3,idom))F #elif __DIM == ==bcdef_sc-(i---,6)=ibcdef(6) ! n nEND-Fh #marcfffffffffh Fnn ENDDO nh', nlperiodic=.TRUE. nh', nDO isor=1,nsors f __DIM == RDO i=1,2* ENudimh', nnn nIF (bcdef_sc-(i---,i).NE. pcenm_bcdef_periodicF #elif __DIM == = lperiodic=.FALSE. f __DIM == RFnn EXIT f __DIM == RFnEND-F -_DIM == RFnENDDO nh', nENDDO h #marcor IM VFIELDh', n,optD pcenm_ lloc_f--h', nldu3(1)n=nv cdimh', nldu3(2)n=nnsorsh', nldu3(3)n=n2* ENudimh', n----- lloc(bcdef_v c,ldu3,,opt,-----------R -RIF (i_2DD.NE. 0F #elif __DIM == RRi_2DD pm_al-f-- lf __DIM == =----- pm_al( pm__alloc,----upoissumg_iT----nn innfo o 'BoM).at, comarotevis--__LINE__------------RRRR RRGOTO 9999h Fnn END-Fh Fnn bcdef_v c(:,:,:)=0h', nDO isor=1,nsors------RRRR Ridom=topo%isor mot(i---)h Fnn nnDO ilda=1,v cdimh', n nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurh', n nd compareGene west boM).at,h Fnn nnd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichh Fnn nnIF (ABS(min_sor(1,idom)-min_phys(1,) .LT.n innfo o lmyeps*(max_sor(1,idom)-min_sor(1,idom))F #elif __DIM == ==bcdef_v c(ilda,i---,1)=ibcdef(ilda,1) ! n nnEND-Fh', end & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichh Fnn nnd compareGene east boM).at,h Fnn nnd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichh Fnn nnIF (ABS(max_sor(1,idom)-max_phys(1)) .LT.n innnfo o lmyeps*(max_sor(1,idom)-min_sor(1,idom))F #elif __DIM == ==bcdef_v c(ilda,i---,2)=ibcdef(ilda,2) ! n nEND-Fh', ed & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichh Fnn nd compareGene south boM).at,h Fnn nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichh Fnn nIF (ABS(min_sor(2,idom)-min_phys(2)) .LT.n innfo o lmyeps*(max_sor(2,idom)-min_sor(2,idom))F #elif __DIM == ==bcdef_v c(ilda,i---,3)=ibcdef(ilda,3) ! n nEND-Fh', ed & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichh Fnn nd compareGene north boM).at,h Fnn nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichh Fnn nIF (ABS(max_sor(2,idom)-max_phys(2)) .LT.n innfo o lmyeps*(max_sor(2,idom)-min_sor(2,idom))F #elif __DIM == ==bcdef_v c(ilda,i---,4)=ibcdef(ilda,4) ! n nEND-Fh#arcorMESHr IM 3D- ! nnd & & 'point status array GMM_STATE2D',__L! CH-8092 Zuh Fnn nd compareGene south boM).at,h Fnn nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichh Fnn nIF (ABS(min_sor(3,idom)-min_phys(3)) .LT.n innfo o lmyeps*(max_sor(3,idom)-min_sor(3,idom))F #elif __DIM == ==bcdef_v c(ilda,i---,5)=ibcdef(ilda,5) ! n nEND-Fh', ed & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichh Fnn nd compareGene north boM).at,h Fnn nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurichh Fnn nIF (ABS(max_sor(3,idom)-max_phys(3)) .LT.n innfo o lmyeps*(max_sor(3,idom)-min_sor(3,idom))F #elif __DIM == ==bcdef_v c(ilda,i---,6)=ibcdef(ilda,6) ! n nEND-Fh #marc ! n #mado ! n #mado ! n lperiodic=.TRUE.h', nDo isor=1,nsors------RRRR RDO i=1,2* ENudimh', nnn DO ilda=1,v cdimh', n n nIF (bcdef_v c(ilda,i---,i).NE. pcenm_bcdef_periodicF #henh', n n n n lperiodic=.FALSE.h', n n n n EXITf __DIM == RFnEND-F __DIM == RFnENDDO- ! = RFnENDDO- ! = RENDDO- #marc ! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swurichh F!Allocatevinof-ene ghost-izeh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swurichh F n,optD pcenm_ lloc_f-- nh', nldu1(1)n=n ENudimh', n----- lloc(ghost-ize,ldu1,,opt,-----------R -RIF (i_2DD.NE. 0F #eli f __DIM == RRi_2DD pm_al-f-- lf __DIM == =----- pm_al( pm__alloc,----upoissumg_iT----nn innfo o 'ghost-ize--__LINE__------------RRRR RRGOTO 9999h Fnn END-Fh Fnn ghost-ize=,ghost-izeh', & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swurih F!ALLOCATI--- OF #el FACTOR FOR COARSENING (LA---HSET TO 2,--rallel & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swurih F n,optD pcenm_ lloc_f-- nh', nldu1(1)n=n ENudimh', n----- lloc(factor,ldu1,,opt,-----------R -RIF (i_2DD.NE. 0F #eli f __DIM == RRi_2DD pm_al-f-- lf __DIM == =----- pm_al( pm__alloc,----upoissumg_iT----nn innfo o 'factor--__LINE__------------RRRR RRGOTO 9999h Fnn END-Fh F & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swurih F!-----NAL IDS FOR MESHESh F & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swurih F n,optD pcenm_ lloc_f-- nh', nldu1(1)n=nBaxlevh', n----- lloc(BPM.id_g,ldu1,,opt,-----------R -RIF (i_2DD.NE. 0F #eli f __DIM == RRi_2DD pm_al-f-- lf __DIM == =----- pm_al( pm__alloc,----upoissumg_iT----nn innnfo o 'BPM.id_g--__LINE__------------RRRR RRGOTO 9999h Fnn END-Fh F & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swurih F!USER IDS FOR MESHESh F & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich, Swurih F n,optD pcenm_ lloc_f-- nh', nldu1(1)n=nBaxlevh', n----- lloc(BPM._id_g,ldu1,,opt,-----------R -RIF (i_2DD.NE. 0F #eli f __DIM == RRi_2DD pm_al-f-- lf __DIM == =----- pm_al( pm__alloc,----upoissumg_iT----nn innnfo o 'BPM._id_g--__LINE__------------RRRR RRGOTO 9999h Fnn END-Fh F n,optD pcenm_ lloc_f--h', nldu3(1)n=n ENudimh', nldu3(2)n=nnsorsh', nldu3(3)n=nBaxlevh', n----- lloc(-ong ,ldu3,,opt,-----------R -RIF (i_2DD.NE. 0F #eli f __DIM == RRi_2DD pm_al-f-- lf __DIM == =----- pm_al( pm__alloc,----upoissumg_iT----nn innfo o '-ong i---imarcespwhen upda i---ata_field--__LINE__------------RRRR RRGOTO 9999h Fnn END-Fh F n,optD pcenm_ lloc_f--h', nldu3(1)n=n ENudimh', nldu3(2)n=nnsorsh', nldu3(3)n=nBaxlevh', n----- lloc(i-oop,ldu3,,opt,-----------R -RIF (i_2DD.NE. 0F #eli f __DIM == RRi_2DD pm_al-f-- lf __DIM == =----- pm_al( pm__alloc,----upoissumg_iT----nnnn innfo o 'i-ooppi---imarcespwhen upda i---ata_field--__LINE__------------RRRR RRGOTO 9999h Fnn END-Fh arcor IM SFIELDh#arcorMESHr IM 2D-#arcor= __3D #if !---------------Cn ,optD pcenm_ lloc_f--h', nldu2(1)n=nnsorsh', nldu2(2)n=nBaxlevh', n----- mg_ lloc(mgfield_2d_sc-_s,ldu2,,opt,-----------R -RIF (i_2DD.NE. 0F #elif __DIM == RRi_2DD pm_al-f-- lf __DIM == =----- pm_al( pm__alloc,----upoissumg_iT----nnn innfo o 'Multigrid fields used Di-ene different levels--__LINE__------------RRRR RRGOTO 9999h Fnn END-Fh F nmgfield =>-mgfield_2d_sc-_sh #marcor= __3D #if __KIND == __------Cn ,optD pcenm_ lloc_f--h', nldu2(1)n=nnsorsh', nldu2(2)n=nBaxlevh', n----- mg_ lloc(mgfield_2d_sc-_d,ldu2,,opt,-----------R -RIF (i_2DD.NE. 0F #elif __DIM == RRi_2DD pm_al-f-- lf __DIM == =----- pm_al( pm__alloc,----upoissumg_iT----nnn innfo o 'Multigrid fields used Di-ene different levels--__LINE__------------RRRR RRGOTO 9999h Fnn END-Fh F nmgfield =>-mgfield_2d_sc-_dp #march #marcorMESHr IM 3D-#arcor= __3D #if !---------------Cn ,optD pcenm_ lloc_f--h', nldu2(1)n=nnsorsh', nldu2(2)n=nBaxlevh', n----- mg_ lloc(mgfield_3d_sc-_s,ldu2,,opt,-----------R -RIF (i_2DD.NE. 0F #elif __DIM == RRi_2DD pm_al-f-- lf __DIM == =----- pm_al( pm__alloc,----upoissumg_iT----nnn innnnnnnnnnnnnfo o 'Multigrid fields used Di-ene different levels--__LINE__------------RRRR RRGOTO 9999h Fnn END-Fh F nmgfield =>-mgfield_3d_sc-_sh #marcor= __3D #if __KIND == __------Cn ,optD pcenm_ lloc_f--h', nldu2(1)n=nnsorsh', nldu2(2)n=nBaxlevh', n----- mg_ lloc(mgfield_3d_sc-_d,ldu2,,opt,-----------R -RIF (i_2DD.NE. 0F #elif __DIM == RRi_2DD pm_al-f-- lf __DIM == =----- pm_al( pm__alloc,----upoissumg_iT----nnn innfo o 'Multigrid fields used Di-ene different levels--__LINE__------------RRRR RRGOTO 9999h Fnn END-Fh F nmgfield =>-mgfield_3d_sc-_dfh #march #march #marcor IM VFIELDh#arcorMESHr IM 2D-#arcor= __3D #if !---------------Cn ,optD pcenm_ lloc_f--h', nldu2(1)n=nnsorsh', nldu2(2)n=nBaxlevh', n----- mg_ lloc(mgfield_2d_v c_s,ldu2,,opt,-----------R -RIF (i_2DD.NE. 0F #elif __DIM == RRi_2DD pm_al-f-- lf __DIM == =----- pm_al( pm__alloc,----upoissumg_iT----nnn innfo o 'Multigrid fields used Di-ene different levels--__LINE__------------RRRR RRGOTO 9999h Fnn END-Fh F nmgfield =>-mgfield_2d_v c_sh #marcor= __3D #if __KIND == __------Cn ,optD pcenm_ lloc_f--h', nldu2(1)n=nnsorsh', nldu2(2)n=nBaxlevh', n----- mg_ lloc(mgfield_2d_v c_d,ldu2,,opt,-----------R -RIF (i_2DD.NE. 0F #elif __DIM == RRi_2DD pm_al-f-- lf __DIM == =----- pm_al( pm__alloc,----upoissumg_iT----nnn innfo o 'Multigrid fields used Di-ene different levels--__LINE__------------RRRR RRGOTO 9999h Fnn END-Fh F nmgfield =>-mgfield_2d_v c_dp #march #marcorMESHr IM 3D-#arcor= __3D #if !---------------Cn ,optD pcenm_ lloc_f--h', nldu2(1)n=nnsorsh', nldu2(2)n=nBaxlevh', n----- mg_ lloc(mgfield_3d_v c_s,ldu2,,opt,-----------R -RIF (i_2DD.NE. 0F #elif __DIM == RRi_2DD pm_al-f-- lf __DIM == =----- pm_al( pm__alloc,----upoissumg_iT----nnn innnnnnnnnnnnnfo o 'Multigrid fields used Di-ene different levels--__LINE__------------RRRR RRGOTO 9999h Fnn END-Fh F nmgfield =>-mgfield_3d_v c_sh #marcor= __3D #if __KIND == __------Cn ,optD pcenm_ lloc_f--h', nldu2(1)n=nnsorsh', nldu2(2)n=nBaxlevh', n----- mg_ lloc(mgfield_3d_v c_d,ldu2,,opt,-----------R -RIF (i_2DD.NE. 0F #elif __DIM == RRi_2DD pm_al-f-- lf __DIM == =----- pm_al( pm__alloc,----upoissumg_iT----nnn innfo o 'Multigrid fields used Di-ene different levels--__LINE__------------RRRR RRGOTO 9999h Fnn END-Fh F nmgfield =>-mgfield_3d_v c_dfh #march #march #marc ! n ,optD pcenm_ lloc_f--h', nldu2(1)n=n2* ENudimh', nldu2(2)n=nnsorsh', n----- lloc(lboM).at,,ldu2,,opt,-----------R -RIF (i_2DD.NE. 0F #elif __DIM == RRi_2DD pm_al-f-- lf __DIM == =----- pm_al( pm__alloc,----upoissumg_iT----nnnn innfo o 'Problem with-ene boM).at,Galloc.--__LINE__------------RRRR RRGOTO 9999h Fnn END-Fh ! n ,optD pcenm_ lloc_f--h', nldu2(1)n=n ENudimh', nldu2(2)n=nBaxlevh', n----- lloc(Bax_node,ldu2,,opt,-----------R -RIF (i_2DD.NE. 0F #elif __DIM == RRi_2DD pm_al-f-- lf __DIM == =----- pm_al( pm__alloc,----upoissumg_iT----nnnn innfo o 'Problem with-anBaximumlnumberGalloc.--__LINE__------------RRRR RRGOTO 9999h Fnn END-Fh Fnn Bax_node(:,:)=0hh', nlboM).at,(:,:)=.FALSE.h', n-ong -:,:,:)=1h', nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,h', ndiDerive coarsernBPM.esFh', nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,h', DO mlev=1,Baxlevh arcorMESHr IM 2D- ! n nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zuri- ! n nd Go-enrough-ene sors, defiTe-ene i-ooppi---imarcespDi-eachnBPM.,- ! n nd caeck andGstore-if itfis-Di-ene boM).at,, allocate-ene - ! n nd multigrid fields, pass-ene boM).at,Gvalues.- ! n nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zuri- ! n nDO i=1,nsors------RRRR R Ridom=topo%isor mot(i-------RRRR RRRRi-oop-:,i,mlev)=-BPM.%nnodes(:,idom)------RRRR RRRRDO j=1, ENudimh', nnn nnnnnIF (Bax_node(j,mlev).LT.i-oop-j,i,mlev)F #elif __DIM == = Bax_node(j,mlev)=i-oop-j,i,mlev) f __DIM == RFnn FnEND-F __DIM == RFnFnENDDO- ! = RFnn nd & & 'point status array GMM_STATE2D',__L! CH-8092 Z- ! = RFnn nd Allocate-ene functevincorrec! on,-ene restricted pm_als,- ! = RFnn nd ene residualsFandGene values-Di-ene boM).at,pDi-eachnlevel.h', n n n d & & 'point status array GMM_STATE2D',__L! CH-8092 Z- orcor IM SFIELDh', nnnnnnn,optD pcenm_ lloc_f--h', nnnnnnnldl2(1)n=n1-ghost-ize(1) ! n nnnnnnldl2(2)n=n1-ghost-ize(2) ! n nnnnnnldu2(1)n=nBPM.%nnodes(1,idom)+ghost-ize(1) ! n nnnnnnldu2(2)n=nBPM.%nnodes(2,idom)+ghost-ize(2) ! n nnnnnn----- lloc(Bgfield(i,mlev)%uc,ldl2,ldu2,,opt,-----------R -RRRRRRRIF (i_2DD.NE. 0F #elif __DIM == RRnnnnnn,_2DD pm_al-f-- lf __DIM == =nnnnnn----- pm_al( pm__alloc,----upoissumg_iT----nnnn innfo o 'Problem with-ene functevincorr.Galloc.--__LINE__------------RRRR RRRRRRRRGOTO 9999h Fnn nnnnnnEND-F h Fnn nnnnnntuc=>Bgfield(i,mlev)%uch Fnn nnnnnntuc=0.0_K) h Fnn nnnnnn,optD pcenm_ lloc_f--h', nnnnnnnldu2(1)n=nBPM.%nnodes(1,idom) ! n nnnnnnldu2(2)n=nBPM.%nnodes(2,idom) ! n nnnnnn----- lloc(Bgfield(i,mlev)%fc,ldu2,,opt,-----------R -RRRRRRRIF (i_2DD.NE. 0F #elif __DIM == RRnnnnnn,_2DD pm_al-f-- lf __DIM == =nnnnnn----- pm_al( pm__alloc,----upoissumg_iT----nnnn innnnnn innnnnn'Problem with-ene restricted pm_.Galloc.--__LINE__------------RRRR RRRRRRRRGOTO 9999h Fnn nnnnnnEND-Fh Fnn nnnnnnBgfield(i,mlev)%fc(:,:)=0.0_K)h', nnnnnnn,optD pcenm_ lloc_f--h', nnnnnnnldl2(1)n=n1-ghost-ize(1) ! n nnnnnnldl2(2)n=n1-ghost-ize(2) ! n nnnnnnldu2(1)n=nBPM.%nnodes(1,idom)+ghost-ize(1) ! n nnnnnnldu2(2)n=nBPM.%nnodes(2,idom)+ghost-ize(2) ! n nnnnnn----- lloc(Bgfield(i,mlev)%pm_,ldl2,ldu2,,opt,-----------R -RRRRRRRIF (i_2DD.NE. 0F #elif __DIM == RRnnnnnn,_2DD pm_al-f-- lf __DIM == =nnnnnn----- pm_al( pm__alloc,----upoissumg_iT----nnnn innfo o 'Problem with-ene residualGalloc.--__LINE__------------RRRR RRRRRRRRGOTO 9999h Fnn nnnnnnEND-Fh Fnn nnnnnnterr=>Bgfield(i,mlev)%err h Fnn nnnnnnterr(:,:)=0.0_K)h', nnnnnn!ALLOCATE #el BCVALUE(IT IS A TYPE!!-------RRRR RRRR!PRINT *,'LPERIODIC:',lperiodic------RRRR RRRRIF (.NOT.lperiodicF #elif __DIM == = ,optD pcenm_ lloc_f--h', nnnnnnnldu1(1)n=n2* ENudimh', nnnnnnn----- mg_ lloc(mgfield(i,mlev)%bcvalue,ldu1,,opt,-----------R -RR RRRRIF (i_2DD.NE. 0F #elif __DIM == RRnnnnnn,_2DD pm_al-f-- lf __DIM == =nnnnnn----- pm_al( pm__alloc,----upoissumg_iT----nnnn innfo o 'Problem with-ene BOUNDARYGalloc.--__LINE__------------RRRR RRRRRRRRGOTO 9999h Fnn nnnnnnEND-Fh Fnn nnnnn!ALLOCATE #el PBCVALUE h Fnn nnnnnDO iface=1,2* ENudim h Fnn nnnnnn,optD pcenm_ lloc_f--h', nnnnnnnIF (iface.EQ.1.OR.iface.EQ.2F #elif __DIM == RRnnnnldu1(1)n=nBax_node(2,mlev)h Fnn nnnnnnELSEf __DIM == RRnnnnldu1(1)n=nBax_node(1,mlev)h Fnn nnnnnnEND-Fh Fnn nnnnnn----- lloc(Bgfield(i,mlev)%bcvalue(iface)%pbcvalue,ldu1,,opt,-----------R -RR RRRRIF (i_2DD.NE. 0F #elif __DIM == RRnnnnnn,_2DD pm_al-f-- lf __DIM == =nnnnnn----- pm_al( pm__alloc,----upoissumg_iT----nnnn innfo o 'Problem with-ene BOUNDARYGalloc.--__LINE__------------RRRR RRRRRRRRGOTO 9999h Fnn nnnnnnEND-F __DIM == RFnFnENDDO- ! = RFnn DO iface=1,2* ENudim------RRRR RRRRRRIF (iface.EQ.1.OR.iface.EQ.2F #eli f __DIM == RFnn Fnnnnndirec(1)=2f __DIM == RFnn FELSEIF (iface.EQ.3.OR.iface.EQ.4)-enenh', n n n n n Fnnnnndirec(1)=1f __DIM == RFnn FEND-Fh Fnn nnnnnnn DO ipoint=1,Bax_node(direc(1),mlev)h Fnn nnnnnnRRRRIF (mlev.EQ.1F #eli h', n n n n n FnnBgfield(i,mlev)%bcvalue(iface)%pbcvalue(ipoint)=bcvalue(i,iface,ipoint)h', n n n n n FnnnnnnnELSEf __DIM == RRnnnnRRRRIF(bcdef_sc-(i,iface).EQ. pcenm_bcdef_neumannF #eli f __DIM == RFnn FnnnnnBgfield(i,mlev)%bcvalue(iface)%pbcvalue(ipoint)= innnnnnnnnnnn& RFnn FnnnnnBgfield(i,mlev-1)%bcvalue(iface)%pbcvalue(2*ipoint-1) f __DIM == RFnn FnnnnELSEf __DIM == RRnnnnRRRRnn!NO CORRECTIONS FOR #el DIRICHLET f __DIM == RFn __DIM == RFnn FnnnnnBgfield(i,mlev)%bcvalue(iface)%pbcvalue(ipoint)=0.0_K)h', nnnnnnnFnnnnEND-F h', nnnnnnnFnnnEND-Fh Fnn nnnnnnn ENDDO- ! = RFnn ENDDO!faces ------RRRR END-F!lperiodic- #marcor IM VFIELDh', nnnnnnn,optD pcenm_ lloc_f--h', nnnnnnnldl3(1)n=n1f __DIM == RFnn ldl3(2)n=n1-ghost-ize(1) ! n nnnnnnldl3(3)n=n1-ghost-ize(2) ! n nnnnnnldu3(1)n=nv cdimh', nnnnnnnldu3(2)n=nBPM.%nnodes(1,idom)+ghost-ize(1) ! n nnnnnnldu3(3)n=nBPM.%nnodes(2,idom)+ghost-ize(2) ! n nnnnnn----- lloc(Bgfield(i,mlev)%uc,ldl3,ldu3,,opt,-----------R -RRRRRRRIF (i_2DD.NE. 0F #elif __DIM == RRnnnnnn,_2DD pm_al-f-- lf __DIM == =nnnnnn----- pm_al( pm__alloc,----upoissumg_iT----nnnn innfo o 'Problem with-ene functevincorr.Galloc.--__LINE__------------RRRR RRRRRRRRGOTO 9999h Fnn nnnnnnEND-Fh Fnn nnnnnntuc=>Bgfield(i,mlev)%uch Fnn nnnnnntuc=0.0_K)f __DIM == = ,optD pcenm_ lloc_f--h', nnnnnnnldu3(1)n=nv cdim h', nnnnnnnldu3(2)n=nBPM.%nnodes(1,idom) ! n nnnnnnldu3(3)n=nBPM.%nnodes(2,idom) ! n nnnnnn----- lloc(Bgfield(i,mlev)%fc,ldu3,,opt,-----------R -RRRRRRRIF (i_2DD.NE. 0F #elif __DIM == RRnnnnnn,_2DD pm_al-f-- lf __DIM == =nnnnnn----- pm_al( pm__alloc,----upoissumg_iT----nnnn innfo o 'Problem with-ene restricted pm_.Galloc.--__LINE__------------RRRR RRRRRRRRGOTO 9999h Fnn nnnnnnEND-Fh Fnn nnnnnnBgfield(i,mlev)%fc(:,:,:)=0.0_K)h', nnnnnnn,optD pcenm_ lloc_f--h', nnnnnnnldl3(1)n=n1f __DIM == RFnn ldl3(2)n=n1-ghost-ize(1) ! n nnnnnnldl3(3)n=n1-ghost-ize(2) ! n nnnnnnldu3(1)n=nv cdimh', nnnnnnnldu3(2)n=nBPM.%nnodes(1,idom)+ghost-ize(1) ! n nnnnnnldu3(3)n=nBPM.%nnodes(2,idom)+ghost-ize(2) ! n nnnnnn----- lloc(Bgfield(i,mlev)%pm_,ldl3,ldu3,,opt,-----------R -RRRRRRRIF (i_2DD.NE. 0F #elif __DIM == RRnnnnnn,_2DD pm_al-f-- lf __DIM == =nnnnnn----- pm_al( pm__alloc,----upoissumg_iT----nnnn innfo o 'Problem with-ene residualGalloc.--__LINE__------------RRRR RRRRRRRRGOTO 9999h Fnn nnnnnnEND-Fh Fnn nnnnnnterr=>Bgfield(i,mlev)%err h Fnn nnnnnnterr(:,:,:)=0.0_K)h #marc ! n ENDDO!DO 1,nsors- #marcorMESHr IM 3D h Fnn nnnDO i=1,nsors------RRRR R RRidom=topo%isor mot(i-------RRRR RRRRRi-oop-:,i,mlev) =-BPM.%nnodes(:,idom)------RRRR RRRRRDO j=1, ENudimh', nnn nnnnnnIF (Bax_node(j,mlev).LT.i-oop-j,i,mlev)F #elif __DIM == = Bax_node(j,mlev)=i-oop-j,i,mlev) f __DIM == RFnn FnnEND-Fh Fnn nnnnnnENDDO- ! = RFnn nIF (topo%sors_bc(1,idom).EQ.1F #elif __DIM == RFnn FnnlboM).at,(1,i)=.TRUE. nnnnnnnnnh Fnn nnnnnnELSEIF (topo%sors_bc(3,idom).EQ.1F #elif __DIM == RFnn FnnlboM).at,(3,i)=.TRUE.h Fnn nnnnnnELSEIF (topo%sors_bc(2,idom).EQ.1F #elif __DIM == RFnn FnnlboM).at,(2,i)=.TRUE. nh Fnn nnnnnnELSEIF (topo%sors_bc(4,idom).EQ.1F #elif __DIM == RFnn FnnlboM).at,(4,i)=.TRUE.h Fnn nnnnnnELSEIF (topo%sors_bc(5,idom).EQ.1F #elif __DIM == RFnn FnnlboM).at,(5,i)=.TRUE. h Fnn nnnnnnELSEIF (topo%sors_bc(6,idom).EQ.1F #elif __DIM == RFnn FnnlboM).at,(6,i)=.TRUE.h Fnn nnnnnnEND-Fh Fnn nnnnnnd & & 'point status array GMM_STATE2D',__L! CH-8092 Z- ! = RFnn nd Allocate-ene functevincorrec! on,-ene restricted pm_alsFandGene - ! = RFnn ndresidualsFDi-eachnlevel.h', n n n d & & 'point status array GMM_STATE2D',__L! CH-8092 Z- orcor IM SFIELDh', nnnnnnn,optD pcenm_ lloc_f--h', nnnnnnnldl3(1)n=n1-ghost-ize(1) ! n nnnnnnldl3(2)n=n1-ghost-ize(2) ! n nnnnnnldl3(3)n=n1-ghost-ize(3) ! n nnnnnnldu3(1)n=nBPM.%nnodes(1,idom)+ghost-ize(1) ! n nnnnnnldu3(2)n=nBPM.%nnodes(2,idom)+ghost-ize(2) ! n nnnnnnldu3(3)n=nBPM.%nnodes(3,idom)+ghost-ize(3) ! n nnnnnn----- lloc(Bgfield(i,mlev)%uc,ldl3,ldu3,,opt,-----------R -RRRRRRRIF (i_2DD.NE. 0F #elif __DIM == RRnnnnnn,_2DD pm_al-f-- lf __DIM == =nnnnnn----- pm_al( pm__alloc,----upoissumg_iT----nnnn innfo o 'Problem with-ene functevincorr.Galloc.--__LINE__------------RRRR RRRRRRRRGOTO 9999h Fnn nnnnnnEND-Fh Fnn nnnnnntuc=>Bgfield(i,mlev)%uch Fnn nnnnnntuc=0.0_K) Fnn nnnnnnf __DIM == = ,optD pcenm_ lloc_f--h', nnnnnnnldu3(1)n=nBPM.%nnodes(1,idom) ! n nnnnnnldu3(2)n=nBPM.%nnodes(2,idom) ! n nnnnnnldu3(3)n=nBPM.%nnodes(3,idom) ! n nnnnnn----- lloc(Bgfield(i,mlev)%fc,ldu3,,opt,-----------R -RRRRRRRIF (i_2DD.NE. 0F #elif __DIM == RRnnnnnn,_2DD pm_al-f-- lf __DIM == =nnnnnn----- pm_al( pm__alloc,----upoissumg_iT----nnnn innfo o 'Problem with-ene restricted pm_.Galloc.--__LINE__------------RRRR RRRRRRRRGOTO 9999h Fnn nnnnnnEND-Fh Fnn nnnnnnBgfield(i,mlev)%fc=0.0_K)h', nnnnnnn,optD pcenm_ lloc_f--h', nnnnnnnldl3(1)n=n1-ghost-ize(1) ! n nnnnnnldl3(2)n=n1-ghost-ize(2) ! n nnnnnnldl3(3)n=n1-ghost-ize(3) ! n nnnnnnldu3(1)n=nBPM.%nnodes(1,idom)+ghost-ize(1) ! n nnnnnnldu3(2)n=nBPM.%nnodes(2,idom)+ghost-ize(2) ! n nnnnnnldu3(3)n=nBPM.%nnodes(3,idom)+ghost-ize(3) ! n nnnnnn----- lloc(Bgfield(i,mlev)%pm_,ldl3,ldu3,,opt,-----------R -RRRRRRRIF (i_2DD.NE. 0F #elif __DIM == RRnnnnnn,_2DD pm_al-f-- lf __DIM == =nnnnnn----- pm_al( pm__alloc,----upoissumg_iT----nnnn innfo o 'Problem with-ene residualGalloc.--__LINE__------------RRRR RRRRRRRRGOTO 9999h Fnn nnnnnnEND-Fh Fnn nnnnnnterr=>Bgfield(i,mlev)%err h Fnn nnnnnnterr=0.0_K) h Fnn nnnnn!ALLOCATE #el BCVALUE(IT IS A TYPE!!-------RRRR RRRRIF (.NOT.lperiodicF #elif __DIM == = ,optD pcenm_ lloc_f--h', nnnnnnnldu1(1)n=n2* ENudimh', nnnnnnn----- mg_ lloc(mgfield(i,mlev)%bcvalue,ldu1,,opt,-----------R -RR RRRRIF (i_2DD.NE. 0F #elif __DIM == RRnnnnnn,_2DD pm_al-f-- lf __DI nnnnnnn----- pm_al( pm__alloc,----upoissumg_iT----nnnn innfo o 'Problem with-ene BOUNDARYGalloc.--__LINE__------------RRRR RRRRRRRRGOTO 9999h Fnn nnnnnnEND-F------RRRR RRRRRR!ALLOCATE #el PBCVALUE h Fnn nnnnnDO iface=1,2* ENudim h Fnn nnnnnn,optD pcenm_ lloc_f--h', nnnnnnnIF (iface.EQ.1.OR.iface.EQ.2F #elif __DIM == RRnnnnldu2(1)n=nBax_node(2,mlev)h Fnn nnnnnnRnnnnldu2(2)=nBax_node(3,mlev)h Fnn nnnnnnELSEorc(iface.EQ.3.OR. iface.EQ.4)-enennn nnnnnnf __DIM == RRnnnnldu2(1)n=nBax_node(1,mlev)h Fnn nnnnnnRnnnnldu2(2)=Bax_node(3,mlev)h Fnn nnnnnnnnnnnelseh Fnn nnnnnnnnnnnnldu2(1)=Bax_node(1,mlev)h Fnn nnnnnnRnnnnnldu2(2)=Bax_node(2,mlev)h Fnn nnnnnnEND-Fh Fnn nnnnnn----- lloc(Bgfield(i,mlev)%bcvalue(iface)%pbcvalue,ldu2,,opt,-----------R -RRRRRRR!Pr--t *,-ize(Bgfield(i,mlev)%bcvalue(iface)%pbcvalue,1) ! n nnnnnnIF (i_2DD.NE. 0F #elif __DIM == RRnnnnnn,_2DD pm_al-f-- lf __DI nnnnnnn----- pm_al( pm__alloc,----upoissumg_iT----nnnn innfo o 'Problem with-ene BOUNDARYGalloc.--__LINE__------------RRRR RRRRRRRRGOTO 9999h Fnn nnnnnnEND-F __DIM == RFnFnENDDO- ! = RFnn DO iface=1,2* ENudim------RRRR RRRRRRIF (iface.EQ.1.OR.iface.EQ.2F #eli f __DIM == RFn __DIM == RFdirec(1)=2f __DIM == RFnn Fn __DIM == RFdirec(2)=3f __DIM == RFnn Fn __DIMelseorc(iface.EQ.3.OR.iface.EQ.4)-#elif __DIM == = = RFdirec(1)=1f __DIM == RFnn FDIM == RFdirec(2)=3f __DIM == RFnn Fn __DIMelsef __DIM == = = RFdirec(1)=1f __DIM == RFnn FDIM == RFdirec(2)=2f __DIM == RFnn Fn __DIM#marc ! n DO ipoint=1,Bax_node(direc(1),mlev)h Fnn nnnnnnRRRRDO jpoint=1,Bax_node(direc(2),mlev)h Fnn nnnnnnRRRRRIF (mlev.EQ.1F #eli h', n n n n n FnnnBgfield(i,mlev)%bcvalue(iface)%pbcvalue(ipoint,jpoint)=bcvalue(i,iface,ipoint,jpoint)f __DIM == RFnn Fn __DIM == RFELSEf __DIM == RRnnnnRRRRnIF(bcdef_sc-(i,iface).EQ. pcenm_bcdef_neumannF #eli f __DIM == RFnn Fnnnnn n FnnnBgfield(i,mlev)%bcvalue(iface)%pbcvalue(ipoint,jpoint)= innnnnnnnnnnn& RFnn FnnnnBgfield(i,mlev-1)%bcvalue(iface)%pbcvalue(2*ipoint-1,2*jpoint-1) f __DIM == RFnn FnnnnFELSEf __DIM == RRnnnnRRRR!NO CORRECTIONS FOR #el DIRICHLET f __DIM == RFn __DIM == RFnn FnnnnBgfield(i,mlev)%bcvalue(iface)%pbcvalue(ipoint,jpoint)=0.0_K)h', nnnnnnnFnnnnEND-F h', nnnnnnnFnnnEND-Fh Fnn nnnnnnn ENDDO- ! = RFnn FnENDDO nnnnnnnnnnnnnnnnnnnnnnnnnnnnn __DIM == RFnFnENDDO!faces ------RRRR #marcf!lperiodic- #marcor IM VFIELDh', nnnnnnn,optD pcenm_ lloc_f--h', nnnnnnnldl4(1)n=n1f __DIM == RFnn ldl4(2)n=n1-ghost-ize(1) ! n nnnnnnldl4(3)n=n1-ghost-ize(2) ! n nnnnnnldl4(4)n=n1-ghost-ize(3) ! n nnnnnnldu4(1)n=nv cdimh', nnnnnnnldu4(2)n=nBPM.%nnodes(1,idom)+ghost-ize(1) ! n nnnnnnldu4(3)n=nBPM.%nnodes(2,idom)+ghost-ize(2) ! n nnnnnnldu4(4)n=nBPM.%nnodes(3,idom)+ghost-ize(3) ! n nnnnnn----- lloc(Bgfield(i,mlev)%uc,ldl4,ldu4,,opt,-----------R -RR RRRRIF (i_2DD.NE. 0F #elif __DIM == RRnnnnnn,_2DD pm_al-f-- lf __DI nnnnnnn----- pm_al( pm__alloc,----upoissumg_iT----nnnn innfo o 'Problem with-ene functevincorr.Galloc.--__LINE__------------RRRR RRRRRRRRGOTO 9999h Fnn nnnnnnEND-Fh Fnn nnnnnntuc=>Bgfield(i,mlev)%uch Fnn nnnnnntuc=0.0_K) Fnn nnnnnnf __DIM == = ,optD pcenm_ lloc_f--h', nnnnnnnldu4(1)n=nv cdimh', nnnnnnnldu4(2)n=nBPM.%nnodes(1,idom) ! n nnnnnnldu4(3)n=nBPM.%nnodes(2,idom) ! n nnnnnnldu4(4)n=nBPM.%nnodes(3,idom) ! n nnnnnn----- lloc(Bgfield(i,mlev)%fc,ldu4,,opt,-----------R -RR RRRRIF (i_2DD.NE. 0F #elif __DIM == RRnnnnnn,_2DD pm_al-f-- lf __DI nnnnnnn----- pm_al( pm__alloc,----upoissumg_iT----nnnn innfo o 'Problem with-ene restricted pm_.Galloc.--__LINE__------------RRRR RRRRRRRRGOTO 9999h Fnn nnnnnnEND-Fh Fnn nnnnnnBgfield(i,mlev)%fc=0.0_K)h', nnnnnnn,optD pcenm_ lloc_f--h', nnnnnnnldl4(1)n=n1f __DIM == RFnn ldl4(2)n=n1-ghost-ize(1) ! n nnnnnnldl4(3)n=n1-ghost-ize(2) ! n nnnnnnldl4(4)n=n1-ghost-ize(3) ! n nnnnnnldu4(1)n=nv cdimh', nnnnnnnldu4(2)n=nBPM.%nnodes(1,idom)+ghost-ize(1) ! n nnnnnnldu4(3)n=nBPM.%nnodes(2,idom)+ghost-ize(2) ! n nnnnnnldu4(4)n=nBPM.%nnodes(3,idom)+ghost-ize(3) ! n nnnnnn----- lloc(Bgfield(i,mlev)%pm_,ldl4,ldu4,,opt,-----------R -RR RRRRIF (i_2DD.NE. 0F #elif __DIM == RRnnnnnn,_2DD pm_al-f-- lf __DI nnnnnnn----- pm_al( pm__alloc,----upoissumg_iT----nnnn innfo o 'Problem with-ene residualGalloc.--__LINE__------------RRRR RRRRRRRRGOTO 9999h Fnn nnnnnnEND-Fh Fnn nnnnnnterr=>Bgfield(i,mlev)%err h Fnn nnnnnnterr=0.0_K)------RRRR RRRRRR!ALLOCATE #el BCVALUE(IT IS A TYPE!!-------RRRR RRRRIF (.NOT.lperiodicF #elif __DIM == = ,optD pcenm_ lloc_f--h', nnnnnnnnnnnldu1=2* ENudimh', nnnnnnn----- mg_ lloc(mgfield(i,mlev)%bcvalue,ldu1,,opt,-----------R -RR RRRRIF (i_2DD.NE. 0F #elif __DIM == RRnnnnnn,_2DD pm_al-f-- lf __DI nnnnnnn----- pm_al( pm__alloc,----upoissumg_iT----nnnn innfo o 'Problem with-ene BOUNDARYGalloc.--__LINE__------------RRRR RRRRRRRRGOTO 9999h Fnn nnnnnnEND-F------RRRR RRRRRR!ALLOCATE #el PBCVALUE h Fnn nnnnnDO iface=1,2* ENudim h Fnn nnnnnn,optD pcenm_ lloc_f--h', nnnnnnnnnnnldu3(1)=v cdimh', nnnnnnnIF (iface.EQ.1.OR.iface.EQ.2F #elif __DIM == RRnnnnnldu3(2)n=nBax_node(2,mlev)h Fnn nnnnnnRnnldu3(3)=nBax_node(3,mlev)h Fnn nnnnnnELSEIF (iface.EQ.3.OR. iface.EQ.4)-enennn nnnnnnf __DIM == RRnnnnnldu3(2)n=nBax_node(1,mlev)h Fnn nnnnnnRnldu3(3)=Bax_node(3,mlev)h Fnn nnnnnnELSEh Fnn nnnnnnRnnnnldu3(2)=Bax_node(1,mlev)h Fnn nnnnnnRnnnnldu3(3)=Bax_node(2,mlev)h Fnn nnnnnnEND-Fh Fnn nnnnnn----- lloc(Bgfield(i,mlev)%bcvalue(iface)%pbcvalue,ldu3,,opt,-----------R -RRRRRRRIF (i_2DD.NE. 0F #elif __DIM == RRnnnnn,_2DD pm_al-f-- lf __DI nnnnnn----- pm_al( pm__alloc,----upoissumg_iT----nnnn innfo o 'Problem with-ene BOUNDARYGalloc.--__LINE__------------RRRR RRRRRRRGOTO 9999h Fnn nnnnnnnEND-F __DIM == RFnFnENDDO- ! = RFnn DO iface=1,2* ENudim------RRRR RRRRRRRRIF (iface.EQ.1.OR.iface.EQ.2F #eli f __DIM == RFn __DIM == RFdirec(1)=2f __DIM == RFnn Fn __DIM =direc(2)=3f __DIM == RFnn Fn elseorc(iface.EQ.3.OR.iface.EQ.4)-#elif __DIM == = = RFdirec(1)=1f __DIM == RFnn FDIM == RFdirec(2)=3f __DIM == RFnn Fn elsef __DIM == = = RFdirec(1)=1f __DIM == RFnn FDIM == RFdirec(2)=2f __DIM == RFnn Fn #marc ! n DO ipoint=1,Bax_node(direc(1),mlev)h Fnn nnnnnnRRRRDO jpoint=1,Bax_node(direc(2),mlev)h Fnn nnnnnnRRRRR DO ilda=1,v cdimh', n n nnnnnnnnnnnnnnnnIF (mlev.EQ.1F #eli h', n n n n n FnnnnnnnnnnnnnBgfield(i,mlev)%bcvalue(iface)%pbcvalue(ilda,ipoint,jpoint)n info o =bcvalue(ilda,i,iface,ipoint,jpoint)f __DIM == RFnn Fn __DIM == RELSE h', n n n n n FnnnnnnnnnnnnIF(bcdef_v c(ilda,i,iface).EQ. pcenm_bcdef_neumannF #eli f __DIM == RFnn Fnnnnn n FnnnnnnnnnnnBgfield(i,mlev)%bcvalue(iface)%pbcvalue(ilda,ipoint,jpoint)= info o Bgfield(i,mlev-1)%bcvalue(iface)%pbcvalue(ilda,2*ipoint-1,2*jpoint-1) f __DIM == RFnn FnnnnFIM == RELSEf __DIM == RFnn FnnnnFIM == !NO CORRECTIONS FOR #el DIRICHLET f __DIM == RFn __DIM == RFnn FnnnnnnBgfield(i,mlev)%bcvalue(iface)%pbcvalue(ilda,ipoint,jpoint)=0.0_K)h', nnnnnnnFnnnn == REND-F h', nnnnnnnFnnn== REND-Ff __DIM == RFnn FnnnnFENDDO- ! = RFnn Fn ENDDO- ! = RFnn FnENDDO nnnnnnnnnnnnnnnnnnnnnnnnnnnn __DIM == RFnFnENDDO -_DIM == RFnEND-F !lperiodic- #marc ! n ENDDO!DO i=1,nsors- #marc ! n factor(:)=2f __DIM == RFBPM._id_g(mlev)=lBPM._idf __DIM == RFBPM.id_g(mlev)=BPM.idf __DIM == RFnewBPM.id=-1f __DIM == RFIF (mlev.LT.BaxlevF #eli f __DIM == RFnn----- mPM._derive(topoid,BPM.id,newBPM.id, info o pcenm_mPM._coarsen,factor,-----------RRRR RRRRlBPM._idn=nnewBPM.id------RRRR RRRRBPM.idn=ntopo%BPM.(lBPM._id)%IDh', nnnnEND-F __DIM == ENDDO!DO mlev=1,BaxlevFh', nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,h', nd ReturnFh', nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,h'9999RFnn-ONTINUEf __DIM ==-----sorsoop-' mg_iT----t0,-----------RRRRRETURN- orccccor IM SFIELDh#arccccorMESHr IM 2D-#arccccor= __3D #if !---------------CnEND SUBROUTINE mg_iT--_2d_sc-_sh #marccor= __3D #if __KIND == __------CnEND SUBROUTINE mg_iT--_2d_sc-_dp #march #marccorMESHr IM 3D-#arccccor= __3D #if !---------------CnEND SUBROUTINE mg_iT--_3d_sc-_sh #marccor= __3D #if __KIND == __------CnEND SUBROUTINE mg_iT--_3d_sc-_dp #march #march #marcor IM VFIELDh#arccccorMESHr IM 2D-#arccccor= __3D #if !---------------CnEND SUBROUTINE mg_iT--_2d_v c_sh #marccor= __3D #if __KIND == __------CnEND SUBROUTINE mg_iT--_2d_v c_dp #march #marccorMESHr IM 3D-#arccccor= __3D #if !---------------CnEND SUBROUTINE mg_iT--_3d_v c_sh #marccor= __3D #if __KIND == __------CnEND SUBROUTINE mg_iT--_3d_v c_dp #march #march #marchlib numerics-r1036/src/ module mg.f0000644000175000017500000000314611616214647017134 0u-ong omaromar nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Module-----Cn: module mg nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,-rih F!h F! Purpose----Cn: This module comtains-ene user-callable functevis ofh F! ene mg solver.h F! h F! Remarks----Cn:h F!h F! References Cn:h F!h F! Revisevis Cn:h F! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,-rih F! $Log: module mg.f,v $h F! Revisevi 1.1.1.1 2007/07/13 10:19:00 ivosh F! CBL versevinof-ene PPM librat,h F!h F! Revisevi 1.1 2004/09/22 18:39:26 kotsalieh F! MGnnew versevih F!h F! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Perallel Png icle MPM. Librat, (PPM)h F! Institutenof-Computatevial Scienceh F! ETH Zentrum, Hirschengraben 84h F! CH-8092 Zurich, Switzerlandh F! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,-rihh FMODULE module mg h', nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,h', nd PPM modulesh', nd & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,h', nUSE module mg_iT--h', nUSE module mg_solvh', nUSE module mg_fiializeh', nUSE module mg_alloch', nUSE module mg_coreh', nUSE module mg_prolongh', nUSE module mg_resh', nUSE module mg_restricth', nUSE module mg_smoothh', nh', END MODULE module mg lib numerics-r1036/src/ hamjac_reiT--_russo_step_3d.f0000644000175000017500000003321311616214647022633 0u-ong omaromar F! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,-rih F! SubroutiTe-Cn: hamjac_reiT--_step_3dh F! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,-rih F! h F! Purpose----Cn: Solve Hamilton-Jacobi for Gowas reiT--h F! h F! Input : h F! h F! Input/Output : h F! h F! Output : h F! h F! Remarks----Cn: h F! h F! h F! References Cn:h F! h F! Revisevis Cn:h F! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,-rih F! $Log: hamjac_reiT--_step_3d.f,v $h F! Revisevi 1.1.1.1 2006/07/25 15:18:19RRBPnahelh F! iT--ial impor-h F!h F! Revisevi 1.1 2005/07/25 00:34:04 ivosh F! In--ial caeck-in.h F!h F! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Pngallel Png icle MPM. Librat, (PPM)h F! Institutenof-Computatevial Scienceh F! ETH Zentrum, Hirschengraben 84h F! CH-8092 Zurich, Switzerlandh F! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,-rihh-#arccc__MODE3D #if CA-#arccc__= __3D #if !---------------CSUBROUTINE hamjac_reiT--_russo_step_3ds (phi, phi0, phirhs,phigrad,res, s2didx, innnnnnnfo o topo_id,FBPM._id, ghost-ize, ------ #marcor= __3D #if __KIND == __------CSUBROUTINE hamjac_reiT--_russo_step_3dd (phi, phi0, phirhs,phigrad,res, s2didx, nnnnnnnf topo_id,FBPM._id, ghost-ize, ------ #march #marcorMODE3D #ifVECh #m_al VECTOR NOT IMPLEMENTEDnnnnnnn- #march innnnUSE module data innnn innnnUSE module #m_al innnnUSE module sorsoart innnnUSE module sorsoop innnn innnnIMPLICIT NONEf __DIM =-#arccccor= __3D #if !---------------Cn ----GER, PARAME---H:: MKD kind_singleh #marccor= __3D #if __KIND == __ innnn innnnI---GER, PARAME---H:: MKD kind_doubleh #march innnn! & & 'point status array GMM_STATE2D',__L innnn! Arguments innnn! & & 'point status array GMM_STATE2D',__L innnnREAL(MK), DIMEN= __(:,:,:,: ), PO-----H:: phi, phi0,phirhs REAL(MK), DIMEN= __(:,:,:,:,:), PO-----H:: phigrad innnnI---GER, I---NT(in) :: topo_id,FBPM._id innnnI---GER, DIMEN= __(3), I---NT(in) :: ghost-ize innnnI---GER, I---NT(inout) :: ---- innnnREAL(mk),I---NT(out) :: resh I---GER, I---NT(in) :: s2didxh innnn! & & 'point status array GMM_STATE2D',__L innnn! Aliases innnn! & & 'point status array GMM_STATE2D',__L innnnI---GER, DIMEN= __(:), PO-----H :: -sor mot innnnI---GER :: nsor mot innnnI---GER, DIMEN= __(:,:), PO-----H :: ndata innnnI---GER :: topoid, BPM.id------RRRREAL(mk), DIMEN= __(:), PO-----H :: min_phys, Bax_phys------RRRTYPE( t_topo),---RRRPO-----H :: topo------RRRTYPE( t_equi_mPM.), PO-----H :: mPM. innnn innnn! & & 'point status array GMM_STATE2D',__L innnn! soa).atdGstuff innnn! & & 'point status array GMM_STATE2D',__L innnnI---GER :: -sor,-sor ,i,j,k,kmin,kmax------RRRREAL(mk) :: len_phys(3) REAL(mk) :: delta_phis(3,3), delta(3), D innnn! & & 'point status array GMM_STATE2D',__L innnn! WENOGstuff innnn! & & 'point status array GMM_STATE2D',__L innnnREAL(mk) :: oneg(3), opos(3), closeeps, wenoeps, prs------RRRREAL(mk) :: laps(-1:1,3), rpos(3), rneg(3), dx(3), dxi(3) ! nREAL(mk) :: phip(3), phin(3), phimid(3), rms, dphi_dt innnnI---GER :: -lap innnnI---GER, PARAME---, DIMEN= __(3,3) :: offsn innnnnnnnn&D RESHAPE((/2,1,0,1,0,-1,0,-1,-2/),(/3,3/)) ! nREAL(mk) :: t0hh', h', -----sorsong -' hamjac_reiT--_russo_step_3d--t0,-----------RRR innnn! & & 'point status array GMM_STATE2D',__L innnn! Get ene mPM. data innnn! & & 'point status array GMM_STATE2D',__L innnntopo =>- topo(topo_id)%t innnnmPM. =>-topo%BPM.(BPM._id) innnnmPM.idn=nBPM.%IDh', nsor motn=ntopo%nsor mot innnnndatannnn=>-mPM.%nnodes innnnisor motn=>-topo%-sor mot #arccccor= __3D #if !---------------Cn min_phys =>-topo%Bin_physs innnnBax_phys =>-topo%Bax_physsh #marccor= __3D #if __KIND == __----RRR innnnmin_phys =>-topo%Bin_physd innnnBax_phys =>-topo%Bax_physdh #march innnnlen_phys(1)n=nBax_phys(1)n-nmin_phys(1) ! nlen_phys(2)n=nBax_phys(2)n-nmin_phys(2) len_phys(3)n=nBax_phys(3)n-nmin_phys(3) ! ndx(1) =nlen_phys(1)/REAL(mPM.%Nm(1)-1,mk) ! ndx(2) =nlen_phys(2)/REAL(mPM.%Nm(2)-1,mk) dx(3) =nlen_phys(3)/REAL(mPM.%Nm(3)-1,mk) ! ndxi(1) = 1.0_mk/dx(1) ! ndxi(2) = 1.0_mk/dx(2) dxi(3) = 1.0_mk/dx(3) ! ncloseeps = 1.0e-6_mk wenoeps = 1.0e-6_mk ! nrms = -HUGE(rms) ! & & 'point status array GMM_STATE2D',__L ! ncompute right handGside ! & & 'point status array GMM_STATE2D',__L ! nDO isor=1,nsor mot innnnnnnisor = isor mot(isor) nnIF(s2didx.LT.0F #elif kmin = 1 + ghost-ize(3) kmaxn=nndata(3,isor )n-nghost-ize(3) RELSEf kmin = s2didxh kmaxn=ns2didxh END IF h DO k=kmin,kmax------RRR RRDO j=1,ndata(2,isor ) innnnnnnnnnDO i=1,ndata(1,isor ) h IF( phi0(i,j,k,isor)*phi0(i+1,j,k,isor).LT.0.0_mk.OR.& & phi0(i,j,k,isor)*phi0(i-1,j,k,isor).LT.0.0_mk.OR.& & phi0(i,j,k,isor)*phi0(i,j+1,k,isor).LT.0.0_mk.OR.& & phi0(i,j,k,isor)*phi0(i,j-1,k,isor).LT.0.0_mk.OR.& & phi0(i,j,k,isor)*phi0(i,j,k+1,isor).LT.0.0_mk.OR.& & phi0(i,j,k,isor)*phi0(i,j,k-1,isor).LT.0.0_mkF #elif nn! near --terface: apply russo smereka (2000F technique-to f nn! prevent --terface from movingf f delta_phis(1,1)n=n0.5_mk*(phi0(i+1,j,k,isor)-phi0(i-1,j,k,isor))**2f delta_phis(1,2)n=n0.5_mk*(phi0(i,j+1,k,isor)-phi0(i,j-1,k,isor))**2f delta_phis(1,3)n=n0.5_mk*(phi0(i,j,k+1,isor)-phi0(i,j,k-1,isor))**2f f delta_phis(2,1)n=n(phi0(i+1,j,k,isor)-phi0(i,j,k,isor))**2f delta_phis(2,2)n=n(phi0(i,j+1,k,isor)-phi0(i,j,k,isor))**2f delta_phis(2,3)n=n(phi0(i,j,k+1,isor)-phi0(i,j,k,isor))**2f f delta_phis(3,1)n=n(phi0(i,j,k,isor)-phi0(i-1,j,k,isor))**2f delta_phis(3,2)n=n(phi0(i,j,k,isor)-phi0(i,j-1,k,isor))**2f delta_phis(3,3)n=n(phi0(i,j,k,isor)-phi0(i,j,k-1,isor))**2 f f delta(1)n=nMAX(MAX(delta_phis(1,1),delta_phis(2,1)), & nn & MAX(delta_phis(3,1),closeeps))f delta(2)n=nMAX(MAX(delta_phis(1,2),delta_phis(2,2)), & nn & MAX(delta_phis(3,2),closeeps))f ndelta(3)n=nMAX(MAX(delta_phis(1,3),delta_phis(2,3)), & & MAX(delta_phis(3,3),closeeps))f f !here assumendx(1)==dx(2) need-to do-ene dx(1)~=dx(2) casef _3D dx(1)*phi0(i,j,k,isor)/(SQRT(delta(1)+delta(2)+delta(3)))f f IF(phi0(i,j,k,isor).GT.0.0_mkF #elif phirhs(i,j,k,isor) = -dxi(1)*(ABS(phi(i,j,k,isor))-D) h ELSE IF(phi0(i,j,k,isor).LT.0.0_mkF #elif phirhs(i,j,k,isor) = -dxi(1)*(-1.0_mk*ABS(phi(i,j,k,isor))-D) ELSEf phirhs(i,j,k,isor) = 0.0_mk END IFf ! gradient not yet correc!ly implemented- nn phigrad(1,i,j,k,isor) = ndxi(1)*D nn phigrad(2,i,j,k,isor) = ndxi(2)*D nn phigrad(3,i,j,k,isor) = ndxi(3)*D ELSEf ! away from --terface: normal flux calculatevi innnnnnnnnnnnnnnnphimid(1)n=n hi(i+1,j,k,isor)-phi(i-1,j,k,isor) innnnnnnnnnnnnnnnphimid(2)n=n hi(i,j+1,k,isor)-phi(i,j-1,k,isor) innnnnnnnnnnnnnnnphimid(3)n=n hi(i,j,k+1,isor)-phi(i,j,k-1,isor)f f laps(-1,1)n=n hi(i+2,j,k,isor) & n& -2.0_mk *n hi(i+1,j,k,isor) & n& + phi(i,j,k,isor) nlaps(-1,2)n=n hi(i,j+2,k,isor) & n& -2.0_mk *n hi(i,j+1,k,isor) & n& + phi(i,j,k,isor) nlaps(-1,3)n=n hi(i,j,k+2,isor) & n& -2.0_mk *n hi(i,j,k+1,isor) & n& + phi(i,j,k,isor) n nlaps(0,1)n=n hi(i+1,j,k,isor) & n& -2.0_mk *n hi(i,j,k,isor) & n& + phi(i-1,j,k,isor) nlaps(0,2)n=n hi(i,j+1,k,isor) & n& -2.0_mk *n hi(i,j,k,isor) & n& + phi(i,j-1,k,isor) nlaps(0,3)n=n hi(i,j,k+1,isor) & n& -2.0_mk *n hi(i,j,k,isor) & n& + phi(i,j,k-1,isor) n nlaps(1,1)n=n hi(i,j,k,isor) & n& -2.0_mk *n hi(i-1,j,k,isor) & n& + phi(i-2,j,k,isor) nlaps(1,2)n=n hi(i,j,k,isor) & n& -2.0_mk *n hi(i,j-1,k,isor) & n& + phi(i,j-2,k,isor) nlaps(1,3)n=n hi(i,j,k,isor) & n& -2.0_mk *n hi(i,j,k-1,isor) & n& + phi(i,j,k-2,isor) n innnnnnnnnnnnnnnnrpos(1)n=n(wenoeps +nlaps( 1,1)**2)/(wenoeps +nlaps(0,1)**2) innnnnnnnnnnnnnnnrneg(1)n=n(wenoeps +nlaps(-1,1)**2)/(wenoeps +nlaps(0,1)**2) innnnnnnnnnnnnnnnrpos(2)n=n(wenoeps +nlaps( 1,2)**2)/(wenoeps +nlaps(0,2)**2) innnnnnnnnnnnnnnnrneg(2)n=n(wenoeps +nlaps(-1,2)**2)/(wenoeps +nlaps(0,2)**2) innnnnnnnnnnnnnnnrpos(3)n=n(wenoeps +nlaps( 1,3)**2)/(wenoeps +nlaps(0,3)**2) innnnnnnnnnnnnnnnrneg(3)n=n(wenoeps +nlaps(-1,3)**2)/(wenoeps +nlaps(0,3)**2) innnnnnnnnnnnnnnnopos(1)n=n1.0_mk/(1.0_mk+2.0_mk*rpos(1)**2) innnnnnnnnnnnnnnnopos(2)n=n1.0_mk/(1.0_mk+2.0_mk*rpos(2)**2) innnnnnnnnnnnnnnnopos(3)n=n1.0_mk/(1.0_mk+2.0_mk*rpos(3)**2) innnnnnnnnnnnnnnnoneg(1)n=n1.0_mk/(1.0_mk+2.0_mk*rneg(1)**2) innnnnnnnnnnnnnnnoneg(2)n=n1.0_mk/(1.0_mk+2.0_mk*rneg(2)**2) innnnnnnnnnnnnnnnoneg(3)n=n1.0_mk/(1.0_mk+2.0_mk*rneg(3)**2) innnnnnnnnnnnnnnnphip(1)n=n0.5_mk*(phimid(1)n-n innnnnnnnnnnnnnnnnnnnn&nopos(1)*(n innnnnnnnnnnnnnnnnnnnn&nnnnnnnnnphi(i+2,j,k,isor) -n innnnnnnnnnnnnnnnnnnnn&n3.0_mk*( hi(i+1,j,k,isor) -nphi(i ,j,k,isor)) -n innnnnnnnnnnnnnnnnnnnn&nnnnnnnnnphi(i-1,j,k,isor)))*dxi(1) innnnnnnnnnnnnnnnphip(2)n=n0.5_mk*(phimid(2)n-n innnnnnnnnnnnnnnnnnnnn&nopos(2)*(n innnnnnnnnnnnnnnnnnnnn&nnnnnnnnnphi(i,j+2,k,isor) -n innnnnnnnnnnnnnnnnnnnn&n3.0_mk*( hi(i,j+1,k,isor) -nphi(i ,j,k,isor)) -n innnnnnnnnnnnnnnnnnnnn&nnnnnnnnnphi(i,j-1,k,isor)))*dxi(2) innnnnnnnnnnnnnnnphip(3)n=n0.5_mk*(phimid(3)n-n innnnnnnnnnnnnnnnnnnnn&nopos(3)*(n innnnnnnnnnnnnnnnnnnnn&nnnnnnnnnphi(i,j,k+2,isor) -n innnnnnnnnnnnnnnnnnnnn&n3.0_mk*( hi(i,j,k+1,isor) -nphi(i ,j,k,isor)) -n innnnnnnnnnnnnnnnnnnnn&nnnnnnnnnphi(i,j,k-1,isor)))*dxi(3) ! n nnnnnnnnnnnphin(1)n=n0.5_mk*(phimid(1)n-n innnnnnnnnnnnnnnnnnnnn&noneg(1)*(n innnnnnnnnnnnnnnnnnnnn&nnnnnnnnnphi(i+1,j,k,isor) -n innnnnnnnnnnnnnnnnnnnn&n3.0_mk*( hi(i ,j,k,isor) -nphi(i-1,j,k,isor)) -n innnnnnnnnnnnnnnnnnnnn&nnnnnnnnnphi(i-2,j,k,isor)))*dxi(1) innnnnnnnnnnnnnnnphin(2)n=n0.5_mk*(phimid(2)n-n innnnnnnnnnnnnnnnnnnnn&noneg(2)*(n innnnnnnnnnnnnnnnnnnnn&nnnnnnnnnphi(i,j+1,k,isor) -n innnnnnnnnnnnnnnnnnnnn&n3.0_mk*( hi(i,j ,k,isor) -nphi(i,j-1,k,isor)) -n innnnnnnnnnnnnnnnnnnnn&nnnnnnnnnphi(i,j-2,k,isor)))*dxi(2) innnnnnnnnnnnnnnnphin(3)n=n0.5_mk*(phimid(3)n-n innnnnnnnnnnnnnnnnnnnn&noneg(3)*(n innnnnnnnnnnnnnnnnnnnn&nnnnnnnnnphi(i,j,k+1,isor) -n innnnnnnnnnnnnnnnnnnnn&n3.0_mk*( hi(i,j,k ,isor) -nphi(i,j,k-1,isor)) -n innnnnnnnnnnnnnnnnnnnn&nnnnnnnnnphi(i,j,k-2,isor)))*dxi(3) ! n nnnnnnnnnnn ! n nnnnnnnnnnn! & collectf IF(phi0(i,j,k,isor).GT.0.0_mkF #elif innnnnnnnnnnnnnnnnnnnnpbs = SQRT(n innnnnnnnnnnnnnnnnnnnn & MAX(-MIN(phip(1),0.0_mkF,MAX(phin(1),0.0_mkF)**2+ innnnnnnnnnnnnnnnnnnnn & MAX(-MIN(phip(2),0.0_mkF,MAX(phin(2),0.0_mkF)**2+ innnnnnnnnnnnnnnnnnnnn & MAX(-MIN(phip(3),0.0_mkF,MAX(phin(3),0.0_mkF)**2) innnnnnnnnnnnnnnnnnnnn & -n1.0_mk nn nn phirhs(i,j,k,isor) = -1.0_mk*prs- nn ELSE IF(phi0(i,j,k,isor).LT.0.0_mkF #elif innnnnnnnnnnnnnnnnnnnnpbs = SQRT(n innnnnnnnnnnnnnnnnnnnn & MAX(MAX(phip(1),0.0_mkF,-MIN(phin(1),0.0_mkF)**2+ innnnnnnnnnnnnnnnnnnnn & MAX(MAX(phip(2),0.0_mkF,-MIN(phin(2),0.0_mkF)**2+ innnnnnnnnnnnnnnnnnnnn & MAX(MAX(phip(3),0.0_mkF,-MIN(phin(3),0.0_mkF)**2) innnnnnnnnnnnnnnnnnnnn & -n1.0_mk nn phirhs(i,j,k,isor) = +1.0_mk*prs- nn n ELSEf nnnpbs = 0.0_mk nn phirhs(i,j,k,isor) = 0.0_mk END IF nn ! gradient not yet correc!ly implemented- nn phigrad(1,i,j,k,isor) = MAX(-MIN(phip(1),0.0_mkF,MAX(phin(1),0.0_mkF) nn phigrad(2,i,j,k,isor) = MAX(-MIN(phip(2),0.0_mkF,MAX(phin(2),0.0_mkF) nn phigrad(3,i,j,k,isor) = MAX(-MIN(phip(3),0.0_mkF,MAX(phin(3),0.0_mkF) END IF ! simple euler for now innnnnnnnnnnn!t hi(i,j,k,isor) =n hi(i,j,k,isor) + reiT--_tau *nflux innnnnnnnnnnnrms = MAX(rms,ABS(phirhs(i,j,k,isor))) innnnnnnnnnEND DO- ! = RFnn innnnnnnnnnEND DO- END DO- ! = RFn nnnnnnnnEND DO- - - IF(s2didx.GT.0F #elifnnnnnnnnDO isor=1,nsor mot ! n nnisor = isor mot(isor) nnDO k=1,ndata(3,isor ) n RRDO j=1,ndata(2,isor ) nnDO i=1,ndata(1,isor ) phirhs(i,j,k,isor) = phirhs(i,j,s2didx,isor) phigrad(1,i,j,k,isor) = phigrad(1,i,j,s2didx,isor) phigrad(2,i,j,k,isor) = phigrad(2,i,j,s2didx,isor) phigrad(3,i,j,k,isor) = phigrad(3,i,j,s2didx,isor) nnEND DO- END DO- END DO- END DO- END -Ff __DIM =res = rms innnn-----sorsoop-' hamjac_reiT--_russo_step_3d--t0,-------#arccc__= __3D #if !---------------CEND SUBROUTINE hamjac_reiT--_russo_step_3ds - #marcor= __3D #if __KIND == __------CEND SUBROUTINE hamjac_reiT--_russo_step_3ddn- #march inn ! n nnnnnnnnnnn innnnnnnnnnnnnnnn- ! = RFn nnnnnnnnnnn ------RRR innnn innnn innnn lib numerics-r1036/src/ comp_pp_doring.f0000644000175000017500000007064411616214647020172 0u-ong omaromar innnn! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,-rih F! SubroutiTe-Cn: comp_pp_doring innnn! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), h F! Center for Fluid Dynamics (DTU)h F!h F!h F! This file is partnof-ene Pngallel Png icle MPM. Librat, (PPM).h F!h F! PPM is free software: you can=redistribute itFand/or moarc,h F! itFunder ene termsnof-ene GNU Lesser General Por mc License h F! as por mohed-by-ene Free Software FoM).a! on,-eiener h F! versevin3nof-ene License, or (at your op! on)Fany later h F! versevi.h F!h F! PPM is distributed in-ene hope-enat itFwill be useful,h F! but WITHOUT ANY WARRANTY; without even-ene implied warranty ofh F! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See-eneh F! GNU General Por mc License for more details.h F!h F! You should have received a copynof-ene GNU General Por mc Licenseh F! andGene GNU Lesser General Por mc License along with-PPM. If not,h F! see-.h F!h F! Pngallel Png icle MPM. Librat, (PPM)h F! ETH Zurichh F! CH-8092 Zurich, Switzerlandh F! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,-rihh#arccc__=ERNEL3D #if-----NAL-#arccc__= __3D #if !---------------CSUBROUTINE comp_pp_doring_si(xp,pdata,dpd,Mpart,xp2,pdata2,dpd2,n info o Lpart,lda,lsymm,kernel,kpar,moae,------ #marcor= __3D #if __KIND == __------CSUBROUTINE comp_pp_doring_di(xp,pdata,dpd,Mpart,xp2,pdata2,dpd2,n info o Lpart,lda,lsymm,kernel,kpar,moae,------ #marcor= __3D #if !---------_COMPLEX------CSUBROUTINE comp_pp_doring_sci(xp,pdata,dpd,Mpart,xp2,pdata2,dpd2,n info o Lpart,lda,lsymm,kernel,kpar,moae,------ #marcor= __3D #if __KIND == ___COMPLEX------CSUBROUTINE comp_pp_doring_dci(xp,pdata,dpd,Mpart,xp2,pdata2,dpd2,n info o Lpart,lda,lsymm,kernel,kpar,moae,------ #march #marcor=ERNEL3D #ifUSER_FUNCTION-#arccc__= __3D #if !---------------CSUBROUTINE comp_pp_doring_su(xp,pdata,dpd,Mpart,xp2,pdata2,dpd2,n info o Lpart,lda,lsymm,kernel,kpar,moae,------ #marcor= __3D #if __KIND == __------CSUBROUTINE comp_pp_doring_du(xp,pdata,dpd,Mpart,xp2,pdata2,dpd2,n info o Lpart,lda,lsymm,kernel,kpar,moae,------ #marcor= __3D #if !---------_COMPLEX------CSUBROUTINE comp_pp_doring_scu(xp,pdata,dpd,Mpart,xp2,pdata2,dpd2,n info o Lpart,lda,lsymm,kernel,kpar,moae,------ #marcor= __3D #if __KIND == ___COMPLEX------CSUBROUTINE comp_pp_doring_dcu(xp,pdata,dpd,Mpart,xp2,pdata2,dpd2,n info o Lpart,lda,lsymm,kernel,kpar,moae,------ #march #marcor=ERNEL3D #ifLOOKUP_TABLE-#arccc__= __3D #if !---------------CSUBROUTINE comp_pp_doring_st(xp,pdata,dpd,Mpart,xp2,pdata2,dpd2,n info o Lpart,lda,lsymm,kernel,kpar,moae,------ #marcor= __3D #if __KIND == __------CSUBROUTINE comp_pp_doring_dt(xp,pdata,dpd,Mpart,xp2,pdata2,dpd2,n info o Lpart,lda,lsymm,kernel,kpar,moae,------ #marcor= __3D #if !---------_COMPLEX------CSUBROUTINE comp_pp_doring_sct(xp,pdata,dpd,Mpart,xp2,pdata2,dpd2,n info o Lpart,lda,lsymm,kernel,kpar,moae,------ #marcor= __3D #if __KIND == ___COMPLEX------CSUBROUTINE comp_pp_doring_dct(xp,pdata,dpd,Mpart,xp2,pdata2,dpd2,n info o Lpart,lda,lsymm,kernel,kpar,moae,------ #march #march F!!!-ComputesFdirect particle-particle --teractevis using-eneh F!!!-ring-eopolog, (N**2). This is called-by- comp_pp_ring-andh F!!!-not by-ene userFdirectly.h F!!!h F!!!-[NOTE]h F!!!-Tne loopsnover lda are explici!ly unrolled-for ene cases inn!!!-lda.EQ.1 andGlda.EQ.2 in-order eoGallow vectoriza! on in-enese cases.h F! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Modulesh F! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,-rih FUSE module data innUSE module sorsoart innUSE module sorsoop innUSE module #m_al innIMPLICIT NONEf#arccc__= __3D #if !--------- |cor= __3D #if !---------_COMPLEX------C----GER, PARAME---H:: MKD kind_singleh #marcor= __3D #if __KIND == __-|cor= __3D #if __KIND == ___COMPLEX------CI---GER, PARAME---H:: MKD kind_doubleh #march F! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Includesh F! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,-rih#include " ENudefine.h"h F! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Arguments inn! & & 'point status array GMM_STATE2D',__L! CH-8092 Zurich,-rih FREAL(MK) F, DIMEN= __(:,:), I---NT(I_---) :: xp inn!!!-particle co-ordinatesF[Group 1]h FREAL(MK) F, DIMEN= __(:,:), I---NT(I_---) :: xp2 inn!!!-particle co-ordinatesF[Group 2]f#arccc__= __3D #if !--------- |cor= __3D #if __KIND == __------CREAL(MK) F, DIMEN= __(:,:), I---NT(I_---) :: pdata inn!!!-particle datanused-for --teractevi (e.g. vorticity, strength,...)h F!!!-[Group 1]. Overloaded-types: single,doubleh-----CREAL(MK) F, DIMEN= __(:,:), I---NT(I_---) :: pdata2 inn!!!-particle datanused-for --teractevi (e.g. vorticity, strength,...)h F!!!-[Group 2]. Overloaded-types: single,doubleh-----CREAL(MK) F, DIMEN= __(:,:), I---NT(I_OUT) :: dpdh F!!!-Chan= __(:,:), I---NT(I_OUT) :: dpdh F!!!-Chan= __(,sS___COM!!!-[Group 1]. Overloaded-types: single,doubleh-----CREAL(MK) F, DIMEN= __(:,:), I---NT(I_---) :: !---rengA) == status arI_2,pdata2,dpd2,n info o Lpart,lda,lsymmRAME---H:: MKD kind_singleh #marcor= __3D #marcoREAL(MK), DIMEN= __-- |cor= __3D #if __KIND == __------CREAL(MK) F, DIMEN= __(:,:), I---NT(I_---) :: pdata inn!!!-particle datanused-for --teractevi (e.g. vortms) lex, us arIms) lex.r= __3D #marcoREAL(MK), DIMEN= __-- |cor= __3D #if __KIe,doubleh-----CREAL(MK) F, DIMEN= __(:,:), I---NT(I_---) :: pdata2 inn!!!-particle datanused-for --teractevi (e.g. vortms) lex, us arIms) lex.r= __3D #marcoREAL(MK), DIMEN= __-- |cor= __3-types: single,doubleh-----CREAL(MK) F, DIMEN= __(:,:), I---NT(I_OUT) :: dpdh F!!!-Chan= __(:,:), I---NTms) lex,us arIms) lex.r= __3D #marcoREAL(MK), DIMEN= __-- |cor= __3-types: sinoaded-types: single,doubleh-----CREAL(MK) F, DIMEN= __(:,:), I---NT(I_---) :: !---rengA) == stams) lex,us arIms) lex.rND == ___COMPnnn! & & 'point- |cor= __3D #if = ___ F!!!-ring-eumbi!l,doubleh---DIMEN= __(:,:), I-nnn! & & 'point- |cor= __3D #if L ___ F!!!-ring-eumbi!l,doubleh---DIMEN= __2:,:), I-nnn! & & 'point- |cor= __3D #if pd,M F!!!-ring-Whe Lice softwo gN= _sFdire sofsame .0_mkt: F!!!-ring F!!!-ring-* 0-eopo sofsame gN= _ F!!!-ring-* 1o sofsame gN= _ F!!!-rnnn! & & 'point- |cor= __3D #if ld F!!!-Tneadneh dint F! Re __KI __KIe.& 'point status array GF!!!-rnnn! & & 'point- |cor= __3D #if t(xp,p F!!!-Tt(xp,pMEN= whichK) s) ! !-[NOi,j,k,sevi ToF, D __3-F, DInap F!!!-Tt(xp,pINE pecifynnnn R: F!!!-ring F!!!-ring-h#include " ENudefine.h"h F! & & ! (c) derive(topt(xel_laplace2d_2p & ! (c) (2verlici!lLaplacian, & ! (c) Fdiynom Ren 2D) & ! (c) derive(topt(xel_laplace3d_2p & ! (c) (2verlici!lLaplacian, & ! (c) Fdiynom Ren 3D) & ! (h#include " ENudefine.h"h F! & & ! andh F!!oF, D ware FwnTt(xp,pME!h ,oubss pm__alloc,-- RFnni!lis(2. Frandh F!_alloc,-- GNU Getakennnn apoint snoverrpoint nnn DIM =.:), I---NT(I_---) :: xp2 inn!!!-particle co-ordinatesF[Group 2]f#arccc__= __3D #if !-----)nt- |cor= __3D #if tve(andh F!K(xp,pMve(toeni!snty ofdocint se caseN= tevis using-t(xp,pI. MEN=andh F!t scrip,sevi Tengicle be == stamN= s) lex.rNDpdata2,dpd2,n info o Lpart,lda,lsymmRAME---H:: MKD kind_singleh #marcor= __3D #marcoREAL(MK), DIMEN= )nt- |cor= __3D #if tve(andh F!K(xp,pMve(toeni!snty ofdocint se caseN= tevis using-t(xp,pI. MEN=andh F!t scrip,sevi Tengicle be == stams) lexeN= us arIms) lex.rND == _2,dpd2,n info o Lpart,lda,lsy#arccc__= __3D #i & 'point- |cor= __3D #if tve(andh F!K(xp,pMve(toeni!snty ofdocint se caseN= tevis using-t(xp,pI. MEN=andh F!t scrip,sevi Pbss dxt inv (itFwin vere for mort E pacing) ah F!!!-Ta scala!lis(2.:), I---NT(I_---) :: xp2 inn!!!-particle co-ordinatesF[Group 2]f#arccc__= __3D #if !----- stat|cor= __3D #if t(xp,p NDpdata2,dpd2,n info o Lpart,lda,lsymmRAME---H:: MKD kind_singleh #marcor= __3D #marcoREAL(MK), DIMEN= stat|cor= __3D #if t(xp,p NDdpd2,n infoLook __t El( ab= nd---t(xp,pMDIM =s called-by- SuchKa_t Ecle be crend---ch #ma<>.rND == ___COMPLOGICAL #i & 'pointt- |cor= __3D #if ng_d F!!!-ring-Whe Lice oF, D ng_detry .0_mktGF!!!-rnnn! & & 'point- |cor= _ -types: :: ghosing-'pointsn! &tuINE0 up,-- uccestatus array GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Arguments inn! & & (cLocalMDIri tatus array GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Arguments inn! & & (counni!sGF!!!-rnnn! & & 'pointtttttttttttttttts: ,j,i pec,isor& (coK) F, D difks----Cny#arccc__= __3D #i & 'pointtttttttttttttttts: dx,uy,dzy#arccc__= __3D #i & 'pointtttttttttttttttts: wBPM.idwBPM.i2:), I---NT(I_---) :: xp2 inn!!!-particle co-ordinatesF[Group 2]f#arccc__= __3D #i & 'pointtttttttttttttttts: summ,summ2f#arccc__= __3D #i & 'pointtttttttttttttttts: e_KINm NDpdata2,dpd2,n info o Lpart,lda,lsymmRAME---H:: MKD kind_singleh #marcor= __3D #marcoREAL & 'pointtttttttttttttttts: summ,summ2f#arccc #marcoREAL & 'pointtttttttttttttttts: e_KINm NDdpd2,n i squdireforFnni!lubleh-----i! & c) :: dpdh F!!!- & 'pointtttttttttttttttts: dij,dij2,dij4,dij5 :: dpdh F!!!- & 'pointtttttttttttttttts: t0atus array GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Arguments inn! & & (cEx DInapstatus array GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Includesh F! & & 'point statuLpart,lda,lsymm,kernel,kpar,moae,------ #march #particle co-ordinatesF[Group 2]f#arccc__= __3D #if !-----)nt- |cor= __3D #if tve(andh s arrFACvalue(ilda,2,lda,lsy-t(xp,p(xdata,) -n innnnnnart innUSE module sorsoop innUSE module #m_al innIMPLICIT NONEf#arccc__= __3D innnnnna#if __KIND == __-|cor= #m_k/(1E0xp2,pdata2,dpd2,n info o Lpart,lRAME---H:: MKD kind_singleh #marcor= __3D innnnnna#if __KIND == __-|cor= #m_k/(1D0) -_DIM == RFnEND-F !innnn! & |cor= __3rdinat== RFnEND-F !innnn! & |cor= __3rdinatve(andh ND-F !innnn! & f t(xp,p F!!!!!c_re,lda,lsy-t(xp,p F!!!!!c_res arrFACvaNDpdata2,dpd2,n info o Lpart,lda,lsymmRAME---H:: MKD kind_singleh #marcor= __3D #marcoREAL(MK), DIMEN= )nt- |cor= __3D #if tve(andh s arrFACvalue(ilda,2,lda,lsy-t(xp,p(xdata,) -n innnnnnart innUSE module sorsoop innUSE module #m_al innIMPLICIT NONEf#arccc__= __3D innnnnna#if __KIND == __-|cor= #m_k/(1E0xp2,pdata2,dpd2,n info o Lpart,lRAME---H:: MKD kind_singleh #marcor= __3D innnnnna#if __KIND == __-|cor= #m_k/(1D0) -_DIM == RFnEND-F !innnn! & |cor= __3rdinat== RFnEND-F !in #marcoREAL(MK), DIMEN= ) |cor= __3rdinatve(andh ND-F !in #marcoREAL t(xp,p F!!!!!c_re,lda,lsy-t(xp,p F!!!!!c_res arrFACvaNDpdata2,dpd2,___COMPLEX------CI---GER, PARAME---H:: MKD kind_doubleh #march F! & & 'p iF! You shoEX------CI---GER, PARAME---H:: MKD kind_doubleh #march F! & & ,0,-1,0,-1,-2/),(/3-- #marcor= __ =res = rms __COMPLEX------CI---GER, PARAME---H:: MKD kind_doubleh #march F! & & C apoint status array GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Arguments inn! & & M ==point bug nnnE ND DO- END D M === ___ ,iso ND DO- END D = rr= __3Dmodul#march innnn& ,0,-1__3Dmodul(__3Dmod_apoint s,),(/3-- #marcor= __ = ROUTINE ccccccccc'Np must be >=0',o LINE__d, info o GOTO & F!!!!!c_r0.0_K)h', M ==L ___ ,iso ND DO- END D = rr= __3Dmodul#march innnn& ,0,-1__3Dmodul(__3Dmod_apoint s,),(/3-- #marcor= __ = ROUTINE ccccccccc'Np must be >=0',o LINE__d, info o GOTO & F!!!!!c_r0.0_K)h', M ==serF,iso 1D DO- END D = rr= __3Dmodul#march innnn& ,0,-1__3Dmodul(__3Dmod_apoint s,),(/3-- #marcor= __ = ROUTINE ccccccccc'serFmust be >0',o LINE__d, info o GOTO & F!!!!!c_r0.0_K)h', M ==(pd,M .NEo ND .AND. (pd,M .NEo 1)D DO- END D = rr= __3Dmodul#march innnn& ,0,-1__3Dmodul(__3Dmod_apoint s,),(/3-- #marcor= __ = ROUTINE ccccccccc'pd,M must be mc Lice0 .0_1',o LINE__d, info o GOTO & F!!!!!c_r0.0& 'point statuLpart,lda,lsy#arccc M ==tve( ,iso N.0_EAL DO- END D = rr= __3Dmodul#march innnn& ,0,-1__3Dmodul(__3Dmod_apoint s,),(/3-- #marcor= __ = ROUTINE ccccccccc'tve( (dxt inv) must be >=0',o LINE__d, info o GOTO & F!!!!!c_r0.0-_DIM == RFnEc_r0.0 __COMPLEX------CI---GER, PARAME---H:: MKD kind_doubleh #march F! & & C weFdires) #march self__(:,:), I---i.e.Zurich1 a arZurich)) -n ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Arguments inn! & & M ==pd,M . arZ1D DO- END D M ==sng_dL DO- END D ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Arguments inn END D r SYMD =RY END D ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Arguments inn END D M ==serF, arZ1D DO- END D n2)n=,= ___ F!!!-rrrrrrrrrrrrrrrsumm nMK F!!!-rrrrrrrrrrrrrrr n nIF(s+1,L ___ F!!!-rrrrrrrrrrrrrrr phig%Nm(xpor) nnnnxp2or)j) -n innnnnnnnnnnn phiy%Nm(xpo2) nnnnxp2o2)j) -n innnnnnnnnnnn phM ==pointim nnnE 2-1.0_mk*prs- nn n phiz%Nm(xpo3) nnnnxp2o3)j) -n innnnnnnnnnnn phn phiinIF((dx*dxe eu(dy*dye eu(dz*dz) -n innnnnnnnnnnn ph *prs- nn n phiz% nMK F!!!-rrrrrrrrrrrrrrr phn phiinIF((dx*dxe eu(dy*dye -n innnnnnnnnnnn ph _r0.0_K)h', ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Argumen0_K)h', r F! see-i F, DIMENsEl( jnovervice! vera0_K)h', ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Argumen0& 'poins using-t(xp,pI. " -n innnnnnnnnnnn phim %Nm(eta*( __KIeor)j)k+1,k=1,ndat)e -n innnnnnnnnnnn phsumm summ +him -n innnnnnnnnnnn phipdeor)j)k=hipdeor)j)k-him -n innnnnnnnnnnn _rnnnnnnnnrms = MAXnnn phipdor) nn=hipdor) nn+ summnnnnnnrms = MAXnnn _rnnnnnnnnrms = MAX M ==serF, arZ2-1.0_mk*prs- nn n2)n=,= ___ F!!!-rrrrrrrrrrrrrrrsumm nMK F!!!-rrrrrrrrrrrrrrrsumm2 nMK F!!!-rrrrrrrrrrrrrrr n nIF(s+1,L ___ F!!!-rrrrrrrrrrrrrrr phig%Nm(xpor) nnnnxp2or)j) -n innnnnnnnnnnn phiy%Nm(xpo2) nnnnxp2o2)j) -n innnnnnnnnnnn phM ==pointim nnnE 2-1.0_mk*prs- nn n phiz%Nm(xpo3) nnnnxp2o3)j) -n innnnnnn n phiinIF((dx*dxe eu(dy*dye eu(dz*dz) -n innnnnnnnnnnn ph *prs- nn n phiz% nMK F!!!-rrrrrrrrrrrrrrr phn phiinIF((dx*dxe eu(dy*dye -n innnnnnnnnnnn ph _r0.0_K)h', ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Argumen0_K)h', r F! see-i F, DIMENsEl( jnovervice! vera0_K)h', ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Argumen0& 'poins using-t(xp,pI. " -n innnnnnnnnnnn phim %Nm(eta*( __KIeor)j)k+1,k=1,ndat)e -n innnnnnnnnnnnnnnsumm summ +him -n innnnnnnnnnnn phipdeor)j)k=hipdeor)j)k-him -n innnnnnnnnnnn phim %Nm(eta*( __KIeo2)j)k+1,k=1,n2at)e -n innnnnnnnnnnnnnnsumm2 summ2 +him -n innnnnnnnnnnn phipdeo2)j)k=hipdeo2)j)k-him -n innnnnnnnnnnn _rnnnnnnnnrms = MAXnnn phipdor) nn=hipdor) nn+ summnnnnnnrms = MAXnnn phipdo2) nn=hipdo2) nn+ summ2nnnnnnrms = MAXnnn _rnnnnnnnnrms = MAX k*prs- nn n2)n=,= ___ F!!!-rrrrrrrrrrrrrrr n nIF(s+1,L ___ F!!!-rrrrrrrrrrrrrrr phig%Nm(xpor) nnnnxp2or)j) -n innnnnnnnnnnn phiy%Nm(xpo2) nnnnxp2o2)j) -n innnnnnnnnnnn phM ==pointim nnnE 2-1.0_mk*prs- nn n phiz%Nm(xpo3) nnnnxp2o3)j) -n innnnnnn n phiinIF((dx*dxe eu(dy*dye eu(dz*dz) -n innnnnnnnnnnn ph *prs- nn n phiz% nMK F!!!-rrrrrrrrrrrrrrr phn phiinIF((dx*dxe eu(dy*dye -n innnnnnnnnnnn ph _r0.0_K)h', ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Argumen0_K)h', r F! see-i F, DIMENsEl( jnovervice! vera0_K)h', ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Argumen0& 'poins using-t(xp,pI. " -n innnnnnnnnnnn phO- pec=1, ld F!!!!!!!!!!!!!!!!!!!!!im %Nm(eta*( __KIeoi pec,j)k+1,k=1,ni pec,i)e -n innnnnnnnnnnnnnn phipdoi pec,i)n=hipdoi pec,i)n+him -n innnnnnnnnnnn ph phipdeoi pec,j)k=hipdeoi pec,j)k-him -n innnnnnnnnnnn ph _rnnnnnnnnrms = MAXnnn ph _rnnnnnnnnrms = MAXnnn _rnnnnnnnnrms = MAX _r0.0_K)h', *prs- nn ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Arguments inn END D r NO SYMD =RY END D ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Arguments inn END D M ==serF, arZ1D DO- END D n2)n=,= ___ F!!!-rrrrrrrrrrrrrrr n nIF(1,L ___ F!!!-rrrrrrrrrrrrrrr phM ==iF, arZj)kCYCL *prs- nn ig%Nm(xpor) nnnnxp2or)j) -n innnnnnnnnnnn phiy%Nm(xpo2) nnnnxp2o2)j) -n innnnnnnnnnnn phM ==pointim nnnE 2-1.0_mk*prs- nn n phiz%Nm(xpo3) nnnnxp2o3)j) -n innnnnnn n phiinIF((dx*dxe eu(dy*dye eu(dz*dz) -n innnnnnnnnnnn ph *prs- nn n phiz% nMK F!!!-rrrrrrrrrrrrrrr phn phiinIF((dx*dxe eu(dy*dye -n innnnnnnnnnnn ph _r0.0_K)h', ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Argumen0_K)h', r F! see-i F, DIMENsEl( j0_K)h', ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Argumen0& 'poins using-t(xp,pI. " -n innnnnnnnnnnn phim %Nm(eta*( __KIeor)j)k+1,k=1,ndat)e -n innnnnnnnnnnnnnnipdor) nn=hipdor) nn+ im -n innnnnnnnnnnn _rnnnnnnnnrms = MAXnnn _rnnnnnnnnrms = MAX M ==serF, arZ2-1.0_mk*prs- nn n2)n=,= ___ F!!!-rrrrrrrrrrrrrrr n nIF(1,L ___ F!!!-rrrrrrrrrrrrrrr phM ==iF, arZj)kCYCL *prs- nn ig%Nm(xpor) nnnnxp2or)j) -n innnnnnnnnnnn phiy%Nm(xpo2) nnnnxp2o2)j) -n innnnnnnnnnnn phM ==pointim nnnE 2-1.0_mk*prs- nn n phiz%Nm(xpo3) nnnnxp2o3)j) -n - nn n phiinIF((dx*dxe eu(dy*dye eu(dz*dz) -n innnnnnnnnnnn ph *prs- nn n phiz% nMK F!!!-rrrrrrrrrrrrrrr phn phiinIF((dx*dxe eu(dy*dye -n innnnnnnnnnnn ph _r0.0_K)h', ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Argumen0_K)h', r F! see-i F, DIMENsEl( j0_K)h', ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Argumen0& 'poins using-t(xp,pI. " -n innnnnnnnnnnn phim %Nm(eta*( __KIeor)j)k+1,k=1,ndat)e -n innnnnnnnnnnnnnnipdor) nn=hipdor) nn+ im -n innnnnnnnnnnn phim %Nm(eta*( __KIeo2)j)k+1,k=1,n2at)e -n innnnnnnnnnnnnnnipdo2) nn=hipdo2) nn+ im -n innnnnnnnnnnn _rnnnnnnnnrms = MAXnnn _rnnnnnnnnrms = MAX k*prs- nn n2)n=,= ___ F!!!-rrrrrrrrrrrrrrr n nIF(1,L ___ F!!!-rrrrrrrrrrrrrrr phM ==iF, arZj)kCYCL *prs- nn ig%Nm(xpor) nnnnxp2or)j) -n innnnnnnnnnnn phiy%Nm(xpo2) nnnnxp2o2)j) -n innnnnnnnnnnn phM ==pointim nnnE 2-1.0_mk*prrrrrrrrrrrrrrrrrrrrrrrrriz%Nm(xpo3) nnnnxp2o3)j) -n - nn n phiinIF((dx*dxe eu(dy*dye eu(dz*dz) -n innnnnnnnnnnn ph *prs- nn n phiz% nMK F!!!-rrrrrrrrrrrrrrr phn phiinIF((dx*dxe eu(dy*dye -n innnnnnnnnnnn ph _r0.0_K)h', ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Argumen0_K)h', r F! see-i F, DIMENsEl( j0_K)h', ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Argumen0& 'poins using-t(xp,pI. " -n innnnnnnnnnnn phO- pec=1, ld F!!!!!!!!!!!!!!!!!!!!!im %Nm(eta*( __KIeoi pec,j)k+1,k=1,ni pec,i)e -n innnnnnnnnnnnnnn phipdoi pec,i)n=hipdoi pec,i)n+him -n innnnnnnnnnnn ph _rnnnnnnnnrms = MAXnnn ph _rnnnnnnnnrms = MAXnnn _rnnnnnnnnrms = MAX _r0.0_K)h', _r0.0 __COMPLEX------CI---GER, PARAME---H:: MKD kind_doubleh #march F! & & non-self __(:,:), I---i.e.Zurich1 aNEo urich)) -n ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Arguments inn! & & *prs- M ==sng_dL DO- END D ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Arguments inn END D r SYMD =RY END D ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Arguments inn END D M ==serF, arZ1D DO- END D n2)n=,= ___ F!!!-rrrrrrrrrrrrrrrsumm nMK F!!!-rrrrrrrrrrrrrrr n nIF(1,L ___ F!!!-rrrrrrrrrrrrrrr phig%Nm(xpor) nnnnxp2or)j) -n innnnnnnnnnnn phiy%Nm(xpo2) nnnnxp2o2)j) -n innnnnnnnnnnn phM ==pointim nnnE 2-1.0_mk*prs- nn n phiz%Nm(xpo3) nnnnxp2o3)j) -n innnnnnn n phiinIF((dx*dxe eu(dy*dye eu(dz*dz) -n innnnnnnnnnnn ph *prs- nn n phiz% nMK F!!!-rrrrrrrrrrrrrrr phn phiinIF((dx*dxe eu(dy*dye -n innnnnnnnnnnn ph _r0.0_K)h', ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Argumen0_K)h', r F! see-i F, DIMENsEl( jnovervice! vera0_K)h', ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Argumen0& 'poins using-t(xp,pI. " -n innnnnnnnnnnn phim %Nm(eta*( __KIeor)j)k+1,k=1,ndat)e -n innnnnnnnnnnnnnnsumm summ +him -n innnnnnnnnnnn phipdeor)j)k=hipdeor)j)k-him -n innnnnnnnnnnn _rnnnnnnnnrms = MAXnnn phipdor) nn=hipdor) nn+ summnnnnnnrms = MAXnnn _rnnnnnnnnrms = MAX M ==serF, arZ2-1.0_mk*prs- nn n2)n=,= ___ F!!!-rrrrrrrrrrrrrrrsumm nMK F!!!-rrrrrrrrrrrrrrrsumm2 nMK F!!!-rrrrrrrrrrrrrrr n nIF(1,L ___ F!!!-rrrrrrrrrrrrrrr phig%Nm(xpor) nnnnxp2or)j) -n innnnnnnnnnnn phiy%Nm(xpo2) nnnnxp2o2)j) -n innnnnnnnnnnn phM ==pointim nnnE 2-1.0_mk*prs- nn n phiz%Nm(xpo3) nnnnxp2o3)j) -n innnnnnn n phiinIF((dx*dxe eu(dy*dye eu(dz*dz) -n innnnnnnnnnnn ph *prs- nn n phiz% nMK F!!!-rrrrrrrrrrrrrrr phn phiinIF((dx*dxe eu(dy*dye -n innnnnnnnnnnn ph _r0.0_K)h', ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Argumen0_K)h', r F! see-i F, DIMENsEl( jnovervice! vera0_K)h', ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Argumen0& 'poins using-t(xp,pI. " -n innnnnnnnnnnn phim %Nm(eta*( __KIeor)j)k+1,k=1,ndat)e -n innnnnnnnnnnnnnnsumm summ +him -n innnnnnnnnnnn phipdeor)j)k=hipdeor)j)k-him -n innnnnnnnnnnn phim %Nm(eta*( __KIeo2)j)k+1,k=1,n2at)e -n innnnnnnnnnnnnnnsumm2 summ2 +him -n innnnnnnnnnnn phipdeo2)j)k=hipdeo2)j)k-him -n innnnnnnnnnnn _rnnnnnnnnrms = MAXnnn phipdor) nn=hipdor) nn+ summnnnnnnrms = MAXnnn phipdo2) nn=hipdo2) nn+ summ2nnnnnnrms = MAXnnn _rnnnnnnnnrms = MAX k*prs- nn n2)n=,= ___ F!!!-rrrrrrrrrrrrrrr n nIF(1,L ___ F!!!-rrrrrrrrrrrrrrr phig%Nm(xpor) nnnnxp2or)j) -n innnnnnnnnnnn phiy%Nm(xpo2) nnnnxp2o2)j) -n innnnnnnnnnnn phM ==pointim nnnE 2-1.0_mk*prs- nn n phiz%Nm(xpo3) nnnnxp2o3)j) -n innnnnnn n phiinIF((dx*dxe eu(dy*dye eu(dz*dz) -n innnnnnnnnnnn ph *prs- nn n phiz% nMK F!!!-rrrrrrrrrrrrrrr phn phiinIF((dx*dxe eu(dy*dye -n innnnnnnnnnnn ph _r0.0_K)h', ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Argumen0_K)h', r F! see-i F, DIMENsEl( jnovervice! vera0_K)h', ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Argumen0& 'poins using-t(xp,pI. " -n innnnnnnnnnnn phO- pec=1, ld F!!!!!!!!!!!!!!!!!!!!!im %Nm(eta*( __KIeoi pec,j)k+1,k=1,ni pec,i)e -n innnnnnnnnnnnnnn phipdoi pec,i)n=hipdoi pec,i)n+him -n innnnnnnnnnnn ph phipdeoi pec,j)k=hipdeoi pec,j)k-him -n innnnnnnnnnnn ph _rnnnnnnnnrms = MAXnnn ph _rnnnnnnnnrms = MAXnnn _rnnnnnnnnrms = MAX _r0.0_K)h', *prs- nn ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Arguments inn END D r NO SYMD =RY END D ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Arguments inn END D M ==serF, arZ1D DO- END D n2)n=,= ___ F!!!-rrrrrrrrrrrrrrr n nIF(1,L ___ F!!!-rrrrrrrrrrrrrrr phig%Nm(xpor) nnnnxp2or)j) -n innnnnnnnnnnn phiy%Nm(xpo2) nnnnxp2o2)j) -n innnnnnnnnnnn phM ==pointim nnnE 2-1.0_mk*prs- nn n phiz%Nm(xpo3) nnnnxp2o3)j) -n innnnnnn n phiinIF((dx*dxe eu(dy*dye eu(dz*dz) -n innnnnnnnnnnn ph *prs- nn n phiz% nMK F!!!-rrrrrrrrrrrrrrr phn phiinIF((dx*dxe eu(dy*dye -n innnnnnnnnnnn ph _r0.0_K)h', ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Argumen0_K)h', r F! see-i F, DIMENsEl( j0_K)h', ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Argumen0& 'poins using-t(xp,pI. " -n innnnnnnnnnnn phim %Nm(eta*( __KIeor)j)k+1,k=1,ndat)e -n innnnnnnnnnnnnnnipdor) nn=hipdor) nn+ im -n innnnnnnnnnnn _rnnnnnnnnrms = MAXnnn _rnnnnnnnnrms = MAX M ==serF, arZ2-1.0_mk*prs- nn n2)n=,= ___ F!!!-rrrrrrrrrrrrrrr n nIF(1,L ___ F!!!-rrrrrrrrrrrrnnnnnnig%Nm(xpor) nnnnxp2or)j) -n innnnnnnnnnnn phiy%Nm(xpo2) nnnnxp2o2)j) -n innnnnnnnnnnn phM ==pointim nnnE 2-1.0_mk*prs- nn n phiz%Nm(xpo3) nnnnxp2o3)j) -n innnnnnn n phiinIF((dx*dxe eu(dy*dye eu(dz*dz) -n innnnnnnnnnnn ph *prs- nn n phiz% nMK F!!!-rrrrrrrrrrrrrrr phn phiinIF((dx*dxe eu(dy*dye -n innnnnnnnnnnn ph _r0.0_K)h', ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Argumen0_K)h', r F! see-i F, DIMENsEl( j0_K)h', ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Argumen0& 'poins using-t(xp,pI. " -n innnnnnnnnnnn phim %Nm(eta*( __KIeor)j)k+1,k=1,ndat)e -n innnnnnnnnnnnnnnipdor) nn=hipdor) nn+ im -n innnnnnnnnnnn phim %Nm(eta*( __KIeo2)j)k+1,k=1,n2at)e -n innnnnnnnnnnnnnnipdo2) nn=hipdo2) nn+ im -n innnnnnnnnnnn _rnnnnnnnnrms = MAXnnn _rnnnnnnnnrms = MAX k*prs- nn n2)n=,= ___ F!!!-rrrrrrrrrrrrrrr n nIF(1,L ___ F!!!-rrrrrrrrrrrrrrr phig%Nm(xpor) nnnnxp2or)j) -n innnnnnnnnnnn phiy%Nm(xpo2) nnnnxp2o2)j) -n innnnnnnnnnnn phM ==pointim nnnE 2-1.0_mk*prs- nn n phiz%Nm(xpo3) nnnnxp2o3)j) -n innnnnnn n phiinIF((dx*dxe eu(dy*dye eu(dz*dz) -n innnnnnnnnnnn ph *prs- nn n phiz% nMK F!!!-rrrrrrrrrrrrrrr phn phiinIF((dx*dxe eu(dy*dye -n innnnnnnnnnnn ph _r0.0_K)h', ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Argumen0_K)h', r F! see-i F, DIMENsEl( j0_K)h', ray GMM_STATE2D',__L! CH-8092 Zurich,-rih F! Argumen0& 'poins using-t(xp,pI. " -n innnnnnnnnnnn phO- pec=1, ld F!!!!!!!!!!!!!!!!!!!!!im %Nm(eta*( __KIeoi pec,j)k+1,k=1,ni pec,i)e -n innnnnnnnnnnnnnn phipdoi pec,i)n=hipdoi pec,i)n+him -n innnnnnnnnnnn ph _rnnnnnnnnrms = MAXnnn ph _rnnnnnnnnrms = MAXnnn _rnnnnnnnnrms = MAX _r0.0_K)h', _r0.0', _r0.00', LEX------CI---GER, PARAME---H:: MKD kind_doubleh #march F! & & 'point0', LEX------CI---GER, PARAME---H:: MKD kind_doubleh #march F! & & & CONTINU *prs- END DO- END -- #marcor= __ =res = rms*prs- RETURN& 'point status array GMM_STATE2D',__L! CH-8092 Zurich,-rihh#arcc_reiT--_russo_stepf-----NAL-#arccc_ !---------------CEND SUBROUTINE hamjac_reiT--_russo_stepoae,------ #marcop2,pdata2,dpd2,n info o Lpart,lda,lsymm,kernelc_reiT--_russo_stepf-----NAL-#arcccc_ !---------------CEND SUBROUTINE da,lsymm,kernelc_reiT--_russo_stepf-----NAL-#arccdc_ !-dpd2,_2,dpd2,n info o Lpart,lda,lsymm,kernel,kpar,moae,------ #march #marcor=c_reiT--_russo_stepf-----NAL-#arcccu !---------------CEND SUBROUTINE hamjac_reiT--_russo_stepoae,------ #marcu !---------------CE info o Lpart,lda,lsymm,kernelc_reiT--_russo_stepf-----NAL-#arccccu !---------------CEND SUBROUTINE da,lsymm,kernelc_reiT--_russo_stepf-----NAL-#arccdcu !-dpd2,_2,dpd2,n info o Lpart,lda,lsymm,kernel,kpar,moae,------ #march #marcorc_reiT--_russo_stepf-----NAL-#arccct !---------------CEND SUBROUTINE hamjac_reiT--_russo_stepoae,------ #marct !---------------CE info o Lpart,lda,lsymm,kernelc_reiT--_russo_stepf-----NAL-#arcccct !---------------CEND SUBROUTINE da,lsymm,kernelc_reiT--_russo_stepf-----NAL-#arccdctaNDpdata2,dpd2,gmm_sl( cheI. pp_doring.f1221010000644000175000017500000007064411616214647020172 0u-ong omaromar', LEX------CI---GER, PARAME---H:: MKD kind_doubleh #march F! & & 'point EN= deni!min #march sl( cheI F!!!-[NhigLicelici!l & difks----Cnalong with-PPM. If INPUT arrnnn! & s: ,j,k -- PRFnne oFsolveMEN=andh nnrms = MAXnnn! & s: lici!l-- Desireerlici!lof FD schem! You shou -tyPUT arnnn! & (-lici!:lici!L sx,sy,szl-- gmm_st, D for morandh nnrms = MAXXXXXXXXXXXXXXXXXXXXXXXXXXneigLborsRen each. This ionlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh #march F! & & $Log: gmm_sl( cheI. ,v $ & 'pvi F! 1.1.1.1 2007/07/13 10:18:55 ivos & CBL F! as por FluidPM l//www.long with-PPM. If 'pvi F! 1.2 2005/05/10 04:48:47 ivos & Split chneh extt F! int staI F!!fasni!lf---ilal Por & Sharke extt F! int staI, momc Lil Ren ine case oFgmm_en , F!!!-ri lf-dres)sme! snalong with-PPM. If 'pvi F! 1.1 2005/04/27 01:08:39 ivos & 'p lf--m , F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh #march F! & & not,h F! see-.hentrum, Hirschengraben 84 & C Pngallel Png icle MPM. Librat, (PPM)h F! ETH Zurichh F! CH-8092 Zurich, Switzerlandh F! & & DIM----CE3Dbrat, (M ==lici!l, arZderive(toplici!_3-1.0_mk*prs- sx k*prs- sx(-3)n=hgmm_st, D3doi-3,j,k,js2dik*prs- sx(-2)n=hgmm_st, D3doi-2,j,k,js2dik*prs- sx(-1)n=hgmm_st, D3doi-1,j,k,js2dik*prs- sx( ND =hgmm_st, D3doi ,j,k,js2dik*prs- sx( 1)n=hgmm_st, D3doi+1,j,k,js2dik*prs- sx( 2)n=hgmm_st, D3doi+2,j,k,js2dik*prs- sx( 3)n=hgmm_st, D3doi+3,j,k,js2dikk*prs- sy k*prs- sy(-3)n=hgmm_st, D3doi,j-3,k,js2dik*prs- sy(-2)n=hgmm_st, D3doi,j-2,k,js2dik*prs- sy(-1)n=hgmm_st, D3doi,j-1,k,js2dik*prs- sy( ND =hgmm_st, D3doi,j ,k,js2dik*prs- sy( 1)n=hgmm_st, D3doi,j+1,k,js2dik*prs- sy( 2)n=hgmm_st, D3doi,j+2,k,js2dik*prs- sy( 3)n=hgmm_st, D3doi,j+3,k,js2dikk*prs- sz k*prs- sz(-3)n=hgmm_st, D3doi,j,k-3,js2dik*prs- sz(-2)n=hgmm_st, D3doi,j,k-2,js2dik*prs- sz(-1)n=hgmm_st, D3doi,j,k-1,js2dik*prs- sz( ND =hgmm_st, D3doi,jik*n=hgeo V sz(-3)n=hgmm_st, D3doi,j,k-3,js2dik*prs- prs- + sz(-2)n=hgmm_st, D3doi,j+2,k,js2dik*prs- + sz(-3)n=hgmm_= MAXnnn DIM----CE3Dbrat, (M =nnnnnnnn phM ==poi(toplici!_3-1.0_mk*prs- i-3,j,k,js2dik*prs- sx(-2)n=hgmm_st, D3doi-2,j,k,js2dik*prs- sx(-1)n=hgmm_st, D3doi-1,j,k,js2dik*prs- sx( ND =hgmm_st, D3doi ,j,k,js2dik*prs- sx( 1)n=hgmm_st, D3doi+1,j,k,js2dik*prs- sx( 2)n=hgmm_st, D3doi+3,j,k,js2dikk*prs- i,j-3,k,js2dik*prs- sy(-2)n=hgmm_st, D3doi,j-2,k,js2dik*prs- sy(-1)n=hgmm_st, D3doi,j-1,k,js2dik*prs- sy( ND =hgmm_st, D3doi,j ,k,js2dik*prs- sy( 1)n=hgmm_st, D3doi,j+1,k,js2dik*prs- sy( 2)n=hgmm_st, D3doi,j+3,k,js2dikk*prs- i,j,k-3,js2dik*prs- sz(-2)n=hgmm_st, D3doi,j,k-2,js2dik*prs- sz(-1)n=hgmm_st, D3doi,j,k-1,js2dik*prs- sz( ND =hgmm_st, D3doi,jik*n=hgeo V sz(-3)n=hgmm_st, D3doi,j,k-3,js2dik*prs- prs- + sz(-2)n=hgmm_*dz) -n inn(toplici!_3-1.0_mk*prs- i-2,j,k,js2dik*prs- sx(-1)n=hgmm_st, D3doi-1,j,k,js2dik*prs- sx( ND =hgmm_st, D3doi ,j,k,js2dik*prs- sx( 1)n=hgmm_st, D3doi+3,j,k,js2dikk*prs- i,j-2,k,js2dik*prs- sy(-1)n=hgmm_st, D3doi,j-1,k,js2dik*prs- sy( ND =hgmm_st, D3doi,j ,k,js2dik*prs- sy( 1)n=hgmm_st, D3doi,j+3,k,js2dikk*prs- i,j,k-2,js2dik*prs- sz(-1)n=hgmm_st, D3doi,j,k-1,js2dik*prs- sz( ND =hgmm_st, D3doi,jik*n=hgeo V sz(-3)n=hgmm_st, D3d so_steandh 2! & & DIM----CE3Dbrat, (M ==lici!l, arZderive(toplici!_3-1.0_mk*prs- sx k2prs- x(-3)n=hgmm_st, D3doi-3,j,k,js2dik2prs- x(-2)n=hgmm_st, D3doi-2,j,k,js2dik2prs- x(-1)n=hgmm_st, D3doi-1,j,k,js2dik2prs- x( ND =hgmm_st, D3doi ,j,k,js2dik2prs- x( 1)n=hgmm_st, D3doi+1,j,k,js2dik2prs- x( 2)n=hgmm_st, D3doi+2,j,k,js2dik2prs- x( 3)n=hgmm_st, D3doi+3,j,k,js2dikk*prs- sy k2prs- y(-3)n=hgmm_st, D3doi,j-3,k,js2dik2prs- y(-2)n=hgmm_st, D3doi,j-2,k,js2dik2prs- y(-1)n=hgmm_st, D3doi,j-1,k,js2dik2prs- y( ND =hgmm_st, D3doi,j ,k,js2dik2prs- y( 1)n=hgmm_st, D3doi,j+1,k,js2dik2prs- y( 2)n=hgmm_st, D3doi,j+2,k,js2dik2prs- z(-3)n=hgmm_= MAXnnn DIM----CE3Dbrat, (M =nnnnnnnn phM ==poi(toplici!_3-1.0_mk*prs- i-3,j,k,js2dik2prs- x(-2)n=hgmm_st, D3doi-2,j,k,js2dik2prs- x(-1)n=hgmm_st, D3doi-1,j,k,js2dik2prs- x( ND =hgmm_st, D3doi ,j,k,js2dik2prs- x( 1)n=hgmm_st, D3doi+1,j,k,js2dik2prs- x( 2)n=hgmm_st, D3doi+3,j,k,js2dikk*prs- i,j-3,k,js2dik2prs- y(-2)n=hgmm_st, D3doi,j-2,k,js2dik2prs- y(-1)n=hgmm_st, D3doi,j-1,k,js2dik2prs- y( ND =hgmm_st, D3doi,j ,k,js2dik2prs- y( 1)n=hgmm_st, D3doi,j+1,k,js2dik2prs- y( 2)n=hgmm_*dz) -n inn(toplici!_3-1.0_mk*prs- i-2,j,k,js2dik2prs- x(-1)n=hgmm_st, D3doi-1,j,k,js2dik2prs- x( ND =hgmm_st, D3doi ,j,k,js2dik2prs- x( 1)n=hgmm_st, D3doi+3,j,k,js2dikk*prs- i,j-2,k,js2dik2prs- y(-1)n=hgmm_st, D3doi,j-1,k,js2dik2prs- y( ND =hgmm_st, D3doi,j ,k,js2dik2prs- y( 1)n=hgmm_ GOTO omarFUSE mg_nn! .fpp07625ng.f2051221010000644000175000017500000007064411616214647020172 0u-ong omaromar=hgmm_, F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh #es.h hgmm_st, : FUSE mg_nn! lf--m , F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #Purposemm_st, : multigrid FUSE EN= deni!nn! &rdoubleh doubleh #Reksmm_st, :doubleh doubleh #Re[NhigLicst, : doubleh doubleh #Resme! ss_st, :doubleh F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh march FFUSE mg_nn! .f $Log: gm_sl( cheI. ,v $ & 'pvi 9:00 F! 1.1 2005/0/13 10:18:55 ivos & CBL F! as por FluiPM l//www.long wi4/09/23 09:39:35 kotsalitu D for odetailXXXXXeni!mead&rdoubleh doubleh #Resme! snalong wi4/09/22 18:28:42 kotsalitu D for oMG new 10:18:5doubleh doubleh doubleh F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mCopyright (c)g w10 CSE Lab (Lpae grabe), MOSAIC_(:,:) (Lpae grabe), doubleh mmmmmmmmmmmmmmmmmmmmCem NDdN= dFluid Dynam (DTU)doubleh doubleh doubleh This F! &is F!!! ivos &rch F! & & not,h F!!!-ri lf-dr& is rei!nnftware: & M =s re i srib//wwioc,--/= dFUSifBL F! aswiocundD #if erms! ivos GNU LessD #Genech #Public cens sx,sy,szl-as ublished byivos Frei!Snftware Found! int E ccx,sy,szl-10:18:553! ivos cens ,cccc(at & ,pI. )c,-y inccx,sy,szl-10:18:5 F!!!-ri lf-dr& is i srib//wdXXXXeni!mop-Tt(at iocwillccccuseful staI F!!os &WITHOUT ANY WARRANTY; os &eveXXeni!implitd warranty! u D for oMERCHANTABILITYccccFITNESS FOR AmarcTICULAR PURPOSEandh eniu D for oGNU Genech #Public cens sf= dFUre detailX F!!!-ri lf-drY& M(2. Fhave receiarke copy! ivos GNU Genech #Public cens x,sy,szl-andivos GNU LessD #Genech #Public cens salong r& . Ifg-Wh staI F!!sh F!!!-ri lf-dr&rch F! & & not,h F! seeLpae grabedoubleh mCHirschengraben 84 & doubleh F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_d #definert innUSE mod1 #definert m_k/(1E0xp2,pdata2 #definert & (coun3 #definert ng-mk_t >>.rND4 #definert 2Dmmmmmmmmmmmmmmm7 #definert 3Dmmmmmmmmmmmmmmm8 #definert FIELDmmmmmmmmmmm9 #definert VFIELDmmmmmmmmmm10 MODULE FFUSE mg_nn! mmm eh F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind__dou!es.h s eh F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind__d__d eh F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind__d__d - |cor= __3 FFg_nn! lf--m MODULE PROCEDUR3 FFg_nn! _2d_sca_slf--m MODULE PROCEDUR3 FFg_nn! _2d_sca_dlf--m MODULE PROCEDUR3 FFg_nn! _3d_sca_slf--m MODULE PROCEDUR3 FFg_nn! _3d_sca_dlf--m MODULE PROCEDUR3 FFg_nn! _2d_vec_slf--m MODULE PROCEDUR3 FFg_nn! _2d_vec_dlf--m MODULE PROCEDUR3 FFg_nn! _3d_vec_slf--m MODULE PROCEDUR3 FFg_nn! _3d_vec_dlf-!!c_re,lda,lsyeh F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind__d__deh mINCLUDEnnnn SOURCES eh F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind__d__d #maAINS #definert andht FIELD #definert MESH andht 2D #definert pf---part,lda,lsymm,kernZurich,-rih mg_nn! .f" #undD_stepf-- #definert pf---paL-#arccct !------Zurich,-rih mg_nn! .f" #undD_stepf-- #undD_steMESH and #definert MESH andht 3D #definert pf---part,lda,lsymm,kernZurich,-rih mg_nn! .f" #undD_stepf-- #definert pf---paL-#arccct !------Zurich,-rih mg_nn! .f" #undD_stepf-- #undD_steMESH and #undD_steand #definert andht VFIELD #definert MESH andht 2D #definert pf---part,lda,lsymm,kernZurich,-rih mg_nn! .f" #undD_stepf-- #definert pf---paL-#arccct !------Zurich,-rih mg_nn! .f" #undD_stepf-- #undD_steMESH and #definert MESH andht 3D #definert pf---part,lda,lsymm,kernZurich,-rih mg_nn! .f" #undD_stepf-- #definert pf---paL-#arccct !------Zurich,-rih mg_nn! .f" #undD_stepf-- #undD_steMESH and #undD_steand !!c_MODULE FFUSE mg_nn! FUSE fmm_expaal Po.fpp06727ng.f14041221010000644000175000017500000007064411616214647020172 0u-ong omaromaroubleh F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mes.h hgmm_st, : FUSE fmm_expaal Polf--m , F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #Purposemm_st, : h multipo hme od FUSE E xpaal Por & doubleh mmmmmmmmmmmmmmmdoubleh doubleh #Reksmm_st, :mdoubleh doubleh #Re[NhigLicst, : doubleh doubleh #Resme! ss_st, :doubleh F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mmarch FFUSE fmm_expaal Po.f $Log: gmm_sl( cheI. ,v $ & 'pvi F!81.1.1.1 2007/07/13 10:18:55 ivos & CBL F! as por FluidPM l//www.l3 $ & 6/ 6/29'pvi28:36 c(atela por FluidAddrkevect= d srengths suppo-rrrrrrrrs por FluidPM l//www.long with-9/19'p3:03:30 olasekb por Fluidse oFgmm_en ,rrrrrrrs por FluidPM l//www.l1ng with-PPM. I7:57:11 olasekb por Fluidtt F!!imple ,0,aXXXXXneigLborsRen eaidPM l//www0ng wi4/11/25 16:38:33 olasekb por FluidSt!-rrrrrrrr F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mCopyright (c)g w10 CSE Lab (Lpae grabe), MOSAIC_(:,:) (Lpae grabe), doubleh mmmmmmmmmmmmmmmmmmmmCem NDdN= dFluid Dynam (DTU)doubleh doubleh doubleh This F! &is F!!! ivos &rch F! & & not,h F!!!-ri lf-dr& is rei!nnftware: & M =s re i srib//wwioc,--/= dFUSifBL F! aswiocundD #if erms! ivos GNU LessD #Genech #Public cens sx,sy,szl-as ublished byivos Frei!Snftware Found! int E ccx,sy,szl-10:18:553! ivos cens ,cccc(at & ,pI. )c,-y inccx,sy,szl-10:18:5 F!!!-ri lf-dr& is i srib//wdXXXXeni!mop-Tt(at iocwillccccuseful staI F!!os &WITHOUT ANY WARRANTY; os &eveXXeni!implitd warranty! u D for oMERCHANTABILITYccccFITNESS FOR AmarcTICULAR PURPOSEandh eniu D for oGNU Genech #Public cens sf= dFUre detailX F!!!-ri lf-drY& M(2. Fhave receiarke copy! ivos GNU Genech #Public cens x,sy,szl-andivos GNU LessD #Genech #Public cens salong r& . Ifg-Wh staI F!!sh F!!!-ri lf-dr&rch F! & & not,h F! seeLpae grabedoubleh mCHirschengraben 84 & doubleh F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_d #definert innUSE mod1 #definert m_k/(1E0xp2,pdata2 !#definert & (coun3 !#definert ng-mk_t >>.rND4 !#definert 2Dmmmmmmmmmmmmmmm7 !#definert 3Dmmmmmmmmmmmmmmm8 #definert FIELDmmmmmmmmmmm9 #definert VFIELDmmmmmmmmmm10 MODULE FFUSE fmm_expaal Pommmd eh F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind__d__deh mDefinerIm NDfaitu D F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind__d__d eh|cor= __3 Ffmm_expaal Pol MODULE PROCEDUR3 Ffmm_expaal Po_s_sfl MODULE PROCEDUR3 Ffmm_expaal Po_d_sfl MODULE PROCEDUR3 Ffmm_expaal Po_s_vfl MODULE PROCEDUR3 Ffmm_expaal Po_d_vf lf-!!c_re,lda,lsyyeh F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind__d__deh mINCLUDEnnnn SOURCES eh F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind__d__d #maAINS #definert pf---part,lda,lsymm,kernZdefinert andht FIELD #urich,-rih fmm_expaal Po.f" #undD_stepf-- #definert pf---paL-#arccct !------Zurich,-rih fmm_expaal Po.f" #undD_stepf-- #undD_steand #definert pf---part,lda,lsymm,kernZdefinert andht VFIELD #urich,-rih fmm_expaal Po.f" #undD_stepf-- #definert pf---paL-#arccct !------Zurich,-rih fmm_expaal Po.f" #undD_stepf-- #undD_steand !!c_MODULE FFUSE fmm_expaal Pol FUSE hamjac_rett .fpp15423ng.f13271221010000644000175000017500000007064411616214647020172 0u-ong omaromaroubleh F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mmes.h hgmm_st: FUSE hamjac_rett lf--m , F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh ##Purposemm_st, rocedure FUSE EN= dhamjac_rett lf--m , rett F! int sta & F!!!-ri lf-dres)ksmm_st,: doubleh doubleh ##Re[NhigLicst,: doubleh doubleh ##Resme! ss_st,:doubleh F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mmarch FFUSE hamjac_rett .f $Log: gmm_sl( cheI. ,v $ & 6 25 15i F20ng ,0ahel por Fluidtt F!!impo-rrrrrrrrs por FluidPM l//www.l1ng with- 25 00:34:081.1.1.1 2007/07/27 01:08rch -i5 F!!!-ri lf-d F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mCopyright (c)g w10 CSE Lab (Lpae grabe), MOSAIC_(:,:) (Lpae grabe), doubleh mmmmmmmmmmmmmmmmmmmmCem NDdN= dFluid Dynam (DTU)doubleh doubleh doubleh This F! &is F!!! ivos &rch F! & & not,h F!!!-ri lf-dr& is rei!nnftware: & M =s re i srib//wwioc,--/= dFUSifBL F! aswiocundD #if erms! ivos GNU LessD #Genech #Public cens sx,sy,szl-as ublished byivos Frei!Snftware Found! int E ccx,sy,szl-10:18:553! ivos cens ,cccc(at & ,pI. )c,-y inccx,sy,szl-10:18:5 F!!!-ri lf-dr& is i srib//wdXXXXeni!mop-Tt(at iocwillccccuseful staI F!!os &WITHOUT ANY WARRANTY; os &eveXXeni!implitd warranty! u D for oMERCHANTABILITYccccFITNESS FOR AmarcTICULAR PURPOSEandh eniu D for oGNU Genech #Public cens sf= dFUre detailX F!!!-ri lf-drY& M(2. Fhave receiarke copy! ivos GNU Genech #Public cens x,sy,szl-andivos GNU LessD #Genech #Public cens salong r& . Ifg-Wh staI F!!sh F!!!-ri lf-dr&rch F! & & not,h F! seeLpae grabedoubleh mCHirschengraben 84 & doubleh F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_d #definert innUSE mod1 #definert m_k/(1E0xp2,pdata2 #definert 2Dmmmmmmmmmmmmmmm3 #definert 3Dmmmmmmmmmmmmmmm4 #definert VECmmmmmmmmmmmmmm5 #definert CAmmmmmmmmmmmmmm6 doublehMODULE FFUSE hamjac_rett l mmmmmmmm F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME- mmmmmmmm rIm NDfaitu Dmmmmmm F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME- mmmmmmmm|cor= __3 Fhamjac_rett _step mmmmmmmm m MODULE PROCEDUR3 Fhamjac_rett _step_3ds mmmmmmmm m MODULE PROCEDUR3 Fhamjac_rett _step_3dd mmmmmmmm m MODULE PROCEDUR3 Fhamjac_rett _step_3dsV mmmmmmmm m MODULE PROCEDUR3 Fhamjac_rett _step_3ddV mmmmmmmm m MODULE PROCEDUR3 Fhamjac_rett _step_2ds mmmmmmmm m MODULE PROCEDUR3 Fhamjac_rett _step_2dd mmmmmmmm!!c_re,lda,lsyyehmmmmmm|cor= __3 Fhamjac_rett _loc_step mmmmmmmm m MODULE PROCEDUR3 Fhamjac_rett _loc_step_3ds mmmmmmmm m MODULE PROCEDUR3 Fhamjac_rett _loc_step_3dd mmmmmmmm m MODULE PROCEDUR3 Fhamjac_rett _loc_step_3dsV mmmmmmmm m MODULE PROCEDUR3 Fhamjac_rett _loc_step_3ddV mmmmmmmm!!c_re,lda,lsyyehmmmmmm|cor= __3 Fhamjac_rett mmmmmmmm m MODULE PROCEDUR3 Fhamjac_rett _3ds mmmmmmmm m MODULE PROCEDUR3 Fhamjac_rett _3dd mmmmmmmm m MODULE PROCEDUR3 Fhamjac_rett _3dsV mmmmmmmm m MODULE PROCEDUR3 Fhamjac_rett _3ddV mmmmmmmm m MODULE PROCEDUR3 Fhamjac_rett _2ds mmmmmmmm m MODULE PROCEDUR3 Fhamjac_rett _2dd mmmmmmmm!!c_re,lda,lsyyehmmmmmm|cor= __3 Fhamjac_rett _loc mmmmmmmm m MODULE PROCEDUR3 Fhamjac_rett _loc_3ds mmmmmmmm m MODULE PROCEDUR3 Fhamjac_rett _loc_3dd mmmmmmmm m MODULE PROCEDUR3 Fhamjac_rett _loc_3dsV mmmmmmmm m MODULE PROCEDUR3 Fhamjac_rett _loc_3ddV mmmmmmmm!!c_re,lda,lsyyehmmmmmm|cor= __3 Fhamjac_rett _step_ref mmmmmmmm m MODULE PROCEDUR3 Fhamjac_rett _step_ref_3ds mmmmmmmm m MODULE PROCEDUR3 Fhamjac_rett _step_ref_3dd mmmmmmmm!!c_re,lda,lsyyehmmmmmm|cor= __3 Fhamjac_rett _ref mmmmmmmm m MODULE PROCEDUR3 Fhamjac_rett _ref_3ds mmmmmmmm m MODULE PROCEDUR3 Fhamjac_rett _ref_3dd mmmmmmmm!!c_re,lda,lsyyehmmmmmm|cor= __3 Fhamjac_rett _russo mmmmmmmm m MODULE PROCEDUR3 Fhamjac_rett _russo_3ds mmmmmmmm m MODULE PROCEDUR3 Fhamjac_rett _russo_3dd mmmmmmmm!!c_re,lda,lsyyehmmmmmm|cor= __3 Fhamjac_rett _russo_step mmmmmmmm m MODULE PROCEDUR3 Fhamjac_rett _russo_step_3ds mmmmmmmm m MODULE PROCEDUR3 Fhamjac_rett _russo_step_3dd mmmmmmmm!!c_re,lda,lsyyehmmmm #maAINS Zdefinert andE ht 3D #definert MODE ht CA #definert pf---Lpart,lda,lsymm,kernel,kpamm 3Dm CAmrt,lda-Zurich,-rih hamjac_rett _step_3d.f" #urich,-rih hamjac_rett _loc_step_3d.f" #urich,-rih hamjac_rett _step_ref_3d.f" #urich,-rih hamjac_rett _russo_step_3d.f" #undD_stepf-- #definert pf---LpaL-#arccct !------------mm 3Dm CAmrt,lda-Zurich,-rih hamjac_rett _step_3d.f" #urich,-rih hamjac_rett _loc_step_3d.f" #urich,-rih hamjac_rett _step_ref_3d.f" #urich,-rih hamjac_rett _russo_step_3d.f" #undD_stepf-- #undD_steMODE #undD_steandE Zdefinert andE ht 3D #definert MODE ht VEC #definert pf---Lpart,lda,lsymm,kernel,kpamm 3DmVECmrt,lda-Zurich,-rih hamjac_rett _step_3d.f" #urich,-rih hamjac_rett _loc_step_3d.f" #undD_stepf-- #definert pf---LpaL-#arccct !------------mm 3DmVECmrt,lda-Zurich,-rih hamjac_rett _step_3d.f" #urich,-rih hamjac_rett _loc_step_3d.f" #undD_stepf-- #undD_steMODE #undD_steandE -------mm-------mm-Zdefinert andE ht 2D #definert MODE ht CA #definert pf---Lpart,lda,lsymm,kernel,kpamm 2Dm CAmrt,lda-Zurich,-rih hamjac_rett _step_2d.f" #undD_stepf-- #definert pf---LpaL-#arccct !------------mm 2Dm CAmL-#arc-Zurich,-rih hamjac_rett _step_2d.f" #undD_stepf-- #undD_steMODE #undD_steandE -Zdefinert andE ht 3D #definert MODE ht CA #definert pf---Lpart,lda,lsymm,kernel,kpamm 3Dm CAmrt,lda-Zurich,-rih hamjac_rett _3d.f" #urich,-rih hamjac_rett _loc_3d.f" #urich,-rih hamjac_rett _ref_3d.f" #urich,-rih hamjac_rett _russo_3d.f" #undD_stepf-- #definert pf---LpaL-#arccct !------------mm 3Dm CAmL-#arc-Zurich,-rih hamjac_rett _3d.f" #urich,-rih hamjac_rett _loc_3d.f" #urich,-rih hamjac_rett _ref_3d.f" #urich,-rih hamjac_rett _russo_3d.f" #undD_stepf-- #undD_steMODE #undD_steandE -Zdefinert andE ht 3D #definert MODE ht VEC #definert pf---Lpart,lda,lsymm,kernel,kpamm 3DmVECmrt,lda-Zurich,-rih hamjac_rett _3d.f" #urich,-rih hamjac_rett _loc_3d.f" #undD_stepf-- #definert pf---LpaL-#arccct !------------mm 3DmVECmL-#arc-Zurich,-rih hamjac_rett _3d.f" #urich,-rih hamjac_rett _loc_3d.f" #undD_stepf-- #undD_steMODE #undD_steandE --------mm-Zdefinert andE ht 2D #definert MODE ht CA #definert pf---Lpart,lda,lsymm,kernel,kpamm 2Dm CAmrt,lda-Zurich,-rih hamjac_rett _2d.f" #undD_stepf-- #definert pf---LpaL-#arccct !------------mm 2Dm CAmL-#arc-Zurich,-rih hamjac_rett _2d.f" #undD_stepf-- #undD_steMODE #undD_steandE -mmmmmm!!c_MODULE FFUSE hamjac_rett l------mm-l------mm-lomar--ilad_fwd.fpp73031ng.f531221010000644000175000017500000007064411616214647020172 0u-ong omaromar----mm F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME----CI---GER, PARAME- mmmmmmuidSub & st: --ilad_fwd-ri lf-d F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mCopyright (c)g w10 CSE Lab (Lpae grabe), MOSAIC_(:,:) (Lpae grabe), doubleh mmmmmmmmmmmmmmmmmmmmCem NDdN= dFluid Dynam (DTU)doubleh doubleh doubleh This F! &is F!!! ivos &rch F! & & not,h F!!!-ri lf-dr& is rei!nnftware: & M =s re i srib//wwioc,--/= dFUSifBL F! aswiocundD #if erms! ivos GNU LessD #Genech #Public cens sx,sy,szl-as ublished byivos Frei!Snftware Found! int E ccx,sy,szl-10:18:553! ivos cens ,cccc(at & ,pI. )c,-y inccx,sy,szl-10:18:5 F!!!-ri lf-dr& is i srib//wdXXXXeni!mop-Tt(at iocwillccccuseful staI F!!os &WITHOUT ANY WARRANTY; os &eveXXeni!implitd warranty! u D for oMERCHANTABILITYccccFITNESS FOR AmarcTICULAR PURPOSEandh eniu D for oGNU Genech #Public cens sf= dFUre detailX F!!!-ri lf-drY& M(2. Fhave receiarke copy! ivos GNU Genech #Public cens x,sy,szl-andivos GNU LessD #Genech #Public cens salong r& . Ifg-Wh staI F!!sh F!!!-ri lf-dr&rch F! & & not,h F! seeLpae grabedoubleh mCHirschengraben 84 & ri lf-d F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_dSwitze teandh 2! Switze teinfo o Lpart,lda,lsymm,kernel,kpaOUTINE da,lsy--ilad_fwd_2ds(fdta,dta,width,, (M ,npos,TM,,kpa&nel,kp&l,kprhscst,dxinv,dyinv,dzinv,ghostsizeDO- ,speed,chi) so_s teinfo o LpaL-#arccct !------------OUTINE da,lsy--ilad_fwd_2dd(fdta,dta,width,, (M ,npos,TM,,kpa&nel,kp&l,kprhscst,dxinv,dyinv,dzinv,ghostsizeDO- ,speed,chi) GOTO so_s teandh F! Switze teinfo o Lpart,lda,lsymm,kernel,kpaOUTINE da,lsy--ilad_fwd_3ds(fdta,dta,width,, (M ,npos,TM,,kpa&nel,kp&l,kprhscst,dxinv,dyinv,dzinv,ghostsizeDO- ,speed,chi) so_s teinfo o LpaL-#arccct !------------OUTINE da,lsy--ilad_fwd_3dd(fdta,dta,width,, (M ,npos,TM,,kpa&nel,kp&l,kprhscst,dxinv,dyinv,dzinv,ghostsizeDO- ,speed,chi) GOTO GOTO ri lf-d! This & perf= ms!vos f= ward4:48:47 istep! ivos GMMandh ri lf-d! ,lsy:48:4& &ailX F!!!!! ri lf-d! =o LRe[NhigLics=o F!!!!! ri lf-d! Cmopp:2, Kim:2b ri lf-d F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mmes.h s ri lf-d F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehUSE FFUSE %Nm(doublehUSE FFUSE %Nm(doublehUSE FFUSE %Nm(ydoublehUSE FFUSE & !-rrrrrrrrUSE FFUSE & oprrrrrrrUSE FFUSE errs: ,j,k USE FFUSE h oc mmmmmmUSE FFUSE typedef mmmmmmUSE FFUSE map_fiel ri lf-IMPLICIT NONE Switze teinfo o Lpart,lda,lsymm,kernel,kpa & ,marcAMETMEN=anMK = Fkiad_s7 le ss x,sy,sz & ,marcAMETMEN=anMK = Fkiad_double GOTO ri lf-d F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh #march s ri lf-d F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_dSwrich,-rih define.h" #ufdD_steMPIx,sy,sz CLUDEn'mpif.h' GOTO ri lf-d F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh #mArgu ,0,smm_st ri lf-d F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_dSwitzeteandh 2! & REAL(MK), andEN,ker(:,:,:) ,maOre,ld =anfdta ri lf-d! ,o aI, level funXXXXX. NeedsaI, be definedXXXXa b ri lf-d! (width+, (M rrrr & REAL(MK), andEN,ker(:,:,:) ,maOre,ld =andta ri lf-d! ,o aI, value funXXXXX. & REAL(MK), andEN,ker(:,:,:) ,mre,lNT(IN), OP,dpdALyPUT peed ri lf-d! rank53!(2d) fiel ! ifrontT peeds. OP,dpdALyI, o10:ri,-rrhscst. & REAL(MK), andEN,ker(:,:,:,:) ,mre,lNT(IN), OP,dpdALyPUT:47 ri lf-d! rank54!(2d) fiel !nnnnifB 'poinposit! ss_ ivos grid nodeX F!!!!! 1st indDx: 1..h dim,ivosn-PPM.[k],i &. OP,dpdAL. Unif= m grid is F!!!!! assu ,d if abs,0,. so_steandh 3! & REAL(MK), andEN,ker(:,:,:,:) ,maOre,ld =anfdta ri lf-d! ,o aI, level funXXXXX. NeedsaI, be definedXXXXa b ri lf-d! (width+, (M rrrr & REAL(MK), andEN,ker(:,:,:,:) ,maOre,ld =andta ri lf-d! ,o aI, value funXXXXX. & REAL(MK), andEN,ker(:,:,:,:) ,mre,lNT(IN), OP,dpdALyPUT peed ri lf-d! rank54!(3d) fiel ! ifrontT peeds. OP,dpdALyI, o10:ri,-rrhscst. & REAL(MK), andEN,ker(:,:,:,:,:) ,mre,lNT(IN), OP,dpdALyPUT:47 ri lf-d! rank55!(3d) fiel !nnnnifB 'poinposit! ss_ ivos grid nodeX F!!!!! 1st indDx: 1..h dim,ivosn-PPM.[k],i &. OP,dpdAL. Unif= m grid is F!!!!! assu ,d if abs,0,. GOTO ri lf-REAL(MK) ,mre,lNT(IN ) =anwidth F!!!!! Width_ ivos narrow b aI, be prUSEcMAXnXXXXXXXsi,-r ivos im NDfaitu DmmmmREAL(MK) ,mre,lNT(IN ) =anrhscst F!!!!! c sstant value f= deni!right h asi,-r igrad u *igrad f3,j,c F!!!!! Ifg peed&is res,0,,ivois argu ,0,cwillccccignUred. & REAL(MK) ,mre,lNT(IN ) =anTM ri lf-d! Curr,0,cthreshol !f= dwave frontT ocaXXXX. & REAL(MK) ,mre,lNT(IN ) =andxinv ri lf-d! invers-r ivos x grid spac . & REAL(MK) ,mre,lNT(IN ) =andyinv ri lf-d! invers-r ivos y grid spac . & REAL(MK) ,mre,lNT(IN ) =andzinv ri lf-d! invers-r ivos z grid spac . (NotcusedXXXX2D-10:18:5 F!! & ,mandEN,ker(3) ,mre,lNT(IN ) =anghostsize ri lf-d! Size_ ivos ghostlay! & ne exsi,-s F!! & ,mre,lNT(IN ) =an, (M ri lf-d! Onn! & svos me od I, be used. One! u D for !! ri lf-d! *p-CE3Dbrat, (M =1 ri lf-d! *p-CE3Dbrat, (M =2 ri lf-d! *p-CE3Dbrat, (M =3 F!! & ,mre,lNT(INNE ) =annpos ri lf-d! Curr,0,cb! & s,o XXXXXeni!closemset F!! & ,mre,lNT(erlic) =anO- ri lf-d! arch s2dius. 0 up nesucLics ri lf-d F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_dri lf-d Local variab s ri lf-d F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh & ith-PPM. ,p,xhi,yhi,zhi,iPPMM. kdoubleh & ith-npos0 y( 1,i &,ioptdoubleh & ith-P1,i2,i3 F!! & ,mandEN,ker(-3:3) PUT arnnn! F!! & ,mandEN,ker(4) ith-ldu & REAL(MK) ith-t0,one ird,one welfth F!!REAL(MK) ith-valijk,det,hsave,fdta0 F!!REAL(MK) ith-lmyeps,ainv,big,absfdta0 F!!REAL(MK) ith-dxihalf,dxi welve,agag F!!REAL(MK) ith-dyihalf,dyi welve F!!REAL(MK) ith-dzihalf,dzi welve F!!REAL(MK),mandEN,ker(3) yPUT:oefs,gphi,gpp F!!REAL(MK),mandEN,ker(3,3) PUTjac,ji F!!REAL(MK),mandEN,ker(-3:3,h dim)PUTphi,psi F!!REAL(MK),mandEN,ker(h dim) PUTalpha,beta ri lf-REAL(MK),mandEN,ker(2) yPUTroots ri lf-TYPE(h t_topo),ri lf-aOre,ld th-topo ri lf-TYPE(h t_equi_mesh),-aOre,ld th-mesh ri lf-d F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_dri lf-d Ex NDnals ri lf-d F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh ri lf-d F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh #mar F! s sx,sy,szl F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh& & art CONTI--ilad_fwdEND DO- END -- topo => Ftopo(topoid)%tdoublehmesh => topo%mesh(meshid)doublehphioubleh= 0.0_MKdoublehpsioubleh= 0.0_MKdoublehbigoubleh= HUGE(big)doublehhsavebleh= 0.9_MK*bigdoublehone irdh= 1.0_MK/3.0_MKdoublehone welfthh= 1.0_MK/12.0_MKd2,n info o Lpart,lda,lsymm,kernel,kpalmyepsleh= FFyepss ss x,sy,szlmyepsleh= FFyepsd GOTO ri lf-dxihalfeh= 0.5_MK*dxinv ri lf-dyihalfeh= 0.5_MK*dyinv ri lf-dxi welveeh= one welfth*dxinv ri lf-dyi welveeh= one welfth*dyinv Switzerlandh F! & dzihalfeh= 0.5_MK*dzinv ri lf-dzi welveeh= one welfth*dzinv GOTO ri lf-d F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh #mCrch argu ,0,s ri lf-d F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_dri lf-Xnnnh debug .GT.oi,jnnnnn phM ==poiXnnnwidth .LT.oi.0_MK,jnnnnn phM ==poiiiiiO- h= Ferrs: errs: ,j,k & Ferrs:( Ferr_ Fno Lil CONTI--ilad_fwdENpa&nel,kp&l,kppppppppp'width must binposit!ve!',__LINE__DO- END -- GOTO 9999END -- phM ==poiXnnnn .NE.p-CE3Dbrat, (M =1).AND.n .NE.p-CE3Dbrat, (M =2) &nel,kp&l,kpppppp.AND.n .NE.p-CE3Dbrat, (M =3),jnnnnn phM ==poiiiiiO- h= Ferrs: errs: ,j,k & Ferrs:( Ferr_ Fno Lil CONTI--ilad_fwdENpa&nel,kp&l,kppppppppp' must bin1, 2,cccc3!',__LINE__DO- END -- GOTO 9999END -- phM = ND -- ,lsydebug f= dargu ,0,c8rch , Switzerlandh F! & npos0h= npos ri lf-d F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_dri lf- #mF= ward4 You s updliciMAXXXXXXXX s,o XXXXXggm_ipos ri lf-d F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_dri lf-DO p=1,npos ri lf-=poiXnnnp .GT.onpos0) EXIT ri lf-=poiiioub ,k,jipos(1,p END -- jjoub ,k,jipos(2,p END -- kkoub ,k,jipos(3,p END -- j &b ,k,jipos(4,p END -- i &b topo%i &! st(y( ND =hgmm_st, xhiou=hmesh%nnodeX(1,i( ND =hgmm_st, yhiou=hmesh%nnodeX(2,i( ND =hgmm_st, zhiou=hmesh%nnodeX(3,i( ND =hgmm_st, fdta0= fdta(iPPMM. k y( ND =hgmm_st, absfdta0 = fdta0 ri lf-=poiXnnnabsfdta0 .LT.oi.0_MK,jabsfdta0 = -absfdta0 F!! lf-d F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD k F!! lf-d GMM updlicicoGOTt sta(sh Kim:2a) F!! lf-d F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD k F!! lf-Xnnn.NOT.nabsfdta0.GT.TM),jnnnnn phM ==poiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD n phM ==poiiiiid gnu.orgciMon-accep/wdXMAXXXXXXXn phM ==poiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD n phM ==poiiiiii = iio- 1n phM ==poiiiiij = jjon phM ==poiiiiik = kdoubleh F!! lf-Xnnni.GT.i,jnnnnn phM ==poi F!! lf-Xnnn(*n=hgeo V sz(-3 y( ND .NE.!! lf-&nel,kp&l,kpppppppppppppONTI3Dbrataccep/wd)p.AND.!! lf-&nel,kp&l,kppppppppppppp(ABS(fdta(iz(-3 y( ND).GT.absfdta0),jnnnnn phM ==poiiiii=poiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:n phM ==poiiiii=poiiiiid Updlici,o -PPM. n phM ==poiiiii=poiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:nSwrich,-rih *n=hglvextn.wri"n phM ==poiiiii=poiiiiiXnnnvalijk .LT.ohsave,jnnnnn phM ==poiiiii=poiiiiiiiiidta(iz(-3 y( ND = valijk n phM ==poiiiii=poiiiiiiiii F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME- mmmmmmmm ==poiiiii=poiiiiid KeepXXXX= dadd I, closemsetn phM ==poiiiii=poiiiiiiiii F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME- mmmmmmmm ==poiiiii=poiiiiiXnnn(*n=hgeo V sz(-3 y( ND .IM------&nel,kp&l,kpppppppppppppppppppppONTI3Dbratfar)p.AND.!! lf-----&nel,kp&l,kppppppppppppppppppppp(ABS(fdta(iz(-3 y( ND) .LT.owidth),jnnnnn phM ==poiiiii=poiiiiiiiiiiiii*n=hgeo V sz(-3 y( ND =! lf-----&nel,kp&l,kpppppppppppppppppppppppppONTI3DbratclosenSwrich,-rih *n=haddto_! st.wri"n phM ==poiiiii=poiiiiiiiii phM ==poi=poiiiiiiiii phM ==poi=poiiiii phM ==poi=poi phM ==poi=poii = iio+ 1n phM ==poiiiiij = jjon phM ==poiiiiik = kdoubleh F!! lf-Xnnni.LE.xhi,jnnnnn phM ==poi F!! lf-Xnnn(*n=hgeo V sz(-3 y( ND .NE.!! lf-&nel,kp&l,kpppppppppppppONTI3Dbrataccep/wd)p.AND.!! lf-&nel,kp&l,kppppppppppppp(ABS(fdta(iz(-3 y( ND).GT.absfdta0),jnnnnn phM ==poiiiii=poiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER, ER, PARAME- mmmmmmmm ==poiiiii=poid Updlici,o -PPM. n phM ==poiiiii=poiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:nSwrich,-rih *n=hglvextn.wri"n phM ==poiiiii=poiiiiiXnnnvalijk .LT.ohsave,jnnnnn phM ==poiiiii=poiiiiiiiiidta(iz(-3 y( ND = valijk n phM ==poiiiii=poiiiiiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME- mmmmmmmm ==poiiiii=poiiiiid KeepXXXX= dadd I, closemsetn phM ==poiiiii=poiiiiiiiii F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME- mmmmmmmm ==poiiiii=poiiiiiXnnn(*n=hgeo V sz(-3 y( ND .IM------&nel,kp&l,kpppppppppppppppppppppONTI3Dbratfar)p.AND.!! lf-----&nel,kp&l,kppppppppppppppppppppp(ABS(fdta(iz(-3 y( ND) .LT.owidth),jnnnnn phM ==poiiiii=poiiiiiiiiiiiii*n=hgeo V sz(-3 y( ND =! lf-----&nel,kp&l,kpppppppppppppppppppppppppONTI3DbratclosenSwrich,-rih *n=haddto_! st.wri"n phM ==poiiiii=poiiiiiiiii phM ==poi=poiiiiiiiii phM ==poi=poiiiii phM ==poi=poi phM ==poi=poii = iion phM ==poiiiiij = jjo- 1n phM ==poiiiiik = kdoubleh F!! lf-Xnnnj.GT.i,jnnnnn phM ==poi F!! lf-Xnnn(*n=hgeo V sz(-3 y( ND .NE.!! lf-&nel,kp&l,kpppppppppppppONTI3Dbrataccep/wd)p.AND.!! lf-&nel,kp&l,kppppppppppppp(ABS(fdta(iz(-3 y( ND).GT.absfdta0),jnnnnn phM ==poiiiii=poiiiiid F! Ptesnidalong with-PPM. IEX------CI---I---GER, PARAME- mmmmmmmm ==poiiiii=poid Updlici,o -PPM. n phM ==poiiiii=poiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:nSwrich,-rih *n=hglvextn.wri"n phM ==poiiiii=poiiiiiXnnnvalijk .LT.ohsave,jnnnnn phM ==poiiiii=poiiiiiiiiidta(iz(-3 y( ND = valijk n phM ==poiiiii=poiiiiiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME- mmmmmmmm ==poiiiii=poiiiiid KeepXXXX= dadd I, closemsetn phM ==poiiiii=poiiiiiiiii F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME- mmmmmmmm ==poiiiii=poiiiiiXnnn(*n=hgeo V sz(-3 y( ND .IM------&nel,kp&l,kpppppppppppppppppppppONTI3Dbratfar)p.AND.!! lf-----&nel,kp&l,kppppppppppppppppppppp(ABS(fdta(iz(-3 y( ND) .LT.owidth),jnnnnn phM ==poiiiii=poiiiiiiiiiiiii*n=hgeo V sz(-3 y( ND =! lf-----&nel,kp&l,kpppppppppppppppppppppppppONTI3DbratclosenSwrich,-rih *n=haddto_! st.wri"n phM ==poiiiii=poiiiiiiiii phM ==poi=poiiiiiiiii phM ==poi=poiiiii phM ==poi=poi phM ==poi=poii = iion phM ==poiiiiij = jjo+ 1n phM ==poiiiiik = kdoubleh F!! lf-Xnnnj.LE.yhi,jnnnnn phM ==poi F!! lf-Xnnn(*n=hgeo V sz(-3 y( ND .NE.!! lf-&nel,kp&l,kpppppppppppppONTI3Dbrataccep/wd)p.AND.!! lf-&nel,kp&l,kppppppppppppp(ABS(fdta(iz(-3 y( ND).GT.absfdta0),jnnnnn phM ==poiiiii=poiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER-GER, PARAME- mmmmmmmm ==poiiiii=poid Updlici,o -PPM. n phM ==poiiiii=poiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:nSwrich,-rih *n=hglvextn.wri"n phM ==poiiiii=poiiiiiXnnnvalijk .LT.ohsave,jnnnnn phM ==poiiiii=poiiiiiiiiidta(iz(-3 y( ND = valijk n phM ==poiiiii=poiiiiiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME- mmmmmmmm ==poiiiii=poiiiiid KeepXXXX= dadd I, closemsetn phM ==poiiiii=poiiiiiiiii F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME- mmmmmmmm ==poiiiii=poiiiiiXnnn(*n=hgeo V sz(-3 y( ND .IM------&nel,kp&l,kpppppppppppppppppppppONTI3Dbratfar)p.AND.!! lf-----&nel,kp&l,kppppppppppppppppppppp(ABS(fdta(iz(-3 y( ND) .LT.owidth),jnnnnn phM ==poiiiii=poiiiiiiiiiiiii*n=hgeo V sz(-3 y( ND =! lf-----&nel,kp&l,kpppppppppppppppppppppppppONTI3DbratclosenSwrich,-rih *n=haddto_! st.wri"n phM ==poiiiii=poiiiiiiiii phM ==poi=poiiiiiiiii phM ==poi=poiiiii phM ==poi=poi phM ==poi=poii = iion phM ==poiiiiij = jjon phM ==poiiiiik = ko- 1n phM ==poiiiiiXnnnk.GT.i,jnnnnn phM ==poi F!! lf-Xnnn(*n=hgeo V sz(-3 y( ND .NE.!! lf-&nel,kp&l,kpppppppppppppONTI3Dbrataccep/wd)p.AND.!! lf-&nel,kp&l,kppppppppppppp(ABS(fdta(iz(-3 y( ND).GT.absfdta0),jnnnnn phM ==poiiiii=poiiiiid F! Ptesnidalong with-PPM. IEX------CI---I---GER, PARAME- mmmmmmmm ==poiiiii=poid Updlici,o -PPM. n phM ==poiiiii=poiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:nSwrich,-rih *n=hglvextn.wri"n phM ==poiiiii=poiiiiiXnnnvalijk .LT.ohsave,jnnnnn phM ==poiiiii=poiiiiiiiiidta(iz(-3 y( ND = valijk n phM ==poiiiii=poiiiiiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME- mmmmmmmm ==poiiiii=poiiiiid KeepXXXX= dadd I, closemsetn phM ==poiiiii=poiiiiiiiii F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME- mmmmmmmm ==poiiiii=poiiiiiXnnn(*n=hgeo V sz(-3 y( ND .IM------&nel,kp&l,kpppppppppppppppppppppONTI3Dbratfar)p.AND.!! lf-----&nel,kp&l,kppppppppppppppppppppp(ABS(fdta(iz(-3 y( ND) .LT.owidth),jnnnnn phM ==poiiiii=poiiiiiiiiiiiii*n=hgeo V sz(-3 y( ND =! lf-----&nel,kp&l,kpppppppppppppppppppppppppONTI3DbratclosenSwrich,-rih *n=haddto_! st.wri"n phM ==poiiiii=poiiiiiiiii phM ==poi=poiiiiiiiii phM ==poi=poiiiii phM ==poi=poi phM ==poi=poii = iin phM ==poiiiiij = jjon phM ==poiiiiik = ko+ 1n phM ==poiiiiiXnnnk.LE.zhi,jnnnnn phM ==poi F!! lf-Xnnn(*n=hgeo V sz(-3 y( ND .NE.!! lf-&nel,kp&l,kpppppppppppppONTI3Dbrataccep/wd)p.AND.!! lf-&nel,kp&l,kppppppppppppp(ABS(fdta(iz(-3 y( ND).GT.absfdta0),jnnnnn phM ==poiiiii=poiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER-GER, PARAME- mmmmmmmm ==poiiiii=poid Updlici,o -PPM. n phM ==poiiiii=poiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:nSwrich,-rih *n=hglvextn.wri"n phM ==poiiiii=poiiiiiXnnnvalijk .LT.ohsave,jnnnnn phM ==poiiiii=poiiiiiiiiidta(iz(-3 y( ND = valijk n phM ==poiiiii=poiiiiiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME- mmmmmmmm ==poiiiii=poiiiiid KeepXXXX= dadd I, closemsetn phM ==poiiiii=poiiiiiiiii F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME- mmmmmmmm ==poiiiii=poiiiiiXnnn(*n=hgeo V sz(-3 y( ND .IM------&nel,kp&l,kpppppppppppppppppppppONTI3Dbratfar)p.AND.!! lf-----&nel,kp&l,kppppppppppppppppppppp(ABS(fdta(iz(-3 y( ND) .LT.owidth),jnnnnn phM ==poiiiii=poiiiiiiiiiiiii*n=hgeo V sz(-3 y( ND =! lf-----&nel,kp&l,kpppppppppppppppppppppppppONTI3DbratclosenSwrich,-rih *n=haddto_! st.wri"n phM ==poiiiii=poiiiiiiiii phM ==poi=poiiiiiiiii phM ==poi=poiiiii phM ==poi=poi phM ==poi=poid F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD n phM ==poiiiiid gAccep/ivois ,o - aremovwwiocfromXeni!! st phM ==poi=poid F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD n phM ==poiiiii*n=hgeo V sPPMM. k y( NDh= F3Dbrataccep/wdn phM ==poiiiii*n=hipos(1,p b ,k,jipos(1,npos0)n phM ==poiiiii*n=hipos(2,p b ,k,jipos(2,npos0)n phM ==poiiiii*n=hipos(3,p b ,k,jipos(3,npos0)n phM ==poiiiii*n=hipos(4,p b ,k,jipos(4,npos0)n phM ==poiiiiinpos0h= npos0o- 1n phM ==poi ND -- h TT .LE.nTM ri lf- DOD -- h p=1,npos ri lf-nposh= npos0 oiiiiid ggggggWRITE(cbuf,'(A,I2.2,A)') 'geo V_',M48:47t,'.out' oiiiiid ggggggOPEN(40,FILE=cbuf,STATUS='REPLACE',AC,dpd='WRITE') oiiiiid ggggggWRITE(cbuf,'(A,I2.2,A)') 'value_',M48:47t,'.out' oiiiiid ggggggOPEN(30,FILE=cbuf,STATUS='REPLACE',AC,dpd='WRITE') oiiiiid ggggggDODkk=1,z47 ri lf-dND -- hDODjj=1,y47 ri lf-dND -- h hDODii=1,x47 ri lf-dND -- h hggggWRITE(40,'(I3)') *n=hgeo V sPPMM. k y( ND ri lf-dND -- h hggggXnnndta(iPPMM. k y( ND .GT.ohsave,jnnnnn phM = mmmmmmmmmmmmmmmmmmmmgggWRITE(30,'(E20.8)') 0.0_MKdoubleh mmmmmmmmmmmmmmmmmmmELSEn phM = mmmmmmmmmmmmmmmmmmmmgggWRITE(30,'(E20.8)') dta(iPPMM. k y( ND =hgmm_ mmmmmmmmmmmmmmmmmmmE phM = mmmmmmmmmmmmmmm DO phM = mmmmmmmmmmm DO phM = mmmmmmm DO phM = mmmmmmmCLOSE(30D =hgmm_ mmmmmmmCLOSE(40D =hgmm_ F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD : MKD n phM =d Updlicighost lay! s f= dboth dta AND *n=hgeo V sx,sy,szl F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh& FFap_fiel _push(topoid,meshid,dta,O- END -- Xnnni- h.NE.!p-CE3DbratsucLics,jnnnnn phM ==poiO- h= Ferrs: errs: ,j,k & Ferrs:( Ferr_( Ntfailed CONTI--ilad_fwdENpa&nel,kp&l,kppppp'push 'fiel !%Nm( failed',__LINE__DO- END -- GOTO 9999END -- E phM =& FFap_fiel _push(topoid,meshid,*n=hgeo V ,O- END -- Xnnni- h.NE.!p-CE3DbratsucLics,jnnnnn phM ==poiO- h= Ferrs: errs: ,j,k & Ferrs:( Ferr_( Ntfailed CONTI--ilad_fwdENpa&nel,kp&l,kppppp'push 's2dius!%Nm( failed',__LINE__DO- END -- GOTO 9999END -- E phM =& FFap_fiel _slad(O- END -- Xnnni- h.NE.!p-CE3DbratsucLics,jnnnnn phM ==poiO- h= Ferrs: errs: ,j,k & Ferrs:( Ferr_( Ntfailed CONTI--ilad_fwdENpa&nel,kp&l,kppppp'slad 'ghosts failed',__LINE__DO- END -- GOTO 9999END -- E phM =& FFap_fiel _pop(topoid,meshid,*n=hgeo V ,ghostsizeDO- END -- Xnnni- h.NE.!p-CE3DbratsucLics,jnnnnn phM ==poiO- h= Ferrs: errs: ,j,k & Ferrs:( Ferr_( Ntfailed CONTI--ilad_fwdENpa&nel,kp&l,kppppp'popp 's2dius!%Nm( failed',__LINE__DO- END -- GOTO 9999END -- E phM =& FFap_fiel _pop(topoid,meshid,dta,ghostsizeDO- END -- Xnnni- h.NE.!p-CE3DbratsucLics,jnnnnn phM ==poiO- h= Ferrs: errs: ,j,k & Ferrs:( Ferr_( Ntfailed CONTI--ilad_fwdENpa&nel,kp&l,kppppp'popp 'fiel !%Nm( failed',__LINE__DO- END -- GOTO 9999END -- E so_steandh 2! & npos0h= npos ri lf-d F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_dri lf- #mF= ward4 You s updliciMAXXXXXXXX s,o XXXXXggm_ipos ri lf-d F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_dri lf-DO p=1,npos ri lf-=poiXnnnp .GT.onpos0) EXIT ri lf-=poiiioub ,k,jipos(1,p END -- jjoub ,k,jipos(2,p END -- j &b ,k,jipos(3,p END -- i &b topo%i &! st(y( ND =hgmm_st, xhiou=hmesh%nnodeX(1,i( ND =hgmm_st, yhiou=hmesh%nnodeX(2,i( ND =hgmm_st, fdta0= fdta(iPPMM.y( ND =hgmm_st, d F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD k F!! lf-d GMM updlicicoGOTt sta(sh Kim:2a) F!! lf-d F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD k F!! lf-Xnnn.NOT.nABS(fdta0).GT.TM),jnnnnn phM ==poiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD n phM ==poiiiiid gnu.orgciMon-accep/wdXMAXXXXXXXn phM ==poiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD n phM ==poiiiiii = iio- 1n phM ==po j = jjon phM ==poiiiiiXnnni.GT.i,jnnnnn phM ==poi F!! lf-Xnnn(*n=hgeo V2 sz(-y( ND .NE.!! lf-&nel,kp&l,kpppppppppppppONTI3Dbrataccep/wd)p.AND.!! lf-&nel,kp&l,kppppppppppppp(ABS(fdta(iz(-y( ND).GT.ABS(fdta0)),jnnnnn phM ==poiiiii=poiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER-GER, PARAME- mmmmmmmm ==poiiiii=poid Updlici,o -PPMn phM ==poiiiii=poiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:nSwrich,-rih *n=hglvextn.wri"n phM ==poiiiii=poiiiiiXnnnvalijk .LT.ohsave,jnnnnn phM ==poiiiii=poiiiiiiiiidta(iz(-y( ND = valijk n phM ==poiiiii=poiiiiiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME- mmmmmmmm ==poiiiii=poiiiiid KeepXXXX= dadd I, closemsetn phM ==poiiiii=poiiiiiiiii F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME- mmmmmmmm ==poiiiii=poii f-Xnnn(*n=hgeo V2 sz(-y( ND .IM------&nel,kp&l,kpppppppppppppppppppppONTI3Dbratfar)p.AND.!! lf-----&nel,kp&l,kppppppppppppppppppppp(ABS(fdta(iz(-y( ND) .LT.owidth),jnnnnn phM ==poiiiii=poiiiiiiiiiiiii*n=hgeo V2 sz(-y( ND =! lf-----&nel,kp&l,kpppppppppppppppppppppppppONTI3DbratclosenSwrich,-rih *n=haddto_! st.wri"n phM ==poiiiii=poiiiiiiiii phM ==poi=poiiiiiiiii phM ==poi=poiiiii phM ==poi=poi phM ==poi=poii = iio+ 1n phM ==poiiiiij = jjon phM ==poiiiiiXnnni.LE.xhi,jnnnnn phM ==poi F!! lf-Xnnn(*n=hgeo V2 sz(-y( ND .NE.!! lf-&nel,kp&l,kpppppppppppppONTI3Dbrataccep/wd)p.AND.!! lf-&nel,kp&l,kppppppppppppp(ABS(fdta(iz(-y( ND).GT.ABS(fdta0)),jnnnnn phM ==poiiiii=poiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER-GER, PARAME- mmmmmmmm ==poiiiii=poid Updlici,o -PPMn phM ==poiiiii=poiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:nSwrich,-rih *n=hglvextn.wri"n phM ==poiiiii=poiiiiiXnnnvalijk .LT.ohsave,jnnnnn phM ==poiiiii=poiiiiiiiiidta(iz(-y( ND = valijk n phM ==poiiiii=poiiiiiiiiid F! Ptdalong with-PPM. IEX------CI---GER-GER, PARAME- mmmmmmmm ==poiiiii=poi=poid KeepXXXX= dadd I, closemsetn phM ==poiiiii=poiiiiiiiii F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME- mmmmmmmm ==poiiiii=poii f-Xnnn(*n=hgeo V2 sz(-y( ND .IM------&nel,kp&l,kpppppppppppppppppppppONTI3Dbratfar)p.AND.!! lf-----&nel,kp&l,kppppppppppppppppppppp(ABS(fdta(iz(-y( ND) .LT.owidth),jnnnnn phM ==poiiiii=poiiiiiiiiiiiii*n=hgeo V2 sz(-y( ND =! lf-----&nel,kp&l,kpppppppppppppppppppppppppONTI3DbratclosenSwrich,-rih *n=haddto_! st.wri"n phM ==poiiiii=poiiiiiiiii phM ==poi=poiiiiiiiii phM ==poiiiiiiiii phM ==poiiiii phM ==poi=poii = iion phM ==poiiiiij = jjo- 1n phM ==poiiiiiXnnnj.GT.i,jnnnnn phM ==poi F!! lf-Xnnn(*n=hgeo V2 sz(-y( ND .NE.!! lf-&nel,kp&l,kpppppppppppppONTI3Dbrataccep/wd)p.AND.!! lf-&nel,kp&l,kppppppppppppp(ABS(fdta(iz(-y( ND).GT.ABS(fdta0)),jnnnnn phM ==poiiiii=poiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER-GER, PARAME- mmmmmmmm ==poiiiii=poid Updlici,o -PPMn phM ==poiiiii=poiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:nSwrich,-rih *n=hglvextn.wri"n phM ==poiiiii=poiiiiiXnnnvalijk .LT.ohsave,jnnnnn phM ==poiiiii=poiiiiiiiiidta(iz(-y( ND = valijk n phM ==poiiiii=poiiiiiiiiid F! Ptdalong with-PPM. IEX------CI---GER-GER, PARAME- mmmmmmmm ==poiiiii=poi=poid KeepXXXX= dadd I, closemsetn phM ==poiiiii=poiiiiiiiii F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME- mmmmmmmm ==poiiiii=poii f-Xnnn(*n=hgeo V2 sz(-y( ND .IM------&nel,kp&l,kpppppppppppppppppppppONTI3Dbratfar)p.AND.!! lf-----&nel,kp&l,kppppppppppppppppppppp(ABS(fdta(iz(-y( ND) .LT.owidth),jnnnnn phM ==poiiiii=poiiiiiiiiiiiii*n=hgeo V2 sz(-y( ND =! lf-----&nel,kp&l,kpppppppppppppppppppppppppONTI3DbratclosenSwrich,-rih *n=haddto_! st.wri"n phM ==poiiiii=poiiiiiiiii phM ==poi=poiiiiiiiii phM ==poiiiiiiiii phM ==poiiiii phM ==poi=poii = iion phM ==poiiiiij = jjo+ 1n phM ==poiiiiiXnnnj.LE.yhi,jnnnnn phM ==poi F!! lf-Xnnn(*n=hgeo V2 sz(-y( ND .NE.!! lf-&nel,kp&l,kpppppppppppppONTI3Dbrataccep/wd)p.AND.!! lf-&nel,kp&l,kppppppppppppp(ABS(fdta(iz(-y( ND).GT.ABS(fdta0)),jnnnnn phM ==poiiiii=poiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER-GER, PARAME- mmmmmmmm ==poiiiii=poid Updlici,o -PPMn phM ==poiiiii=poiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:nSwrich,-rih *n=hglvextn.wri"n phM ==poiiiii=poiiiiiXnnnvalijk .LT.ohsave,jnnnnn phM ==poiiiii=poiiiiiiiiidta(iz(-y( ND = valijk n phM ==poiiiii=poiiiiiiiiid F! Ptdalong with-PPM. IEX------CI---GER-GER, PARAME- mmmmmmmm ==poiiiii=poi=poid KeepXXXX= dadd I, closemsetn phM ==poiiiii=poiiiiiiiii F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME- mmmmmmmm ==poiiiii=poii f-Xnnn(*n=hgeo V2 sz(-y( ND .IM------&nel,kp&l,kpppppppppppppppppppppONTI3Dbratfar)p.AND.!! lf-----&nel,kp&l,kppppppppppppppppppppp(ABS(fdta(iz(-y( ND) .LT.owidth),jnnnnn phM ==poiiiii=poiiiiiiiiiiiii*n=hgeo V2 sz(-y( ND =! lf-----&nel,kp&l,kpppppppppppppppppppppppppONTI3DbratclosenSwrich,-rih *n=haddto_! st.wri"n phM ==poiiiii=poiiiiiiiii phM ==poi=poiiiiiiiii phM ==poiiiiiiiii phM ==poiiiii phM ==poi=poid F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD n phM ==poiiiiid gAccep/ivois ,o - aremovwwiocfromXeni!! st phM ==poi=poid F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD n phM ==poiiiii*n=hgeo V2d(iPPMM.y( NDh= F3Dbrataccep/wdn phM ==poiiiii*n=hipos(1,p b ,k,jipos(1,npos0)n phM ==poiiiii*n=hipos(2,p b ,k,jipos(2,npos0)n phM ==poiiiii*n=hipos(3,p b ,k,jipos(3,npos0)n phM ==poiiiiinpos0h= npos0o- 1n phM ==poi ND -- h TT .LE.nTM ri lf- DOD -- h p=1,npos ri lf-nposh= npos0 oiiiiid F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD : MKD n phM =d Updlicighost lay! s f= dboth dta AND *n=hgeo V2d-ri lf-d F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh& FFap_fiel _push(topoid,meshid,dta,O- END -- Xnnni- h.NE.!p-CE3DbratsucLics,jnnnnn phM ==poiO- h= Ferrs: errs: ,j,k & Ferrs:( Ferr_( Ntfailed CONTI--ilad_fwdENpa&nel,kp&l,kppppp'push 'fiel !%Nm( failed',__LINE__DO- ,j,k GOTO 9999END -- E phM =& FFap_fiel _push(topoid,meshid,*n=hgeo V2 ,O- END -- Xnnni- h.NE.!p-CE3DbratsucLics,jnnnnn phM ==poiO- h= Ferrs: errs: ,j,k & Ferrs:( Ferr_( Ntfailed CONTI--ilad_fwdENpa&nel,kp&l,kppppp'push 's2dius!%Nm( failed',__LINE__DO- END -- GOTO 9999END -- E phM =& FFap_fiel _slad(O- END -- Xnnni- h.NE.!p-CE3DbratsucLics,jnnnnn phM ==poiO- h= Ferrs: errs: ,j,k & Ferrs:( Ferr_( Ntfailed CONTI--ilad_fwdENpa&nel,kp&l,kppppp'slad 'ghosts failed',__LINE__DO- END -- GOTO 9999END -- E phM =& FFap_fiel _pop(topoid,meshid,*n=hgeo V2 ,ghostsizeDO- END -- Xnnni- h.NE.!p-CE3DbratsucLics,jnnnnn phM ==poiO- h= Ferrs: errs: ,j,k & Ferrs:( Ferr_( Ntfailed CONTI--ilad_fwdENpa&nel,kp&l,kppppp'popp 's2dius!%Nm( failed',__LINE__DO- END -- GOTO 9999END -- E phM =& FFap_fiel _pop(topoid,meshid,dta,ghostsizeDO- END -- Xnnni- h.NE.!p-CE3DbratsucLics,jnnnnn phM ==poiO- h= Ferrs: errs: ,j,k & Ferrs:( Ferr_( Ntfailed CONTI--ilad_fwdENpa&nel,kp&l,kppppp'popp 'fiel !%Nm( failed',__LINE__DO- END -- GOTO 9999END -- E GOTO ri lf-d F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh #march ri lf-d F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_do9999 CONTINUE phM =& & op CONTI--ilad_fwdEND DO- END -- RETURN dSwitze teandh 2! Switze teinfo o Lpart,lda,lsymm,kernel,kpa!!c_OUTINE da,lsy--ilad_fwd_2ds so_s teinfo o LpaL-#arccct !------------!!c_OUTINE da,lsy--ilad_fwd_2dd GOTO so_s teandh F! Switze teinfo o Lpart,lda,lsymm,kernel,kpa!!c_OUTINE da,lsy--ilad_fwd_3ds so_s teinfo o LpaL-#arccct !------------!!c_OUTINE da,lsy--ilad_fwd_3dd GOTO GOTO ode_rhsfunXFFacro.hpp72ng.f6521221010000644000175000017500000007064411616214647020172 0u-ong omaromarEND -- F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME- mmmmmmmm! $Log: ode_rhsfunXFFacro.h,v $ mmmmmmmm! Revi18:551.1.1.1 2007/07/13 10:19:01 ivos ri lf-=p! CBL-10:18:55 ivos &PM!! n ri lf-=p! mmmmmmmm! Revi18:551.1 2004/07/26 07:52:28 michaebe mmmmmmmm! Macro I, make ode_step!shor a aeasi aI, read. & =p! mmmmmmmm! F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME- mmmmmmmmIF(ct SlNT(ipack%Nm(),jnnnnn phM ==poiiIF(ct SlNT(lpack%Nm(),jnnnnn phM ==poiioiiIF(ct SlNT(rpack%Nm(),jnnnnn phM ==poiioiiiiithrowawayh= rhsfunX(topoid,xp,up,dup,lda,N F!!,& phM ==poi=poiiiiiiiii& ipack=ipack%Nm(,lpack=lpack%Nm(,rpack=rpack%Nm(,& phM ==poi=poiiiiiiiii& i- =O- END -- ELSEn phM ==poiioiiiiithrowawayh= rhsfunX(topoid,xp,up,dup,lda,N F!!,& phM ==poi=poiiiiiiiii& ipack=ipack%Nm(,lpack=lpack%Nm(,i- =O- END -- E!c_ phM ==poi=ELSEn phM ==poiioiiIF(ct SlNT(rpack%Nm(),jnnnnn phM ==poiioiiiiithrowawayh= rhsfunX(topoid,xp,up,dup,lda,N F!!,& phM ==poi=poiiiiiiiii& ipack=ipack%Nm(,rpack=rpack%Nm(,i- =O- END -- ELSEn phM ==poiioiiiiithrowawayh= rhsfunX(topoid,xp,up,dup,lda,N F!!,& phM ==poi=poiiiiiiiii& ipack=ipack%Nm(,i- =O- END -- E!c_ phM ==poi=E!c_ phM ==pELSEn phM ==poiiIF(ct SlNT(lpack%Nm(),jnnnnn phM ==poiioiiIF(ct SlNT(rpack%Nm(),jnnnnn phM ==poiioiiiiithrowawayh= rhsfunX(topoid,xp,up,dup,lda,N F!!,& phM ==poi=poiiiiiiiii& lpack=lpack%Nm(,rpack=rpack%Nm(,i- =O- END -- ELSEn phM ==poiioiiiiithrowawayh= rhsfunX(topoid,xp,up,dup,lda,N F!!,& phM ==poi=poiiiiiiiii& lpack=lpack%Nm(,i- =O- END -- E!c_ phM ==poi=ELSEn phM ==poiioiiIF(ct SlNT(rpack%Nm(),jnnnnn phM ==poiioiiiiithrowawayh= rhsfunX(topoid,xp,up,dup,lda,N F!!,& phM ==poi=poiiiiiiiii& rpack=rpack%Nm(,i- =O- END -- ELSEn phM ==poiioiiiiithrowawayh= rhsfunX(topoid,xp,up,dup,lda,N F!!,& phM ==poi=poiiiiiiiii& i- =O- END -- E!c_ phM ==poi=E!c_ phM ==pE!c_ phM ==p templo V_comp_pp_cell.fpp22ng.f15171221010000644000175000017500000007064411616214647020172 0u-ong omaromarhM ==pd F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh #mSub & :ND -- templo V_comp_pp_cell ri lf-d F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPurposemmmmmm: Templo V f= deni!us asub & which cu.orgcsdoubleh #mmmmmmmmmmmmmmmmdirect F!!icle- F!!icle im NDact! ss_us7 cell ri lf-d#mmmmmmmmmmmmmmmm! sts. HowaI, us ivois templo V: ri lf-d#mmmmmmmmmmmmmmmmmmm(1) cupyivois file I, you a pplicaXXXX cudemdir ri lf-d#mmmmmmmmmmmmmmmmmmm(2) rename!vos file aIhis & (make sure ri lf-d#mmmmmmmmmmmmmmmmmmmmmmmI, als, replocee exvos occurr,0Lics ivos ri lf-d#mmmmmmmmmmmmmmmmmmmmmmmsub & name!ine exWRITE's2die ,0,s F!!d#mmmmmmmmmmmmmmmmmmm(3) changedaddresXXXXXhead a aadd you aCVS ri lf-d#mmmmmmmmmmmmmmmmmmmmmmmLog (if needed F!!d#mmmmmmmmmmmmmmmmmmm(4) declarea aadd addTt stal argu ,0,s ri lf-d#mmmmmmmmmmmmmmmmmmm(5)aadd USE a CLUDEns2die ,0,s f= dyou ri lf-d#mmmmmmmmmmmmmmmmmmmmmmmms.h s ahead afiles ri lf-d#mmmmmmmmmmmmmmmmmmm(6) define'poinpreci18:55 ifloaXX ,o -%Nm(doublehd#mmmmmmmmmmmmmmmmmmmmmmm(maybe prUvidemdiffer,0,c10:18:5cs ivois ri lf-d#mmmmmmmmmmmmmmmmmmmmmmmsub & f= ddiffer,0,cpreci18:5sD =hgmm_ mmmmmmmmmmmmmmmmmmm (7)aadd F!!icle- F!!icle im NDact! ss_where ri lf-d#mmmmmmmmmmmmmmmmmmmmmmmneededa(sh48:4 f= dUSER CODE). Make suremI, ri lf-d#mmmmmmmmmmmmmmmmmmmmmmmreplocee exoccurr,0Lics idi ,0s_withivos ri lf-d#mmmmmmmmmmmmmmmmmmmmmmmvariab which actu eyicoGtai0s_poinprob m ri lf-d#mmmmmmmmmmmmmmmmmmmmmmmdi ,0s stalityXXXXyou acude F!!d#mmmmmmmmmmmmmmmmmmm(8) Opt stal: Make argu ,0,c8rch 7 coGOTt stal ri lf-d#mmmmmmmmmmmmmmmmmmmmmmmoXXeni!debug level iyou a pplicaXXXX F!!d#mmmmmmmmmmmmmmmmmmm(9) Opt stal: Make Ihis & us iyou aowX F!!d#mmmmmmmmmmmmmmmmmmmmmmmerrs: logg7 ,hmessagedwrit7 ,h eocaXXXX, ri lf-d#mmmmmmmmmmmmmmmmmmmmmmmsub & art,msub & op ri lf-d#mmmmmmmmmmmmmmmmmmmmmmmtim7 & s F!!d#mmmmmmmmmmmmmmmmmmm(10)Opt stal: Movwweni!variab declarat! ss_fo ri lf-d#mmmmmmmmmmmmmmmmmmmmmmmc! st aNm I, you ac! ,0,cprogram ri lf-d#mmmmmmmmmmmmmmmmmmmmmmmadd Ihem s argu ,0,saI, Ihis & . Tois ri lf-d#mmmmmmmmmmmmmmmmmmmmmmmmakeswiocpossible I, usemse10:al sets! u D for #mmmmmmmmmmmmmmmmmmmmmmm! sts. F!!d#mmmmmmmmmmmmmmmmmmm(11)Opt stal: Removwwvos ims.e=-1 aims.e=1 ri lf-d#mmmmmmmmmmmmmmmmmmmmmmmcaseswfromXenis & abuild/destroy ri lf-d#mmmmmmmmmmmmmmmmmmmmmmmtni!! stsmdirectlyXXXXyou ac! ,0,cprogram by ri lf-d#mmmmmmmmmmmmmmmmmmmmmmmc eX , FnAXXX! st_c! st/..destroy. You ri lf-d#mmmmmmmmmmmmmmmmmmmmmmmc nivosn-removwwims.ecfromXeni!argu ,0,c! st phM =d#mmmmmmmmmmmmmmmmmmmmmmmof Ihis & .doubleh doubleh #mInorgmmmmmmmm: xp(:,:) (F) F!!icle co-ordinagcsdoubleh #mmmmmmmmmmmmmmmmpdlia(:,:) (F) F!!icle %Nm( usedXf= dim NDact! s phM =d#mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm(e.g. vo!!icity,mstr,0gth, ...D =hgmm_ mmmmmmmmmmmmmmmmm...mmmmmmmm(.)dUSER:madd more imorgmargu ,0,saas ri lf-d#mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmneeded ri lf-d#mmmmmmmmmmmmmmmmNpmmmmmmmmm(I)cb! & s,F!!iclesmoXXenis roc F!!d#mmmmmmmmmmmmmmmmcutoffmmmmm(F) cutoffmradius f= dPP im NDact! ss ri lf-d#mmmmmmmmmmmmmmmm!symmmmmmmm(L) Do symmetdPP im NDact! ss? ri lf-d#mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm.TRUE.!!: Yes ri lf-d#mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm.FALSE.!: N, ri lf-d#mmmmmmmmmmmmmmmmims.ecmmmmm(I)cMo,-r iact! s. Any5 ivos folowX : ri lf-d#mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm0 dPP im NDact! ss ri lf-d#mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm1 abuild cell!! stsm arech ri lf-d#mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm-1 destroy cell!! stsm arech ri lf-d#mmmmmmmmmmmmmmmmn &! st mm(I)cb! & s &di0s_oXXeni!eocal ri lf-d#mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm rocesso ri lf-ddoubleh #mInorg/& orgm: 3Dbras(:) (F) us adefined 3Dbraet! s /o ri lf-d#mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm& orgmfromXeni!im NDact! snni.e F!!d#mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm ot,0,ial energy) ri lf-ddoubleh #mO orgmmmmmmm: dpd(:,:) (F) Changed s,F!!icle %Nm( (pdlia) due I, F!!d#mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmim NDact! s F!!d#mmmmmmmmmmmmmmmmO- hhhhhhh(I)crrch s2dius. =0 if nomerrs:.doubleh doubleh #mR& smmmmm: , FnAXXX! st_c! stdoubleh #mmmmmmmmmmmmmmmmppm_c! st_destroy ri lf-d#mmmmmmmmmmmmmmmm, FnAXXX! st_MkNAXXXIdxdoubleh doubleh #mRemarksmmmmmm: I s,F!!iclesmhavebmovw abe wesn-c esX= d!symmmhas ri lf-d#mmmmmmmmmmmmmmmmchanged,h ways-c e_withiims.e=1.doubleh doubleh #mmmmmmmmmmmmmmmmsh4:4 f= dUSER inivois file afill indoubleh #mmmmmmmmmmmmmmmmpoinpF!!icle- F!!icle im NDact! ss_ine ex4 ploces F!!d#mmmmmmmmmmmmmmmmUswwvos dpdmarrayaI, rech vos result. It is you ri lf-d#mmmmmmmmmmmmmmmmresp ssibilityXI, roperlyX eocaXe air F! zs ri lf-d#mmmmmmmmmmmmmmmmvois arrayaBEFOREmc eX Ihis & .doubleh doubleh #mmmmmmmmmmmmmmmmAft afinish ' exvi , steps,h ways-c e_mmmmmmmmmmmmmmmmmdi ,0s stalirrayaBEF2dimG ,j,:emmmmmmm) rMSER CODE). Make suremI, ri lf-d#mmmmmmmmmmmmresu0 #mRemarksmm .doub-d#mmm dPP ommmrkss you oces -d#mmmmmmmmmmmmresu0 #mResuremI,leak,0,cprogri lf-d#mmmmmmmmmmmm-d#mmmmmmmmmmmmresu0 #mReI : riCYCLEblehmzs riREmlf-d#mmml riprogrhardwammmmmmmmmmmmmmmmmmmmmmneedeity,ms=hgvf-d#mv acorizi lf-)... F!t : riDO-loopmmmmmmmmmmmmmmmmpoinpF!!icle-wo!!icl#mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm0 dPP im NDari l!icl==po i!icl-mmmmmmmmmmmmmmmmmmmmmcaseswfromXeeeeeeeeee.)dmmmmmmmmmmmmmmmmmmmmcaseswfromXeeeeeeeeee mmmmmmmmmmm DO phM =mmmmmmmmmm0 dPP im NDari l!icl==po!icl+1, bymmmmmmmmmmmmmmmmmmmmmadd Ihem s eeeeeeeee.)dmmmmmmmmmmmmmmmmmmmmcaseswfromXeeeeeeeeee mmmmmmmmmmm marksmmmmmm:18:5scFnAXX:mmmmmmm marksmmmmmm:2004/0,F!!i:mmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu $m:2004/0:07/07/13 $marksmmmmmm:2004/007/4 07:52:22/24 11:35:53-=p! CBL-10:1mmmm:2004/007/3 07:52:22/19 14:01:39 gonnetpBL-10:1mmmm:2004/007/2 07:52:22/04 17:20:48-=p! CBL-10:1mmmm:2004/007/6 07:52:21 mi17:24:35-=p! CBL-10:1mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu Copyrh dt (c)07:10 CSE Lab (ETH Zuacth)..MOSAIC GG ,p (ETH Zuacth)..mmmmmmmmmmmmmmmmmmmmcaseswfrCen ' eoisFluid Dynamics (DTUbleh #mO orgmmmmmmmmmmmmmTafill indF!!dicl= n r /ollel r /ct! ssMmeshL-=p! m (PPM)bleh #mmmmmmmmmmmmri lfill). Msoftwamm:ipromovwwredo ribp/wditf-d#mmmaheaifmmmmmmmmmmitfun lf- n ' mlf-d#mmm GNU Lddolf-Gf-ddi lPcchL-cenrrammmmmmmmma!!dcbh esy#mmm F). MSoftwamm Foun -d#mmm emmmlf-mmmmmmmmmos &PM!!3f-d#mmm L-cenrrINE__(at F!!d#movwwv)f-dI,latlf-mmmmmmmmmos &PM!bleh #mmmmmmmmmmmmri lfildo ribp/wde ae haXe aat itfmmrksbwX fulmmmmmmmmmmbp/ WITHOUT ANY WARRANTY;mmmmm ,j gvf-1 ai F!wdewmc ntymmmmmmmmmmmmMERCHANTABILITYNE__FITNESS Ih A PARTICULAR PURPOlf-dS. MakemmmmmmmmmGNU Gf-ddi lPcchL-cenrrafmmaherss_ftoubsbleh #mmmmmmmmmmmmYromsm ,sm e wesreceic eaile I,-d#mmm GNU Gf-ddi lPcchL-cenrrmmmmmmmmma (m GNU Lddolf-Gf-ddi lPcchL-cenrraalostemmmmmri .eI notmmmmmmmmmma) bleh #mmmmmmmmmmmmr /ollel r /ct! ssMmeshL-=p! m (PPM)mmmmmmmmmETH Zuacthleh #mPu CH-8092 Zuacth, Smmmze mmmmBL-10:1mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doublBL-10:1lsy--ilad_fp_pp_cell ri lf-d F! (xp,, ,Np,s f= d, lf-d, kppppppppppppppppppppppppm) rM,I)cb!, re,F) us RETURNmmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu Mead ammmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu re imoUDEnhead af#mmmmmmmmmmUDEn _popead kNAXXXIdxdmmmmmmmIMPLICIT NONEmmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu I*n=hadammmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPe ,0,s f'cLics,jnn.h'mmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu re imoDeci18:=hgmm_ mmmmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubl!h #mPe TEGER, PARAMETile:: MK errs: kind_ lf-leleh #mPe TEGER, PARAMETile:: MK errs: kind_docemmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu Ari lf-d#mmmmmmmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPREAL(MK)..DIMEN!c_OChang,Pe TENT(IN#mP)e:: xpleh #mPREAL(MK)..DIMEN!c_OChang,Pe TENT(IN#mP)e:: p#mmmmmmmmmmmmre imorgmargu ,0,saas ri lf-d#mmmf-d#mmmmmmmmmme TEGER ,Pe TENT(IN#mP)e:: Npleh #mPREAL(MK) ,Pe TENT(IN#mP)e:: s f= dleh #mPLOGICAL ,Pe TENT(IN#mP)e:: lf-dmmmmmmme TEGER ,Pe TENT(IN#mP)e:: m) rM,I)cb!leh #mPREAL(MK)..DIMEN!c_OChang,Pe TENT(IN)e:: releh #mPREAL(MK)..DIMEN!c_OCh),mmme TENT(IN)e:: F) us mmmmmmme TEGER ,Pe TENT( )e:: RETUmmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu L#mmmclarat! ss Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh #march ri counri lmmmmmmme TEGER :: R,idom,ibox,jboxmmmmmmme TEGER :: R==poil!icl i!il!,ismmmmmmmmmme TEGER :: cbox,i_ine poiiiii=poii cobleh #mmreci18:5scdammmmmmmREAL(MK) :: dx,dy,dzmmmmmmmmmaquamm -d#_ine m( (pdlia) o scdmmmmmmmREAL(MK) :: dijiii=poii c f= dPaquammeleh #mPREAL(MK)..SAVE :: cut2mmmmmmmmma I, reanF!!icle imoces boxmmmmmmme TEGER :: R ianF,j jbymmmmmmmmmmbox smmmafmmamarksmm leh #mPREAL(MK)..DIMEN!c_OC3) :: bsmmmmmmmmmmmmmarksmm leh #mPmmre imoif ri lf-d#mmwX : ri lff-d#mmclarase10:NE__sF!!d#mmm ck-mmmmmmmmmsmmmalimiti lf-d, t m saaNm(doi oces nhead Tt stal armre mmmmmmmmma you rt! s I,bove.eIniciMAX:al sets! u D fCarksmm ,sn-c mmmmmmmmm: rsss_fo ri lf-d# . eram ri lf-d#mmmtal a I, you ac! mmmmmmmmm:o,c! st phM =d#mmm .doubleh doubleh #mITYPEtfailtype_ptr"n p I, y)..DIMEN!c_OCh),mPOe TER..SAVE :: cmm leh #mPmm&di0s_omarkloces you ac#mmmmmmmmmme TEGER, DIMEN!c_OChang,PPOe TER..SAVE :: ! mmmmmmmmmmarkshM ==poismm mmmmmmme TEGER, DIMEN!c_OChang,PPOe TER..SAVE :: 0,s,jnpleh #mPmm&di0s_o_ine ex4 plo! s R ini#mmmmmmmmmme TEGER, SAVE :: nnpleh #mPmmmarks= dor #m AND *xo_idexmmmmmmme TEGER :: n1,n2,nzmmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu Exne nals Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh #march rmmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu I*lf-d#msemmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPrrs: er0Nmmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu CTt ss ri lf-d#dmmmmmmmmmmre imoprommay wa =dode_step.doubri lf-d#mmmg level iyou a pplicmmmmmmmmmmXXXX F!!d#mmm.)dmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mP.!p-c f= dPf- h mmmm==poiioiiiiithrow20.8)'*,'(2',M48:(ad_fp_pp_cell ri lf-d F! ): l,kppppp'popp 'fielc f= dPmumm be >0'oiiiiithrowrrs: er- ND -- -- E phM =& FFap.!p-NpPf- h==poiioiiiiithrow20.8)'*,'(2',M48:(ad_fp_pp_cell ri lf-d F! ): l,kppppp'popp 'fielNpPmumm be >0'oiiiiithrowrrs: er- ND -- -- E phM =& mmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu If(I)cMo,er- ,l!! stsm arech ri lf-d#mmmmmmmmmmmmmre imoTdoubri,sm e exbe do18:bycprogram by ryou ac! -d#me lf-d#mmmdi ,0s stjumm #mmmsaI, i lf-d#mmdmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mP.!p-I)cMo,l,kp&-1==poiioiiiiithrows:( Fery ri lf-d#mmm(y ri GOTO 9999ENDDEALLOCA8)'0,s,jnp,NmLACE' E!c_ -- E phM =& mmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu Bstsm new arech r F!!d#mmmmmmmmmmmre imoTdoubri,sm e exbe do18:bycprogram by ryou ac! -d#me lf-d#mmmdi ,0s stjumm #mmmsaI, i lf-d#mmdmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mP.!p-I)cMo,l,kp&1==poiioiiiiithrowalong with-PPM. IEX------CI---GER, PARAME---H:: MKD k F!! lf-d GMM updlicicD! stsm osm arech t#mmmsal=p! y waal red F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD k F!! lf-Xnnn.NOT.nABs:( Fery ri lf-d#mmm(y ri GOoiiiiithrowalong with-PPM. IEX------CI---GER, PARAME---H:: MKD k F!! lf-d GMM updlicic#me smmmaX : rimarklocesR inispa ri lyou ac#mmmsm ,sm adboti=poid F! Ptecicb Make smmmaX : rim f= d.oiiiiithrowalong with-PPM. IEX------CI---GER, PARAME---H:: MKD k F!! lf-d GMM updlibsmmm(1:3(3,ns f= dleh #mPPPPPcut23,ns f= d*s f= dloiiiiithrowalong with-PPM. IEX------CI---GER, PARAME---H:: MKD k F!! lf-d GMM updlicicGf-ddite arech F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD k F!! lf-Xnnn.NOT.nABs:( Fer stdoubleh #mmm(xp,Np,bsmmm, lf-d,y ri NmL E!c_ .!p-CE3Dbratsu ==poi F!! lf-Xnnn(*n=20.8)'*,'(2',M48:(ad_fp_pp_cell ri lf-d F! ): l,kpppppppppppppppppppp'Bstsmlf-d#mmmech rNE__DO 'F!! lf-Xnnn(*n=rrs: er- ND -- -- E phM =====& mmmmmmmhrowalong with-PPM. IEX------CI---GER, PARAME---H:: MKD k F!! lf-d GMM updlicicGf-ddite arehM ==poismm F! Ptesnidalong with-PPM. IEX------CI---GER, PARAME---H:: MKD k F!! lf-Xnnn.NOT.nABs:( Fer stdoublehubleh doub( lf-d,0,s,jnp,nnp GOTO 9999END -- E GOTO ri lmmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu PARTICLE-PARTICLEme TERE') oiSri lf-d im NDammmmmmmmmmmTdoubmmrksnotmv acoriz Tt sthas t#mmmfgu ,bd!syn-c e_inos -d#mmmmmmmseF) utf-d#op !!mmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mP.!p- lf-d==poi F!! lf-Xnnnri ldomf-np)cb!leh #mPPPPPPPPPn1deX(Nmmm_sdomiiiinpos0h= npos02deX(Nmmm_sdomi*Nmm2_sdomiiiinpos0h= npos0zdeX(Nmm3_sdomiiiinpos0h= nposM. k os ri l,kp&2==poiiiii=poiiiiiiiiiiiiin2 er0Nii=poiiiiiiiiiiiiinz er2Nii=poiiiiiiiii h Nii=poiiiiiiiii!-d#op -c rs REALimarklo(: ri-2e ae anF!doesp.douiiiinpos0h= nposri l=0,nz-2Nii=poiiiiiiiiinposri j=0,Nmm2_sdomi-2Nii=poiiiiiiiiinposnposri i=0,Nmm1_sdomi-2Nii=poiiiiiiiiinposnposiiii!-_idexaX : rimaine mboxmmmmmmmmmmmmmmmmmmmmmmmmmmmcbox==popoiipoin1*=poin2*iiii=poiiiiid F! Ptesnidiiii!-d#op -c rs box- *xo_ii lf-d#mmmmmmmmmm=poiiiiiiiiinposnposri i_ii lf-npnpleh #mP=poiiiiid F! Ptesnidiiii!-d ri mi18: *xo_idicFnAasub &is phM =d#mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmibox==pcbox+'0,sm1_s phM )+n1*0,sm2_s phM )+pppppppppppppppppppppppppONTI3Dbr iin2*0,sm3_s phM )iiiinpos0h= nposssssssssssssssssjbox==pcbox+'j,sm1_s phM )+n1*j,sm2_s phM )+pppppppppppppppppppppppppONTI3Dbr iin2*j,sm3_s phM )iiiinpos0h= nposssssssssssssssssmlong with-PPM. IEX------CI---GER, PARAME---H:: MKleh #mP=poiiiiid F! Ptesnidiiii!- Rp! o_idicFnAt stOTt sr areis _pptyiiinpos0h= nposssssssssssssssssmlong with-PPM. IEX------CI---GER, PARAME---H:: MKleh #mP=poiiiiid F! PtesnidiiiiR ==pc#mmm(sdomi%lhbx(iboxiiiinpos0h= nposssssssssssssssssianF ==pc#mmm(sdomi%lhbx(ibox+1)- ND -- .!p-CanF jnnnnR )iCYCLEiiinpos0h= nposssssssssssssssssmlong with-PPM. IEX------CI---GER, PARAME---H:: MKleh #mP=poiiiiid F! Ptesnidiiii!- Wi &i ae *xo_tself sets!im NDam#mmmtavoidiiii=poiiiiiiiiid F! Ptdaloniiii!- rgu .de!!icle imoctself nosi #mmwn=poi=poid F! Ptesnidssssssssssssssssmlong with-PPM. IEX------CI---GER, PARAME---H:: MKleh #mP=poiiiiid F! Ptesnidiiii.!p-C *xol,kp&jbox==poiiiii=poiiiiiiiiiiiii*n=hgeo V2 ri i!icl=R ianF- ND -- ip==pc#mmm(sdomi%lpub(i!icliiiinpos0h= nposssssssssssssssssV2 ri l!icl=(o!icl+1), bymmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmjp==pc#mmm(sdomi%lpub(j!icliiiinpos0h= nposssssssssssssssssV2 dx ==pxsm1_sp) -pxsm1_jpiiiinpos0h= nposssssssssssssssssV2 dy ==pxsm2_sp) -pxsm2_jpiiiinpos0h= nposssssssssssssssssV2 M. k os ri lXIT 2==poiiiii=poiiiiiiiiiiiiissssssssssssssssV2 dz ==pxsm3_sp) -pxsm3_jpiiiinpos0h= nposssssssssssssssssV2 diphM (dx*dx)+(dy*dy)+(dz*dziiiinpos0h= nposssssssssssssssssV2 poiioiiiiithrowawayh= issssssssssssssssV2 dz =eh mmmmmmmmmmm0h= nposssssssssssssssssV2 diphM (dx*dx)+(dy*dy)iiinpos0h= nposssssssssssssssssV2 ppoi=poiiiiiiiii phM =====================M. k oj lXIT cut2)iCYCLEiiinpos0h= nposssssssssssssssssssssssssssssmlong with-PPM. IEX------CI---GER, PARiiinpos0h= nposssssssssssssssssssssssssssssm r /ct! ssip phM =d#i lf-diiinpos0h= nposssssssssssssssssssssssssssssm !icle imojp=#mmm.)dUaymmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm! vicFmos &a:al sets!im NDam.iiinpos0h= nposssssssssssssssssssssssssssssmlong with-PPM. IEX------CI---GER, PARiiinpos0h= nposssssssssssssssssssssssssssssmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm! Make sure HERE:mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm! F) Chais(3,nf(F) F!!iis(,mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm! F) F!!ijpi, oj)iiinpos0h= nposssssssssssssssssV2 ! F) Chajs(3,n-F) Chais(iiinpos0h= nposssssssssssssssssV2 mmmmmmmmmmmnposssssssssssssssssV2 mmmmmmmmmmmnposssssssssssssssssV2 mlong with-PPM. IEX------CI---GER, PARAME---H:: MKleh #mP=poiiiiid F! Ptesnidiiii!- Fsub & ommlf-boxFnAOTt sr vebmovw ammmmmmmnposssssssssssssssssV2 mlong with-PPM. IEX------CI---GER, PARAME---H:: MKleh #mP=poiiiiid F! Ptesnidiiiipoiioiiiiithrowawayh= issssssssssssssss! getoublehi lfCODEir you acoti= !icle imooiiiiithrowawayh= issssssssssssssssj ==pc#mmm(sdomi%lhbx(jboxiiiinpos0h= nposssssssssssssssssssssjanF ==pc#mmm(sdomi%lhbx(jbox+1)- ND -- ssss! skip &is _ine m _pptyiiinpos0h= nposssssssssssssssssssss,jnnnanF jnnnnj )iCYCLEiiinpos0h= nposssssssssssssssssssss! d#op -c rs vebmovw abins,c10.doubrmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmri i!icl=R ianF ND -- ip==pc#mmm(sdomi%lpub(i!icliiiinpos0h= nposssssssssssssssssV2 !AOTt sr geocats vebmovw abiiinpos0h= nposssssssssssssssssV2 !Ai ae ommlf-rmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmri l!icl=j jbymmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmjp==pc#mmm(sdomi%lpub(j!icliiiinpos0h= nposssssssssssssssssV2 dx ==pxsm1_sp) -pxsm1_jpiiiinpos0h= nposssssssssssssssssV2 dy ==pxsm2_sp) -pxsm2_jpiiiinpos0h= nposssssssssssssssssV2 M. k os ri lXIT 2==poiiiii=poiiiiiiiiiiiiissssssssssssssssV2 dz ==pxsm3_sp) -pxsm3_jpiiiinpos0h= nposssssssssssssssssV2 diphM (dx*dx)+(dy*dy)+(dz*dziiiinpos0h= nposssssssssssssssssV2 poiioiiiiithrowawayh= issssssssssssssssV2 dz =eh mmmmmmmmmmm0h= nposssssssssssssssssV2 diphM (dx*dx)+(dy*dy)iiinpos0h= nposssssssssssssssssV2 ppoi=poiiiiiiiii phM =====================M. k oj lXIT cut2)iCYCLEiiinpos0h= nposssssssssssssssssssssssssssssmlong with-PPM. IEX------CI---GER, PARiiinpos0h= nposssssssssssssssssssssssssssssm r /ct! ssip phM =d#i lf-diiinpos0h= nposssssssssssssssssssssssssssssm !icle imojp=#mmm.)dUaymmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm! vicFmos &a:al sets!im NDam.iiinpos0h= nposssssssssssssssssssssssssssssmlong with-PPM. IEX------CI---GER, PARiiinpos0h= nposssssssssssssssssssssssssssssmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm! Make sure HERE:mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm! F) Chais(3,nf(F) F!!iis(,mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm! F) F!!ijpi, oj)iiinpos0h= nposssssssssssssssssV2 ! F) Chajs(3,n-F) Chais(iiinpos0h= nposssssssssssssssssV2 mmmmmmmmmmmnposssssssssssssssssV2 mmmmmmmmmmmnposssssssssssssssssV2 h TT .LE! C *xol,kp&jboxmmmmmmmnposssssssssssssssss h p=1,npos rE! C phM mmmmmmmnposssssssssssss h p=1,npos rEs rE! Cmmmmmmmnposssssssss h p=1,npos rEs rEs rE! iiii=poiiiiid F! h p=1,npos rEs rEs rEs rE! iiii=poiiiii h p=1,npos rEs rEs rEs rEs rE! Cdomlmmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu PARTICLE-PARTICLEme TERE') oiSrnotmi lf-d im NDammmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPpoiioiiiiithrowri ldomf-np)cb!leh #mPPPPPPPPPn1deX(Nmmm_sdomiiiinpos0h= npos02deX(Nmmm_sdomi*Nmm2_sdomiiiinpos0h= npos0zdeX(Nmm3_sdomiiiinpos0h= nposM. k os ri l,kp&2==poiiiii=poiiiiiiiiiiiiin2 er0Nii=poiiiiiiiiiiiiinz er2Nii=poiiiiiiiii h Nii=poiiiiiiiii!-d#op -c rs REALimarklo(: ri-2e ae anF!doesp.douiiiinpos0h= nposri l=1,nz-2Nii=poiiiiiiiiinposri j=1,Nmm2_sdomi-2Nii=poiiiiiiiiinposnposri i=1,Nmm1_sdomi-2Nii=poiiiiiiiiinposnposiiii!-_idexaX : rimaine mboxmmmmmmmmmmmmmmmmmmmmmmmmmmmcbox==popoiipoin1*=poin2*iiii=poiiiiid F! Ptesnidiiii!-d#op -c rs box- *xo_ii lf-d#mmmmmmmmmm=poiiiiiiiiinposnposri i_ii lf-npnpleh #mP=poiiiiid F! Ptesnidiiii!-d ri mi18: *xo_idicFnAasub &is phM =d#mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmibox==pcbox+'0,sm1_s phM )+n1*0,sm2_s phM )+pppppppppppppppppppppppppONTI3Dbr iin2*0,sm3_s phM )iiiinpos0h= nposssssssssssssssssjbox==pcbox+'j,sm1_s phM )+n1*j,sm2_s phM )+pppppppppppppppppppppppppONTI3Dbr iin2*j,sm3_s phM )iiiinpos0h= nposssssssssssssssssmlong with-PPM. IEX------CI---GER, PARAME---H:: MKleh #mP=poiiiiid F! Ptesnidiiii!- Rp! o_idicFnAt stOTt sr areis _pptyiiinpos0h= nposssssssssssssssssmlong with-PPM. IEX------CI---GER, PARAME---H:: MKleh #mP=pppppppppppppppppppppppR ==pc#mmm(sdomi%lhbx(iboxiiiinpos0h= nposssssssssssssssssianF ==pc#mmm(sdomi%lhbx(ibox+1)- ND -- .!p-CanF jnnnnR )iCYCLEiiinpos0h= nposssssssssssssssssmlong with-PPM. IEX------CI---GER, PARAME---H:: MKleh #mP=poiiiiid F! Ptsssssssssm dPPa #mmmhere ri lf-di &i ae *xo_tselfpoid F! Ptesnidssssssssssssssssmlong with-PPM. IEX------CI---GER, PARAME---H:: MKleh #mP=poiiiiid F! Ptesnidiiii.!p-C *xol,kp&jbox==poiiiii=poiiiiiiiiiiiii*n=hgeo V2 ri i!icl=R ianF ND -- ip==pc#mmm(sdomi%lpub(i!icliiiinpos0h= nposssssssssssssssssV2 ri l!icl=R ianF ND -- jp==pc#mmm(sdomi%lpub(j!icliiiinpos0h= nposssssssssssssssssV2 ! No!!icle imocehM =d#i lf-diiinpos0h= nposssssssssssssssssssssssssssssm _tselfpoid F! Ptesnidssssssssssssssssssssssssssss.!p-Cpol,kp&jp)iCYCLEiiinpos0h= nposssssssssssssssssssssssssssssdx ==pxsm1_sp) -pxsm1_jpiiiinpos0h= nposssssssssssssssssV2 dy ==pxsm2_sp) -pxsm2_jpiiiinpos0h= nposssssssssssssssssV2 M. k os ri lXIT 2==poiiiii=poiiiiiiiiiiiiissssssssssssssssV2 dz ==pxsm3_sp) -pxsm3_jpiiiinpos0h= nposssssssssssssssssssssV2 diphM (dx*dx)+(dy*dy)+(dz*dziiiinpos0h= nposssssssssssssssssV2 poiioiiiiithrowawayh= issssssssssssssssV2 dz =eh mmmmmmmmmmm0h= nposssssssssssssssssV2 diphM (dx*dx)+(dy*dy)iiinpos0h= nposssssssssssssssssV2 ppoi=poiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiM. k oj lXIT cut2)iCYCLEiiinpos0h= nposssssssssssssssssssssssssssssmlong with-PPM. IEX------CI---GER,iiinpos0h= nposssssssssssssssssssssssssssssm r /ct! ssip phM =d#i lf-diiinpos0h= nposssssssssssssssssssssssssssssm !icle imojp.iiinpos0h= nposssssssssssssssssssssssssssssmlong with-PPM. IEX------CI---GER,iiinpos0h= nposssssssssssssssssssssssssssssmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm! Make sure HERE:mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm! F) Chais(3,nf(F) F!!iis(,mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm! F) F!!ijpi, oj)iiinpos00000000000000000000000000000000 mmmmmmmmmmmnposssssssssssssssssV2 mmmmmmmmmmmnposssssssssssssssssV2 mlong with-PPM. IEX------CI---GER, PARAME---H:: MKleh #mP=poiiiiid F! Ptesnidiiii!- dPPmmhere ri lf-di &Pa #mhM ==poilf-dboxFnmmmmmmmnposssssssssssssssssV2 mlong with-PPM. IEX------CI---GER, PARAME---H:: MKleh #mP=poiiiiid F! Ptesnidiiiipoiioiiiiithrowawayh= issssssssssssssss! getoublehi lfCODEir you acoti= !icle imooiiiiithrowawayh= issssssssssssssssj ==pc#mmm(sdomi%lhbx(jboxiiiinpos0h= nposssssssssssssssssssssjanF ==pc#mmm(sdomi%lhbx(jbox+1)- ND -- ssss! skip &is _ine m _pptyiiinpos0h= nposssssssssssssssssssss,jnnnanF jnnnnj )iCYCLEiiinpos0h= nposssssssssssssssssssss! d#op -c rs vebmovw abins,c10.doubrmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmri i!icl=R ianF ND -- ip==pc#mmm(sdomi%lpub(i!icliiiinpos0h= nposssssssssssssssssV2 !AOTt sr geocats vebmovw abiiinpos0h= nposssssssssssssssssV2 !Ai ae ommlf-rmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmri l!icl=j jbymmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmjp==pc#mmm(sdomi%lpub(j!icliiiinpos0h= nposssssssssssssssssV2 dx ==pxsm1_sp) -pxsm1_jpiiiinpos0h= nposssssssssssssssssV2 dy ==pxsm2_sp) -pxsm2_jpiiiinpos0h= nposssssssssssssssssV2 M. k os ri lXIT 2==poiiiii=poiiiiiiiiiiiiissssssssssssssssV2 dz ==pxsm3_sp) -pxsm3_jpiiiinpos0h= nposssssssssssssssssssssV2 diphM (dx*dx)+(dy*dy)+(dz*dziiiinpos0h= npossssssssssssssssssssssssssssspoiioiiiiithrowawayh= issssssssssssssssV2 dz =eh mmmmmmmmmmm0h= nposssssssssssssssssV2 diphM (dx*dx)+(dy*dy)iiinpos0h= nposssssssssssssssssV2 ppoi=poiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiM. k oj lXIT cut2)iCYCLEiiinpos0h= npppppppppppppppppppppppppppppppmlong with-PPM. IEX------CI---GER,iiinpos0h= nposssssssssssssssssssssssssssssm r /ct! ssip phM =d#i lf-diiinpos0h= nposssssssssssssssssssssssssssssm !icle imojp.iiinpos0h= nposssssssssssssssssssssssssssssmlong with-PPM. IEX------CI---GER,iiinpos0h= nposssssssssssssssssssssssssssssmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm! Make sure HERE:mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm! F) Chais(3,nf(F) F!!iis(,mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm! F) F!!ijpi, oj)iiinpos00000000000000000000000000000000 mmmmmmmmmmmn000000000000000000000000000 mmmmmmmmmmmn00000000000000000000000 h TT .LE! C *xol,kp&jboxmmmmmmmnposssssssssssssssss h p=1,npos rE! C phM mmmmmmmnposssssssssssss h p=1,npos rEs rE! Cmmmmmmmnposssssssss h p=1,npos rEs rEs rE! iiii=poiiiiid F! h p=1,npos rEs rEs rEs rE! iiii=poiiiii h p=1,npos rEs rEs rEs rEs rE! Cdomloiiiii hi lmmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu Rd#mmmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleE phM =& & opze teanoiiiii h1lsy--ilad_fp_pp_cell ri lf-d F! templo V_comaet! spp72ng.f00351517122164110000644000175000017500000007064411616214647020172 0u-ong omaromar#reci18:__MPI #reci18:__FFTWtemplo V_compead kmg_i lfpp72ng.f72316521221015610000644000175000017500000007064411616214647020172 0u-ong omaromarmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu Mead Es rEs rE templo_compead kmg_i lfmmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPuleh #mPu m: Templo V fE head TX : rii lf-d#mm-d#mmwleh douleh #mPuleh #mPuleh #mPu m: I s,F!!iclX:mmmmmmm marksmmmmm:18:5scFnAXXX:mmmmmmm marksmmmmm:2004/0,F!!ii:mmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPummmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu Copyrh dt (c)07:10 CSE Lab (ETH Zuacth)..MOSAIC GG ,p (ETH Zuacth)..mmmmmmmmmmmmmmmmmmmmcaseswfrCen ' eoisFluid Dynamics (DTUbleh #mO orgmmmmmmmmmmmmmTafill indF!!dicl= n r /ollel r /ct! ssMmeshL-=p! m (PPM)bleh #mmmmmmmmmmmmri lfill). Msoftwamm:ipromovwwredo ribp/wditf-d#mmmaheaifmmmmmmmmmmitfun lf- n ' mlf-d#mmm GNU Lddolf-Gf-ddi lPcchL-cenrrammmmmmmmma!!dcbh esy#mmm F). MSoftwamm Foun -d#mmm emmmlf-mmmmmmmmmos &PM!!3f-d#mmm L-cenrrINE__(at F!!d#movwwv)f-dI,latlf-mmmmmmmmmos &PM!bleh #mmmmmmmmmmmmri lfildo ribp/wde ae haXe aat itfmmrksbwX fulmmmmmmmmmmbp/ WITHOUT ANY WARRANTY;mmmmm ,j gvf-1 ai F!wdewmc ntymmmmmmmmmmmmMERCHANTABILITYNE__FITNESS Ih A PARTICULAR PURPOlf-dS. MakemmmmmmmmmGNU Gf-ddi lPcchL-cenrrafmmaherss_ftoubsbleh #mmmmmmmmmmmmYromsm ,sm e wesreceic eaile I,-d#mmm GNU Gf-ddi lPcchL-cenrrmmmmmmmmma (m GNU Lddolf-Gf-ddi lPcchL-cenrraalostemmmmmri .eI notmmmmmmmmmma) bleh #mmmmmmmmmmmmr /ollel r /ct! ssMmeshL-=p! m (PPM)mmmmmmmmmETH Zuacthleh #mPu CH-8092 Zuacth, Smmmze mmmmBL-10:1mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doublB #reci18:__SINGLE_PRECI!c_O 1 #reci18:__DOUBLE_PRECI!c_O 2 #reci18:__e TEGER 3 #reci18:__LOGICAL 4 #reci18:__2Dmmmmmmmcaseswfr7 #reci18:__3Dmmmmmmmcaseswfr8 #reci18:__SFIELDmmmmmmmcase9 #reci18:__VFIELDmmmmmmmcas10NmmmmmmmMODULEo_compead kmg_i lfmmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubmmmmmmm Mead ammmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubmBL-10:1mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doub mmmmmmmhre TERFACEo_compg_i lfmmmmmmmmmmmmMODULEoPROCEDUREo_compg_i lf_2d_sca_smmmmmmmmmmmmMODULEoPROCEDUREo_compg_i lf_2d_sca_dmmmmmmmmmmmmMODULEoPROCEDUREo_compg_i lf_3d_sca_smmmmmmmmmmmmMODULEoPROCEDUREo_compg_i lf_3d_sca_dmmmmmmmmmmmmMODULEoPROCEDUREo_compg_i lf_2d_vec_smmmmmmmmmmmmMODULEoPROCEDUREo_compg_i lf_2d_vec_dmmmmmmmmmmmmMODULEoPROCEDUREo_compg_i lf_3d_vec_smmmmmmmmmmmmMODULEoPROCEDUREo_compg_i lf_3d_vec_dmmmmmmmmm==p TERFACEmBL-10:1mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doub L-10:1mPe ,0,s fTHE SOURCESBL-10:1mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doub mmmmmmmhM =&AINS #reci18:__DIM:__SFIELD #reci18:__MESH_DIM:__2D #reci18:__KI=p __SINGLE_PRECI!c_O #i*n=had "_compg_i lf.f" #un lf:__KI=p #reci18:__KI=p __DOUBLE_PRECI!c_O #i*n=had "_compg_i lf.f" #un lf:__KI=p #un lf:__MESH_DIM #reci18:__MESH_DIM:__3D #reci18:__KI=p __SINGLE_PRECI!c_O #i*n=had "_compg_i lf.f" #un lf:__KI=p #reci18:__KI=p __DOUBLE_PRECI!c_O #i*n=had "_compg_i lf.f" #un lf:__KI=p #un lf:__MESH_DIM #un lf:__DIM #reci18:__DIM:__VFIELD #reci18:__MESH_DIM:__2D #reci18:__KI=p __SINGLE_PRECI!c_O #i*n=had "_compg_i lf.f" #un lf:__KI=p #reci18:__KI=p __DOUBLE_PRECI!c_O #i*n=had "_compg_i lf.f" #un lf:__KI=p #un lf:__MESH_DIM #reci18:__MESH_DIM:__3D #reci18:__KI=p __SINGLE_PRECI!c_O #i*n=had "_compg_i lf.f" #un lf:__KI=p #reci18:__KI=p __DOUBLE_PRECI!c_O #i*n=had "_compg_i lf.f" #un lf:__KI=p #un lf:__MESH_DIM #un lf:__DIM noiiiii h1MODULEo_compead kmg_i lfm templo V_comode_i lfpp72ng.f1412115171221675110000644000175000017500000007064411616214647020172 0u-ong omaromarL-10:1mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubind_doub L-10:1mP Sop ri rE temploooooo_comode_i lfmmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPuleh #mPu m: Templo V fmoTdoub ri i lf-d#mmmm ri lcMo,solvebleh #mInorg/& orgm: 3Dploooooo: leh #mInorg/& orgm: dpd(:,:) (I)crrch sssssssssssss2dius. =0 if nomeleh #mInorg/& orgm: I s,F!!iclesleh #mInorg/& orgm:18:5scFnAXX:sleh #mInorg/& orgm:2004/0,F!!i:mmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu $Log: _comode_i lf,v $marksmmmmmm:2004/007/07/13 07:57/57/13s10:19:00-=p! CBL-10:1mmmCBLmos &PM!! n rPM l-=p! mleh #mInorg/& orgm:2004/007/8 07:56/09/04 18:34:53-=pchatel -d#mmmmmmmFixFnAt stOleanupsdode_stepitblehp indmmmmmmmmmmmmmrelease-1-0leh #mInorg/& orgm:2004/007/7 07:52:28/12 12:53:59 mcthaebmmmmmmmmmmminrrrt eaih ck-fmmasomeblehp inreleh #mInorg/& orgm:2004/007/6 07:52:27 mi13:49:18-=p! CBL-10:1mmmm:n-c em: , FnAseex4 plo!Dact! snhea lf-lehmentbleh #mR& smmmmm:2004/007/5 07:52:27 mi11:33:04 mcthaebmmmmmmmmmmminrrrt e! snsets n _colcMo, due pead bleh #mR& smmmmm:2004/007/4 07:52:27 mi07:48:58 mcthaebmmmmmmmmmmmAtommmmd.mm:n-c eri lf-d#mmwX globals (n-c e eocomode_crecellode)bleh #mmmmmmmmmmmmmm:2004/007/3 07:52:26/10 16:20:03-=p! CBL-10:1mmmM-c eri cpplyou activesdodecolum007/c#me NEC cpplyodrnotmu aognmmmmmmmmmmmmm nm ommlfwise!! orgmmmmmmmmmmmmmmm:2004/007/2 07:52:22/20 14:54:21 mcthaebmmmmmmmmmmmadd e! snsets _compead k , lbleh #mmmmmmmmmmmmmm:2004/007/1 07:52:22/19 08:33:55 mcthaebmmmmmmmmmmminlf-d# ai Fou ratPM!bleh #mmmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu Copyrh dt (c)07:10 CSE Lab (ETH Zuacth)..MOSAIC GG ,p (ETH Zuacth)..mmmmmmmmmmmmmmmmmmmmcaseswfrCen ' eoisFluid Dynamics (DTUbleh #mO orgmmmmmmmmmmmmmTafill indF!!dicl= n r /ollel r /ct! ssMmeshL-=p! m (PPM)bleh #mmmmmmmmmmmmri lfill). Msoftwamm:ipromovwwredo ribp/wditf-d#mmmaheaifmmmmmmmmmmitfun lf- n ' mlf-d#mmm GNU Lddolf-Gf-ddi lPcchL-cenrrammmmmmmmma!!dcbh esy#mmm F). MSoftwamm Foun -d#mmm emmmlf-mmmmmmmmmos &PM!!3f-d#mmm L-cenrrINE__(at F!!d#movwwv)f-dI,latlf-mmmmmmmmmos &PM!bleh #mmmmmmmmmmmmri lfildo ribp/wde ae haXe aat itfmmrksbwX fulmmmmmmmmmmbp/ WITHOUT ANY WARRANTY;mmmmm ,j gvf-1 ai F!wdewmc ntymmmmmmmmmmmmMERCHANTABILITYNE__FITNESS Ih A PARTICULAR PURPOlf-dS. MakemmmmmmmmmGNU Gf-ddi lPcchL-cenrrafmmaherss_ftoubsbleh #mmmmmmmmmmmmYromsm ,sm e wesreceic eaile I,-d#mmm GNU Gf-ddi lPcchL-cenrrmmmmmmmmma (m GNU Lddolf-Gf-ddi lPcchL-cenrraalostemmmmmri .eI notmmmmmmmmmma) bleh #mmmmmmmmmmmmr /ollel r /ct! ssMmeshL-=p! m (PPM)mmmmmmmmmETH Zuacthleh #mPu CH-8092 Zuacth, Smmmze mmmmBL-10:1mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doublL-10:1lsy--ilad_fode_i lf(topoid GOTO 999mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doorg/& orgm:n=hadammmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh do #i*n=had "_comaet! s"mmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doorg/& :1mmmM-ad ammmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doorg/& :1UDEn _popead k duefodeorg/& :1UDEn _popead k dueorg/& :1UDEn _popead ksub org/& :1UDEn _popead ksub oporg/& :1UDEn _popead kerro mmmmmmmnpIMPLICIT NONEmmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doorg/& :1mmmAri lf-d#mmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doorg/& :1e TEGER, e TENT(IN#mP)e:: topoidorg/& :1e TEGER, e TENT( )e:: RETUmmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doorg/& :1mmL#mmmcVarat! ssmmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doorg/& :1e TEGER :: Rmov, mcdorg/& :1e TEGER, DIMEN!c_OC3) :: tldammmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doorg/& :1mmmcri sub org/& :1mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doorg/& :1s:( sub ('ad_fode_i lf',t0 GOTO 9999Es:( Ferpead k duefode_e rivatlmmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doorg/& :1mmmcTt sr ,saas ri lf-d#mmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doorg/& :1eF(_comaebuglXIT ==poi F!! lf-Xnnn(mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehF!! lf-Xnnn(mtOTt sr _colis plf-d#mmmdF!! lf-Xnnn(mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehF!! lf-Xnnn(eF(.NOT._com plf-d#mmmd==poiiiii=poiiiiiiiiirrs: er_comerro kerro mmmmmmmnp 9999Es:( Fererro ( Fererr_ Fer o plf,'ad_fode_i lf',&mmmmmmmnp 9999EEEEEE& 'Pleasemcri _com plfDEir y!',__L--i__ GOTO 9999ENDDDDD -- E phM =====m==p =poiiiiiii==p =poiiiiiiimcd er- ND --mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doorg/& :1mmnullifmasomebhead Tvarat! ssmmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doorg/& :1NULLIFY(ad_fode_isOTtme); :1NULLIFY(ad_fode_adaptive)org/& :1NULLIFY(ad_fode_ ges); :1NULLIFY(ad_fode_a yo)org/& :1NULLIFY(ad_fode_ f-d); :1:1NULLIFY(ad_fode_bfrsmmm)org/& :1NULLIFY(ad_f phM nal_mcd); NULLIFY(ad_f r_mcd)org/& :1NULLIFY(ad_fode_ksOTtme)org/& :1 Ferpax_mcdrg/& :1er0Nii=poiii Ferpax_mcd_ri lfd er0Nmmmmmmm--mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doorg/& :1mmrego lf- n ID,-d#mmm topologydodebwX dAasub &e ure solvebleh #mI--mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doorg/& :1ad_fode_topoid ertopoidoE ph hM =& rg/& :1mmmmmmm--mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doorg/& :1mmsub oporg/& :1mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doorg/& :1s:( sub op('ad_fode_i lf',t0 GOTO 9999Eze teanoiiiii h1lsy--ilad_fode_i lfmtemplo V_compead kode_t! d#mmmpp72ng.f46716521221510000644000175000017500000007064411616214647020172 0u-ong omaromar/& :1mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh dodoorg/& orgMead Es rEs templo_compead kode_t! d#mmmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPuorg/& orgm: Templo V fmoprocedurebhead Tasubad_fode_t! d#mmmmmmmmmmmBL-10:1mmmm:nI s,F!!iclesleh #mInorg/& orgm:18:5scFnAXX:sleh #mInorg/& orgm:2004/0,F!!i:mmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu $Log: _compead kode_t! d#mmm,v $marksmmmmmm:2004/007/07/13 07:57/57/13s10:19:00-=p! CBL-10:1mmmCBLmos &PM!! n rPM l-=p! mleh #mInorg/& orgm:2004/007/2 07:52:27 mi11:21:04 mcthaebmmmmmmmmmmmadd edummy phM facmmmmmmmmmBL-10:1mmmm:2004/007/1 07:52:27 mi07:45:47 mcthaebmmmmmmmmmmmProcedurebhead s crecelde ae courets atommmatPM!bleh #mmmmmmmmmmmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu Copyrh dt (c)07:10 CSE Lab (ETH Zuacth)..MOSAIC GG ,p (ETH Zuacth)..mmmmmmmmmmmmmmmmmmmmcaseswfrCen ' eoisFluid Dynamics (DTUbleh #mO orgmmmmmmmmmmmmmTafill indF!!dicl= n r /ollel r /ct! ssMmeshL-=p! m (PPM)bleh #mmmmmmmmmmmmri lfill). Msoftwamm:ipromovwwredo ribp/wditf-d#mmmaheaifmmmmmmmmmmitfun lf- n ' mlf-d#mmm GNU Lddolf-Gf-ddi lPcchL-cenrrammmmmmmmma!!dcbh esy#mmm F). MSoftwamm Foun -d#mmm emmmlf-mmmmmmmmmos &PM!!3f-d#mmm L-cenrrINE__(at F!!d#movwwv)f-dI,latlf-mmmmmmmmmos &PM!bleh #mmmmmmmmmmmmri lfildo ribp/wde ae haXe aat itfmmrksbwX fulmmmmmmmmmmbp/ WITHOUT ANY WARRANTY;mmmmm ,j gvf-1 ai F!wdewmc ntymmmmmmmmmmmmMERCHANTABILITYNE__FITNESS Ih A PARTICULAR PURPOlf-dS. MakemmmmmmmmmGNU Gf-ddi lPcchL-cenrrafmmaherss_ftoubsbleh #mmmmmmmmmmmmYromsm ,sm e wesreceic eaile I,-d#mmm GNU Gf-ddi lPcchL-cenrrmmmmmmmmma (m GNU Lddolf-Gf-ddi lPcchL-cenrraalostemmmmmri .eI notmmmmmmmmmma) bleh #mmmmmmmmmmmmr /ollel r /ct! ssMmeshL-=p! m (PPM)mmmmmmmmmETH Zuacthleh #mPu CH-8092 Zuacth, Smmmze mmmmBL-10:1mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doublL-10:1MODULEo_compead kode_t! d#mmmmorg/& :1mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD org/& :1mmmDummy phM facmmmmmmmm:1mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD org/& :1e TERFACEo_comode_t! d#mmmmmmmmmm-10:1MODULEoPROCEDUREo_comode_t! d#mmmmmmmmmm-1==p TERFACEmmmmmmm-1mmmmmmmM =&AINS #i*n=had "_comode_t! d#mmm" noiiiii h1MODULEo_compead kode_t! d#mmmmommmmmmm-1mtemplo V_com ri lf-d oru acpp72ng.f364206521221034310000644000175000017500000007064411616214647020172 0u-ong omaromarL-10:1mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doublL-10:1mP Sop ri rE temploooo_com ri lf-d oru acmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu Copyrh dt (c)07:10 CSE Lab (ETH Zuacth)..MOSAIC GG ,p (ETH Zuacth)..mmmmmmmmmmmmmmmmmmmmcaseswfrCen ' eoisFluid Dynamics (DTUbleh #mO orgmmmmmmmmmmmmmTafill indF!!dicl= n r /ollel r /ct! ssMmeshL-=p! m (PPM)bleh #mmmmmmmmmmmmri lfill). Msoftwamm:ipromovwwredo ribp/wditf-d#mmmaheaifmmmmmmmmmmitfun lf- n ' mlf-d#mmm GNU Lddolf-Gf-ddi lPcchL-cenrrammmmmmmmma!!dcbh esy#mmm F). MSoftwamm Foun -d#mmm emmmlf-mmmmmmmmmos &PM!!3f-d#mmm L-cenrrINE__(at F!!d#movwwv)f-dI,latlf-mmmmmmmmmos &PM!bleh #mmmmmmmmmmmmri lfildo ribp/wde ae haXe aat itfmmrksbwX fulmmmmmmmmmmbp/ WITHOUT ANY WARRANTY;mmmmm ,j gvf-1 ai F!wdewmc ntymmmmmmmmmmmmMERCHANTABILITYNE__FITNESS Ih A PARTICULAR PURPOlf-dS. MakemmmmmmmmmGNU Gf-ddi lPcchL-cenrrafmmaherss_ftoubsbleh #mmmmmmmmmmmmYromsm ,sm e wesreceic eaile I,-d#mmm GNU Gf-ddi lPcchL-cenrrmmmmmmmmma (m GNU Lddolf-Gf-ddi lPcchL-cenrraalostemmmmmri .eI notmmmmmmmmmma) bleh #mmmmmmmmmmmmr /ollel r /ct! ssMmeshL-=p! m (PPM)mmmmmmmmmETH Zuacthleh #mPu CH-8092 Zuacth, Smmmze mmmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubl #ifmmm__KERNEL ==:__e TERNAL #ifmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmmlsy--ilad_f ri lf-d oru ac_si(dh,s f= d,kernel,eps,kdic,gt, pppppppppppppkappa GO#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmmlsy--ilad_f ri lf-d oru ac_di(dh,s f= d,kernel,eps,kdic,gt, pppppppppppppkappa GO#elifm__KI=p ==:__SINGLE_PRECI!c_O_COMPLEX mmmmmmlsy--ilad_f ri lf-d oru ac_sci(dh,s f= d,kernel,eps,kdic,gt, pppppppppppppkappa GO#elifm__KI=p ==:__DOUBLE_PRECI!c_O_COMPLEX mmmmmmlsy--ilad_f ri lf-d oru ac_dci(dh,s f= d,kernel,eps,kdic,gt, pppppppppppppkappa GO#enaifO#elifm__KERNEL ==:__Make_FUN') oi #ifmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmmlsy--ilad_f ri lf-d oru ac_su(dh,s f= d,kernel,eps,kdic,gt, pppppppppppppkappa GO#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmmlsy--ilad_f ri lf-d oru ac_du(dh,s f= d,kernel,eps,kdic,gt, pppppppppppppkappa GO#elifm__KI=p ==:__SINGLE_PRECI!c_O_COMPLEX mmmmmmlsy--ilad_f ri lf-d oru ac_scu(dh,s f= d,kernel,eps,kdic,gt, pppppppppppppkappa GO#elifm__KI=p ==:__DOUBLE_PRECI!c_O_COMPLEX mmmmmmlsy--ilad_f ri lf-d oru ac_dcu(dh,s f= d,kernel,eps,kdic,gt, pppppppppppppkappa GO#enaifO#elifm__KERNEL ==:__LOOKUP_TABLE #ifmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmmlsy--ilad_f ri lf-d oru ac_st(dh,s f= d,kernel,eps,kdic,gt, pppppppppppppkappa GO#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmmlsy--ilad_f ri lf-d oru ac_dt(dh,s f= d,kernel,eps,kdic,gt, pppppppppppppkappa GO#elifm__KI=p ==:__SINGLE_PRECI!c_O_COMPLEX mmmmmmlsy--ilad_f ri lf-d oru ac_sct(dh,s f= d,kernel,eps,kdic,gt, pppppppppppppkappa GO#elifm__KI=p ==:__DOUBLE_PRECI!c_O_COMPLEX mmmmmmlsy--ilad_f ri lf-d oru ac_dct(dh,s f= d,kernel,eps,kdic,gt, pppppppppppppkappa GO#enaifO#enaifOmmmmmmm!u Compp/wm ri ldo cretis-d#mmw oru ac#mmwfactmmmmmmmmmm!u need e eenrureb aat ri ldo creteAseeond-ordemmmmmmmmm!u molf-d,-d#mmm kernel funac#mmwis _qui l esomemmmmmmmm!u value/c#me kernel is _valuceldemmwamregulmmesmmmmmmmm!u #mmm,eso0.doubfactmmmovwwonlyebwX dAifMakemmmmmmmm!! vebmovw abamm mmwamregulgrid (e.g. aftemmmmmmmmm!u remmesing)bleh #mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmmmmM-ad ammmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmUDEn _popead k dueorg/& UDEn _popead ksub org/& UDEn _popead ksub oporg/& UDEn _popead kerro mmmmmmmUDEn _popead kwritlmmmmmmmIMPLICIT NONEm#ifmmm__KI=p ==:__SINGLE_PRECI!c_O |m__KI=p ==:__SINGLE_PRECI!c_O_COMPLEX mmmmmme TEGER, PARAMETER :: MK er_comkind_ lf-leO#elifm__KI=p ==:__DOUBLE_PRECI!c_O |m__KI=p ==:__DOUBLE_PRECI!c_O_COMPLEX mmmmmme TEGER, PARAMETER :: MK er_comkind_doceO#enaifOmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmorgm:n=hadammmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh dodo #i*n=had "_comaet! s"mmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmorgAri lf-d#mmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmREAL(MK), DIMEN!c_OC:), e TENT(IN#mP)e:: dsmmmmmmmm!u grid spaclf-s peri you ac4/0,F1.._comdimleh #mmREAL(MK) , e TENT(IN#mP)e:: s f= dmmmmmmmm!u PPPmmhere ri l s f= dX d.eI no s f= dXoub d, vesaba negativemmmmmmmm!u value=#mmm.leh #mmREAL(MK) , e TENT(IN#mP)e:: epsmmmmmmmm!u Kernel smmm (width)m#ifmmm__KI=p ==:__SINGLE_PRECI!c_O |m__KI=p ==:__DOUBLE_PRECI!c_O mmmmmmREAL(MK) , e TENT(IN#mP)e:: gtmmmmmmmm!u get value=asub &e seeond ordem kernel molf-d. Ove oad e ypes:mmmmmmmm!u lf-le,doceOmmmmmmREAL(MK) , e TENT( )e:: kappammmmmmmm!u compp/wdldo cretis-d#mmw oru ac#mmwfactmm. Eve y kernel _valuce#mmwhasmmmmmmmm!u odebwXmulti F!wdewmmmm &is p ordem odecoru ac=asubdo cretis-d#mmmmmmmmmm!u eff acs. Ove oad e ypes: lf-le,doceO#elifm__KI=p ==:__SINGLE_PRECI!c_O_COMPLEX |m__KI=p ==:__DOUBLE_PRECI!c_O_COMPLEX mmmmmmCOMPLEX(MK) , e TENT(IN#mP)e:: gtmmmmmmmm!u get value=asub &e seeond ordem kernel molf-d. Ove oad e ypes:mmmmmmmm!u lf-le complex, doce complex mmmmmmCOMPLEX(MK) , e TENT( )e:: kappammmmmmmm!u compp/wdldo cretis-d#mmw oru ac#mmwfactmm. Eve y kernel _valuce#mmwhasmmmmmmmm!u odebwXmulti F!wdewmmmm &is p ordem odecoru ac=asubdo cretis-d#mmmmmmmmmm!u eff acs. Ove oad e ypes: lf-le complex, doce complex #enaifO#ifmmm__KERNEL ==:__e TERNAL mmmmmme TEGER , e TENT(IN#mP)e:: kernelmmmmmmmm!u kernel fsubwhich odecompp/w ae coru ac#mm/c#l sets_co- phM nalmmmmmmmm!u kernels,especifmaonts :mmmmmmmm!ummmmmmmm!u PARAME---H:: MKD kind_doubleh doubleh #mmo!mmmmm_comvebaomkmmml_laplace2d_2pleh #mmo!mmmmm (2nd ordem Laplacian,leh #mmo!mmmmm polynom-d# an 2D)leh #mmo!mmmmm_comvebaomkmmml_laplace3d_2pleh #mmo!mmmmm (2nd ordem Laplacian,leh #mmo!mmmmm polynom-d# an 3D)leh #mmo!mmPARAME---H:: MKD kind_doubleh doubleh #mmo!mleh #mmo!mm#l setsF!!d#mwn kernel funac#mm, vesab ae funac#mmwublehi =#mmm.mYrommmmmmmmm!u funac#mmwsm ,sm tsteponts ri lf-dma s. =0 iontsvalue/m#ifmmm__KI=p ==:__SINGLE_PRECI!c_O |m__KI=p ==:__DOUBLE_PRECI!c_O mmmmmmREAL(MK) , DIMEN!c_OC:), e TENT(IN#mP)e:: kdicmmmmmmmm!u Kernel vebao ri s-dS. Mdocuu ratPM! subad_f ri lf-dkernels.i*ndmmmmmmmmmmm!!-d cripc#mm/c#ypemovwwbwX lf-le or complex.O#elifm__KI=p ==:__SINGLE_PRECI!c_O_COMPLEX |m__KI=p ==:__DOUBLE_PRECI!c_O_COMPLEX mmmmmmCOMPLEX(MK), DIMEN!c_OC:), e TENT(IN#mP)e:: kdicmmmmmmmm!u Kernel vebao ri s-dS. Mdocuu ratPM! subad_f ri lf-dkernels.i*ndmmmmmmmmmmm!!-d cripc#mm/c#ypemovwwbwX lf-le complex subdoce complex.O#enaifO#elifm__KERNEL ==:__LOOKUP_TABLE mmmmmmREAL(MK) , e TENT(IN#mP)e:: kdicmmmmmmmm!u Kernel vebao ri s-dS. Mdocuu ratPM! subad_f ri lf-dkernels.i*ndmmmmmmmmmmm!!-d cripc#mm/cPesabdxtt! sinvo(: riinverets n tt! s spaclf-) asmmmmmmmm!u a scal#mmm.l#ifmmm__KI=p ==:__SINGLE_PRECI!c_O |m__KI=p ==:__DOUBLE_PRECI!c_O mmmmmmREAL(MK) , DIMEN!c_OC:mP), e TENT(IN#mP)e:: kernelm#elifm__KI=p ==:__SINGLE_PRECI!c_O_COMPLEX |m__KI=p ==:__DOUBLE_PRECI!c_O_COMPLEX mmmmmmCOMPLEX(MK), DIMEN!c_OC:mP), e TENT(IN#mP)e:: kernelm#enaifOmmmmmmm!u Lookup tt! s wmmmm abulceldekernel valuesbleh #mmm!u Such a tt! s ovwwbwXcreceldei lf-d<>.m#enaifOmmmmmme TEGER , e TENT( )e:: RETUmmmmmmmm!u Rd#mmms 0 upmmwsucces#mmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmmmmL#mmmcvarat! ssmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmREAL(MK) :: 0, oj2, oj4, oj5leh #mmREAL(MK) :: hi,dx,dy,dz, oj,factmm,factmm2m#ifmmm__KI=p ==:__SINGLE_PRECI!c_O |m__KI=p ==:__DOUBLE_PRECI!c_O mmmmmmREAL(MK) :: eta,summO#elifm__KI=p ==:__SINGLE_PRECI!c_O_COMPLEX |m__KI=p ==:__DOUBLE_PRECI!c_O_COMPLEX mmmmmmCOMPLEX(MK) :: eta,summO#enaifOmmmmmme TEGER :: lhx,lhy,lhz,i,j,k,idx mmmmmmCHARE')ER(LEN=ad_f har) :: cbufOmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmorgExhM nalammmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh dodo #ifmmm__KERNEL ==:__Make_FUN') oi #ifmmm__KI=p ==:__SINGLE_PRECI!c_O |m__KI=p ==:__DOUBLE_PRECI!c_O mmmmmmREAL(MK) , DIMEN!c_OC:), e TENT(IN#mP)e:: kdicmmmmmmm TERFACEmmmmmmm-1 FUN') oiekernel(x,kdiciiiinpos0h= nposMMPLICIT NONEm#ifmmm__KI=p ==:__SINGLE_PRECI!c_O |m__KI=p ==:__SINGLE_PRECI!c_O_COMPLEX mmmmmm0h= nposM TEGER, PARAMETER :: MK erKI=p(1.0E0GO#elifm__KI=p ==:__DOUBLE_PRECI!c_O |m__KI=p ==:__DOUBLE_PRECI!c_O_COMPLEX mmmmmm0h= nposM TEGER, PARAMETER :: MK erKI=p(1.0D0)O#enaifOmmmmmmmmmmmmmmREAL(MK), e TENT(IN)e:: xmmmmmmmnposssssREAL(MK), DIMEN!c_OC:), e TENT(IN)e:: kdicmmmmmmmnposssssREAL(MK)e:: kernelmmmmmmmmmmm h1FUN') oiekernel mmmmmm h1 TERFACEm#elifm__KI=p ==:__SINGLE_PRECI!c_O_COMPLEX |m__KI=p ==:__DOUBLE_PRECI!c_O_COMPLEX mmmmmmCOMPLEX(MK), DIMEN!c_OC:), e TENT(IN#mP)e:: kdicmmmmmmm TERFACEmmmmmmm-1 FUN') oiekernel(x,kdiciiiinpos0h= nposMMPLICIT NONEm#ifmmm__KI=p ==:__SINGLE_PRECI!c_O |m__KI=p ==:__SINGLE_PRECI!c_O_COMPLEX mmmmmm0h= nposM TEGER, PARAMETER :: MK erKI=p(1.0E0GO#elifm__KI=p ==:__DOUBLE_PRECI!c_O |m__KI=p ==:__DOUBLE_PRECI!c_O_COMPLEX mmmmmm0h= nposM TEGER, PARAMETER :: MK erKI=p(1.0D0)O#enaifOmmmmmmmmmmmmmmREAL(MK), e TENT(IN)e:: xmmmmmmmnposssssCOMPLEX(MK), DIMEN!c_OC:), e TENT(IN)e:: kdicmmmmmmmnposssssCOMPLEX(MK) :: kernelmmmmmmmmmmm h1FUN') oiekernel mmmmmm h1 TERFACEm#enaifO#enaifOOmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmorgm:lf-d#msmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPs:( sub ('ad_f ri lf-d oru ac',t0 GOTO 999kappa er1 mmmmmOmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmorgCTt sr ri lf-d#bleh #mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmM. k_comaebug lXIT ==poi F!! lf-XnnnM. k.NOT. _com plf-d#mmmd==poiiiii=poiiiiiiiiirrs: er_comerro kerro mmmmmmmnp 9999Es:( Fererro ( Fererr_ Fer o plf,'ad_f ri lf-d oru ac', ppppppppppppppppppppp'Pleasemcri _com plfDEir y!',__L--i__ GOTO 9999ENDDDDD -- E phM =====ppoi=poiiiiiiiiiM. keps jnnnnh mmmm==poiiiii=poiiiiiiiiirrs: er_comerro kerro mmmmmmmnp 9999Es:( Fererro ( Fererr_ ri lf-d,'ad_f ri lf-d oru ac', ppppppppppppppppppppp'eps mustwbwX> 0',__L--i__ GOTO 9999ENDDDDD -- E phM =====ppoi=poiiiiiiiiiM. kSIZE(dh,1) jnnnn_comdim==poiiiii=poiiiiiiiiirrs: er_comerro kerro mmmmmmmnp 9999Es:( Fererro ( Fererr_ ri lf-d,'ad_f ri lf-d oru ac', ppppppppppppppppppppp'dh mustwbwXat leasd,-d#lengmmm_comdim',__L--i__ GOTO 9999ENDDDDD -- E phM =====ppoi=poiiiiiiiiiri i=1,_comdimleh #mmiiiiiiiiM. kdh(i) jnEnnh mmmm==poiiiii=poiiiiiiiiiiiiirrs: er_comerro kerro mmmmmmmnp 9999E999Es:( Fererro ( Fererr_ ri lf-d,'ad_f ri lf-d oru ac', ppppppppppppppppppppppppp'dh mustwbwX>0 peri you ac4/0,',__L--i__ GOTO 9999ENDDDDDDDDD -- E phM =========ppoi=poiiiiiiiii mmmmm#ifmmm__KERNEL ==:__LOOKUP_TABLE mmmmmmiiiiM. kkdic jnnnnh mmmm==poiiiii=poiiiiiiiiirrs: er_comerro kerro mmmmmmmnp 9999Es:( Fererro ( Fererr_ ri lf-d,'ad_f ri lf-d oru ac', ppppppppppppppppppppp'kdic (dxtt! sinv) mustwbwX>=0',__L--i__ GOTO 9999ENDDDDD -- E phM =====ppoi=p#enaifOmmmmmm hi lmmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu IntegratPM! boun smmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmM. ks f= dX.GEnnh mmmm==poiiiii=poiiiiihi ==pc f= dmmmmmmmpoiioiiiiithrowhi ==p5h mmmmmmmmmmm hi lmmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu SummatPM! boun smmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmlhx==p T(hi/dh(1))leh #mmlhy==p T(hi/dh(2))leh #mmM. k_comaim lXIT 2==lhz==p T(hi/dh(3))lmmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu Do creteAsummmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPsumm =eh mmmmmmmmmmmM. k_comaim lXIT 2==poiiiii=poiiiiiri i=-lhx,lhxmmmmmmmnposssssdx==pREAL(i,mm=*dh(1)mmmmmmmnposssssri l=-lhy,lhyiiinpos0h= nposssssdy==pREAL(j,mm=*dh(2GOTO 9999ENDDDDDDDDDri k=-lhz,lhzOTO 9999ENDDDDDDDDDssssdz==pREAL(k,mm=*dh(3)iiinpos0000000000000000 oj ==pdx*dx + dy*dy + dz*dz #i*n=had "_com ri lf-dkernels.i*n"iiinpos0000000000000000! seeond ordem molf-diiinpos0000000000000000eta er oj*eueorg/& :111111111111111summ =esumm + eueorg/& :11111111111 mmmmmmmmmmmn0000000 mmmmmmmmmmmn000 mmmmmmmmmmmn000summ =esumm*dh(1)*dh(2G*dh(3)iiinpospoiioiiiiithrowri i=-lhx,lhxmmmmmmmnposssssdx==pREAL(i,mm=*dh(1)mmmmmmmnposssssri l=-lhy,lhyiiinpos0h= nposssssdy==pREAL(j,mm=*dh(2GOTO 9999ENDDDDDDDDD oj ==pdx*dx + dy*dy #i*n=had "_com ri lf-dkernels.i*n"iiinpos000000000000! seeond ordem molf-diiinpos000000000000eta er oj*eueorg/& :11111111111summ =esumm + eueorg/& :1111111 mmmmmmmmmmmn000 mmmmmmmmmmmn000summ =esumm*dh(1)*dh(2Gmmmmmmm hi lmmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu Coru ac#mmwfactmmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubl#ifm__KERNEL !=:__LOOKUP_TABLE mmmmmmkappa er(REAL(_comaim,mm=*gt*eps)/summO#enaifOmmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu Debug o: dpdleh #mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmM. k_comaebug lXIT 1==poiiiii=poiiiiiWRITE(cbuf,'(A,F16.10)') 'Do cretmm-d#mmw oru ac#mmwfactmm: ',kappammmmmmmmmmms:( Ferwritlk_comrank,'ad_f ri lf-d oru ac',cbuf, GOTO 999 hi lmmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu Rd#mmmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleE phM =& & ops:( sub op('ad_f ri lf-d oru ac',t0 GOTO 999ze tean#ifmmm__KERNEL ==:__e TERNAL #ifmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmm h1lsy--ilad_f ri lf-d oru ac_siO#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmm h1lsy--ilad_f ri lf-d oru ac_diO#elifm__KI=p ==:__SINGLE_PRECI!c_O_COMPLEX mmmmmm h1lsy--ilad_f ri lf-d oru ac_sciO#elifm__KI=p ==:__DOUBLE_PRECI!c_O_COMPLEX mmmmmm h1lsy--ilad_f ri lf-d oru ac_dciO#enaifOm#elifm__KERNEL ==:__Make_FUN') oi #ifmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmm h1lsy--ilad_f ri lf-d oru ac_suO#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmm h1lsy--ilad_f ri lf-d oru ac_duO#elifm__KI=p ==:__SINGLE_PRECI!c_O_COMPLEX mmmmmm h1lsy--ilad_f ri lf-d oru ac_scuO#elifm__KI=p ==:__DOUBLE_PRECI!c_O_COMPLEX mmmmmm h1lsy--ilad_f ri lf-d oru ac_dcuO#enaifOm#elifm__KERNEL ==:__LOOKUP_TABLE #ifmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmm h1lsy--ilad_f ri lf-d oru ac_stO#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmm h1lsy--ilad_f ri lf-d oru ac_dtO#elifm__KI=p ==:__SINGLE_PRECI!c_O_COMPLEX mmmmmm h1lsy--ilad_f ri lf-d oru ac_sctO#elifm__KI=p ==:__DOUBLE_PRECI!c_O_COMPLEX mmmmmm h1lsy--ilad_f ri lf-d oru ac_dctm#enaifO#enaifOtemplo V_compead kmg_prolostpp72ng.f63146521221067410000644000175000017500000007064411616214647020172 0u-ong omaromarmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu Mead Es rEs rE templo_compead kmg_prolostmmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPuleh #mPu m: Templo V fE multigrid pead leh #mPu leh #mPuleh #mPu m: I s,F!!iclX:mmmmmmm marksmmmmm:18:5scFnAXXX: leh #mPuleh #mPu m:2004/0,F!!ii:mmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu $Log $marksmmmmmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPuleh #mPu Copyrh dt (c)07:10 CSE Lab (ETH Zuacth)..MOSAIC GG ,p (ETH Zuacth)..mmmmmmmmmmmmmmmmmmmmcaseswfrCen ' eoisFluid Dynamics (DTUbleh #mO orgmmmmmmmmmmmmmTafill indF!!dicl= n r /ollel r /ct! ssMmeshL-=p! m (PPM)bleh #mmmmmmmmmmmmri lfill). Msoftwamm:ipromovwwredo ribp/wditf-d#mmmaheaifmmmmmmmmmmitfun lf- n ' mlf-d#mmm GNU Lddolf-Gf-ddi lPcchL-cenrrammmmmmmmma!!dcbh esy#mmm F). MSoftwamm Foun -d#mmm emmmlf-mmmmmmmmmos &PM!!3f-d#mmm L-cenrrINE__(at F!!d#movwwv)f-dI,latlf-mmmmmmmmmos &PM!bleh #mmmmmmmmmmmmri lfildo ribp/wde ae haXe aat itfmmrksbwX fulmmmmmmmmmmbp/ WITHOUT ANY WARRANTY;mmmmm ,j gvf-1 ai F!wdewmc ntymmmmmmmmmmmmMERCHANTABILITYNE__FITNESS Ih A PARTICULAR PURPOlf-dS. MakemmmmmmmmmGNU Gf-ddi lPcchL-cenrrafmmaherss_ftoubsbleh #mmmmmmmmmmmmYromsm ,sm e wesreceic eaile I,-d#mmm GNU Gf-ddi lPcchL-cenrrmmmmmmmmma (m GNU Lddolf-Gf-ddi lPcchL-cenrraalostemmmmmri .eI notmmmmmmmmmma) bleh #mmmmmmmmmmmmr /ollel r /ct! ssMmeshL-=p! m (PPM)mmmmmmmmmETH Zuacthleh #mPu CH-8092 Zuacth, Smmmze mmmmBL-10:1mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doublB #reci18:__SINGLE_PRECI!c_O 1 #reci18:__DOUBLE_PRECI!c_O 2 #reci18:__e TEGER 3 #reci18:__LOGICAL 4 #reci18:__2Dmmmmmmmmmmmmmmm7 #reci18:__3Dmmmmmmmcaseswfr8 #reci18:__SFIELDmmmmmmmcase9 #reci18:__VFIELDmmmmmmmcas10NmMODULEo_compead kmg_prolost lehmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubbleh Mead ammmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubb-ub mmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubb-ub mPu e ,0,s fTHE SOURCESBL-mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubb-ub mM =&AINS #reci18:__DIM:__SFIELD #reci18:__MESH_DIM:__2D #reci18:__KI=p __SINGLE_PRECI!c_O #i*n=had "_compg_prolost" #un lf:__KI=p #reci18:__KI=p __DOUBLE_PRECI!c_O #i*n=had "_compg_prolost" #un lf:__KI=p #un lf:__MESH_DIM #reci18:__MESH_DIM:__3D #reci18:__KI=p __SINGLE_PRECI!c_O #i*n=had "_compg_prolost" #un lf:__KI=p #reci18:__KI=p __DOUBLE_PRECI!c_O #i*n=had "_compg_prolost" #un lf:__KI=p #un lf:__MESH_DIM #un lf:__DIM #reci18:__DIM:__VFIELD #reci18:__MESH_DIM:__2D #reci18:__KI=p __SINGLE_PRECI!c_O #i*n=had "_compg_prolost" #un lf:__KI=p #reci18:__KI=p __DOUBLE_PRECI!c_O #i*n=had "_compg_prolost" #un lf:__KI=p #un lf:__MESH_DIM #reci18:__MESH_DIM:__3D #reci18:__KI=p __SINGLE_PRECI!c_O #i*n=had "_compg_prolost" #un lf:__KI=p #reci18:__KI=p __DOUBLE_PRECI!c_O #i*n=had "_compg_prolost" #un lf:__KI=p #un lf:__MESH_DIM #un lf:__DIM h1MODULEo_compead kmg_prolostm templo V_comfdsolveb_fft_bd_2dpp72ng.f322356521221070210000644000175000017500000007064411616214647020172 0u-ong omaromarL-10:1mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu Sop ri rE temploooo_comfdsolveb_fft_bd_2dmmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPuleh #mPu m: Templo V fmoTdoub ri perfmmmlfFasd,Fourilf-T nsfmmm backwmcdleh #mPu i lf-d n _u aompp/wdlp mms p _comfdsolveb_i lfmmmmmmm leh #mPu In 3Dploooooo: duefin(:,:) (F)07d, due mc ydodebwXt nsfmmmwdlmmmmmmm leh #mPu In 3D/o: dpdo: lda(:) 2diusmmm -d# due mc ymmmmmmm leh #mPu m: dpd(:,:) ( duefout(:,:) (F)0t nsfmmmwdl dueorg/& u I)crrch sssss2dius. =0 if nome. =0AifMno erro bleh #mmmmmmmmmmmmmm:18:5scFnAXX:leh #mmmmmmmmmmmmmm:2004/0,F!!i:mmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu $Log: _comfdsolveb_fft_bd_2d,v $marksmmmmmm:2004/007/07/13 07:57/57/13s10:18:54-=p! CBL-10:1mmmCBLmos &PM!! n rPM l-=p! mleh #mInorg/& orgm:2004/007/4 07:56/09/04 18:34:42-=pchatel -d#mmmmmmmFixFnAt stOleanupsdode_stepitblehp indmmmmmmmmmmmmmrelease-1-0leh #mInorg/& orgm:2004/007/3 07:55:22/18 08:01:28owhiebnreleh #mIn mcnor changes p erro mmes gesleh #mInorg/& orgm:2004/007/2 07:55:22/16 22:22:58-=p! CBL-10:1mmmBugfix:mreplacedrnon-existlf-d _popead k duemfdsolvebemmmmBL-10:1mmm _popead k duemfieldsolvebbleh #mmmmmmmmmmmmmm:2004/007/1 07:55:22/16 11:54:02owhiebnreleh #mIn inlf-d# ai Fou ratPM!marksmmmmmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu Copyrh dt (c)07:10 CSE Lab (ETH Zuacth)..MOSAIC GG ,p (ETH Zuacth)..mmmmmmmmmmmmmmmmmmmmcaseswfrCen ' eoisFluid Dynamics (DTUbleh #mO orgmmmmmmmmmmmmmTafill indF!!dicl= n r /ollel r /ct! ssMmeshL-=p! m (PPM)bleh #mmmmmmmmmmmmri lfill). Msoftwamm:ipromovwwredo ribp/wditf-d#mmmaheaifmmmmmmmmmmitfun lf- n ' mlf-d#mmm GNU Lddolf-Gf-ddi lPcchL-cenrrammmmmmmmma!!dcbh esy#mmm F). MSoftwamm Foun -d#mmm emmmlf-mmmmmmmmmos &PM!!3f-d#mmm L-cenrrINE__(at F!!d#movwwv)f-dI,latlf-mmmmmmmmmos &PM!bleh #mmmmmmmmmmmmri lfildo ribp/wde ae haXe aat itfmmrksbwX fulmmmmmmmmmmbp/ WITHOUT ANY WARRANTY;mmmmm ,j gvf-1 ai F!wdewmc ntymmmmmmmmmmmmMERCHANTABILITYNE__FITNESS Ih A PARTICULAR PURPOlf-dS. MakemmmmmmmmmGNU Gf-ddi lPcchL-cenrrafmmaherss_ftoubsbleh #mmmmmmmmmmmmYromsm ,sm e wesreceic eaile I,-d#mmm GNU Gf-ddi lPcchL-cenrrmmmmmmmmma (m GNU Lddolf-Gf-ddi lPcchL-cenrraalostemmmmmri .eI notmmmmmmmmmma) bleh #mmmmmmmmmmmmr /ollel r /ct! ssMmeshL-=p! m (PPM)mmmmmmmmmETH Zuacthleh mPu CH-8092 Zuacth, Smmmze mmmmBL-10:1mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubl#ifmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmmlsy--ilad_ffdsolveb_fft_bd_2ds( duefin,lda, duefout GO#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmmlsy--ilad_ffdsolveb_fft_bd_2dd( duefin,lda, duefout GO#elifm__KI=p ==:__SINGLE_PRECI!c_O_COMPLEX mmmmmmlsy--ilad_ffdsolveb_fft_bd_2dc( duefin,lda, duefout GO#elifm__KI=p ==:__DOUBLE_PRECI!c_O_COMPLEX mmmmmmlsy--ilad_ffdsolveb_fft_bd_2dcc( duefin,lda, duefout GO#enaifOmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmorgm:n=hadammmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh dodo #i*n=had "_comaet! s"mmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh dodo eh #mmorgM-ad ammmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmUDEn _popead k dueorg/& UDEn _popead k duemfieldsolveborg/& UDEn _popead ksub org/& UDEn _popead ksub oporg/& UDEn _popead kerro mmmmmmmUDEn _popead kri lfmmmmmmmMMPLICIT NONEm#ifmmm__KI=p ==:__SINGLE_PRECI!c_O |m__KI=p ==__SINGLE_PRECI!c_O_COMPLEX mmmmmmmM TEGER, PARAMETER :: MK er_comkind_ lf-leO#elifm__KI=p ==:__DOUBLE_PRECI!c_O |m__KI=p ==__DOUBLE_PRECI!c_O_COMPLEX mmmmmmmM TEGER, PARAMETER :: MK er_comkind_doceO#enaifOmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmorgFFTW i*n=hadBL-10:1mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubl#if lf:m__FFTWmmmmmmmM ,0,s f"fftw3" #enaifOmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmorgAri lf-d#h #mmOmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmor ,saas dueorg/& COMPLEX(MK), DIMEN!c_OC:,:) , e TENT(IN#mP)e:: dduefinmmmmmmmmmammm -d#mc ymmmmmmme TEGER, DIMEN!c_OC:) , e TENT(IN)e:: ldammmmmmm! o: dpd ddue,iinveretsfasd,fourilf-t nsfmmmwdm#ifmmm__KI=p ==:__SINGLE_PRECI!c_O |m__KI=p ==:__DOUBLE_PRECI!c_O mmmmmmREAL(MK), DIMEN!c_OC:,:) , POe TER : ( duefoutO#elifm__KI=p ==:__SINGLE_PRECI!c_O_COMPLEX|m__KI=p ==:__DOUBLE_PRECI!c_O_COMPLEX mmmmmmCOMPLEX(MK), DIMEN!c_OC:,:) , POe TER : ( duefoutO#enaifOmmmmmme TEGER , e TENT( )e:: RETUmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmormL#mmmcvarat! ssmOmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmortimeborg/& REAL(MK) :: 0leh #mmorcountnreleh #mIe TEGER :: R,j,Rmovmmmmmmmmmammm -d#ri ldduefin leh #mIe TEGER :: Nxfin, Nyfinmmmmmmmmmammm -d#ri ldduef ,j leh #mIe TEGER :: Nxfout NyfoutO#if lf:__FFTWmmmmmmm!gFFTW P mmleh #mIe TEGER*8 :: P mml#enaifO#if lf:__MATHKEISANmmmmmmm!gMATHKEISANcvarat! ssmfmmaMathKeisvwwFFTeleh #mIe TEGER :: Rsign_fft,isysm#ifmmm__KI=p ==:__SINGLE_PRECI!c_O |m__KI=p ==:__DOUBLE_PRECI!c_O m#elifm__KI=p ==:__SINGLE_PRECI!c_O_COMPLEX |m__KI=p ==:__DOUBLE_PRECI!c_O_COMPLEX mmmmmm! vebao ri smfmmacfft ( lfault=1)mmmmmmme TEGER :: Rncx,iincy #enaifOmmmmmmm scale_ffts n t nsfmmmatPM!marksmmREAL(MK) :: scale_fftOmmmmmmm worklf-d orageOmmmmmmREAL(MK), DIMEN!c_OC:),POe TER :: tt! s, workleh #mmort&e smmm -d#ri lworklf-d orageOmmmmmme TEGER, DIMEN!c_OC1) :: lda_tt! s, lda_workl#enaifOmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmorgExhM nalamOmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doublOmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmorgm:lf-d#msmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPs:( sub ('ad_ffdsolveb_fft_bd_2d',t0 GO#ifmm!(aet! sd(__FFTW) |maet! sd(__MATHKEISAN))leh #mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmorgErro ifml-=p! m supportlfilnot availaeOmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmrrs: er_comerro kerro m#ifn lf:__FFTWmmmmmmms:( Fererro ( Fererr_nofftw,'ad_ffdsolveb_fft_bd_2d', ppppppppppppp'ri lwasblehp indmmmmm ,j fftw support',__L--i__ GO#enaifOm#ifn lf:__MATHKEISANmmmmmmms:( Fererro ( Fererr_noMathKeisvw,'ad_ffdsolveb_fft_bd_2d', ppppppppppppp'ri lwasblehp indmmmmm ,j MATHKEISANcsupport',__L--i__ GO#enaifOmmmmmm -- E mmmmmmm#elsmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPorgCTt sr ri lf-d#mmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPM. k_comaebug lXIT ==poi F!! lf-XnnnM. kSIZE(lda,1) jnnnn2==poiiiii=poiiiii #mmrrs: er_comerro kerro mii=poiiiii #mms:( Fererro ( Fererr_ ri lf-d,'ad_ffdsolveb_fft_bd_2d', ppppppppppppppppppppp'lda mustwbwXat leasd,-d#smmm 2',__L--i__ GOTO 9999ENDDDDD -- E phM =====ppoi=poiiiiiiiiiM. klda(1) jnEnnh==poiiiii=poiiiii #mmrrs: er_comerro kerro mii=poiiiii #mms:( Fererro ( Fererr_ ri lf-d,'ad_ffdsolveb_fft_bd_2d', ppppppppppppppppppppp'mmes#smmm: lda(1) mustwbwX>0',__L--i__ GOTO 9999ENDDDDD -- E phM =====ppoi=poiiiiiiiiiM. klda(2) jnEnnh==poiiiii=poiiiii #mmrrs: er_comerro kerro mii=poiiiii #mms:( Fererro ( Fererr_ ri lf-d,'ad_ffdsolveb_fft_bd_2d', ppppppppppppppppppppp'mmes#smmm: lda(2) mustwbwX>0',__L--i__ GOTO 9999ENDDDDD -- E phM =====ppoi=poiiiiippoi=poiiiiiNxfin=lda(1)poiiiiiNyfin=lda(2)leh #mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmorgAi lfatesresult mc ymmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubl#ifmmm__KI=p ==:__SINGLE_PRECI!c_O |m__KI=p ==:__DOUBLE_PRECI!c_O oiiiiiNxf ,j = (Nxfin-1)*2m#elifm__KI=p ==:__SINGLE_PRECI!c_O_COMPLEX |m__KI=p ==:__DOUBLE_PRECI!c_O_COMPLEX mmmmmmNxf ,j = Nxfin -1O#enaifOmmmmmmNyfout=Nyfinmmmmmmmlda(1)=Nxf ,j+1mmmmmmmlda(2)=NyfoutOii #mms:( Ferri lf( duefout lda,_comvebaomri lf_fit GOTO 999M. krrs: .NEnnh==poiiiii=poiiiiirrs: er_comerro kfduelmmmmmmmmmmms:( Fererro ( Fererr_ i lf,'ad_ffdsolveb_fft_bd_2d', p ppppppppppppppppp'fftsresult DATA_',__L--i__ GOTO 9999END -- E phM =ppoi=poiiiiimlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmorgFFT --T nsfmmm in x-you ac4/0poiiiiimlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmolong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmommNECmos &PM!!- UseaMathKeisvwwL-=p! m 1.5mmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubl#if lf:__MATHKEISANmmmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmorgAi lfatesworklf-d orageOmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubl#ifmmm__KI=p ==:__SINGLE_PRECI!c_O |m__KI=p ==:__DOUBLE_PRECI!c_O oiiiiilda_work(1) = 4*Nxf ,jm#elifm__KI=p ==:__SINGLE_PRECI!c_O_COMPLEX |m__KI=p==:__DOUBLE_PRECI!c_O_COMPLEX mmmmmmlda_work(1) = 6*Nxf ,jm#enaifOmmmmmms:( Ferri lf(work,lda_work,_comvebaomri lf_fit GOTO 999M. krrs: .NEnnh==poiiiii=poiiiiirrs: er_comerro kfduelmmmmmmmmmmms:( Fererro ( Fererr_ i lf,'ad_ffdsolveb_fft_bd_2d', p ppppppppppppppppp'worklnot ai lfated',__L--i__ GOTO 9999END -- E phM =ppoi=poiiiiimlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmorgForwmcdgFFT poiiiiimlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmscale_ffts= 1mmmmmmmRsign_ffts= 1mmmmmmmri l=1,Nyfinm#ifmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmmmmmms:( csfft(Rsign_fft, Nxfout scale_fft, duefin(1,j),pppppppppppppppppppppppppppppppppppppppppp duefout(1,j),ptt! s_bd_s, work, isysGO#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmmmmmms:( zdfft(Rsign_fft, Nxfout scale_fft, duefin(1,j),pppppppppppppppppppppppppppppppppppppppppp duefout(1,j),ptt! s_bd_d, work, isysGO#elifm__KI=p ==:__SINGLE_PRECI!c_O_COMPLEX mmmmmm0h= s:( cfft(Rsign_fft, Nxfout scale_fft, duefin(1,j),pRncx,iiiiiiiipppppppppppppppppppppp duefout(1,j),pincy,ptt! s_fd_c_y, lda_tt! s_y, work, pppppppppppppppppppppplda_work(1), isysGO#elifm__KI=p ==:__DOUBLE_PRECI!c_O_COMPLEX mmmmmm0h= s:( zfft(Rsign_fft, Nxfout scale_fft, duefin(1,j),pRncx,iiiiiiiipppppppppppppppppppppp duefout(1,j),pincy,ptt! s_fd_c_y, lda_tt! s_y, work, pppppppppppppppppppppplda_work(1), isysGO#enaifOmmmmmm hmmmmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu Deai lfate Memorymmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doublmm0h= s:( Ferri lf(work,lda_work,_comvebaomdeai lf GOTO 999M. krrs: .NEnnh==poiiiii=poiiiiiWRITE(mmeg,'(A)') 'c ,sm not deai lfate memory'iii=poiiiiirrs: er_comerro kerro mii=poiiiiis:( Fererro ( Fererr_deai lf 'ad_ffdsolveb_bd_2d',mmeg,__L--i__ ppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppp GOTO 9999END -- E phM =ppoi=p#elsmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPorgFFTW os &PM!!fmmaL--UX,..bleh #mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubl#ifmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmms:( sfftw_execute_dft_c2r(P mm_bd_s, duefin(1,1), duefout(1,1) GO#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmms:( dfftw_execute_dft_c2r(P mm_bd_d, duefin(1,1), duefout(1,1) GO#elifm__KI=p ==:__SINGLE_PRECI!c_O_COMPLEX mmmmmms:( sfftw_execute_dft(P mm_bd_c_y, duefin(1,1), duefout(1,1) GO#elifm__KI=p ==:__DOUBLE_PRECI!c_O_COMPLEX mmmmmms:( dfftw_execute_dft(P mm_bd_cc_y, duefin(1,1), duefout(1,1) GO#enaifO#enaifO#enaifOmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmorgCopy marg deconfmmm mmmmmri econvenc4/0poiiiiimlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmri l=1,NyfoutOii #mmmmmmmm duefout(lda(1),j) er duefout(1,j)Ommmmmm hmmmmmmmOmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmorgRd#mmmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleE phM =& & ops:( sub op('ad_ffdsolveb_fft_bd_2d',t0 GO & opze tean #ifmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmm h1lsy--ilad_ffdsolveb_fft_bd_2dsO#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmm h1lsy--ilad_ffdsolveb_fft_bd_2ddO#elifm__KI=p ==:__SINGLE_PRECI!c_O_COMPLEX mmmmmm h1lsy--ilad_ffdsolveb_fft_bd_2dcO#elifm__KI=p ==:__DOUBLE_PRECI!c_O_COMPLEX mmmmmm h1lsy--ilad_ffdsolveb_fft_bd_2dccO#enaifOtemplo V_compead kbempp72ng.f33106521221726510000644000175000017500000007064411616214647020172 0u-ong omaromarmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmorgMead Es rEs temploooomm _popead kbemOmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmoleh #mmorgm: Templo V fmoTdoubpead econtainab ae user-cri t! s sop rieleh #mIn -d#ri lboun ! m eFou r solvebbleh #mmm leh #mmorgRd I s,F!!icl:leh #mmmmmmmmmmmmmm:18:5scFnAXX:leh #mmmmmmmmmmmmmm:2004/0,F!!i:mmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu $Log: _compead kbem,v $marksmmmmmm:2004/007/07/13 07:57/57/13s10:18:56-=p! CBL-10:1mmmCBLmos &PM!! n rPM l-=p! mleh #mInorg/& orgm:2004/007/4 07:54/57/27 09:19:13 0oingoorg/& orgAdd e_compead kbem_quadrd knublehsX lfcwditfhasdodebwXuser cri t! sleh #mInorg/& orgm:2004/007/3 07:54/57/26 13:40:28owp! CBL-10:1mmmInlf-d# ai Fou ratPM!/c#merraare meta-pead s=asub &e user-BL-10:1mmmcri t! s funac#mms. Onlyetmerrapeall insfmmrksbwXgivf-1aw ymmmmmmm dode &e userbleh #mmmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu Pe/ollel r /ct! ssMmeshL-=p! m (PPM)mmmmmmmmmmInstitp/wd Compp/atPM!d# Sci5scFmmmmmmmmmmETH Z rrum, Hirschengrabf-184BL-10:1mmmCH-8092 Zuacth, Smmmze mmmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doublmmmmmmmMODULEo_compead kbemOOii #mmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh dOii #mmmmmm rPM m-ad ammmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh dOii #mmmmmUDEn _popead kbem_basisOii #mmmmmUDEn _popead kbem_quadrd Oii #mmmmmUDEn _popead kbem_quadrd knublehsOOii #mm h1MODULEo_compead kbemOtemplo V_comode_steppp72ng.f7407765212217p10000644000175000017500000007064411616214647020172 0u-ong omaromarmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu Sop ri rE temploooomm _poode_stepOmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmoleh #mmorgm: Templo V fmointegratnsfontsgm -d#m m-asleh #mInorg/& orgIn 3Dploooooo: -asid temploooomms2diuid -d#m-asdodeadvascFmmmmmmmmmmmmmmmmmmmmmmmmmxpC:,:) ooomms2F)mxp (trad.ecoords)mmmmmmmmmmmmmmmmmmmmmmmmmupC:,:) ooomms2F)mfunac#mmwodeintegratnmmmmmmmmmmmmmmmmmmmmmmmmmdupC:,:) ooomm2F)mdvatPvm -d#,p ( ime)mmmmmmmmmmmmmmmmmmmmmmmmmlda 2diuleadlf-ddimen&PM!! upmmmmmmmmmmmmmmmmmmmmmmmmmNdicl= 2diuper p /ct! seleh #mIn bfrC:,:) ooomm2F)mbufferleh #mIn igm 2diuwhich gm w8:5 inmmmmmmmmmmmmmmmmmmmmmmmmm ime(4) ooomms2F)m imer due:m ime(1)lfilakemmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm m ime,m ime(2)e &e endleh #mPu ime,m ime(3)e &e currf-diiinposu imema imem(4) akemmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm imemstepOmmmmmmmmmmmmmmmmmmmmmmmmrhsfunammmmmmmmmmmmmmmm2diufunac#mmwublehi =ode &e rhsleh #mIn ipack dueC:,:) 2diumovwwvd# orage mc ymmmmmmm lpack dueC:,:) 2Liumovwwvd# orage mc ymmmmmmm rpack dueC:,:) 2Fiumovwwvd# orage mc ymmmmmmm mmmmmmm m: dpd(:,:) (I)crrch sssss 2dius. =0 if nomeleh #mInorg/& orgm: I s,F!!icl:lmmmmmmm leh #mPu m:18:5scFnAXX:lmmmmmmm leh #mPu m:2004/0,F!!i:mmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu $Log: _comode_step,v $marksmmmmmm:2004/007/07/13 07:57/57/13s10:19:01-=p! CBL-10:1mmmCBLmos &PM!! n rPM l-=p! mleh #mInorg/& orgm:2004/007/20 07:56/09/04 18:34:54-=pchatel -d#mmmmmmmFixFnAt stOleanupsdode_stepitblehp indmmmmmmmmmmmmmrelease-1-0leh #mInorg/& orgm:2004/007/19 07:56/02/03 09:37:06-=p! CBL-10:1mmmChangedr ,saas ri lf-d# from INdodePOe TER odeallow=asubghost_saableh #mmmmmmmmmmmmmm:2004/007/18 07:55:28/05 09:30:06-=p! CBL-10:1mmmAdd e n f t!bergstlf-dSTS! Michaelbleh #mmmmmmmmmmmmmm:2004/007/17 07:55:27/22 08:03:43-=pchatel -d#mmmmmmmUs eaiDO loop rathlf- a-1amosctmm not-d#mmwasub &e 1stmstepr ,siasdRK4bleh #mmm 2mreas/0,:leh #mmm 1)lDO loopsaare us eeos ywh8:5 elsme ae l in..bleh #mmm n2==Ias pp /f-dly caus saa seg faultwasuba system mmmmmm-asrate memory (litepmy perswvd# laptopbleh #mO orgmmmmmmm:2004/007/16 07:55:21/05 16:27:18owp! CBL-10:1mmmfixFd e TENTAt stPOe TER at ribp/wlf-d#mmm ri lf-d#bleh #mmm orgmmmmmmm:2004/007/15 07:54/10/11 06:53:14owhiebnreleh #mIn cosmect!sleh #mInorg/& orgm:2004/007/14 07:54/10/01-15:15:11owhiebnreleh #mIn add eRunge Kutta 4mmmordemleh #mInorg/& orgm:2004/007/13 07:54/58/26 15:21:00 mcchaebemmmmmmmmmm ,ser/wde1:ndicl=odebwXt! s ode a-d s ghosts. ghosts?leh #mInorg/& orgm:2004/007/12 07:54/58/13s15:30:45 mcchaebemmmmmmmmmmadd emid ubleh runge kuttaleh #mInorg/& orgm:2004/007/11 07:54/58/12 13:45:23 mcchaebemmmmmmmmmmheaifi e_comode_sf-d() er.bleh #mmm orgmmmmmmm:2004/007/10 07:54/57/27 10:29:20 mcchaebemmmmmmmmmm/f-am e n schememvebao ri smfrom _comode_scheme.. odmmmmmmmmmm_comvebaomode_scheme..leh #mmm orgmmmmmmm:2004/007/9 07:54/57/26 14:57:18owmcchaebemmmmmmmmmm/f-am e n osctmm t stscalaet! ssleh #mInorg/& orgm:2004/007/8 07:54/57/26 13:49:19owp! CBL-10:1mmmm: oc eR rie seec#mmsmfrom ae header comlf-d.leh #mmm orgmmmmmmm:2004/007/7 07:54/57/26 11:49:01-=mcchaebemmmmmmmmmmadd eoc rload ee stsop rileh #mmm orgmmmmmmm:2004/007/6 07:54/57/26 11:33:04 mcchaebemmmmmmmmmm ,ser/wde &e usef-d#mmm _co -as# due pead .leh #mmm orgmmmmmmm:2004/007/5 07:54/57/26 08:13:51-=mcchaebemmmmmmmmmmAdd escalc-as#asublda=1.leh #mmm orgmmmmmmm:2004/007/4 07:54/57/26 07:59:51-=mcchaebemmmmmmmmmmCosmect!s. L rie p /ctallydodo lostleh #mInorg/& orgm:2004/007/3 07:54/57/26 07:54:57-=mcchaebemmmmmmmmmmAtommmmd. Furthlfherssadd ecmc ilf-mc ysdodet nsportlauxill! m dueorg/& u ode &e user-givf-1rh dt ht stsiasdfunac#mmleh #mInorg/& orgm:2004/007/2 07:54/56/10 16:20:04 p! CBL-10:1mmmMoc eri xpp you actPvms decolum007/c#memNECmxpp yom not u aognmmmorg/& u ohem othlfwise!! orgmmmmmmmmmmmmmmm:2004/007/1 07:54:22/19 08:33:57-=mcchaebemmmmmmmmmminlf-d# ai Fou ratPM!bleh #mmmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu Copyrh dt (c)07:10 CSE Lab (ETH Zuacth)..MOSAIC GG ,p (ETH Zuacth)..mmmmmmmmmmmmmmmmmmmmcaseswfrCen ' eoisFluid Dynamics (DTUbleh #mO orgmmmmmmmmmmmmmTafill indF!!dicl= n r /ollel r /ct! ssMmeshL-=p! m (PPM)bleh #mmmmmmmmmmmmri lfill). Msoftwamm:ipromovwwredo ribp/wditf-d#mmmaheaifmmmmmmmmmmitfun lf- n ' mlf-d#mmm GNU Lddolf-Gf-ddi lPcchL-cenrrammmmmmmmma!!dcbh esy#mmm F). MSoftwamm Foun -d#mmm emmmlf-mmmmmmmmmos &PM!!3f-d#mmm L-cenrrINE__(at F!!d#movwwv)f-dI,latlf-mmmmmmmmmos &PM!bleh #mmmmmmmmmmmmri lfildo ribp/wde ae haXe aat itfmmrksbwX fulmmmmmmmmmmbp/ WITHOUT ANY WARRANTY;mmmmm ,j gvf-1 ai F!wdewmc ntymmmmmmmmmmmmMERCHANTABILITYNE__FITNESS Ih A PARTICULAR PURPOlf-dS. MakemmmmmmmmmGNU Gf-ddi lPcchL-cenrrafmmaherss_ftoubsbleh #mmmmmmmmmmmmYromsm ,sm e wesreceic eaile I,-d#mmm GNU Gf-ddi lPcchL-cenrrmmmmmmmmma (m GNU Lddolf-Gf-ddi lPcchL-cenrraalostemmmmmri .eI notmmmmmmmmmma) bleh #mmmmmmmmmmmmr /ollel r /ct! ssMmeshL-=p! m (PPM)mmmmmmmmmETH Zuacthleh #mPu CH-8092 Zuacth, Smmmze mmmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doublm#ifmmm__MODE ==:__SCAl#ifmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmmlsy--ilad_fode_step_ss(-asid,xp,up,dup,lda,Ndicl,bfr,igm, ime,ppppppp &mrhsfuna, ipack due, rpack due, lpack due, GO#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmmlsy--ilad_fode_step_ds(-asid,xp,up,dup,lda,Ndicl,bfr,igm, ime,ppppppp &mrhsfuna, ipack due, rpack due, lpack due, GO#enaifO#elifm__MODE ==:__VECl#ifmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmmlsy--ilad_fode_step_sv(-asid,xp,up,dup,lda,Ndicl,bfr,igm, ime,ppppppp &mrhsfuna, ipack due, rpack due, lpack due, GO#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmmlsy--ilad_fode_step_dv(-asid,xp,up,dup,lda,Ndicl,bfr,igm, ime,ppppppp &mrhsfuna, ipack due, rpack due, lpack due, GO#enaifO#enaifOmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doOmmmmmmmmmrgm:n=hadammmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doO#i*n=had "_comaet! s"mmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doOmmmmmmmmmrgM-ad ammmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doOmmmmmmmmUDEn _popead k duem-asleh #mImmUDEn _popead k dueorg/& mmUDEn _popead kcTt s_idorg/& mmUDEn _popead ksub org/& UDEn _popead ksub oporg/& UDEn _popead kerro mmmmmmmmmUDEn _popead kri lfmmmmmmmmmUDEn _popead kk dueorg/& mmMMPLICIT NONEm#ifmmmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmmmmM TEGER, PARAMETER :: mk er_comkind_ lf-leO#else mmmmmmmmM TEGER, PARAMETER :: mk er_comkind_doceO#enaifO#if lf:__F7:53m#ifmmmmm__KI=p ==:__SINGLE_PRECI!c_O #ifmmmmm__MODE ==:__SCAlmmmmmmmmPROCEDURE(rhsfuna_ss) :: rhsfunaO#elifm m__MODE ==:__VEClmmmmmmmmPROCEDURE(rhsfuna_sv) :: rhsfunaO#enaifO#else #ifmmmmm__MODE ==:__SCAlmmmmmmmmPROCEDURE(rhsfuna_ds) :: rhsfunaO#elifm m__MODE ==:__VEClmmmmmmmmPROCEDURE(rhsfuna_dv) :: rhsfunaO#enaifO#enaifO#else #ifmmmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmmmmM TERFACioiiiiithrow FUN') oi rhsfuna( opoid,xp,up,dup,lda,ndicl,ipack,ppppppp &lpack,rpack GOTO 9999ENDDDDe TEGER , e TENT(IN) :: topoidOTO 9999ENDDDDe TEGER , e TENT(IN) :: lda,ndiclOTO 9999ENDDDDe TEGER , e TENT()e:: RETUm#ifmmmmm__MODE ==:__SCAlmmmmmmmmmmmmmREAL(KI=p(1.0E0)), DIMEN!c_OC:,:), POe TER :: xplmmmmmmmmmmmmmREAL(KI=p(1.0E0)), DIMEN!c_OC:), POe TER :: uplmmmmmmmmmmmmmREAL(KI=p(1.0E0)), DIMEN!c_OC:), POe TER :: dupO#elifm m__MODE ==:__VEClmmmmmmmmmmmmmREAL(KI=p(1.0E0)), DIMEN!c_OC:,:), POe TER :: xp,uplmmmmmmmmmmmmmREAL(KI=p(1.0E0)), DIMEN!c_OC:,:), POe TER :: dupO#enaifOmmmmmmmmNDDDDe TEGER, DIMEN!c_OC:,:), e TENT(IN), OP) oiALe:: RpackOmmmmmmmmNDDDDLOGICAL, DIMEN!c_OC:,:), e TENT(IN), OP) oiALe:: lpackOmmmmmmmmNDDDDREAL(kind(1.0E0)), DIMEN!c_OC:,:), e TENT(IN), OP) oiALe:: rpackOmmmmmmmmNDDDDe TEGER :: rhsfunaO h1FUN') oi rhsfuna h1M TERFACio#else mmmmmmmmM TERFACioiiiiithrow FUN') oi rhsfuna( opoid,xp,up,dup,lda,ndicl,ipack,ppppppp &lpack,rpack GOTO 9999ENDDDDe TEGER , e TENT(IN) :: topoidOTO 9999ENDDDDe TEGER , e TENT(IN) :: lda,ndiclOTO 9999ENDDDDe TEGER , e TENT()e:: RETUm#ifmmmmm__MODE ==:__SCAlmmmmmmmmmmmmmREAL(KI=p(1.0D0)), DIMEN!c_OC:,:), POe TER :: xplmmmmmmmmmmmmmREAL(KI=p(1.0D0)), DIMEN!c_OC:), POe TER :: uplmmmmmmmmmmmmmREAL(KI=p(1.0D0)), DIMEN!c_OC:), POe TER :: dupO#elifm m__MODE ==:__VEClmmmmmmmmmmmmmREAL(KI=p(1.0D0)), DIMEN!c_OC:,:), POe TER :: xp,uplmmmmmmmmmmmmmREAL(KI=p(1.0D0)), DIMEN!c_OC:,:), POe TER :: dupO#enaifOmmmmmmmmNDDDDe TEGER, DIMEN!c_OC:,:), e TENT(IN), OP) oiALe:: RpackOmmmmmmmmNDDDDLOGICAL, DIMEN!c_OC:,:), e TENT(IN), OP) oiALe:: lpackOmmmmmmmmNDDDDREAL(kind(1.0D0)), DIMEN!c_OC:,:), e TENT(IN), OP) oiALe:: rpackOmmmmmmmmNDDDDe TEGER :: rhsfunaO h1FUN') oi rhsfuna h1M TERFACio#enaifO#enaifOmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doOmmmmmmmmmrgAri lf-d#mmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doOmmmmmmmme TEGER, e TENT( out)e:: RETUmmmmmmmmme TEGER, e TENT(in mP)e:: -asidm#ifmmmmm__MODE ==:__SCAlmmmmmmmmREAL(mk), DIMEN!c_OC:mP), POe TER :: up,dup O#elifm m__MODE ==:__VEC OmmmmmmmmREAL(mk), DIMEN!c_OC:,:), POe TER :: up,dupO#enaif OmmmmmmmmREAL(mk), DIMEN!c_OC:,:), POe TER :: xplmmmmmmmmREAL(mk), DIMEN!c_OC:,:), POe TER :: bfrmmmmmmmmme TEGER, e TENT(in mP)e:: igmlmmmmmmmmREAL(mk), DIMEN!c_OC4), e TENT(inout)e:: imemmmmmmmmme TEGER, e TENT(in mP)e :: lda,mNdiclmmmmmmmmme TEGER, DIMEN!c_OC:,:), e TENT(IN), OP) oiALe:: Rpack dueorg/& mmREAL(mk), DIMEN!c_OC:,:), e TENT(IN), OP) oiALe:: rpack dueorg/& mmLOGICAL, DIMEN!c_OC:,:), e TENT(IN), OP) oiALe:: lpack dueorg/& mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doOmmmmmmmmmrgL#mmmcVarat! ssorg/& mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doOmmmmmmmmREAL(mk) :: , dlmmmmmmmmme TEGER :: scheme, throwaw y, i, jmmmmmmmmme TEGER :: umidmin, umidmaxmmmmmmmmme TEGER :: mid, ildammmmmmmmmREAL(mk) :: M_PImmmmmmmmme TEGER :: stsnorg/& mmREAL(mk), DIMEN!c_OC20) :: stsnuOmmmmmmmmREAL(mk) :: aummmmmmmmme TEGER :: topoidOTO 9999ELOGICAL :: topo_validOTO 9999Emlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doOmmmmmmmmmrgfmrks (m nu vebao ri smfmma n shsX chemeOTO 9999Emlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doOmmmmmmmmM_PI = ACOS(-1.0_MKGOTO 9999EstsnuC1) = 0.0_mkOTO 9999EstsnuC5) = 0.04_mkOTO 9999EstsnuC7) = 0.0015_mkOTO 9999EstsnuC9) = 0.04_mkOTO 9999EstsnuC20) = 0.006_mkOTO 9999Emlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doOmmmmmmmmmrgcri sub org/& mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doOmmmmmmmms:( sub ('ad_fode_step',t0 GO & op9Emlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doOmmmmmmmmmrgcTt sr ,saas ri lf-d#mmmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doOmmmmmmmmeF(Ndicl.EQ.h==poiiiii=poiiiii mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehiii=poiiiii m bestgcrse: nothlf-d o doiii=poiiiii mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehiii=poiiiii ime(3)e= ime(3)e+m ime(4)iii=poiiiii -- E phM === h1MFOmmmmmmmmeF(_comaebuglXITh==poiiiii=poiiiii eF(.NOT._cominlf-d#mmmd==poiiiii=poiiiii #mmrrs: er_comerro kerro mii=poiiiii #mms:( Fererro ( Fererr_ Fernoinlf,'ad_fode_step',ppppppp p &m'Pleasegcri _cominlfgfmrst!',__L--i__ GOTO 9999ENDDDDD -- E phM ====== h1MFOmmmmmmmmii mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehiii=poiiiii m cTt sr-asidmmmmmmmmmii mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehiii=poiiiii umidmin erLBOU=p(_cominhM nal_mid,1)iii=poiiiii umidmax erUBOU=p(_cominhM nal_mid,1)iii=poiiiii eF(-asidjnnnumidmin.OR.-asidjGnnumidmax==poiiiii=poiiiii #mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubiii=poiiiii #mmmXuser mid doeilnot existiii=poiiiii #mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubiii=poiiiii #mmrrs: er_comerro kerro mii=poiiiii #mms:( Fererro ( Fererr_ ri lf-d,'ad_fode_step', ppppppp p &m'ODEID doeilnot exist',__L--i__ GOTO 9999ENDDDDD -- E phM ====== LSEOTO 9999ENDDDDDeF(_cominhM nal_mid(-asid).EQ.-HUGE(-asid)==poiiiii=poiiiii #mm#mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_diii=poiiiii #mm#mmmXuser mid doeilnot existiii=poiiiii #mm#mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_diii=poiiiii #mm#mmrrs: er_comerro kerro mii=poiiiii #mm#mms:( Fererro ( Fererr_ ri lf-d,'ad_fode_step',& pppppp p p &m'ODEID doeilnot exist',__L--i__ GOTO 9999ENDDDDD DD -- E phM ====== == h1MFOmmmmmmmmii h1MFOmmmmmmmmii mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehiii=poiiiii m cTt srdimen&PM!Ommmmmmmmii mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehiii=poiiiii eF(Ndicl.LITh==poiiiii=poiiiii #mmrrs: er_comerro kerro mii=poiiiii #mms:( Fererro ( Fererr_ ri lf-d,'ad_fode_step', ppppppp p &m'Ndicl=cannot be <0',__L--i__ GOTO 9999ENDDDDD -- E phM ===== h1MFOmmmmmmmmii eF(ldajnEnh==poiiiii=poiiiii #mmrrs: er_comerro kerro mii=poiiiii #mms:( Fererro ( Fererr_ ri lf-d,'ad_fode_step', ppppppp p &m'LDA mustwbwX>00',__L--i__ GOTO 9999ENDDDDD -- E phM ===== h1MFOmmmmmmmmii eF( ime(4)jnEnh.0_mk==poiiiii=poiiiii #mmrrs: er_comerro kerro mii=poiiiii #mms:( Fererro ( Fererr_ ri lf-d,'ad_fode_step', ppppppp p &m'dt mustwbwX>=0',__L--i__ GOTO 9999ENDDDDD -- E phM ===== h1MFOmmmmmmmmii eF( ime(3).LIT ime(1)==poiiiii=poiiiii #mmrrs: er_comerro kerro mii=poiiiii #mms:( Fererro ( Fererr_ ri lf-d,'ad_fode_step', ppppppp p &m' imemmustwbwX>= t ',__L--i__ GOTO 9999ENDDDDD -- E phM ===== h1MFOmmmmmmmmii eF(scheme.EQ._comvebaomode_scheme_sts==poiiiii=poiiiii #mm#meF(.NOT.PRESENT(ipack due)==poiiiii=poiiiii #mm#mm#mmrrs: er_comerro kerro mii=poiiiii #mmii #mms:( Fererro ( Fererr_ ri lf-d,'ad_fode_step', ppppppp p p &m'fmmaSTS!promnewde o specify Ne ipack dueC1,1)',ppppppp p p &m__L--i__ GOTO 9999ENDDDDD DD DD -- E phM ====== == == LSEOTO 9999ENDDDDDDDDDDDeF(ipack dueC1,1).NEn1.AND.ipack dueC1,1).NEn7.AND. p &pppppp p p &mipack dueC1,1).NEn9.AND.ipack dueC1,1).NEn2h==poiiiii=poiiiii #mmmmmmmmmmmrrs: er_comerro kerro mii=poiiiii #mmii #mm mms:( Fererro ( Fererr_ ri lf-d,'ad_fode_step', ppppppp p p p &m'ipack dueC1,1)mmustwbwXeFou r of {1,7,9,20}',ppppppp p p p &m__L--i__ GOTO 9999ENDDDDD DD DD DD -- E phM ====== == == = h1MFOmmmmmmmmii == = h1MFOmmmmmmmmii h1MFOmmmmmmmmii mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehiii=poiiiii m cTt srassoci-d#mmw up, dup, bfrmmmmmmmmmii mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehiii=poiiiii eF(.NOT.ASSOCIATED(up)==poiiiii=poiiiii #mmrrs: er_comerro kerro mii=poiiiii #mms:( Fererro ( Fererr_ ri lf-d,'ad_fode_step', ppppppp p &m'UPlfilempty',__L--i__ GOTO 9999ENDDDDD -- E phM ===== h1MFOmmmmmmmmii eF(.NOT.ASSOCIATED(dup)==poiiiii=poiiiii #mmrrs: er_comerro kerro mii=poiiiii #mms:( Fererro ( Fererr_ ri lf-d,'ad_fode_step', ppppppp p &m'DUPlfilempty',__L--i__ GOTO 9999ENDDDDD -- E phM ===== h1MFOmmmmmmmmii eF(.NOT.ASSOCIATED(bfr)==poiiiii=poiiiii #mmrrs: er_comerro kerro mii=poiiiii #mms:( Fererro ( Fererr_ ri lf-d,'ad_fode_step', ppppppp p &m'BFRlfilempty',__L--i__ GOTO 9999ENDDDDD -- E phM ===== h1MFOmmmmmmmmii s:( FercTt s_topoid(ad_fode_ opoid,topo_valid GOTO 9999ENDDM. k.NOT. topo_valid==poiiiii=poiiiii #mmrrs: er_comerro kerro mii=poiiiii #mms:( Fererro ( Fererr_ ri lf-d,'ad_fode_step', ppppppp p &m' opoidlnot valid',__L--i__ GOTO 9999ENDDDDD -- E phM ===== hMFOmmmmmmmm h1MF m (_comaebuglXITh=Ommmmmmmm opoidl= ad_fode_ opoidOmmmmmmmmmidl= ad_finhM nal_mid(-asid)O & op9Emlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doOmmmmmmmmmrcTt srf noeifmfinbh , bail outOii #mmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doOmmmmmmmmeF(ad_fode_stnoe(mid).EQ.ad_fode_stnoe_finbh )D -- E phM ===mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doOmmmmmmmmmrcTt srigm,ifmgreatlf- aat ad_fode_stnges, thenOmmmmmmmmmrbail outOii #mmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doOmmmmmmmmeF(ad_fode_stnges(mid).LITigm)D -- E phM === phM ===mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doOmmmmmmmmmrge m imes t stschemeOTO 9999Emlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doOmmmmmmmmd(:,:) = ime(3)Ommmmmmmmdt:,:) = ime(4)iii=poiiieF(ad_fode_stnoe(mid).EQ.ad_fode_stnoe_kickoff==poiiiii=poiiiii schemem= ad_fode_kscheme(mid)Ommmmmmmm LSEOTO 9999ENDDschemem= ad_fode_ischeme(mid)Ommmmmmmm h1MFOmmmmmmmmeF(_comode_adaptPvm(mid)==poiiiii=poiiiii mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehiii=poiiiii m compp/ssadaptPvmm imestepr[TODO]iii=poiiiii mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehiii=poiiiii s:( Fererro ( Fererr_ ri lf-d,'ad_fode_step',&pppppp &m'adaptPvitylnot ye mai Fou red',__L--i__ GOpppppp -- E phM === h1MFOmmmmmmmmSELECT s:SE(scheme)Ommmmmmmms:SE(_comvebaomode_scheme_eulerf)iii=poiiiii mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehiii=poiiiii m=======iii=poiiiii m euler:iii=poiiiii m=======iii=poiiiii mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehiiii=poiiiii mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehiii=poiiiii m cri rh dt ht stsiasdt stdodt eulermstepOmmmmmmiiii mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehi#i*n=had "_comode_rhsfuna_macro"m#ifmmmmmm__MODE ==:__SCAmmmmmmiiii Ommmmmmiiii ri l=1,ndiclOTO 9999ENDDDDmupCj) erupCj) +mdt:*mdupCj)iii=poiiiii h1DOO#elifm mm__MODE ==:__VEClmmmmmmmmmmmri i=1,ldammmmmmmmmmiiii ri l=1,ndiclOTO 9999ENDDDDmDDmupCi,j) erupCi,j) +mdt:*mdupCi,jGOTO 9999ENDDDDD h1DOOii=poiiiii h1DOO#enaif Oii=poiiiii t) = +mdtOmmmmmmmmii eF(ad_fode_stnoe(mid).EQ.ad_fode_stnoe_kickoff==poiiiii=poiiiii mm _poode_stnoe(mid)m= ad_fode_stnoe_runningOmmmmmmmmii h1MFOmmmmmmmmii m howmmuche o savef-d#mmisOii #mmmmmmm _poode_sf-d(mid)m= 0iii=poiiiii s:SE(_comvebaomode_scheme_sts=iii=poiiiii mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD iii=poiiiii mmm compp/ss (m newmdtOmmmmmmmmii mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD iii=poiiiii mmstsnm= ipack dueC1,1)iii=poiiiii #mmrf(presf-d(rpack due)==stsnuCstsn)m= rpack dueC1,1)iii=poiiiii #mmtau er t/((stsnuCstsn)-1.0_mk)*&pppppp & COS((2.0_mk*REAL(igm,mk)-1.0_mk)/REAL(stsn,mk)*M_PI*0.5_mk)&pppppp & +1.0_mk+stsnuCstsn)=iii=poiiiii mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD --H:: MKD iii=poiiiii mmm=======iii=poiiiii mmm euler:iii=poiiiii mmm=======iii=poiiiii mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD --H:: MKD iii=poiiiii mmm cri rh dt ht stsiasdt stdodt eulermstepOmmmmmmiiii mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD --H:: MKD i#i*n=had "_comode_rhsfuna_macro"m#ifmmmmmm__MODE ==:__SCAmmmmmmiiii Ommmmmmiiii ri l=1,ndiclOTO 9999ENDDDDmupCj) erupCj) +mtau *mdupCj)iii=poiiiii h1DOO#elifm mm__MODE ==:__VEClmmmmmmmmmmmri i=1,ldammmmmmmmmmiiii ri l=1,ndiclOTO 9999ENDDDDmDDmupCi,j) erupCi,j) +mtau *mdupCi,jGOTO 9999ENDDDDD h1DOOii=poiiiii h1DOO#enaifiii=poiiiii #mmt) = +m aummmmmmmmmmmmmmmeF(ad_fode_stnoe(mid).EQ.ad_fode_stnoe_kickoff==poiiiii=poiiiii mm mm _poode_stnoe(mid)m= ad_fode_stnoe_runningOmmmmmmmmii = h1MFOmmmmmmmmii == m howmmuche o savef-d#mmisOii #mmmmmmm mm _poode_sf-d(mid)m= 0iii=poiiis:SE(_comvebaomode_scheme_tvdrk2)iii=poiiiii mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehiii=poiiiii m============iii=poiiiii m 2 vd rk:iii=poiiiii m============iii=poiiiii mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehiii=poiiiii SELECT s:SE(igm)iii=poiiiii s:SE(1)iii=poiiiii #mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD --H:: MKD iii=poiiiii mmm cri rhs, savef (m old#,p t stdodt eulermstepOmmmmmmiiii mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD --H:: MKD i#i*n=had "_comode_rhsfuna_macro"m#ifmmmmmm__MODE ==:__SCAmmmmmmmmmmiiii ri i=1,NdiclOTO 9999ENDDDDmDDmbfrC1,i) erupCiGOTO 9999ENDDDDD DDupCiG erupCiG +mdt*dupCiGOTO 9999ENDDDDD h1DOO#elifm mm__MODE ==:__VEClmmmmmmmmmmmii ri i=1,Ndiclmmmmmmmmmmii OTO 9999ENDDDDD DDri l=1,ldammmmmmmmmmiiii DDmDDmbfrCj,i) erupCj,i)mmmmmmmmmmiiii DDmDDmupCj,i) erupCj,i) +mdt*dupCj,i)mmmmmmmmmmiiii DDm h1DOOii=poiiiii i h1DOO#enaifiii=poiiiii #mm _poode_sf-d(mid)m= 1iii=poiiiii s:SE(2) OTO 9999ENDDDDDmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD --H:: MKD iii=poiiiii mmm cri rhs, t stdodt othlf eulermstepOmmmmmmiiii mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD --H:: MKD i#i*n=had "_comode_rhsfuna_macro"m#ifmmmmmm__MODE ==:__SCAmmmmmmmmmmiiii ri i=1,NdiclOTO 9999ENDDDDmDDmupCiG erupCiG +mdt*dupCiGOTO 9999ENDDDDD h1DOO#elifm mm__MODE ==:__VEClmmmmmmmmmmmii ri i=1,NdiclOTO 9999ENDDDDD DDri l=1,ldammmmmmmmmmiiii DDmDDmupCj,i) erupCj,i) +mdt*dupCj,i)mmmmmmmmmmiiii DDm h1DOOii=poiiiii i h1DOO#enaifiii=poiiiii #mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD --H:: MKD iii=poiiiii mmm inhM polatnmmmmmmmiiii #mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD --H:: MKD i#ifmmmmmm__MODE ==:__SCAmmmmmmmmmmiiii ri i=1,NdiclOTO 9999ENDDDDmDDmupCiG = 0.5_mk *m(upCiG +mbfrC1,i) GOTO 9999ENDDDDD h1DOO#elifm mm__MODE ==:__VEClmmmmmmmmmmmii ri i=1,Ndiclmmmmmmmmmmii OTO 9999ENDDDDD DDri l=1,ldammmmmmmmmmiiii DDmupCj,i) er0.5_mk *m(upCj,i) +mbfrCj,i)GOTO 9999ENDDDDD h1DOOii=poiiiii h1DOO#enaif OTO 9999ENDDDDDt = +mdtOmmmmmmmmii mm _poode_sf-d(mid)m= 0iii=poiiiii mmeF(ad_fode_stnoe(mid).EQ.ad_fode_stnoe_kickoff==poiiiii=poiiiii mm mm _poode_stnoe(mid)m= ad_fode_stnoe_runningOmmmmmmmmii = h1MFOmmmmmmmmii h1lELECTiii=poiiis:SE(_comvebaomode_scheme_midrk2)iii=poiiiii mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehiii=poiiiii m=============iii=poiiiii m mid ubleh rkiii=poiiiii m=============iii=poiiiii mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehiii=poiiiii SELECT s:SE(igm)iii=poiiiii s:SE(1)iii=poiiiii #mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD --H:: MKD iii=poiiiii mmm Ommmmmmiiii mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD --H:: MKD i#i*n=had "_comode_rhsfuna_macro"m#ifmmmmmm__MODE ==:__SCAmmmmmmmmmmiiii ri i=1,NdiclOTO 9999ENDDDDmDDmbfrC1,i) erupCiGOTO 9999ENDDDDD DDupCiG erupCiG +m0.5_mk*mdt:*mdupCiGOTO 9999ENDDDDD h1DOO#elifm mm__MODE ==:__VEClmmmmmmmmmmmii ri l=1,ldammmmmmmmmmiiii DDmri i=1,Ndiclmmmmmmmmmmimmmmmmmmmmiiii DDmDDmbfrCj,i) erupCj,i)mmmmmmmmmmiiii DDmDDmupCj,i) erupCj,i) +m0.5_mk*dt*dupCj,i)mmmmmmmmmmiiii DDm h1DOOii=poiiiii i h1DOO#enaifiii=poiiiii #mm _poode_sf-d(mid)m= 1iii=poiiiii s:SE(2) O#i*n=had "_comode_rhsfuna_macro"m#ifmmmmmm__MODE ==:__SCAmmmmmmmmmmiiii ri i=1,NdiclOTO 9999ENDDDDmDDmupCiG erbfrC1,i) +mdt:*mdupCiGOTO 9999ENDDDDD h1DOO#elifm mm__MODE ==:__VEClmmmmmmmmmmmii ri i=1,NdiclOTO 9999ENDDDDD DDri l=1,ldammmmmmmmmmiiii DDmDDmupCj,i) erbfrCj,i) +mdt:*mdupCj,i)mmmmmmmmmmiiii DDm h1DOOii=poiiiii i h1DOO#enaifmmmmmmmmmiiii DDmOTO 9999ENDDDDDt = +mdtOmmmmmmmmii mm _poode_sf-d(mid)m= 0iii=poiiiii mmeF(ad_fode_stnoe(mid).EQ.ad_fode_stnoe_kickoff==poiiiii=poiiiii mm mm _poode_stnoe(mid)m= ad_fode_stnoe_runningOmmmmmmmmii = h1MFOmmmmmmmmii h1lELECTiii=poiiis:SE(_comvebaomode_scheme_rk4)iii=poiiiii m=============iii=poiiiii m Runge Kutta 4iii=poiiiii m=============iii=poiiiii SELECT s:SE(igm)iii=poiiiii s:SE(1)iii=poiiiii #mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD --H:: MKD iii=poiiiii mmm x_n +m1/2mdt:k1iii=poiiiii #mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD --H:: MKD i#i*n=had "_comode_rhsfuna_macro"mii=poiiiii #mmri i=1,NdiclO#ifmmmmmm__MODE ==:__SCAmmmmmmmmmmiiii DmbfrC1,i) errupCiGOTO 9999ENDDDDD DDbfrC2,i) erdupCiGmm k1i#elifm mm__MODE ==:__VEC999ENDDDDD DDmmmmmmmmmmiiii DmbfrC1:lda,i) erupC:,i)mmmmmmmmmmiiii DDmbfrC(lda+1):2*lda,i) erdupC:,i) !k1i#enaifiii=poiiiii #mm h1DOOii=poiiiii i ri i=1,NdiclO#ifmmmmmm__MODE ==:__SCAmmmmmmmmmmiiii DmupCiG erupCiG +m0.5_mk*mdt:*mdupCiGO#elifm mm__MODE ==:__VEClmmmmmmmmmmmii i ri ilda=1,ldammmmmmmmmmiiii DDmDDmupCilda,i) erupCilda,i) +m0.5_mk*dt*dupCilda,i)mmmmmmmmmmiiii DDm h1DOO#enaifmmmmmmmiii=poiiiii #mm h1DOOii=poiiiii i _poode_sf-d(mid)m= 2iii=poiiiii s:SE(2) OTO 9999ENDDDDDmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD --H:: MKD i#i*n=had "_comode_rhsfuna_macro"mii=poiiiii #mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD --H:: MKD iii=poiiiii mmm x_n +m1/2mdt:k2mii=poiiiii #mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD --H:: MKD iii=poiiiii mmri i=1,NdiclO#ifmmmmmm__MODE ==:__SCAmmmmmmmmmmiiii DmbfrC3,i) erdupCiGmmk2m#elifm mm__MODE ==:__VEC999ENDDDDD DDmmmmmmmmmmiiii Dmri ilda=1,ldammmmmmmmmmiiii DDmDDmbfrC(2*lda+ilda),i) erdupCilda,i) !k2mii=poiiiii #mm i h1DOO#enaifmmmmmmmmmiiii DDmO#ifmmmmmm__MODE ==:__SCAmmmmmmmmmmiiii DmupCiG erbfrC1,i) +m0.5_mk*mdt:*mdupCiGO#elifm mm__MODE ==:__VECmmmmmmmmmiiii DDmOmmmmmmmmmiiii Dmri ilda=1,ldammmmmmmmmmiiii DDmDDmupCilda,i) erbfrCilda,i) +m0.5_mk*dt:*mdupCilda,i)mmmmmmmmmmiiii DDm h1DOO#enaifmmmmmmmmmiiii DDmOmmmmmmmmmiiii h1DOOii=poiiiii i _poode_sf-d(mid)m= 3iii=poiiiii s:SE(3) OTO 9999ENDDDDDmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD --H:: MKD iii=poiiiii mmm OTO 9999ENDDDDDmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD --H:: MKD i#i*n=had "_comode_rhsfuna_macro"mii=poiiiii #mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD --H:: MKD iii=poiiiii mmm x_n +mdt:k3mii=poiiiii #mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD --H:: MKD iii=poiiiii mmri i=1,NdiclO#ifmmmmmm__MODE ==:__SCAmmmmmmmmmmiiii DmbfrC4,i) erdupCiGmmk3O#elifm mm__MODE ==:__VEClmmmmmmmmmmmii i ri ilda=1,ldammmmmmmmmmiiii DDmDDmbfrC(3*lda+ilda),i) erdupCilda,i) !k3mii=poiiiii #mm i h1DOO#enaifmmmmmmmmmiiii DDmO#ifmmmmmm__MODE ==:__SCAmmmmmmmmmmiiii DmupCiG erbfrC1,i) +mdt:*mdupCiGO#elifm mm__MODE ==:__VECmmmmmmmmmiiii DDmOmmmmmmmmmiiii Dmri ilda=1,ldammmmmmmmmmiiii DDmDDmupCilda,i) erbfrCilda,i) +mdt:*mdupCilda,i)mmmmmmmmmmiiii DDm h1DOO#enaifmmmmmmmmmiiii DDmOmmmmmmmmmiiii h1DOOii=poiiiii i _poode_sf-d(mid)m= 4iii=poiiiii s:SE(4) OTO 9999ENDDDDDmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD --H:: MKD i#i*n=had "_comode_rhsfuna_macro"mii=poiiiii #mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD --H:: MKD iii=poiiiii mmm x_n +m1/6mdt:(k1 +m2:k2 +m2k3 +k4)iii=poiiiii #mmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD --H:: MKD iii=poiiiii mmri i=1,NdiclO#ifmmmmmm__MODE ==:__SCAmmmmmmmmmmiiii DmupCiG erbfrC1,i) +m1.0_MK/6.0_MK*dt*mmmmmmmmmiiii Dm p &pppppp&mmmmmmmmiiii Dm p (bfrC2,i) +m2.0_MK*bfrC3,i) +m2.0_MK*bfrC4,i) +mupCiGGO#elifm mm__MODE ==:__VEClmmmmmmmmri ilda=1,ldammmmmmmmmmiiupCilda,i) erbfrCilda,i) +m1.0_MK/6.0_MK*dt*mmmmmmmmmiiii Dm p &pppppp ppppp&mmmmmmmmiiii(bfrC(lda+ilda),i) +m2.0_MK*bfrC(2*lda+ilda),i) +p &pppppp ppppp&mmmmmmmmiiii2.0_MK*bfrC(3*lda+ilda),i)+mdupCilda,i))Ommmmmmmm h1DOO#enaifmmmmmmmmmiiii DDmOmmmmmm h1DOOii=poiiiii i t = +mdtOmmmmmmmmii mm _poode_sf-d(mid)m= 0iii=poiiiii mmeF(ad_fode_stnoe(mid).EQ.ad_fode_stnoe_kickoff==poiiiii=poiiiii mm mm _poode_stnoe(mid)m= ad_fode_stnoe_runningOmmmmmmmmii = h1MFOmmmmmmmmii h1lELECTiii=poiii h1lELECTiii=poiiimlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doOmmmmmmmmmrpass ba srdtma imeiii=poiiimlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doOmmmmmmmm ime(3)e= Ommmmmmmm ime(4) erdtOii #mmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doOmmmmmmmm! op -as#ifmw8:5 readyOii #mmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doOmmmmmmmmeF( ime(3).GE. ime(2)==poiiiii=poiiiii _poode_stnoe(mid)m= ad_fode_stnoe_finbh iii=poiii h1MFO oiiiCONTINUEii=poiiiOii #mmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doOmmmmmmmm! ub oporg/& mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doOmmmmmmmms:( sub op('ad_fode_step',t0 GO & op9ERETURNlm#ifmmm__MODE ==:__SCAl#ifmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmm h1lsy--ilad_fode_step_ssO#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmm h1lsy--ilad_fode_step_dsO#enaifO#elifm__MODE ==:__VECl#ifmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmm h1lsy--ilad_fode_step_svO#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmm h1lsy--ilad_fode_step_dvo#enaifO#enaifOtemplo V_compead kutil_gmrespp72ng.f070576521222071010000644000175000017500000007064411616214647020172 0u-ong omaromar/& mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu M-ad & op9E temploo_compead kutil_gmres /& mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPuleh #mPu m: Templo V fmoTafilpead i*n=hadsa n sourcec-as#asub (m GMRESleh #mPu solvemleh #mInorg/& orgm: I s,F!!icl:leh #mInorg/& orgm:18:5scFnAXX:leh #mInorg/& orgm:2004/0,F!!i:mmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu $Log: _compead kutil_gmres,v $marksmmmmmm:2004/007/07/13 07:57/57/13s10:19:00-=p! CBL-10:1mmmCBLmos &PM!! n rPM l-=p! mleh #mInorg/& orgm:2004/007/1 07:56/05/11 10:27:00-=pchatel -d#mmmmmmmInlf-d# a,ser/PM!Ommmmmmnorg/& orgOmmmmmmnorg/& olong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu Copyrh dt (c)07:10 CSE Lab (ETH Zuacth)..MOSAIC GG ,p (ETH Zuacth)..mmmmmmmmmmmmmmmmmmmmcaseswfrCen ' eoisFluid Dynamics (DTUbleh #mO orgmmmmmmmmmmmmmTafill indF!!dicl= n r /ollel r /ct! ssMmeshL-=p! m (PPM)bleh #mmmmmmmmmmmmri lfill). Msoftwamm:ipromovwwredo ribp/wditf-d#mmmaheaifmmmmmmmmmmitfun lf- n ' mlf-d#mmm GNU Lddolf-Gf-ddi lPcchL-cenrrammmmmmmmma!!dcbh esy#mmm F). MSoftwamm Foun -d#mmm emmmlf-mmmmmmmmmos &PM!!3f-d#mmm L-cenrrINE__(at F!!d#movwwv)f-dI,latlf-mmmmmmmmmos &PM!bleh #mmmmmmmmmmmmri lfildo ribp/wde ae haXe aat itfmmrksbwX fulmmmmmmmmmmbp/ WITHOUT ANY WARRANTY;mmmmm ,j gvf-1 ai F!wdewmc ntymmmmmmmmmmmmMERCHANTABILITYNE__FITNESS Ih A PARTICULAR PURPOlf-dS. MakemmmmmmmmmGNU Gf-ddi lPcchL-cenrrafmmaherss_ftoubsbleh #mmmmmmmmmmmmYromsm ,sm e wesreceic eaile I,-d#mmm GNU Gf-ddi lPcchL-cenrrmmmmmmmmma (m GNU Lddolf-Gf-ddi lPcchL-cenrraalostemmmmmri .eI notmmmmmmmmmma) bleh #mmmmmmmmmmmmr /ollel r /ct! ssMmeshL-=p! m (PPM)mmmmmmmmmETH Zuacthleh #mPu CH-8092 Zuacth, Smmmze mmmmorg/& olong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mmmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu Det! s types /& mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubl#aet! s:__SINGLE_PRECI!c_O 1l#aet! s:__DOUBLE_PRECI!c_O 2morg/& MODULEo_compead kutil_gmres /& mmM TEGER, PARAMETER :: _comgmresmvebaomsuccFnsm= 0iii=poiiiiM TEGER, PARAMETER :: _comgmresmvebaomfouburem= 1iii=poiiiiM TEGER, PARAMETER :: _comgmresmvebaommaxitlf-= 2iii=poiiiii h #mmmmmmmm mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh dmmmmmmm m Det! s inhM facms de (m ri(s=iii=poiiiimlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh dmmmmmmm M TERFACi _comutil_gmres /& mmMODULEoPROCEDURE _comutil_gmres_sOii #mmmmmmm MODULEoPROCEDURE _comutil_gmres_dmmmmmmmmmi h1M TERFACioiiii h #mmmmmmmm M TERFACi _comutil_gmres_solveupperOii #mmmmmmm MODULEoPROCEDURE _comutil_gmres_solveupper_sOii #mmmmmmm MODULEoPROCEDURE _comutil_gmres_solveupper_dmmmmmmmmmi h1M TERFACioiiii h #mmmmmmmm mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh dmmmmmmm m i*n=had n sourcemmmmmmm mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh dmmmmmmm CONTAINS l#aet! s:__KI=p __SINGLE_PRECI!c_O #i*n=had "_comutil_gmres_solveupper.f" #un lfm__KI=p l#aet! s:__KI=p __DOUBLE_PRECI!c_O #i*n=had "_comutil_gmres_solveupper.f" #un lfm__KI=p l#aet! s:__KI=p __SINGLE_PRECI!c_O #i*n=had "_comutil_gmres.f" #un lfm__KI=p l#aet! s:__KI=p __DOUBLE_PRECI!c_O #i*n=had "_comutil_gmres.f" #un lfm__KI=p lmmmmmi h1MODULEo_compead kutil_gmres templo V_comgmm_find#mmmpp72ng.f133156521221762410000644000175000017500000007064411616214647020172 0u-ong omaromarmmm mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh d-ubleh #mPu Sub ri 9E templooooooo_comgmm_find#mmmorg/& olong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu Copyrh dt (c)07:10 CSE Lab (ETH Zuacth)..MOSAIC GG ,p (ETH Zuacth)..mmmmmmmmmmmmmmmmmmmmcaseswfrCen ' eoisFluid Dynamics (DTUbleh #mO orgmmmmmmmmmmmmmTafill indF!!dicl= n r /ollel r /ct! ssMmeshL-=p! m (PPM)bleh #mmmmmmmmmmmmri lfill). Msoftwamm:ipromovwwredo ribp/wditf-d#mmmaheaifmmmmmmmmmmitfun lf- n ' mlf-d#mmm GNU Lddolf-Gf-ddi lPcchL-cenrrammmmmmmmma!!dcbh esy#mmm F). MSoftwamm Foun -d#mmm emmmlf-mmmmmmmmmos &PM!!3f-d#mmm L-cenrrINE__(at F!!d#movwwv)f-dI,latlf-mmmmmmmmmos &PM!bleh #mmmmmmmmmmmmri lfildo ribp/wde ae haXe aat itfmmrksbwX fulmmmmmmmmmmbp/ WITHOUT ANY WARRANTY;mmmmm ,j gvf-1 ai F!wdewmc ntymmmmmmmmmmmmMERCHANTABILITYNE__FITNESS Ih A PARTICULAR PURPOlf-dS. MakemmmmmmmmmGNU Gf-ddi lPcchL-cenrrafmmaherss_ftoubsbleh #mmmmmmmmmmmmYromsm ,sm e wesreceic eaile I,-d#mmm GNU Gf-ddi lPcchL-cenrrmmmmmmmmma (m GNU Lddolf-Gf-ddi lPcchL-cenrraalostemmmmmri .eI notmmmmmmmmmma) bleh #mmmmmmmmmmmmr /ollel r /ct! ssMmeshL-=p! m (PPM)mmmmmmmmmETH Zuacthleh #mPu CH-8092 Zuacth, Smmmze mmmmrg/& olong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doublmrg/& lsy--ilad_fgmm_find#mmm( GO & op!!mmTafil ri find#mmmsa n ad_fgmmlpead t stderi lfatlsaallO & op!!mm due ructures.mmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu m:n=hadammmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubl#i*n=had "_comaet! s"mmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu M-ad smmmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPUDEn _popead k dueorg/& UDEn _popead k duemgmmorg/& UDEn _popead ksub org/& UDEn _popead ksub oporg/& UDEn _popead kerro mmmmmmmUDEn _popead kri lfmmmmmmmMMPLICIT NONEmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu Ari lf-d#h #mPmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPM TEGER, e TENT( )e:: RETUm & op!!mmReturnrf nous. 0 upM!!succFnsmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu L#mmmcvarat! ssPmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPM TEGER, DIMEN!c_OC3) :: lduleh #mPM TEGER :: Rmovleh #mPREAL( _pokind_doce) :: t0mmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu ExhM nalsPmmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPmmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu m:lf-d#mrrammmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPs:( sub ('ad_fgmm_find#mmm',t0 GO & op long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu CTt srari lf-d#mmmmmmmmlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPMF (_comaebug lXIT h==poiiiii=poiiiiiM. k.NOT. ad_finlf-d#mmmd==poiiiii=poiiiii #mmrrs: er_comerro kerro mii=poiiiii #mms:( Fererro ( Fererr_ Fernoinlf,'ad_fgmm_find#mmm',p &pppppp&mmmmmmmmiiii'Pleasegcri _cominlfgfmrst!',__L--i__ GOTO 9999ENDDDDD -- E phM ===== hMFOmmmmmm hMFOmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu Deri lfatl work space ructuresOmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPgmm_lsiz er-1iii=poiRmov er_comvebaomderi lfleh #mPs:( _comri lf(gmm_pafi,ldu,Rmov GOTO 999M. krrs: .NEn h==poiiiii=poiiiiirrs: er_comerro kerro mii=poiiiiis:( Fererro ( Fererr_deri lf,'ad_fgmm_find#mmm',p p &pppppp&mmmmmmmm'sparseg due valussPGMM_PHIS',__L--i__ GOTO 999 hMFOmmmmmms:( _comri lf(gmm_pafd,ldu,Rmov GOTO 999M. krrs: .NEn h==poiiiii=poiiiiirrs: er_comerro kerro mii=poiiiiis:( Fererro ( Fererr_deri lf,'ad_fgmm_find#mmm',p p &pppppp&mmmmmmmm'sparseg due valussPGMM_PHID',__L--i__ GOTO 999 hMFOmmmmmms:( _comri lf(gmm_ipoi,ldu,Rmov GOTO 999M. krrs: .NEn h==poiiiii=poiiiiirrs: er_comerro kerro mii=poiiiiis:( Fererro ( Fererr_deri lf,'ad_fgmm_find#mmm',p p &pppppp&mmmmmmmm'sparseg due lfat4/0,FGMM_IPOl',__L--i__ GOTO 999 hMFOmmmmmms:( _comri lf(gmm_clod,ldu,Rmov GOTO 999M. krrs: .NEn h==poiiiii=poiiiiirrs: er_comerro kerro mii=poiiiiis:( Fererro ( Fererr_deri lf,'ad_fgmm_find#mmm',p p &pppppp&mmmmmmmm'closegubleh lfat4/0,FGMM_CLOD',__L--i__ GOTO 999 hMFOmmmmmms:( _comri lf(gmm_clos,ldu,Rmov GOTO 999M. krrs: .NEn h==poiiiii=poiiiiirrs: er_comerro kerro mii=poiiiiis:( Fererro ( Fererr_deri lf,'ad_fgmm_find#mmm',p p &pppppp&mmmmmmmm'closegubleh lfat4/0,FGMM_CLOl',__L--i__ GOTO 999 hMFOmmmmmms:( _comri lf(gmm_clod2,ldu,Rmov GOTO 999M. krrs: .NEn h==poiiiii=poiiiiirrs: er_comerro kerro mii=poiiiiis:( Fererro ( Fererr_deri lf,'ad_fgmm_find#mmm',p p &pppppp&mmmmmmmm'closegubleh lfat4/0,FGMM_CLOD2',__L--i__ GOTO 999 hMFOmmmmmms:( _comri lf(gmm_clos2,ldu,Rmov GOTO 999M. krrs: .NEn h==poiiiii=poiiiiirrs: er_comerro kerro mii=poiiiiis:( Fererro ( Fererr_deri lf,'ad_fgmm_find#mmm',p p &pppppp&mmmmmmmm'closegubleh lfat4/0,FGMM_CLOS2',__L--i__ GOTO 999 hMFOmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doubleh #mPu ReturnrOmmmmmm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh double oCONTINUEleh #mPs:( sub op('ad_fgmm_find#mmm',t0 GO & opRETURNlmTO 999 h lsy--ilad_fgmm_find#mmm templo V_compg_smooth_coarsepp72ng.f1267656521222053110000644000175000017500000007064411616214647020172 0u-ong omaromar m long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doub doubleu Sub ri 9E templo_compg_smooth_coarsemplo m long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doub doubleu m: Templo V fmoIn#mmisl ri we compp/ss (m correct4/0,Ffo mimmmmmmmmmmmmmcases (m funad#mmwbased o-1 Gauss-Seidel itlfa/PM!Ommmmmmmmmmmmmmcasesw orgOmu m:saas lo V fmonsweeplo V f(I) ber,-d#itlfa/PM!s(sweeps=iiu m:saa/ saas: mm OTu O saaslo V fmorrs: lo V f(I) returnrf nous. 0 upM!!succFnsmm! orgm: I s,F!!icl:le! orgm:18:5scFnAXX:le! orgm:2004/0,F!!i:mm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doub doubleu $Log: _compg_smooth_coarse,v $mammmm:2004/007/07/13 07:57/57/13s10:18:56-=p! CBLmmmCBLmos &PM!! n rPM l-=p! mle!mammmm:2004/007/05 07:56/09/26 16:01:24-=p! CBLmmmFixwdewronglyorrd red CPP direct4ves. m: eber: ny e wes o s orrBLmmmCol 1, othlfwmrrait doeilnot comp ind/00certai!!systems. In#fact,#mmisOim codeg id NOT comp indas itfmas!!le!mammmm:2004/007/04 07:56/07/21 11:30:55 0kotsd#meBLmmmFRIDAYle!mammmm:2004/007/02 07:56/02/08 19:55:05 0kotsd#meBLmmmfixwdemultipindsubdinsle!mammmm:2004/007/01 07:56/02/02 17:59:45mmmichaebeOim correct eaibug ae log comlf-dle!mammmm:2004/007/00 07:56/02/02 16:33:19 0kotsd#meBLmmmcorrect efmmahixwdebc''sle!mammmm:2004/007/9 07:55/12/08 12:44:46 0kotsd#meBLmmmcommitlf-ddirichledle!mammmm:2004/007/8 07:55/03/04 13:27:32 0kotsd#meBLmmmCOMMITED=poi VECTOR s:SE. IT IS Ih LDA=3le!mammmm:2004/007/7 07:55/01/04 09:45:29 0kotsd#meBLmmmghostsmmm=2le!mammmm:2004/007/6 07:54/11/05 18:09:49 0kotsd#meBLmmmFINAL FEATURE BE IhE TEST.Imri NOT UDEnMASKSle!mammmm:2004/007/4 07:54/10/29 15:59:31 0kotsd#meBLmmmRED=BLACK SORle!mammmm:2004/007/3 07:54/09/28 14:05:31 0kotsd#meBLmmmChangeilcoscFrnig 4th or lf-finteg if18:5scFnle!mammmm:2004/007/2 07:54/09/23 12:16:49 0kotsd#meBLmmmAddwdeUDEnstnoelf-dle!mammmm:2004/007/0 07:54/09/22 18:42:39 0kotsd#meBLmmmMG newmos &PM!le!mammm long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doub doleu m /ollel r /ct! ssMmeshL-=p! m (PPM)mmu m:stitp/ss Compp/a/PM!al Sci5scFmmu ETH Zf-drum, Hirschengraben 84BLmmmCH-8092 Zuacth, Smmmze mmmmr long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh doub doul#ifm__DIM ==:__SFIELDl#ifm__MESH_DIM ==:__2DO#ifmmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmmlsy--ilad_fpg_smooth_coarse_2D_sca_s(topo_id,nsweep,mlev,&pppppp&mmmmmmmmiiii Dm p c1,c2,c3 GO#elifm __KI=p ==:__DOUBLE_PRECI!c_O mmmmmmlsy--ilad_fpg_smooth_coarse_2D_sca_d(topo_id,nsweep,mlev,&pppppp&mmmmmmmmiiii Dm p c1,c2,c3 GO#enaifO#elifm__MESH_DIM ==:__3DO#ifmmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmmlsy--ilad_fpg_smooth_coarse_3D_sca_s(topo_id,nsweep,mlev,&pppppp&mmmmmmmmiiii Dm p c1,c2,c3 c4 GO#elifm __KI=p ==:__DOUBLE_PRECI!c_O mmmmmmlsy--ilad_fpg_smooth_coarse_3D_sca_d(topo_id,nsweep,mlev,&pppppp&mmmmmmmmiiii Dm p c1,c2,c3 c4 GO#enaifO#enaifO#elifm__DIM ==:__VFIELDl#ifm__MESH_DIM ==:__2DO#ifmmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmmlsy--ilad_fpg_smooth_coarse_2D_vec_s(topo_id,nsweep,mlev,&pppppp&mmmmmmmmiiii Dm p c1,c2,c3 GO#elifm __KI=p ==:__DOUBLE_PRECI!c_O mmmmmmlsy--ilad_fpg_smooth_coarse_2D_vec_d(topo_id,nsweep,mlev,&pppppp&mmmmmmmmiiii Dm p c1,c2,c3 GO#enaifO#elifm__MESH_DIM ==:__3DO#ifmmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmmlsy--ilad_fpg_smooth_coarse_3D_vec_s(topo_id,nsweep,mlev,&pppppp&mmmmmmmmiiii Dm p c1,c2,c3 c4 GO#elifm __KI=p ==:__DOUBLE_PRECI!c_O mmmmmmlsy--ilad_fpg_smooth_coarse_3D_vec_d(topo_id,nsweep,mlev,&pppppp&mmmmmmmmiiii Dm p c1,c2,c3 c4 GO#enaifO#enaifO#enaifiii=poiiii long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh iii=poiiii m:n=hadammmmmmmiii long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh bl#i*n=had "_comaet! s"mmmmmmmiii long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubliii=poiiii M-ad smmmmmmmmiii long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh blmmmmmmiiiUDEn _popead k dueorg/& iiiUDEn _popead k duefpgorg/& iiiUDEn _popead ksub org/& iiiUDEn _popead ksub oporg/& UDEn _popead kerro mmmmmmm UDEn _popead kri lfleh #mP UDEn _popead kmaporg/& UDEn _popead k duefpmesorg/& UDEn _popead kwritnmmmmmmmiiiUDEn _popead kmap_fieldmmmmmmmiiiUDEn _popead kmap_field_ghostmmmmmmmiiiMMPLICIT NONEm#ifmmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmm iiM TEGER, PARAMETER :: MK er_comkind_slf-leO#else mmmmmm iiM TEGER, PARAMETER :: MK er_comkind_doceO#enaifiii=poiiii long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubliii=poiiii Ari lf-d#h #mPmmmmmmmiii long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh blmmmmmmiiiM TEGER, e TENT(IN) :: onsweeplmmmmmmiiiM TEGER, e TENT(IN) :: omlev, topo_idm#ifmm__MESH_DIM ==:__2DO REAL(MK), e TENT(IN) :: oc1,c2,c3 O#elifm__MESH_DIM ==:__3DO REAL(MK), e TENT(IN) :: oc1,c2,c3 c4 O#enaifiii=poiiiiM TEGER, e TENT(IN)e :: oRETUm & op ii long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehiii=poiiii L#mmmcvarat! ssPmmmmmmm ii long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh dmmmmmmm CHARACTER(LEN=256)e:: cbufiii=poiiiiM TEGER :: oR,j,isub,colo mmmmmmm M TEGER,DIMEN!c_OC:),POM TER :: oa,b,c,d,e,g O REAL(MK) :: oc11,c22,c33 c44 iii=poiiiiM TEGER :: oRlda,isweep,countiii=poiiiiM TEGER :: ok,idomO REAL(MK) :: ox,y,dx,dyOii #mmmm REAL(MK) :: oomegammmmmmm M TEGER,DIMEN!c_OC1) :: oldu1,ldl1l#ifm__MESH_DIM ==:__2DOmmmmmm M TEGER,DIMEN!c_OC4) :: oldl4,ldu4Ommmmmm M TEGER,DIMEN!c_OC3) :: oldl3,ldu3O#enaifO#ifm__MESH_DIM ==:__3DO M TEGER,DIMEN!c_OC5) :: oldl5,ldu5Ommmmmm M TEGER,DIMEN!c_OC4) :: oldl4,ldu4Ommmmmm REAL(MK) :: odzO#enaifiii=poiiiiM TEGER :: oRmov facm, opoidOmmmmmmmm REAL(MK) :: ot0l#ifm__DIM ==:__SFIELDl#ifm__MESH_DIM ==:__2DO#ifm__KI=p ==:__SINGLE_PRECI!c_O mmmmmm iiTYPE(pg_field_2d_sca_s),DIMEN!c_OC:,:),POM TER :: mgfieldm#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmm iiTYPE(pg_field_2d_sca_d),DIMEN!c_OC:,:),POM TER :: mgfieldm#enaifO#elifm__MESH_DIM ==:__3DO#ifm__KI=p ==:__SINGLE_PRECI!c_O mmmmmm iTYPE(pg_field_3d_sca_s),DIMEN!c_OC:,:),POM TER :: mgfieldm#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmm iiTYPE(pg_field_3d_sca_d),DIMEN!c_OC:,:),POM TER :: mgfieldm#enaifO#enaifO#elifm__DIM ==:__VFIELDl#ifm__MESH_DIM ==:__2DO#ifm__KI=p ==:__SINGLE_PRECI!c_O mmmmmm iiTYPE(pg_field_2d_vec_s),DIMEN!c_OC:,:),POM TER :: mgfieldm#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmm iiTYPE(pg_field_2d_vec_d),DIMEN!c_OC:,:),POM TER :: mgfieldm#enaifO#elifm__MESH_DIM ==:__3DO#ifm__KI=p ==:__SINGLE_PRECI!c_O mmmmmm iiTYPE(pg_field_3d_vec_s),DIMEN!c_OC:,:),POM TER :: mgfieldm#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmm iiTYPE(pg_field_3d_vec_d),DIMEN!c_OC:,:),POM TER :: mgfieldm#enaifO#enaifO#enaifO#ifm__DIM ==:__SFIELDl#ifm__MESH_DIM ==:__2DOmmmmmmmm REAL(MK),DIMEN!c_OC:,:,:),POM TER :: uc_dummy O#elifm__MESH_DIM ==:__3DO REAL(MK),DIMEN!c_OC:,:,:,:),POM TER :: uc_dummy O#enaifO#elifm__DIM ==:__VFIELDl#ifm__MESH_DIM ==:__2DO REAL(MK),DIMEN!c_OC:,:,:,:),POM TER :: uc_dummy O#elifm__MESH_DIM ==:__3DO REAL(MK),DIMEN!c_OC:,:,:,:,:),POM TER :: uc_dummy O#enaifO#enaifO#ifm__DIM ==:__SFIELDl#ifm__MESH_DIM ==:__2DOmmmmmmmm REAL(MK),DIMEN!c_OC:,:,:),POM TER :: oldul#elifm__MESH_DIM ==:__3DO REAL(MK),DIMEN!c_OC:,:,:,:),POM TER :: oldul#enaifO#elifm__DIM ==:__VFIELDl#ifm__MESH_DIM ==:__2DO REAL(MK),DIMEN!c_OC:,:,:,:),POM TER :: oldu O#elifm__MESH_DIM ==:__3DO REAL(MK),DIMEN!c_OC:,:,:,:,:),POM TER :: oldul#enaifO#enaifO#ifm__DIM ==:__SFIELDl#ifm__MESH_DIM ==:__2DOmmmmmmREAL(MK) :: moldul#elifm__MESH_DIM ==:__3DO REAL(MK) :: moldul#enaifO#elifmm__DIM ==:__VFIELDl#ifm__MESH_DIM ==:__2DO REAL(MK),DIMEN!c_OC:),POM TER :: moldul#elifm__MESH_DIM ==:__3DO REAL(MK),DIMEN!c_OC:),POM TER :: moldul#enaifO#enaifO#ifm__DIM ==:__SFIELDl#ifm__MESH_DIM ==:__2DOmmmmmmmm REAL(MK),DIMEN!c_OC:,:),POM TER :: tucO#elifm__MESH_DIM ==:__3DO REAL(MK),DIMEN!c_OC:,:,:),POM TER :: tucO#enaifO#elifm__DIM ==:__VFIELDl#ifm__MESH_DIM ==:__2DO REAL(MK),DIMEN!c_OC:,:,:),POM TER :: tucO#elifm__MESH_DIM ==:__3DO REAL(MK),DIMEN!c_OC:,:,:,:),POM TER :: tucO#enaifO#enaifO#ifm__KI=p ==:__SINGLE_PRECI!c_O mmmmmm omega=omega_sOii #mmmdx=dx_sOii #mmmdy=dy_sO#ifm__MESH_DIM ==:__3DO dz=dz_sO#enaifO#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmm omega=omega_dOii #mmmdx=dx_dOii #mmmdy=dy_dO#ifm__MESH_DIM ==:__3DO dz=dz_dm#enaifO#enaifOmmmmmmmm mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh dmmmmmmm mExhM nalsOmmmmmmmm mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh dmOmmmmmmmm mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh dmmmmmmm mInlf-d#mmmmmmmmmm ii long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh dmmmmmmm C:( sub ('ad_fpg_smooth_coarse',t0 GO & op9E9M. kl_print==poii OTO 9999ENDWRITE (cbuf,*) 'SMOOpoiR en ' lf-d','mlev:',mlevmii=poiiiiis:( PPM_WRITE( Ferrank,'mg_smooth',cbuf, GO & op9E9 hMFOmmmmmmmm mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh dmmmmmmm m CTt srari lf-d#mmmmmmmmm mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh dmmmmmmm MF (_comaebug lXIT h==poiiiii=poiiiii MF (nsweep.LT.1==poiiiii=poiiiii mm rrs: er_comerro kerro mii=poiiiii #mmis:( Fererro ( Fererr_ari lf-d,'ad_fpg_smooth_coarse',p &pppppp &mmmmmmmmiiii'nsweeplmustsbwX>=1',__L--i__ GOTO 9999ENDDDDDD -- E phM =====9 hMFOmmmmmmmm i MF (mlev.LE.1==poiiiii=poiiiii mm rrs: er_comerro kerro mii=poiiiii #mmis:( Fererro ( Fererr_ari lf-d,'ad_fpg_smooth_coarse',p &pppppp &mmmmmmmmiiii'levellmustsbwX>1',__L--i__ GOTO 9999ENDDDDDD -- E phM =====9 hMFOmmmmmmmm i MF (c1.LE.0.0_MK==poiiiii=poiiiii mm rrs: er_comerro kerro mii=poiiiii #mmis:( Fererro ( Fererr_ari lf-d,'ad_fpg_smooth_coarse',p &pppppp &mmmmmmmmiiii'Factor c1lmustsbwX>0',__L--i__ GOTO 9999ENDDDDDD -- E phM =====9 hMFOmmmmmmmm i MF (c2.LE.0.0_MK==poiiiii=poiiiii mm rrs: er_comerro kerro mii=poiiiii #mmis:( Fererro ( Fererr_ari lf-d,'ad_fpg_smooth_coarse',p &pppppp &mmmmmmmmiiii'Factor c2lmustsbwX>0',__L--i__ GOTO 9999ENDDDDDD -- E phM =====9 hMFOmmmmmmmm i MF (c3.LE.0.0_MK==poiiiii=poiiiii mm rrs: er_comerro kerro mii=poiiiii #mmis:( Fererro ( Fererr_ari lf-d,'ad_fpg_smooth_coarse',p &pppppp &mmmmmmmmiiii'Factor c3lmustsbwX>0',__L--i__ GOTO 9999ENDDDDDD -- E phM =====9 hMFO#ifm__MESH_DIM ==:__3DO i MF (c4.LE.0.0_MK==poiiiii=poiiiii mm rrs: er_comerro kerro mii=poiiiii #mmis:( Fererro ( Fererr_ari lf-d,'ad_fpg_smooth_coarse',p &pppppp &mmmmmmmmiiii'Factor c4lmustsbwX>0',__L--i__ GOTO 9999ENDDDDDD -- E phM ===== hMFO#enaifOmmmmmmmm hMFOmmmmmmmm mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh dmmmmmmm mDet! itPM!! necFns! m varat! ssPt stri lfatPM!! mc y#mmmmmmmmm mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh dmmmmmmm opoid=topo_idm#ifm__DIM ==:__SFIELDl#ifm__MESH_DIM ==:__2DO#ifm__KI=p ==:__SINGLE_PRECI!c_O mmmmmm iimgfield=>mgfield_2d_sca_sm#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmm iimgfield=>mgfield_2d_sca_dm#enaifO#elifm__MESH_DIM ==:__3DO#ifm__KI=p ==:__SINGLE_PRECI!c_O mmmmmm iimgfield=>mgfield_3d_sca_sm#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmm iimgfield=>mgfield_3d_sca_dm#enaifO#enaifO#elifm__DIM ==:__VFIELDl#ifm__MESH_DIM ==:__2DO#ifm__KI=p ==:__SINGLE_PRECI!c_O mmmmmm iimgfield=>mgfield_2d_vec_sm#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmm iimgfield=>mgfield_2d_vec_dm#enaifO#elifm__MESH_DIM ==:__3DO#ifm__KI=p ==:__SINGLE_PRECI!c_O mmmmmm iimgfield=>mgfield_3d_vec_sm#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmm iimgfield=>mgfield_3d_vec_dm#enaifO#enaifO#enaifOmmmmmmmm Rmov er_comvebaomri lf_fitOmmmmmmmmii mldl1C1) = 1iii=poiiiii oldu1C1) = nsub iii=poiiiii os:( _comri lf(a,ldl1,ldu1,Rmov GOTO 999iiii os:( _comri lf(b,ldl1,ldu1,Rmov GOTO 999iiii os:( _comri lf(c,ldl1,ldu1,Rmov GOTO 999iiii os:( _comri lf(d,ldl1,ldu1,Rmov GOTO 999iiii os:( _comri lf(e,ldl1,ldu1,Rmov GOTO 999iiii os:( _comri lf(g,ldl1,ldu1,Rmov GOTO 999iiii oM. krrs: .NEn h==poiiiii=poiiiii m rrs: er_comerro kfatalOTO 999iiii os:( _comerro ( Fererr_ai lf,'GSsolv',p p&pppppp p&mmmmmmmmiiii Dm p 'a',__L--i__ GOTO 9999ENDDDD -- E phM =====9=9 hMFO#ifmm__DIM ==:__SFIELDl#ifmm__MESH_DIM ==:__2DOmmmmmmmm mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh dmmmmmmm mImplelf-da/PM!Ommmmmmmm mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh Ommmmmmmm Rmov er_comvebaomri lf_fitOmmmmmmmmii mldl3C1) = 1-ghostsmmm(1)iii=poiiiii #mldl3C2) = 1-ghostsmmm(2)iii=poiiiii #mldl3C3) = 1iii=poiiiii oldu3C1) = max_nodm(1,mlev)+ghostsmmm(1)iii=poiiiii #mldu3C2) = max_nodm(2,mlev)+ghostsmmm(2)iii=poiiiii #mldu3C3) = nsub iii=poiiiii os:( _comri lf(uc_dummy,ldl3,ldu3,Rmov GOTO 999iiii oM. krrs: .NEn h==poiiiii=poiiiii m rrs: er_comerro kfatalOTO 999iiii os:( _comerro ( Fererr_ai lf,'GSsolv',p p&pppppp p&mmmmmmmmiiii Dm p 'uc_dummy',__L--i__ GOTO 9999ENDDDD -- E phM =====9=9 hMFO =====9=9ri isweep=1,nsweeplmmmmmmiii9=9ri colo =0,1iii=poiiiii #mm9ri isub=1,nsub iii=poiiiii ooooootuc=>mgfield(isub,mlev)%uciii=poiiiii oooooouc_dummyC:,:,isub)=tucC:,:)iii=poiiiii ooo hDO!ri isubmOmmmmmmmmmiiii mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_douOmmmmmmmmmiiii mCommunifatlOmmmmmmmmmiiii mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_douOOmmmmmmmmmiiii s:( _commap_field_ghost_get( opoid,pmes_id_g(mlev),&pppppp pp&mmmmmmmmiiii Dm p ghostsmmm GOTO 9999ENDDDDDs:( _commap_field_push( opoid,pmes_id_g(mlev),uc_dummy,&pppppp pp&mmmmmmmmiiii Dm p GOTO 9999ENDDDDDs:( _commap_field_sena( GOTO 9999ENDDDDDs:( _commap_field_pop( opoid,pmes_id_g(mlev),uc_dummy,&pppppp pp&mmmmmmmmiiii Dm p ghostsmmm GOTO 9999ENDDDDD9ri isub=1,nsub iii=poiiiii ooooootuc=>mgfield(isub,mlev)%uciii=poiiiii ooooooi ooooootucC:,:)=uc_dummyC&pppppp &mmmmmmmmiiiiiiiiiiiiiiiii:,:,isub)iii=poiiiii oooori j= (2,isub,mlev),is op(2,isub,mlev)iii=poiiiii ooooooiri i= (1,isub,mlev)+mod(j+colo ,2),&pppppp ppppppppppppppppppp&is op(1,isub,mlev),2mii=poiiiii #mm i oi ooooootucCi,j) = c1*C&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiiiiiiiii(tucCi-1,j)+ &pppppp &mmmmmmmmiiiiiii #mm i oi ooooootucCi+1,j))*c2 +m&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiiiiiii(tucCi,j-1)+&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiiiiiiiitucCi,j+1))*c3-&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiimgfield(isub,mlev)%fcCi,j))iii=poiiiii ooooooioo hDOiii=poiiiii oooooo hDOiii=poiiiii ooo hDO!isubiii=poiiiii oooM. krsweep.EQ.nsweep==poii DmOmmmmmmmmmiiii DMF (colo .EQ.1==poiiiii=poiiiii mm m9ri isub=1,nsub iii=poiiiii ooooootuc=>mgfield(isub,mlev)%uciii=poiiiii oooooouc_dummyC:,:,isub)=tucC:,:)mOmmmmmmmmmiiii Dm hDO DmOmmmmmmmmmiiii D hMFOmmmmmmmm i i D hMFOmmmmmmmm i i hDO!ri colo DmOmmmmmmmmmiiii M. krsweep.EQ.nsweep==poiimii=poiiiii #mmis:( Fermap_field_ghost_get( opoid,pmes_id_g(mlev),&pppppp pp&mmmmmmmmiiii Dm p ghostsmmm GOTO 9999ENDDDDDs:( _commap_field_push( opoid,pmes_id_g(mlev),uc_dummy,&pppppp pp&mmmmmmmmiiii Dm p GOTO 9999ENDDDDDs:( _commap_field_sena( GOTO 9999ENDDDDDs:( _commap_field_pop( opoid,pmes_id_g(mlev),uc_dummy,&pppppp pp&mmmmmmmmiiii Dm p ghostsmmm GOTO 9999ENDDDDD9ri isub=1,nsub iii=poiiiii ooooootuc=>mgfield(isub,mlev)%uciii=poiiiii ooooooi ooooootucC:,:)=uc_dummyC&pppppp &mmmmmmmmiiiiiiiiiiiiiiiii:,:,isub)iii=pooooooooooo hDO D phM =====9=9 hMFO =====9=9 hDO!ri nsweeplmmmmmmiii9=9iRmov er_comvebaomderi lfleh #mPPPPPPPPldl3C1) = 1-ghostsmmm(1)iii=poiiiii #mldl3C2) = 1-ghostsmmm(2)iii=poiiiii #mldl3C3) = 1iii=poiiiii oldu3C1) = max_nodm(1,mlev)+ghostsmmm(1)iii=poiiiii #mldu3C2) = max_nodm(2,mlev)+ghostsmmm(2)iii=poiiiii #mldu3C3) = nsub iii=poiiiii os:( _comri lf(uc_dummy,ldl3,ldu3,Rmov GOTO 999iiii oM. krrs: .NEn h==poiiiii=poiiiii m rrs: er_comerro kfatalOTO 999iiii os:( _comerro ( Fererr_ai lf,'GSsolv',p p&pppppp p&mmmmmmmmiiii Dm p 'uc_dummy',__L--i__ GOTO 9999ENDDDD -- E phM =====9=9 hMFO#elifm__MESH_DIM ==:__3DO mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh dmmmmmmm mImplelf-da/PM!Ommmmmmmm mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh Ommmmmmmm Rmov er_comvebaomri lf_fitOmmmmmmmmii mldl4C1) = 1-ghostsmmm(1)iii=poiiiii #mldl4C2) = 1-ghostsmmm(2)iii=poiiiii #mldl4C3) = 1-ghostsmmm(3)iii=poiiiii #mldl4C4) = 1iii=poiiiii oldu4C1) = max_nodm(1,mlev)+ghostsmmm(1)iii=poiiiii #mldu4C2) = max_nodm(2,mlev)+ghostsmmm(2)iii=poiiiii #mldu4C3) = max_nodm(3,mlev)+ghostsmmm(3)iii=poiiiii #mldu4C4) = nsub iii=poiiiii os:( _comri lf(uc_dummy,ldl4,ldu4,Rmov GOTO 999iiii oM. krrs: .NEn h==poiiiii=poiiiii m rrs: er_comerro kfatalOTO 999iiii os:( _comerro ( Fererr_ai lf,'GSsolv',p p&pppppp p&mmmmmmmmiiii Dm p 'uc_dummy',__L--i__ GOTO 9999ENDDDD -- E phM =====9=9 hMFO =====9=9ri isweep=1,nsweepD phM =====9=ri colo =0,1iii=poiiiii #mm9ri isub=1,nsub iii=poiiiii ooooootuc=>mgfield(isub,mlev)%ucDmOmmmmmmmmmiiii D#mm9ri k=1-ghostsmmm(3),max_nodm(3,mlev)+ghostsmmm(3)iii=poiiiii #mi D#mm9ri j=1-ghostsmmm(2),max_nodm(2,mlev)+ghostsmmm(2)iii=poiiiii #miiii #mm9ri i=1-ghostsmmm(1),max_nodm(1,mlev)+ghostsmmm(1)iii=poiiiii #mmmmmmmmmmmmuc_dummyCR,j,k,isub)=tucCR,j,k)iii=poiiiii #mmmmmmmmmm hDOiii=poiiiii oooooommm hDOiii=poiiiii oooooomm hDOiii=poiiiii ooo hDO!ri isubmOmmmmmmmmmiiii mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_douOmmmmmmmmmiiii mCommunifatlOmmmmmmmmmiiii mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_douOmmmmmmmmiiii s:( Fermap_field_ghost_get( opoid,pmes_id_g(mlev),&pppppp pp&mmmmmmmmiiii Dm p ghostsmmm GOTO 9999ENDDDDDs:( _commap_field_push( opoid,pmes_id_g(mlev),uc_dummy,&pppppp pp&mmmmmmmmiiii Dm p GOTO 9999ENDDDDDs:( _commap_field_sena( GOTO 9999ENDDDDDs:( _commap_field_pop( opoid,pmes_id_g(mlev),uc_dummy,&pppppp pp&mmmmmmmmiiii Dm p ghostsmmm GOTO 9999ENDDDDD9 a=0OTO 9999ENDDDDD9 b=0OTO 9999ENDDDDD9 c=0OTO 9999ENDDDDD9 d=0OTO 9999ENDDDDD9 e=0OTO 9999ENDDDDD9 g=0OTO 9999ENDDDDD9ri isub=1,nsub iii=poiiiii ooooootuc=>mgfield(isub,mlev)%ucDmOmmmmmmmmmiiii D#mm9ri k=1-ghostsmmm(3),max_nodm(3,mlev)+ghostsmmm(3)iii=poiiiii #mi D#mm9ri j=1-ghostsmmm(2),max_nodm(2,mlev)+ghostsmmm(2)iii=poiiiii #miiii #mm9ri i=1-ghostsmmm(1),max_nodm(1,mlev)+ghostsmmm(1)iii=poiiiii #mmmmmmmmmmmmiitucCi,j,k)=uc_dummyCR,j,k,isub)iii=poiiiii #mmmmmmmmmm hDOiii=poiiiii oooooommm hDOiii=poiiiii oooooom hDOiii=poiiiii oooooM. k.NOT.lperiodic==poiiiii=poiiiii mm m99ri ifacm=1,6iii=poiiiii oooooomM. kbcdef_sca(isub,ifacm).EQ._comvebaombcdef_periodic==poiiiii=poiiiii mm m99 mDi NOTHINGmOmmmmmmmmmiiii D#mmELSEM. kbcdef_sca(isub,ifacm).EQ._comvebaombcdef_dirichled==poiiiii=poiiiii mm m99 oM. krfacm.EQ.1==poiiiii=poiiiii mm m99999999a(isub)=1iii=poiiiii #mm9 oooooomM. kbcdef_sca(isub,2).EQ.h==poiiiii=poiiiii m b(isub)=-1DmOmmmmmmmmmiiii D#mm9D#mmE hMFmOmmmmmmmmmiiii D#mm9D#mi=1iii=poiiiii #mm9 oooooomri j=1,max_nodm(2,mlev)iii=poiiiii m ri k=1,max_nodm(3,mlev)mii=poiiiii #mm i oi ooooootucCi,j,k)=0.0_MKmii=poiiiii #mm i oi ooooenadoOmmmmmmmmmiiii D#mm9D#mmE hDOiii=poiiiii oooooommm LSEM. krfacm.EQ.2==poiiiii=poiiiii m b(isub)=1iii=poiiiii #mm9 oooooomM. kbcdef_sca(isub,1).EQ.h==poiiiii=poiiiii m a(isub)=-1DmOmmmmmmmmmiiii D#mm9D#mmE hMFmOmmmmmmmmmiiii D#mm9D#mi=max_nodm(1,mlev)iii=poiiiii #mm9 oooooomri j=1,max_nodm(2,mlev)iii=poiiiii m ri k=1,max_nodm(3,mlev)mii=poiiiii #mm i oi oooootucCi,j,k)=0.0_MKmii=poiiiii #mm i oi ooooE hDOiii=poiiiii oooooommm ooenadoOmmmmmmmmmiiii D#mm9D LSEM. krfacm.EQ.3==poiiiii=poiiiii m c(isub)=1iii=poiiiii #mm9 oooooomM. kbcdef_sca(isub,4).EQ.h==poiiiii=poiiiii m d(isub)=-1DmOmmmmmmmmmiiii D#mm9D#mmE hMFmOmmmmmmmmmiiii D#mm9D#mj=1iii=poiiiii #mm9 oooooomri i=1,max_nodm(1,mlev)iii=poiiiii #mm9 oooooom Do k=1,max_nodm(3,mlev)mii=poiiiii #mm i oi oooootucCi,j,k)=0.0_MKmii=poiiiii #mm i oi ooooenadoOmmmmmmmmmiiii D#mm9D#mmE hDOiii=poiiiii oooooommm LSEM. krfacm.EQ.4==poiiiii=poiiiii m d(isub)=1iii=poiiiii #mm9 oooooomM. kbcdef_sca(isub,3).EQ.h==poiiiii=poiiiii m c(isub)=-1DmOmmmmmmmmmiiii D#mm9D#mmE hMFmOmmmmmmmmmiiii D#mm9D#mj=max_nodm(2,mlev)iii=poiiiii m ri i=1,max_nodm(1,mlev)iii=poiiiii #mm9 oooooom Do k=1,max_nodm(3,mlev)mii=poiiiii #mm i oi oooootucCi,j,k)=0.0_MKmii=poiiiii #mm i oi ooooenadoOmmmmmmmmmiiii D#mm9D#mmE hDOiii=poiiiii oooooommm LSEM. krfacm.EQ.5==phenOmmmmmmmmmiiii D#mm9D#me(isub)=1iii=poiiiii #mm9 oooooomM. kbcdef_sca(isub,6).EQ.h==poiiiii=poiiiii m g(isub)=-1DmOmmmmmmmmmiiii D#mm9D#mmE hMFmOmmmmmmmmmiiii D#mm9D#mk=1iii=poiiiii #mm9 oooooomri i=1,max_nodm(1,mlev)iii=poiiiii #mm9 oooooom Do j=1,max_nodm(2,mlev)iii=poiiiii m otucCi,j,k)=0.0_MKmii=poiiiii #mm i oi ooooenadoOmmmmmmmmmiiii D#mm9D#mmE hDOiii=poiiiii oooooommmD#mm9D#mmELSEM. krfacm.EQ.6==phenOmmmmmmmmmiiii D#mm9D#mg(isub)=1iii=poiiiii #mm9 oooooomM. kbcdef_sca(isub,5).EQ.h==poiiiii=poiiiii m e(isub)=-1DmOmmmmmmmmmiiii D#mm9D#mmE hMFmOmmmmmmmmmiiii D#mm9D#mmk=max_nodm(3,mlev)mii=poiiiii #mm i oi ooooooooooori i=1,max_nodm(1,mlev)mOmmmmmmmmmiiii D#mm9D#mmoooooooooro j=1,max_nodm(2,mlev)iii=poiiiii m otucCi,j,k)=0.0_MKmii=poiiiii #mm i oi ooooooooooooooooenadoOmmmmmmmmmiiii D#mm9D#mmE hDOiii=poiiiii oooooommmD#mm9D#mm enaifooooommmD#mm9D#mm iii=poiiiii ooooooE hMFmOmmmmmmmmmiiii D# hDO!ifacmmOmmmmmmmmmiiii D hMF iii=poiiiii oooooori k= (3,isub,mlev)+e(isub),is op(3,isub,mlev)-g(isub)mOmmmmmmmmmiiii D#mm9Dri j= (2,isub,mlev)+c(isub),is op(2,isub,mlev)-d(isub)iii=poiiiii #mm9 oooooomri i= (1,isub,mlev)+mod(j+k+colo ,2)+a(isub),m&pppppp &mmmmmmmmiiiiiiiiiiiiiis op(1,isub,mlev)-b(isub)-mod(j+k+colo ,2),2mii=poiiiii #mm i oi oooooM. k(i.GE.1.AND.i.LE.max_nodm(1,mlev)).AND.(j.GE.1.AND.j.LE.max_nodm(2,mlev))m&pppppp &mmmmmmmmiiiiiiiiiiiii.AND.(k.GE.1.AND.k.LE.max_nodm(3,mlev))==poiiiii=poiiiii m moldu=tucCR,j,k)iii=poiiiii #mmmmmmmmmmmmmmmmmmtucCR,j,k) = moldu+&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiiiomega*C&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiiic1*C(tucCi-1,j,k)+m&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiitucCi+1,j,k))*c2 +m&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiiiiiii(tucCi,j-1,k)+&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiitucCi,j+1,k))*c3 +m&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiii(tucCR,j,k-1)+&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiitucCR,j,k+1))*c4 -m&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiiiiiii iimgfield(isub,mlev)%fcCi,j,k))&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiii-moldu)mOmmmmmmmmmiiii D#mm9D#mmo hMFOmmmmmmmm i i D#mm9D#mmo hDOiii=poiiiii oooooommm hDOiii=poiiiii oooooo hDOiii=poiiiii ooo hDO!isub#h #iii=poiiiii oooooomM. krsweep.EQ.nsweep==poii Diii=poiiiii mm m99 oM. kcolo .EQ.1==poiiiii=poiiiii mm m999999ri isub=1,nsub iii=poiiiii oooooooooootuc=>mgfield(isub,mlev)%ucDmOmmmmmmmmmiiii D#mm9 m9ri k=1-ghostsmmm(3),max_nodm(3,mlev)+ghostsmmm(3)iii=poiiiii #mi D#mm9 m9ri j=1-ghostsmmm(2),max_nodm(2,mlev)+ghostsmmm(2)iii=poiiiii #miiii #mm9 m9ri i=1-ghostsmmm(1),max_nodm(1,mlev)+ghostsmmm(1)iii=poiiiii #mmmmmmmmmmmmiiuc_dummyCR,j,k,isub)=tucCR,j,k)iii=poiiiii #mmmmmmmmmm mmE hDOiii=poiiiii oooooommmD#mE hDOiii=poiiiii oooooommmD#E hDOiiii=poiiiii oooooommm hDO!isubiii=poiiiii ooooommm hMFOmmmmmmmm i i D#mm hMFOmmmmmmmm i hDO!ri colo Ommmmmmmm i i DM. krsweep.EQ.nsweep==poiimii=poiiiii #mmi s:( Fermap_field_ghost_get( opoid,pmes_id_g(mlev),&pppppp pp&mmmmmmmmiiii Dm p ghostsmmm GOTO 9999ENDDDDDDDs:( _commap_field_push( opoid,pmes_id_g(mlev),uc_dummy,&pppppp pp&mmmmmmmmiiii Dm p GOTO 9999ENDDDDDDDs:( _commap_field_sena( GOOTO 9999ENDDDDDDDs:( _commap_field_pop( opoid,pmes_id_g(mlev),uc_dummy,&pppppp pp&mmmmmmmmiiii Dm p ghostsmmm GOTO 9999ENDDDDD9 hMFOmmmmmmmm i i Dri isub=1,nsub iii=poiiiii ooooootuc=>mgfield(isub,mlev)%ucDmOmmmmmmmmmiiii D#mm9ri k=1-ghostsmmm(3),max_nodm(3,mlev)+ghostsmmm(3)iii=poiiiii #mi D#mm9ri j=1-ghostsmmm(2),max_nodm(2,mlev)+ghostsmmm(2)iii=poiiiii #miiii #mm9ri i=1-ghostsmmm(1),max_nodm(1,mlev)+ghostsmmm(1)iii=poiiiii #mmmmmmmmmmmmiitucCi,j,k)=uc_dummyCR,j,k,isub)iii=poiiiii #mmmmmmmmmm hDOiii=poiiiii oooooommm hDOiii=poiiiii oooooom hDOiii=poiiiii ooo hDO!isubiii=poiiii hDO!ro isweepiii=poiiiii oRmov er_comvebaomderi lfleh #mPPPPPPPPldl4C1) = 1-ghostsmmm(1)iii=poiiiii #mldl4C2) = 1-ghostsmmm(2)iii=poiiiii #mldl4C3) = 1-ghostsmmm(3)iii=poiiiii #mldl4C4) = 1iii=poiiiii oldu4C1) = max_nodm(1,mlev)+ghostsmmm(1)iii=poiiiii #mldu4C2) = max_nodm(2,mlev)+ghostsmmm(2)iii=poiiiii #mldu4C3) = max_nodm(3,mlev)+ghostsmmm(3)iii=poiiiii #mldu4C4) = nsub iii=poiiiii os:( _comri lf(uc_dummy,ldl4,ldu4,Rmov GOTO 999iiii oM. krrs: .NEn h==poiiiii=poiiiii m rrs: er_comerro kfatalOTO 999iiii os:( _comerro ( Fererr_ai lf,'GSsolv',p p&pppppp p&mmmmmmmmiiiiiiiiiiiiiii'uc_dummy',__L--i__ GOTO 9999ENDDDD -- E phM =====9=9 hMFO#enaifO#elifm__DIM ==:__VFIELDl#ifmm__MESH_DIM ==:__2DOmmmmmmmm mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh dmmmmmmm mImplelf-da/PM!Ommmmmmmm mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh Ommmmmmmm Rmov er_comvebaomri lf_fitOmmmmmmmmii Pldl4C1) = 1iii=poiiiii #mldl4C2) = 1-ghostsmmm(1)iii=poiiiii #mldl4C3) = 1-ghostsmmm(2)iii=poiiiii #mldl4C4) = 1iii=poiiiii oldu4C1) = vecdimiii=poiiiii #mldu4C2) = max_nodm(1,mlev)+ghostsmmm(1)iii=poiiiii #mldu4C3) = max_nodm(2,mlev)+ghostsmmm(2)iii=poiiiii #mldu4C4) = nsub iii=poiiiii os:( _comri lf(uc_dummy,ldl4,ldu4,Rmov GOTO 999iiii oM. krrs: .NEn h==poiiiii=poiiiii m rrs: er_comerro kfatalOTO 999iiii os:( _comerro ( Fererr_ai lf,'GSsolv',p p&pppppp p&mmmmmmmmiiiiiiiiiiiiiii'uc_dummy',__L--i__ GOTO 9999999999 -- E phM =====9=9 hMFO =====9=9ri isweep=1,nsweeplmmmmmmiii9=9ri colo =0,1iii=poiiiii #mm9ri isub=1,nsub iii=poiiiii ooooootuc=>mgfield(isub,mlev)%uciii=poiiiii oooooouc_dummyC:,:,:,isub)=tucC:,:,:)iii=poiiiii ooo hDO!ri isubmOmmmmmmmmmiiii mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_douOmmmmmmmmmiiii mCommunifatlmOmmmmmmmmmiiii mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_douOmmmmmmmmmiiii s:( Fermap_field_ghost_get( opoid,pmes_id_g(mlev),&pppppp pp&mmmmmmmmiiii Dm p ghostsmmm GOTO 9999ENDDDDDs:( _commap_field_push( opoid,pmes_id_g(mlev),uc_dummy,&pppppp pp&mmmmmmmmiiii Dm p vecdim GOTO 9999ENDDDDDs:( _commap_field_sena( GOTO 9999ENDDDDDs:( _commap_field_pop( opoid,pmes_id_g(mlev),uc_dummy,&pppppp pp&mmmmmmmmiiii Dm p vecdim ghostsmmm GOTO 9999ENDDDDD9ri isub=1,nsub iii=poiiiii ooooootuc=>mgfield(isub,mlev)%uciii=poiiiii ooooootucC:,:,:)=uc_dummyC&pppppp &mmmmmmmmiiiiiiiiiiiiiiiii:,:,:,isub)iii=poiiiii oooooori j= (2,isub,mlev),is op(2,isub,mlev)iii=poiiiii ooooooioiri i= (1,isub,mlev)+mod(j+colo ,2),is op(1,isub,mlev),2mii=poiiiii #mm i oi ori ilda=1,vecdimiii=poiiiii #moiiiii ooooootucCRlda,i,j) = c1*C&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiiiiiiiii(tucCilda,i-1,j)+ &pppppp &mmmmmmmmiiiiiii #mm i oi ooooootucCilda,i+1,j))*c2 +m&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiiiiiii(tucCilda,i,j-1)+&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiiiiiiiitucCilda,i,j+1))*c3-&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiimgfield(isub,mlev)%fcCilda,i,j))iii=poiiiii #mmmmmmmmmm hDODmOmmmmmmmmmiiii D#mm9 hDOiii=poiiiii oooooo hDOiii=poiiiii ooo hDOOmmmmmmmmmiiii D#mm9M. krsweep.EQ.nsweep==poiimii=poiiiii #mmi D#mm9M. kcolo .EQ.1==poiiiii=poiiiii mm m999999ri isub=1,nsub iii=poiiiii oooooooooootuc=>mgfield(isub,mlev)%uciii=poiiiii ooooooooooouc_dummyC:,:,:,isub)=tucC:,:,:)iii=poiiiii oooii ooo hDOOmmmmmmmmmiiii D#mm9o hMFOmmmmmmmm i i D#mm9D hMFO =====9=9 hDO!ri colo DmOmmmmmmmmmiiii M. krsweep.EQ.nsweep==poiimii=poiiiii #mms:( Fermap_field_ghost_get( opoid,pmes_id_g(mlev),&pppppp pp&mmmmmmmmiiii Dm p ghostsmmm GOTO 9999ENDDDDDs:( _commap_field_push( opoid,pmes_id_g(mlev),uc_dummy,&pppppp pp&mmmmmmmmiiii Dm p vecdim GOTO 9999ENDDDDDs:( _commap_field_sena( GOTO 9999ENDDDDDs:( _commap_field_pop( opoid,pmes_id_g(mlev),uc_dummy,&pppppp pp&mmmmmmmmiiii Dm p vecdim ghostsmmm GOTO 9999ENDDDDD9ri isub=1,nsub iii=poiiiii ooooootuc=>mgfield(isub,mlev)%uciii=poiiiii ooooootucC:,:,:)=uc_dummyC&pppppp &mmmmmmmmiiiiiiiiiiiiiiiii:,:,:,isub)iii=poiiiii ooo hDOOmmmmmmmmmiiii hMF iii=poiiii hDO!ri nsweeplmmmmmmiii9=9iRmov er_comvebaomderi lfleh #mPPPPPPPPldl4C1) = 1iii=poiiiii #mldl4C2) = 1-ghostsmmm(1)iii=poiiiii #mldl4C3) = 1-ghostsmmm(2)iii=poiiiii #mldl4C4) = 1iii=poiiiii oldu4C1) = vecdimiii=poiiiii #mldu4C2) = max_nodm(1,mlev)+ghostsmmm(1)iii=poiiiii #mldu4C3) = max_nodm(2,mlev)+ghostsmmm(2)iii=poiiiii #mldu4C4) = nsub iii=poiiiii os:( _comri lf(uc_dummy,ldl4,ldu4,Rmov GOTO 999iiii oM. krrs: .NEn h==poiiiii=poiiiii m rrs: er_comerro kfatalOTO 999iiii os:( _comerro ( Fererr_ai lf,'GSsolv',p p&pppppp p&mmmmmmmmiiiiiiiiiiiiiii'uc_dummy',__L--i__ GOTO 9999ENDDDD -- E phM =====9=9 hMFO#elifm__MESH_DIM ==:__3DO mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh dmmmmmmm mImplelf-da/PM!Ommmmmmmm mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh Ommmpoiiiii m rmov er_comvebaomri lf_fitOmmmmmmmmii Pldl5C1) = 1iii=poiiiii #mldl5C2) = 1-ghostsmmm(1)iii=poiiiii #mldl5C3) = 1-ghostsmmm(2)iii=poiiiii #mldl5C4) = 1-ghostsmmm(3)iii=poiiiii #mldl5C5) = 1iii=poiiiii oldu5C1) = vecdimiii=poiiiii #mldu5C2) = max_nodm(1,mlev)+ghostsmmm(1)iii=poiiiii #mldu5C3) = max_nodm(2,mlev)+ghostsmmm(2)iii=poiiiii #mldu5C4) = max_nodm(3,mlev)+ghostsmmm(3)iii=poiiiii #mldu5C5) = nsub iii=poiiiii os:( _comri lf(uc_dummy,ldl5,ldu5,Rmov GOTO 999iiii oM. krrs: .NEn h==poiiiii=poiiiii m rrs: er_comerro kfatalOTO 999iiii os:( _comerro ( Fererr_ai lf,'GSsolv',p p&pppppp p&mmmmmmmmiiiiiiiiiiiiiii'uc_dummy',__L--i__ GOTO 9999ENDDDD -- E phM =====9=9 hMFOi=poiiiii m rmov er_comvebaomri lf_fitOmmmmmmmmii ldu1C1)=vecdimiii=poiiiii #s:( _comri lf(moldu,ldu1,Rmov GOTO 999iiii M. krrs: .NEn h==poiiiii=poiiiii m rrs: er_comerro kfatalOTO 999iiii os:( _comerro ( Fererr_ai lf,'GSsolv',p p&pppppp p&mmmmmmmmiiiiiiiiiiiiiii'moldu',__L--i__ GOTO 9999ENDDDD -- E phM =====9= hMFO =====9=9ri isweep=1,nsweepD phM =====9=ri colo =0,1iii=poiiiii #mmri isub=1,nsub iii=poiiiii oooooomlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_iii=poiiiii oooooomImpemplboundarissPmmmmmmm iii oooooomlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_iii=poiiiii ooooootuc=>mgfield(isub,mlev)%uciii=poiiiii oooooori k=1-ghostsmmm(3),max_nodm(3,mlev)+ghostsmmm(3)iii=poiiiii #mi D#mmri j=1-ghostsmmm(2),max_nodm(2,mlev)+ghostsmmm(2)iii=poiiiii #miiii #mm9ri i=1-ghostsmmm(1),max_nodm(1,mlev)+ghostsmmm(1)i#ifdefm__VECTORiii=poiiiii #moiiiii ooouc_dummyC1,R,j,k,isub)=tucC1,R,j,k)iii=poiiiii #mmmmmmmmmmmmuc_dummyC2,R,j,k,isub)=tucC2,R,j,k)iii=poiiiii #mmmmmmmmmmmmuc_dummyC3,R,j,k,isub)=tucC3,R,j,k)i#else mmmmmm iiii #miiii #mm9ri ilda=1,vecdimmOmmmmmmmmmiiii D#mm9D#mmuc_dummyCRlda,i,j,k,isub)=tucCRlda,i,j,k)iii=poiiiii #mmmmmmmmmmm hDODO#enaifOmmmmmmmm mmmmmmmmm hDOOmmmmmmmmmiiii D#mm9 hDOiii=poiiiii oooooomm hDODOiiiii oooooomm hDO!ri isubmOmmmmmmmmmiiii mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_douOmmmmmmmmmiiii mCommunifatlmOmmmmmmmmmiiii mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_douOmmmmmmmmmiiii s:( Fermap_field_ghost_get( opoid,pmes_id_g(mlev),&pppppp pp&mmmmmmmmiiii Dm p ghostsmmm GOTO 9999ENDDDDDDs:( _commap_field_push( opoid,pmes_id_g(mlev),uc_dummy,&pppppp pp&mmmmmmmmiiii Dm p vecdim GOTO 9999ENDDDDDDs:( _commap_field_sena( GOTO 9999ENDDDDDDs:( _commap_field_pop( opoid,pmes_id_g(mlev),uc_dummy,&pppppp pp&mmmmmmmmiiii Dm p vecdim ghostsmmm GOTO 9999ENDDDDD9 a=0OTO 9999ENDDDDD9 b=0OTO 9999ENDDDDD9 c=0OTO 9999ENDDDDD9 d=0OTO 9999ENDDDDD9 e=0OTO 9999ENDDDDD9 g=0OTO 9999ENDDDDD9ri isub=1,nsub iii=poiiiii ooooootuc=>mgfield(isub,mlev)%uciii=poiiiii #mi D#mmri k=1-ghostsmmm(3),max_nodm(3,mlev)+ghostsmmm(3)iii=poiiiii #mi D#mm9ri j=1-ghostsmmm(2),max_nodm(2,mlev)+ghostsmmm(2)iii=poiiiii #miiii #mm9ri i=1-ghostsmmm(1),max_nodm(1,mlev)+ghostsmmm(1)i#ifdefm__VECTORiii=poiiiii #moiiiii oooootucC1,R,j,k)=uc_dummyC1,R,j,k,isub)iii=poiiiii #moiiiii oooootucC2,R,j,k)=uc_dummyC2,R,j,k,isub)iii=poiiiii #moiiiii oooootucC3,R,j,k)=uc_dummyC3,R,j,k,isub)i#else mmmmmm iiii #miiii #mm9ri ilda=1,vecdimmOmmmmmmmmmiiii D#mm9D#mmiitucCilda,i,j,k)=uc_dummyCRlda,i,j,k,isub)iii=poiiiii #mmmmmmmmmmm hDOO#enaifOmmmmmmmm mmmmmmmmm hDOOmmmmmmmmmiiii D#mm9 hDOiii=poiiiii oooooom hDOiii=poiiiii oooooDODmilda=1,vecdimiii=poiiiii #moiiiiM. k.NOT.lperiodic==poiiiii=poiiiii mm m9999ri ifacm=1,6iii=poiiiii oooooommM. kbcdef_vecCRlda,isub,ifacm).EQ._comvebaombcdef_periodic==poiiiii=poiiiii mm m99 mDi NOTHINGiii=poiiiii oooooomm LSEM. kbcdef_vecCRlda,isub,ifacm).EQ._comvebaombcdef_dirichled==poiiiii=poiiiii mm m99 ooM. krfacm.EQ.1==poiiiii=poiiiii mm m99999999a(isub)=1iii=poiiiii #mm9 oooooomM. kbcdef_vecCRlda,isub,2).EQ.h==poiiiii=poiiiii m b(isub)=-1iii=poiiiii m hMFOmmmmmmmm i i D#mm9D#mmoi=1iii=poiiiii #mm9 oooooomri j=1,max_nodm(2,mlev)iii=poiiiii m ri k=1,max_nodm(3,mlev)mii=poiiiii #mm i oi ooooooiitucCilda,i,j,k)=0.0_MKmii=poiiiii #mm i oi oooooE hDOiii=poiiiii oooooommmD#mE hDOiii=poiiiii oooooommm LSEM. krfacm.EQ.2==poiiiii=poiiiii m b(isub)=1iii=poiiiii #mm9 oooooomM. kbcdef_vecCRlda,isub,1).EQ.h==poiiiii=poiiiii m a(isub)=-1iii=poiiiii m hMFOmmmmmmmm i i D#mm9D#mmi=max_nodm(1,mlev)iii=poiiiii #mm9 oooooomri j=1,max_nodm(2,mlev)iii=poiiiii m ri k=1,max_nodm(3,mlev)mii=poiiiii #mm i oi ooooooitucCilda,i,j,k)=0.0_MKmii=poiiiii #mm i oi oooooE hDOiii=poiiiii oooooommmD#mE hDOiii=poiiiii oooooommm LSEM. krfacm.EQ.3==poiiiii=poiiiii m c(isub)=1iii=poiiiii #mm9 oooooomM. kbcdef_vecCRlda,isub,4).EQ.h==poiiiii=poiiiii m d(isub)=-1iii=poiiiii m hMFOmmmmmmmm i i D#mm9D#mmj=1iii=poiiiii #mm9 oooooomri i=1,max_nodm(1,mlev)iii=poiiiii #mm9 oooooom Do k=1,max_nodm(3,mlev)mii=poiiiii #mm i oi oooooooootucCilda,i,j,k)=0.0_MKmmii=poiiiii #mm i oi ooooenadoOmmmmmmmmmiiii D#mm9D#mmE hDOiii=poiiiii oooooommm LSEM. krfacm.EQ.4==poiiiii=poiiiii m d(isub)=1iii=poiiiii #mm9 oooooomM. kbcdef_vecCRlda,isub,3).EQ.h==poiiiii=poiiiii m c(isub)=-1iii=poiiiii m hMFOmmmmmmmm i i D#mm9D#mmj=max_nodm(2,mlev)iii=poiiiii m ri i=1,max_nodm(1,mlev)iii=poiiiii #mm9 oooooom Do k=1,max_nodm(3,mlev)mii=poiiiii #mm i oi oooooooootucCilda,i,j,k)=0.0_MKmii=poiiiii #mm i oi ooooenadoOmmmmmmmmmiiii D#mm9D#mmE hDOiii=poiiiii oooooommm LSEM. krfacm.EQ.5==phenOmmmmmmmmmiiii D#mm9D#me(isub)=1iii=poiiiii #mm9 ooooooM. kbcdef_vecCRlda,isub,6).EQ.h==poiiiii=poiiiii m g(isub)=-1iii=poiiiii #mmmmmmmmmmm hMFOmmmmmmmm i i D#mm9D#mmk=1iii=poiiiii #mm9 oooooomri i=1,max_nodm(1,mlev)iii=poiiiii #mm9 oooooom mri j=1,max_nodm(2,mlev)iii=poiiiii m oitucCilda,i,j,k)=0.0_MKmii=poiiiii #mm i oi oooooE hDOiii=poiiiii oooooommmD#mE hDOiii=poiiiii oooooommmmELSEM. krfacm.EQ.6==poiiiii=poiiiii m g(isub)=1iii=poiiiii #mm9 oooooomM. kbcdef_vecCRlda,isub,5).EQ.h==poiiiii=poiiiii m e(isub)=-1iii=poiiiii m hMFOmmmmmmmm i i D#mm9D#mmok=max_nodm(3,mlev)mii=poiiiii #mm i oi ooori i=1,max_nodm(1,mlev)iii=poiiiii #mm9 oooooom Do j=1,max_nodm(2,mlev)iii=poiiiii m o oitucCilda,i,j,k)=0.0_MKmii=poiiiii #mm i oi ooooE hDOiii=poiiiii oooooommmD#mE hDOiii=poiiiii oooooommmmE hMFOmmmmmmmm i i D#mm hMFOmmmmmmmm i mmmD#mE hDO!facmOmmmmmmmm i mmmD# hMFOmmmmmmmm i mmmD# hDO!ildaiii=poiiiii oooooori k= (3,isub,mlev)+e(isub),is op(3,isub,mlev)-g(isub)mmOmmmmmmmmmiiii D#mm9Dri j= (2,isub,mlev)+c(isub),is op(2,isub,mlev)-d(isub)iii=poiiiii #mm9 oooooomri i= (1,isub,mlev)+mod(j+k+colo ,2)+a(isub),m&pppppp &mmmmmmmmiiiiiiiiiis op(1,isub,mlev)-b(isub)-mod(j+k+colo ,2),2mii=poiiiii #mm i oi ooooM. k(i.GE.1.AND.i.LE.max_nodm(1,mlev)).AND.(j.GE.1.AND.j.LE.max_nodm(2,mlev))m&pppppp &mmmmmmmmiiiiiiiiiiii.AND.(k.GE.1.AND.k.LE.max_nodm(3,mlev))==poiii#ifdefm__VECTORiii=poiiiii #moiiiii oooomolduC1) = tucC1,R,j,k)iii=poiiiii #mmmmmmmmmmmmomolduC2) = tucC2,R,j,k)iii=poiiiii #mmmmmmmmmmmmomolduC3) = tucC3,R,j,k)i#else mmmmmm iiii #miiii #mmdo ilda=1,vecdimiii=poiiiii #moiiiii oooomolduCilda) = tucCRlda,i,j,k)iii=poiiiii #mmmmmmmmmmenamdoO#enaifO#ifdefm__VECTORiii=poiiiii #moiiiii oooooooootucC1,R,j,k) = moldu(1)+&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiiiomega*C& pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiiic1*C(tucC1,i-1,j,k)+m&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiitucC1,i+1,j,k))*c2 +m&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiiiiiii(tucC1,i,j-1,k)+&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiitucC1,i,j+1,k))*c3 +m&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiii(tucC1,R,j,k-1)+&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiitucC1,R,j,k+1))*c4 -m&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiimgfield(isub,mlev)%fcC1,R,j,k))&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiii-moldu(1))mii=poiiiii #mm i oi oooooooootucC2,R,j,k) = moldu(2)+&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiiiomega*C& pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiiic1*C(tucC2,i-1,j,k)+m&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiitucC2,i+1,j,k))*c2 +m&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiiiiiii(tucC2,i,j-1,k)+&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiitucC2,i,j+1,k))*c3 +m&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiii(tucC2,R,j,k-1)+&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiitucC2,R,j,k+1))*c4 -m&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiimgfield(isub,mlev)%fcC2,R,j,k))&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiii-moldu(2))mii=poiiiii #mm i oi oooooooootucC3,R,j,k) = moldu(3)+&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiiiomega*C& pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiiic1*C(tucC3,i-1,j,k)+m&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiitucC3,i+1,j,k))*c2 +m&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiiiiiii(tucC3,i,j-1,k)+&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiitucC3,i,j+1,k))*c3 +m&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiii(tucC3,R,j,k-1)+&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiitucC3,R,j,k+1))*c4 -m&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiimgfield(isub,mlev)%fcC3,R,j,k))&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiii-moldu(3))i#else mmmmmm iiii #miiii #mmri ilda=1,vecdimiii=poiiiii #moiiiii oooooo oitucCilda,i,j,k) = moldu(ilda)+&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiiiomega*C& pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiiic1*C(tucCilda,i-1,j,k)+m&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiitucCilda,i+1,j,k))*c2 +m&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiiiiiii(tucCilda,i,j-1,k)+&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiitucCilda,i,j+1,k))*c3 +m&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiii(tucCRlda,i,j,k-1)+&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiitucCRlda,i,j,k+1))*c4 -m&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiiimgfield(isub,mlev)%fcCilda,i,j,k))&pppppp &mmmmmmmmiiiiiiiiiiiiiiiiiiii-moldu(ilda))iii=poiiiii #mmmmmmmmmm mmE hDO!ildai#enaifOmmmmmmmm mmmmmmmmmmo hMFOmmmmmmmm i i D#mm9D#mmo hDO!iiii=poiiiii oooooommm hDO!jOmmmmmmmm i i D#mm hDO!kOmmmmmmmm i i D hDO!isub#h #iii=poiiiii oooooomM. krsweep.EQ.nsweep==poiiiii=poiiiii oooooommM. kcolo .EQ.1==poiiiii=poiiiii mm m99999ri isub=1,nsub iii=poiiiii oooooooooootuc=>mgfield(isub,mlev)%uciii=poiiiii ooooooooooori k=1-ghostsmmm(3),max_nodm(3,mlev)+ghostsmmm(3)iii=poiiiii #mi D#mm9 m99ri j=1-ghostsmmm(2),max_nodm(2,mlev)+ghostsmmm(2)iii=poiiiii #miiii #mm9 m9m9ri i=1-ghostsmmm(1),max_nodm(1,mlev)+ghostsmmm(1)iii=poiiiii #mmmmmmmmmmmmii m9ri ilda=1,vecdimmOmmmmmmmmmiiii D#mm9D#mmiiiiiiiiiuc_dummyCRlda,i,j,k,isub)=tucCRlda,i,j,k)iii=poiiiii #mmmmmmmmmmmmmmmmm hDODOiiiii oooooommmmmmmmmmmmmm hDOmii=poiiiii #mm i oi ooooE hDOiii=poiiiii oooooommmD# hDODOiiiii oooooommmmmmmm hDO!isubmmmmmii=poiiiii #mm i oi hMFOmmmmmmmm i i D#mm9 hMF iii=poiiiii hDO!ri colo Ommmmmmmm iM. krsweep.EQ.nsweep==poiimii=poiiiii #mms:( Fermap_field_ghost_get( opoid,pmes_id_g(mlev),&pppppp pp&mmmmmmmmiiii Dm p ghostsmmm GOTO 9999ENDDDDDs:( _commap_field_push( opoid,pmes_id_g(mlev),uc_dummy,&pppppp pp&mmmmmmmmiiii Dm p vecdim GOTO 9999ENDDDDDs:( _commap_field_sena( GOTO 9999ENDDDDDs:( _commap_field_pop( opoid,pmes_id_g(mlev),uc_dummy,&pppppp pp&mmmmmmmmiiii Dm p vecdim ghostsmmm GOTO 9999ENDDDDD99999ri isub=1,nsub DOiiiii oooooommmmmmmtuc=>mgfield(isub,mlev)%uciii=poiiiii #mi D#mmri k=1-ghostsmmm(3),max_nodm(3,mlev)+ghostsmmm(3)iii=poiiiii #mi D#mm9ri j=1-ghostsmmm(2),max_nodm(2,mlev)+ghostsmmm(2)iii=poiiiii #miiii #mm9ri i=1-ghostsmmm(1),max_nodm(1,mlev)+ghostsmmm(1)immmmmiiii Dm p ri ilda=1,vecdimmOmmmmmmmmmiiii D#mm9D#mmiitucCilda,i,j,k)=uc_dummyCRlda,i,j,k,isub)iii=poiiiii #mmmmmmmmmmm hDOOi=poiiiii #mmmmmmmmmmm hDOOi=poiiiii #mmmmmmmmmm hDOiii=poiiiii oooooomm hDOiii=poiiiii ooooomm hDOiii=poiiiii hMFOmmmmmmmm hDO!ro isweepiii=poiiiii oRmov er_comvebaomderi lfleh #mPPPPPPPPldl5C1) = 1iii=poiiiii #mldl5C2) = 1-ghostsmmm(1)iii=poiiiii #mldl5C3) = 1-ghostsmmm(2)iii=poiiiii #mldl5C4) = 1-ghostsmmm(3)iii=poiiiii #mldl5C5) = 1iii=poiiiii oldu5C1) = vecdimiii=poiiiii #mldu5C2) = max_nodm(1,mlev)+ghostsmmm(1)iii=poiiiii #mldu5C4) = max_nodm(2,mlev)+ghostsmmm(2)iii=poiiiii #mldu5C4) = max_nodm(3,mlev)+ghostsmmm(3)iii=poiiiii #mldu5C5) = nsub iii=poiiiii os:( _comri lf(uc_dummy,ldl5,ldu5,Rmov GOTO 999iiii oM. krrs: .NEn h==poiiiii=poiiiii m rrs: er_comerro kfatalOTO 999iiii os:( _comerro ( Fererr_ai lf,'GSsolv',p p&pppppp p&mmmmmmmmiiiiiiiiiiiiiii'uc_dummy',__L--i__ GOTO 9999ENDDDD -- E phM =====9=9 hMFOi=poiiiii m rmov er_comvebaomderi lfleh #mPPPPPPPldu1C1)=vecdimiii=poiiiii #s:( _comri lf(moldu,ldu1,Rmov GOTO 999iiii M. krrs: .NEn h==poiiiii=poiiiii m rrs: er_comerro kfatalOTO 999iiii os:( _comerro ( Fererr_ai lf,'GSsolv',p p&pppppp p&mmmmmmmmiiiiiiiiiiiiiii'moldu',__L--i__ GOTO 9999ENDDDD -- E phM =====9= hMFO#enaifO#enaifOmmmmmmmm mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh Ommmpoiiii! Return Ommmmmmmm mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh Om i osONTINUEOmmmmmmmm s:( sub op('ad_fpg_smooth_coarse',t0 GOTO 9999ENRETURN m#ifm__DIM ==:__SFIELDl#ifmmm__MESH_DIM ==:__2DO#ifmmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmm h SUBROUTINE ad_fpg_smooth_coarse_2D_sca_sm#elifmm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmm h SUBROUTINE ad_fpg_smooth_coarse_2D_sca_dm#enaifO#elifm__MESH_DIM ==:__3DO#ifmmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmm h SUBROUTINE ad_fpg_smooth_coarse_3D_sca_sm#elifmm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmm h SUBROUTINE ad_fpg_smooth_coarse_3D_sca_dm#enaifO#enaifO#elifm__DIM ==:__VFIELDl#ifmmm__MESH_DIM ==:__2DO#ifmmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmm h SUBROUTINE ad_fpg_smooth_coarse_2D_vec_sm#elifmm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmm h SUBROUTINE ad_fpg_smooth_coarse_2D_vec_dm#enaifO#elifm__MESH_DIM ==:__3DO#ifmmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmm h SUBROUTINE ad_fpg_smooth_coarse_3D_vec_sm#elifmm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmm h SUBROUTINE ad_fpg_smooth_coarse_3D_vec_dm#enaifO#enaifO#enaifOlibad_numerics-r1036/src/ad_fpodule_fdsolve kfinalmmm.f0000644000175000017500000000523011616214647022232 0u omaromarmmmmm mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h Ommmpoi! Modulemmmmmm : ad_fpodule_fdsolve kfinalmmm mmmmm mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h Ommmpoi!Ommmpoi! Purpemplmmmm : This podule rrcludes the source code for field solve Ommmpoi! routines.Ommmpoi!Ommmpoi! Remarkslmmmm :Ommmpoi!Ommmpoi! Referencesmm :Ommmpoi!Ommmpoi! Revisionsmmm :Ommmpoi!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h Ommmpoi!Ommmpoi!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h Ommmpoi! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), Ommmpoi! Cente for Fluid Dynamics (DTU)Ommmpoi!Ommmpoi!Ommmpoi! This file rs vebt of the Peballel Pebticle Mesh Library (PPM).Ommmpoi!Ommmpoi! PPM rs free software: you can redistribute rt and/or podifyOmmmpoi! rt unde the te ms of the GNU Lesse Genebal Public License Ommmpoi! as vublished by the Free Software Founda/PM!, eithe Ommmpoi! ve sion 3 of the License, or (at your movion) any late Ommmpoi! ve sion.Ommmpoi!Ommmpoi! PPM rs distributed rr the hope that rt will be useful,Ommmpoi! but WITHOUT ANY WARRANTY; without ever the implied warranty ofOmmmpoi! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSEn See thm mmmmm m GNU Genebal Public License for pore details.Ommmpoi!Ommmpoi! You should have received a copy of the GNU Genebal Public LicenseOmmmpoi! and the GNU Lesse Genebal Public License along with PPM. If not,Ommmpoi! see .Ommmpoi!Ommmpoi! Peballel Pebticle Mesh Library (PPM)Ommmpoi! ETH ZurichOmmmpoi! CH-8092 Zurich, Switzerland Ommmpoi!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h OmmmpoOmmmpoi!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h Ommmpoi! Define typesOmmmpoi!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h O#define __SINGLE_PRECI!c_O 1O#define __DOUBLE_PRECI!c_O 2 poiMODULE ad_fpodule_fdsolve kfinalmmm Ommmmmmmm mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh Ommmmmmmm m Define inte facmmto ad_ffdsolve kfinalmmm mmmmm mm mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh Ommmmmmmm INTERFACE ad_ffdsolve kfinalmmm mmmmm mm poiMODULE PROCEDURE ad_ffdsolve kfinalmmm mmmmm mm h INTERFACEOmmmmmmmm mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh Ommmmmmmm m rrclude the source Ommmmmmmm mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh Ommmmmmmm sONTAINS #rrclude "ad_ffdsolve kfinalmmm.f" Ommmmmm h MODULE ad_fpodule_fdsolve kfinalmmm libad_numerics-r1036/src/ad_fpodule_bem_basis.f0000644000175000017500000000570711616214647020462 0u omaromarmmmpoi!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h Ommmpoi! Modulemmmmmm : ad_fpodule_bem_basis mmmmm mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h Ommmpoi!Ommmpoi! Purpemplmmmm : bem poduleOmmmpoi!Ommmpoi! Remarkslmmmm : Ommmpoi!Ommmpoi! Referencesmm : Ommmpoi!Ommmpoi! Revisionsmmm :Ommmpoi!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h Ommmpoi! $Log: ad_fpodule_bem_basis.f,v $Ommmpoi! Revision 1.1.1.1 2007/07/13 10:18:57 rvosOmmmpoi! CBL ve sion of the PPM libraryOmmmpoi!Ommmpoi! Revision 1.1 2004/07/26 07:29:24 rvosOmmmpoi! First commrt afte spitting the old podules into single-inte facmOmmmpoi! units.Ommmpoi!Ommmpoi!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h Ommmpoi! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), Ommmpoi! Cente for Fluid Dynamics (DTU)Ommmpoi!Ommmpoi!Ommmpoi! This file rs vebt of the Peballel Pebticle Mesh Library (PPM).Ommmpoi!Ommmpoi! PPM rs free software: you can redistribute rt and/or podifyOmmmpoi! rt unde the te ms of the GNU Lesse Genebal Public License Ommmpoi! as vublished by the Free Software Founda/PM!, eithe Ommmpoi! ve sion 3 of the License, or (at your movion) any late Ommmpoi! ve sion.Ommmpoi!Ommmpoi! PPM rs distributed rr the hope that rt will be useful,Ommmpoi! but WITHOUT ANY WARRANTY; without ever the implied warranty ofOmmmpoi! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSEn See thm mmmmm m GNU Genebal Public License for pore details.Ommmpoi!Ommmpoi! You should have received a copy of the GNU Genebal Public LicenseOmmmpoi! and the GNU Lesse Genebal Public License along with PPM. If not,Ommmpoi! see .Ommmpoi!Ommmpoi! Peballel Pebticle Mesh Library (PPM)Ommmpoi! ETH ZurichOmmmpoi! CH-8092 Zurich, Switzerland Ommmpoi!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h OOmmmpoi!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h Ommmpoi! Define da/a typesOmmmpoi!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h O#define __SINGLE_PRECI!c_O 1O#define __DOUBLE_PRECI!c_O 2OOmmmpoiMODULE ad_fpodule_bem_basis Ommmmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -Ommmmmmmm! Define inte facmmto ad_fbem_basis mmmmm mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -OmmmmmmmmINTERFACE ad_fbem_basis mmmmm mm oiMODULE PROCEDURE ad_fbem_basis_s mmmmm mm oiMODULE PROCEDURE ad_fbem_basis_d mmmmm mm h INTERFACEOOmmmmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -Ommmmmmmm! Irclude the sources mmmmm mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -OmmmmmmmmsONTAINS #define __KI=p __SINGLE_PRECI!c_O #rrclude "ad_fbem_basis.f" #undef __KI=p #define __KI=p __DOUBLE_PRECI!c_O #rrclude "ad_fbem_basis.f" #undef __KI=p mmm mm h MODULE ad_fpodule_bem_basis libad_numerics-r1036/src/ad_fodemmap_pop.f0000644000175000017500000002451511616214647017451 0u omaromarmmmpoi!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h Ommmpoi! Subroutine m : ad_fodemmap_pop mmmmm mlong with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h Ommmpoi!Ommmpoi! Purpemplmmmm : pops whats needed of the bufferOmmmpoi!Ommmpoi! Input lmmmm : odeid (I) podmmto aushOmmmpoi! lda (I) leading dimensPM!Ommmmmm! Nvebt (I) numbe of pebticlesOmmmpoi!Ommmpoi! Output lmmmm: bfrC:,:) (F) buffermto aop intoOmmmmmm! rrs: (I) RETURN tusOmmmpoi!Ommmpoi! Remarkslmmmm : Ommmpoi!Ommmpoi! Referencesmm : Ommmpoi!Ommmpoi! Revisionsmmm :Ommmpoi!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h Ommmpoi! $Log: ad_fodemmap_pop.f,v $Ommmpoi! Revision 1.1.1.1 2007/07/13 10:19:00 rvosOmmmpoi! CBL ve sion of the PPM libraryOmmmpoi!Ommmpoi! Revision 1.14 2006/09/04 18:34:53 achatelaOmmmpoi! Fixesmand cleanups to make rt compile fo Ommmmmm! release-1-0Ommmpoi!Ommmpoi! Revision 1.13 2005/04/21 05:00:56 rvosOmmmpoi! Removed unnecessary USE ad_fpodule_erro .Ommmpoi!Ommmpoi! Revision 1.12 2004/08/13 15:44:25 michaebmOmmmpoi! rrcluded mvebt as input argulf-dOmmmpoi!Ommmpoi! Revision 1.11 2004/08/13 12:27:06 michaebmOmmmpoi! corrected some mvebt bugOmmmpoi!Ommmpoi! Revision 1.10 2004/08/12 13:48:22 michaebmOmmmpoi! rrcluded check for ldasena -> bail out if 0Ommmpoi!Ommmpoi! Revision 1.9 2004/08/12 13:10:58 michaebmOmmmpoi! corrected calle specificaion rr sub ebtOmmmpoi!Ommmpoi! Revision 1.8 2004/07/26 13:49:18 rvosOmmmpoi! Removed Routines sectionsmfrom the heade commf-d.Ommmpoi!Ommmpoi! Revision 1.7 2004/07/26 11:59:40 rvosOmmmpoi! Fixesmto make rt compile.Ommmpoi!Ommmpoi! Revision 1.6 2004/07/26 11:47:17 michaebmOmmmpoi! forgotmto umplad_fpodule_erro Ommmpoi!Ommmpoi! Revision 1.5 2004/07/26 11:33:04 michaebmOmmmpoi! rrse ted the umplof the ad_ ode da/a podule.Ommmpoi!Ommmpoi! Revision 1.4 2004/07/26 07:50:32 michaebmOmmmpoi! Atomized. Othe wimplno changes.Ommmpoi!Ommmpoi! Revision 1.3 2004/06/10 16:20:03 rvosOmmmpoi! Moved all cpp directtivesmto column 1.=phe NEC cpp did not recognmmm mmmmm m the_ othe wimp!!!Ommmpoi!Ommmpoi! Revision 1.2 2004/02/20 14:56:52 michaebmOmmmpoi! added the umplof ad_fpodule_util.Ommmpoi!Ommmpoi! Revision 1.1 2004/02/19 08:33:55 michaebmOmmmpoi! rritial implelf-da/PM!.Ommmpoi!Ommmpoi!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h Ommmpoi! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), Ommmpoi! Cente for Fluid Dynamics (DTU)Ommmpoi!Ommmpoi!Ommmpoi! This file rs vebt of the Peballel Pebticle Mesh Library (PPM).Ommmpoi!Ommmpoi! PPM rs free software: you can redistribute rt and/or podifyOmmmpoi! rt unde the te ms of the GNU Lesse Genebal Public License Ommmpoi! as vublished by the Free Software Founda/PM!, eithe Ommmpoi! ve sion 3 of the License, or (at your movion) any late Ommmpoi! ve sion.Ommmpoi!Ommmpoi! PPM rs distributed rr the hope that rt will be useful,Ommmpoi! but WITHOUT ANY WARRANTY; without ever the implied warranty ofOmmmpoi! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSEn See thm mmmmm m GNU Genebal Public License for pore details.Ommmpoi!Ommmpoi! You should have received a copy of the GNU Genebal Public LicenseOmmmpoi! and the GNU Lesse Genebal Public License along with PPM. If not,Ommmpoi! see .Ommmpoi!Ommmpoi! Peballel Pebticle Mesh Library (PPM)Ommmpoi! ETH ZurichOmmmpoi! CH-8092 Zurich, Switzerland mmmpoi!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h Ol#ifmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmmSUBROUTINE ad_fodemmap_pop_s(odeid,bfr,lda,Nvebt,mvebt GO#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmmSUBROUTINE ad_fodemmap_pop_d(odeid,bfr,lda,nvebt,mvebt GO#enaifOmmmmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -Ommmmmmmm! Ircludes mmmmm mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -O#rrclude "ad_fdefine.h"Ommmmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -Ommmmmmmm! Modules mmmmm mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -OmmmmmmmmUSE ad_fpodule_da/afodeOmmmmmmmmUSE ad_fpodule_da/aOmmmmmmmmUSE ad_fpodule_sub ebtOmmmpoimmUSE ad_fpodule_sub opOmmmpoimmUSE ad_fpodule_mapOmmmpoimmUSE ad_fpodule_erro OmmmpoimmUSE ad_fpodule_ri lfleh #mPPPIMPLICIT NONEO#ifmmmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmm INTEGER, PARAMETER :: mk er_comkind_singlei#else mmmmmm iINTEGER, PARAMETER :: mk er_comkind_doubleO#enaifOmmmmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -Ommmmmmmm! Argulf-ds mmmmm mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -OmmmmmmmmINTEGER, INTENT( out) :: OmmmmmmmmINTEGER, INTENT(rr ) :: odeidOmmmmmmmmREAL(mk), DIMEN!c_OC:,:), POINTERmmmmmmm:: bfrOmmmmmmmmINTEGER, INTENT(rr ) :: ldaiii=poiiiINTEGER, INTENT(rr ) :: Nvebtiii=poiiiINTEGER, INTENT(rrout) :: Mvebtiii=poiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -Ommmmmmmm! Local Variables mmmmm mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -OmmmmmmmmINTEGER :: ldasenaOmmmmmmmmINTEGER :: throwawayOmmmmmmmmINTEGER :: mid, rmovOmmmmmmmmINTEGER :: umidmi!, umidmaxiii=poiiiINTEGER, DIMEN!c_OC2) :: dimeOmmmmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -Ommmmmmmm! call sub ebtOmmmpoimm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -Ommmmmmmms:( sub ('ad_fodemmap_pop',t0 GOTO 9999EIF(Mvebt.EQ.h==poiiiii=poiiiii !long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehiii=poiiiii ! just save the numbe of ges that we would have sf-dOmmmpoiiiii !long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehiii=poiiiii ! already happened rr ad_fodemstepiii=poiiiii !long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehiii=poiiiii -- E phM === h IFOmmmmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -Ommmmmmmm! check input argulf-ds mmmmm mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -OmmmmmmmmIF(ad_fdebug.GT.h==poiiiii=poiiiii !long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehiii=poiiiii ! check if ad_ rs rritializediii=poiiiii !long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehiii=poiiiii IF(.NOT.ad_frritialized==poiimii=poiiiii #mmrrs: er_comerro kerro Ommmpoimmmmmmmms:( _comerro ( Fererr_ Fernorrit,'ad_fodemmap_pop',&Ommmpoimmmmmmmmmmmmm& 'Please call ad_frrit first!',__L--i__ GOTO 9999ENDDDDD -- E phM =====9 h IFOmmmmmmmmii !long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehiii=poiiiii ! check odeidOmmmmmmmmii !long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehiii=poiiiii umidmi! erLBOUND(ad_frrternal_mid,1)iii=poiiiii umidmax erUBOUND(ad_frrternal_mid,1)iii=poiiiii IF(odeid.LT.umidmi!.OR.odeid.GT.umidmax==poiimii=poiiiii #mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubmii=poiiiii #mm! user mid does not existmii=poiiiii #mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubmii=poiiiii #mmrrs: er_comerro kerro Ommmpoimmmmmmmms:( _comerro ( Fererr_argulf-d,'ad_fodemmap_pop', &Ommmpoimmmmmmmmmmmmm& 'odeid does not exist',__L--i__ GOTO 9999ENDDDDD -- E phM =====9 LSEOTO 9999ENDDDDDIF(ad_frrternal_mid(odeid).EQ.-HUGE(odeid)==poiiiii=poiiiii mm m9!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_diii=poiiiii mm m9! user mid does not existmii=poiiiii #mm m9!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_diii=poiiiii mm m9rrs: er_comerro kerro Ommmpoimmmmmmmmmmms:( _comerro ( Fererr_argulf-d,'ad_fodemmap_pop',&mOmmmmmmmmmiiii D#mm9D#& 'odeid does not exist',__L--i__ GOTO 9999ENDDDDD DD -- E phM =====9=99 h IFOmmmmmmmmii h IFOmmmmmmmmii !long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehiii=poiiiii ! check dimensPM!Ommmmmmmmii !long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doublehiii=poiiiii IF(Mvebt.LT.h==poiiiii=poiiiii m9rrs: er_comerro kerro Ommmpoimmmmmmmms:( _comerro ( Fererr_argulf-d,'ad_fodemmap_pop', &Ommmpoimmmmmmmmmmmmm& 'Mvebt cannot be <0',__L--i__ GOTO 9999ENDDDDD -- E phM =====9 h IFOmmmmmmmmii IF(lda.LE.h==poiiiii=poiiiii m9rrs: er_comerro kerro Ommmpoimmmmmmmms:( _comerro ( Fererr_argulf-d,'ad_fodemmap_pop', &Ommmpoimmmmmmmmmmmmm& 'LDA must be >00',__L--i__ GOTO 9999ENDDDDD -- E phM =====9 h IFOmmmmmmmm h IFOOmmmmmmmmmid = ad_frrternal_mid(odeid)Ommmmmmmmldasena =mlda*ad_fodemsf-d(mid)OmmmmmmmmIF(ldasena.EQ.h== -- E Ommmmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -Ommmmmmmm! get the stuffOmmmmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -Ommmmmmmms:( _commap_vebt_pop(bfr,ldasena,Nvebt,mvebt GOmmmmmmmmIF( .NEnh==poiiiii=poiiiii -- E phM === h IFOmmmmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -Ommmmmmmm! have to blow rt up to full buffermsmmm again Ommmmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -OmmmmmmmmIF(ad_fodemsf-d(mid).LT.ad_fodembfrsmmm(mid)==poiiiii=poiiiii rmov er_comvebaomri lf_fit_preservm mmmmm mm podimeC1) = ad_fodembfrsmmm(mid)*ldaiii=poiiiii dimeC2) = Mvebtiii=poiii #s:( _comri lf(bfr,dime,Rmov GOTO 999iiii IF( .NEnh==poiiiii=poiiiii m rrs: er_comerro kfatalOTO 999iiii oos:( _comerro ( Fererr_ai lf,'ad_fodemmap_pop', &Ommmpoimmmmmmmmmmmmm& 'growing buffermBFR',__L--i__ GOTO 9999ENDDDDD -- E phM =====9 h IFOmmmmmmmm h IFO i osONTINUEmmmmmmmmOmmmmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -Ommmmmmmm! sub opOmmmpoimm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -Ommmmmmmms:( sub op('ad_fodemmap_pop',t0 GOTO 9999ERETURN #ifmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmm h SUBROUTINE ad_fodemmap_pop_sO#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmm h SUBROUTINE ad_fodemmap_pop_dO#enaifOlibad_numerics-r1036/src/ad_fpodule_da/afmg.f0000644000175000017500000005062511616214647020131 0u omaromarmmpoimm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh --Ommmmmmm! Modulemmmmmm m : ad_fpodule_da/afmg mmpoimm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh --Ommmmmmm!Ommmmmmm! Purpemplmmmm : multigrid da/a poduleOmmmmmmm! Ommmmmmm!Ommmmmmm! Remarkslmmmm :Ommmpoim!Ommmmmmm! Referencesmm : Ommmpoim!Ommmmmmm! Revisionsmmm :Ommmpoim!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh --Ommmmmmm! $Log: ad_fpodule_da/afmg.f,v $Ommmpoii! Revision 1.1.1.1 2007/07/13 10:18:57 rvosOmmmpoii! CBL ve sion of the PPM libraryOmmmpoim!Ommmmmmm! Revision 1.6 2006/07/21 11:30:57 kotsalieOmmmmmmm! FRIDAYOmmmpoim!Ommmmmmm! Revision 1.5 2005/12/08 12:42:36 kotsalieOmmmmmmm! commrting dirichledOmmmpoim!Ommmmmmm! Revision 1.4 2004/10/29 16:00:47 kotsalieOmmmmmmm! RED BLACK SORiii=poii!Ommmmmmm! Revision 1.3 2004/09/28 14:18:19 kotsalieOmmmmmmm! Added 4th orderOmmmpoii!Ommmmmmm! Revision 1.2 2004/09/22 18:40:26 kotsalieOmmmmmmm! MG new ve sionOmmmpoii!Ommmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh --Ommmmmmm! Peballel Pebticle Mesh Library (PPM)Ommmpoim! Irstitute of Compuda/PM!al ScienceOmmmpoim! ETH Zf-drum, Hirschengraben 84Ommmpoii! CH-8092 Zurich, Switzerland mmmpoim!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh --O O#define __SINGLE_PRECI!c_O 1O#define __DOUBLE_PRECI!c_O 2O#define __INTEGER 3O#define __LOGIs:( 4O#define __2D 7O#define __3D 8O#define __SFIELD 9O#define __VFIELD 10 MODULE ad_fpodule_da/afmg Omm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -Omm!Modules mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -OmmmUSE ad_fpodule_da/a,ONLY:_comkind_single,_comkind_doubleOmmmPRIVATE :: _comkind_single,_comkind_doubleOmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -Omm!phe boundary conai/PM! values!!Omm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -OO#define __DIM:__SFIELDl#define __MESH_DIM __2DO#define __KI=p __SINGLE_PRECI!c_O TYPE bc_value_2d_sca_smmpoii! 1st rrdex pmes pemi/PM! locallyOmmmpoREAL(_comkind_single), DIMEN!c_OC:),POINTERmmm:: pbcvalue mm h TYPE bc_value_2d_sca_sm#undef __KI=p #define __KI=p ==:__DOUBLE_PRECI!c_O mmTYPE bc_value_2d_sca_d mmmpo!1st rrdex pmes pemi/PM! locallyOmmmpoREAL(_comkind_single), DIMEN!c_OC:),POINTERmmm:: pbcvalue mm h TYPE bc_value_2d_sca_d #undef __KI=p #define __KI=p ==:__SINGLE_PRECI!c_O mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -Omm! Our multigrid field with all its necessary componf-ds (Take a look at the Omm! theory) mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -OmmTYPE mg_field_2d_sca_smmpoii!function corrections, erro restrictions, erro s mmmpo!1st and 2nd rrdex: pmes pemi/PM!(local)OmmmpoREAL(_comkind_single), DIMEN!c_OC:,:),POINTERmm:: uc OmmmpoREAL(_comkind_single), DIMEN!c_OC:,:),POINTERmm:: fc OmmmpoREAL(_comkind_single), DIMEN!c_OC:,:),POINTERmm:: err Ommmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -Ommmmm!TRUE FOR RED (EVEN) MESH POINTSOmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h OmmmmmLOGIs:(,DIMEN!c_OC:,:),POINTERmmmmmmmmmmmmmmmmm:: mask_red Ommmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -Ommmmm!TRUE FOR BLACK (ODD) MESH POINTSOmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h OmmmmmLOGIs:(,DIMEN!c_OC:,:),POINTERmmmmmmmmmmmmmmmmm:: mask_blackmmmii=po!leds save the boundary conai/PM!.rrdex:facmmof the subdomain(1:4)OmmmpoTYPE(bc_value_2d_sca_s), DIMEN!c_OC:), POINTERmmm:: bcvalue Omm h TYPE mg_field_2d_sca_sm#undef __KI=p #define __KI=p ==:__DOUBLE_PRECI!c_OmmmmiiTYPE mg_field_2d_sca_dmmpoii!function corrections, erro restrictions, erro s, mmmpo!1st:3rd rrdex: pmes pemi/PM!(local)OmmmpoREAL(_comkind_double), DIMEN!c_OC:,:),POINTERmm:: uc OmmmpoREAL(_comkind_double), DIMEN!c_OC:,:),POINTERmm:: fc OmmmpoREAL(_comkind_double), DIMEN!c_OC:,:),POINTERmm:: err Ommmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -Ommmmm!TRUE FOR RED (EVEN) MESH POINTSOmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h OmmmmmLOGIs:(,DIMEN!c_OC:,:),POINTERmmmmmmmmmmmmmmmmm:: mask_red Ommmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -Ommmmm!TRUE FOR BLACK (ODD) MESH POINTSOmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -OmmmmmLOGIs:(,DIMEN!c_OC:,:),POINTERmmmmmmmmmmmmmmmmm:: mask_blackmmii=po!leds save the boundary conai/PM!.rrdex:facmmof the subdomain(1:4)OmmmpoTYPE(bc_value_2d_sca_d), DIMEN!c_OC:), POINTERmmm:: bcvalue Omm h TYPE mg_field_2d_sca_dm#undef __KI=p #define __KI=p ==:__SINGLE_PRECI!c_O mm!1st rrdex: subdomain,2nd rrdex : multigrid levelmiiTYPE(mg_field_2d_sca_s), DIMEN!c_OC:,:), POINTERmm:: imgfield_2d_sca_s #undef __KI=p #define __KI=p ==:__DOUBLE_PRECI!c_O mm!1st rrdex: subdomain,2nd rrdex : multigrid levelmiiTYPE(mg_field_2d_sca_d), DIMEN!c_OC:,:), POINTERmm:: imgfield_2d_sca_d #undef __KI=p #undef __MESH_DIM l#define __MESH_DIM __3DO#define __KI=p __SINGLE_PRECI!c_O TYPE bc_value_3d_sca_smmpoii! 1st-2nd rrdex pmes pemi/PM! locallyOmmmpoREAL(_comkind_single), DIMEN!c_OC:,:),POINTERmmm:: pbcvalue mm h TYPE bc_value_3d_sca_sm#undef __KI=p #define __KI=p ==:__DOUBLE_PRECI!c_O mmTYPE bc_value_3d_sca_d mmmpo!1st-2nd rrdex pmes pemi/PM! locallyOmmmpoREAL(_comkind_single), DIMEN!c_OC:,:),POINTERmmm:: pbcvalue mm h TYPE bc_value_3d_sca_d #undef __KI=p #define __KI=p ==:__SINGLE_PRECI!c_O mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -Omm! Our multigrid field with all its necessary componf-ds (Take a look at the Omm! theory) mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -OmmTYPE mg_field_3d_sca_smmpoii!function corrections, erro restrictions, erro s mmmpo!1st-3rd rrdex: pmes pemi/PM!(local)OmmmpoREAL(_comkind_single), DIMEN!c_OC:,:,:),POINTERmm:: uc OmmmpoREAL(_comkind_single), DIMEN!c_OC:,:,:),POINTERmm:: fc OmmmpoREAL(_comkind_single), DIMEN!c_OC:,:,:),POINTERmm:: err Ommmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -Ommmmm!TRUE FOR RED (EVEN) MESH POINTSOmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h OmmmmmLOGIs:(,DIMEN!c_OC:,:,:),POINTERmmmmmmmmmmmmmmmmm:: mask_red Ommmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -Ommmmm!TRUE FOR BLACK (ODD) MESH POINTSOmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -OmmmmmLOGIs:(,DIMEN!c_OC:,:,:),POINTERmmmmmmmmmmmmmmmmm:: mask_blackmmmii=po!leds save the boundary conai/PM!.rrdex:facmmof the subdomain(1:6)OmmmpoTYPE(bc_value_3d_sca_s), DIMEN!c_OC:), POINTERmmm:: bcvalue Omm h TYPE mg_field_3d_sca_sm#undef __KI=p #define __KI=p ==:__DOUBLE_PRECI!c_OmmmmiiTYPE mg_field_3d_sca_dmmpoii!function corrections, erro restrictions, erro s, mmmpo!1st:3rd rrdex: pmes pemi/PM!(local)OmmmpoREAL(_comkind_double), DIMEN!c_OC:,:,:),POINTERmm:: uc OmmmpoREAL(_comkind_double), DIMEN!c_OC:,:,:),POINTERmm:: fc OmmmpoREAL(_comkind_double), DIMEN!c_OC:,:,:),POINTERmm:: err Ommmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -Ommmmm!TRUE FOR RED (EVEN) MESH POINTSOmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h OmmmmmLOGIs:(,DIMEN!c_OC:,:,:),POINTERmmmmmmmmmmmmmmmmm:: mask_red Ommmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -Ommmmm!TRUE FOR BLACK (ODD) MESH POINTSOmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -OmmmmmLOGIs:(,DIMEN!c_OC:,:,:),POINTERmmmmmmmmmmmmmmmmm:: mask_blackmmii=po!leds save the boundary conai/PM!.rrdex:facmmof the subdomain(1:6)OmmmpoTYPE(bc_value_3d_sca_d), DIMEN!c_OC:), POINTERmmm:: bcvalue Omm h TYPE mg_field_3d_sca_d #undef __KI=p #define __KI=p ==:__SINGLE_PRECI!c_O mm!1st rrdex: subdomain,2nd rrdex : multigrid levelmiiTYPE(mg_field_3d_sca_s), DIMEN!c_OC:,:), POINTERmm:: imgfield_3d_sca_s #undef __KI=p #define __KI=p ==:__DOUBLE_PRECI!c_O mm!1st rrdex: subdomain,2nd rrdex : multigrid levelmiiTYPE(mg_field_3d_sca_d), DIMEN!c_OC:,:), POINTERmm:: imgfield_3d_sca_d #undef __KI=p #undef __MESH_DIM l#undef __DIM l#define __DIM __VFIELDl#define __MESH_DIM __2DO#define __KI=p __SINGLE_PRECI!c_O TYPE bc_value_2d_vec_smii=po! 1st rrdex pmes pemi/PM! locallyOmmmpoREAL(_comkind_single), DIMEN!c_OC:),POINTERmmm:: pbcvalue mm h TYPE bc_value_2d_vec_sm#undef __KI=p #define __KI=p ==:__DOUBLE_PRECI!c_O mmTYPE bc_value_2d_vec_dmmmmpo!1st rrdex pmes pemi/PM! locallyOmmmpoREAL(_comkind_single), DIMEN!c_OC:),POINTERmmm:: pbcvalue mm h TYPE bc_value_2d_vec_dm#undef __KI=p #define __KI=p ==:__SINGLE_PRECI!c_O mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -Omm! Our multigrid field with all its necessary componf-ds (Take a look at the Omm! theory) mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -OmmTYPE mg_field_2d_vec_smii=po!function corrections, erro restrictions, erro s mmmpo!1st rrdex componf-d 2nd and 3rd rrdex: pmes pemi/PM!(local)OmmmpoREAL(_comkind_single), DIMEN!c_OC:,:,:),POINTERmm:: uc OmmmpoREAL(_comkind_single), DIMEN!c_OC:,:,:),POINTERmm:: fc OmmmpoREAL(_comkind_single), DIMEN!c_OC:,:,:),POINTERmm:: err Ommmmm!long with-PPM. IEX------CI---GERARAME---H:: MKD kind_doubleh -h -h -Ommmmm!TRUE FOR RED (EVEN) MESH POINTSOmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h OmmmmmLOGIs:(,DIMEN!c_OC:,:),POINTERmmmmmmmmmmmmmmmmm:: mask_red Ommmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -Ommmmm!TRUE FOR BLACK (ODD) MESH POINTSOmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -OmmmmmLOGIs:(,DIMEN!c_OC:,:),POINTERmmmmmmmmmmmmmmmmm:: mask_blackmmmii=po!leds save the boundary conai/PM!.rrdex:componf-d,facmmof the subdomain(1:4)OmmmpoTYPE(bc_value_2d_vec_s), DIMEN!c_OC:,:), POINTERmmm:: bcvalue Omm h TYPE mg_field_2d_vec_sm#undef __KI=p #define __KI=p ==:__DOUBLE_PRECI!c_OmmmmmTYPE mg_field_2d_vec_dmmpoii!function corrections, erro restrictions, erro s, mmmpo!1st rrdex: componf-d 2nd:3rd rrdex: pmes pemi/PM!(local)OmmmpoREAL(_comkind_double), DIMEN!c_OC:,:,:),POINTERmm:: uc OmmmpoREAL(_comkind_double), DIMEN!c_OC:,:,:),POINTERmm:: fc OmmmpoREAL(_comkind_double), DIMEN!c_OC:,:,:),POINTERmm:: err Ommmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -Ommmmm!TRUE FOR RED (EVEN) MESH POINTSOmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h OmmmmmLOGIs:(,DIMEN!c_OC:,:),POINTERmmmmmmmmmmmmmmmmm:: mask_red Ommmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -Ommmmm!TRUE FOR BLACK (ODD) MESH POINTSOmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -OmmmmmLOGIs:(,DIMEN!c_OC:,:),POINTERmmmmmmmmmmmmmmmmm:: mask_blackmmii=po!leds save the boundary conai/PM!.rrdex:componf-d,facmmof the subdomain(1:4)OmmmpoTYPE(bc_value_2d_vec_d), DIMEN!c_OC:), POINTERmmm:: bcvalue Omm h TYPE mg_field_2d_vec_dm#undef __KI=p #define __KI=p ==:__SINGLE_PRECI!c_O mm!1st rrdex: subdomain,2nd rrdex : multigrid levelmiiTYPE(mg_field_2d_vec_s), DIMEN!c_OC:,:), POINTERmm:: imgfield_2d_vec_s #undef __KI=p #define __KI=p ==:__DOUBLE_PRECI!c_O mm!1st rrdex: subdomain,2nd rrdex : multigrid levelmiiTYPE(mg_field_2d_vec_d), DIMEN!c_OC:,:), POINTERmm:: imgfield_2d_vec_d #undef __KI=p #undef __MESH_DIM l#define __MESH_DIM __3DO#define __KI=p __SINGLE_PRECI!c_O TYPE bc_value_3d_vec_smii=po! 1st-2nd rrdex pmes pemi/PM! locallyOmmmpoREAL(_comkind_single), DIMEN!c_OC:,:,:),POINTERmmm:: pbcvalue mm h TYPE bc_value_3d_vec_sm#undef __KI=p #define __KI=p ==:__DOUBLE_PRECI!c_O mmTYPE bc_value_3d_vec_dmmmmpo!1st-2nd rrdex pmes pemi/PM! locallyOmmmpoREAL(_comkind_single), DIMEN!c_OC:,:,:),POINTERmmm:: pbcvalue mm h TYPE bc_value_3d_vec_d #undef __KI=p #define __KI=p ==:__SINGLE_PRECI!c_O mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -Omm! Our multigrid field with all its necessary componf-ds (Take a look at the Omm! theory) mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -OmmTYPE mg_field_3d_vec_smii=po!function corrections, erro restrictions, erro s mmmpo!1st rrdex: componf-d 2nd-4th rrdex: pmes pemi/PM!(local)OmmmpoREAL(_comkind_single), DIMEN!c_OC:,:,:,:),POINTERmm:: uc OmmmpoREAL(_comkind_single), DIMEN!c_OC:,:,:,:),POINTERmm:: fc OmmmpoREAL(_comkind_single), DIMEN!c_OC:,:,:,:),POINTERmm:: err Ommmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -Ommmmm!TRUE FOR RED (EVEN) MESH POINTSOmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h OmmmmmLOGIs:(,DIMEN!c_OC:,:,:),POINTERmmmmmmmmmmmmmmmmm:: mask_red Ommmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -Ommmmm!TRUE FOR BLACK (ODD) MESH POINTSOmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -OmmmmmLOGIs:(,DIMEN!c_OC:,:,:),POINTERmmmmmmmmmmmmmmmmm:: mask_blackmmmii=po!leds save the boundary conai/PM!.rrdex:componf-d,facmmof the subdomain(1:6)OmmmpoTYPE(bc_value_3d_vec_s), DIMEN!c_OC:), POINTERmmm:: bcvalue Omm h TYPE mg_field_3d_vec_sm#undef __KI=p #define __KI=p ==:__DOUBLE_PRECI!c_OmmmmiiTYPE mg_field_3d_vec_dmmpoii!function corrections, erro restrictions, erro s, mmmpo!1st rrdex componf-d,2nd:4th rrdex: pmes pemi/PM!(local)OmmmpoREAL(_comkind_double), DIMEN!c_OC:,:,:,:),POINTERmm:: uc OmmmpoREAL(_comkind_double), DIMEN!c_OC:,:,:,:),POINTERmm:: fc OmmmpoREAL(_comkind_double), DIMEN!c_OC:,:,:,:),POINTERmm:: err Ommmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -Ommmmm!TRUE FOR RED (EVEN) MESH POINTSOmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -OmmmmmmLOGIs:(,DIMEN!c_OC:,:,:),POINTERmmmmmmmmmmmmmmmmm:: mask_red Ommmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -Ommmmm!TRUE FOR BLACK (ODD) MESH POINTSOmmmmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -OmmmmmLOGIs:(,DIMEN!c_OC:,:,:),POINTERmmmmmmmmmmmmmmmmm:: mask_blackmmii=po!leds save the boundary conai/PM!.rrdex:facmmof the subdomain(1:6)OmmmpoTYPE(bc_value_3d_vec_d), DIMEN!c_OC:), POINTERmmm:: bcvalue Omm h TYPE mg_field_3d_vec_d #undef __KI=p #define __KI=p ==:__SINGLE_PRECI!c_O mm!1st rrdex: subdomain,2nd rrdex : multigrid levelmiiTYPE(mg_field_3d_vec_s), DIMEN!c_OC:,:), POINTERmm:: imgfield_3d_vec_s #undef __KI=p #define __KI=p ==:__DOUBLE_PRECI!c_O mm!1st rrdex: subdomain,2nd rrdex : multigrid levelmiiTYPE(mg_field_3d_vec_d), DIMEN!c_OC:,:), POINTERmm:: imgfield_3d_vec_d #undef __KI=p #undef __MESH_DIM l#undef __DIM mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -Omm!S ing rrdex for the itera/PM! through the pmes pei-ds. Omm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -OmmINTEGER, DIMEN!c_OC:,:,:), POINTERmm:: ebtOmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -Omm!S opping rrdex for the itera/PM! through the pmes pei-ds.Omm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -OmmINTEGER, DIMEN!c_OC:,:,:), POINTERmm:: i op Omm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -Omm!Facto for coarsening the pmesOmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -OmmINTEGER, DIMEN!c_OC:),POINTERmmmmmmmmmm:: facto Omm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -Omm!Array with rrternal pmesids mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -OmmINTEGER, DIMEN!c_OC:),POINTERmmmmmmmmmm:: pmesid_gOmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -Omm!Array with external pmes_ids mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -OmmINTEGER, DIMEN!c_OC:),POINTERmmmmmmmmmm:: pmes_id_gOmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -Omm!Smmm of the ghostlayer. It rs 1 for the multigrid sincmmwe d Omm!for the time being secona order frrite differences mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -OmmINTEGER, DIMEN!c_OC:),POINTERmmmmmmm:: ghostsmmm mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -Omm!BOUNDARYosONDITc_OS of the compuda/PM!al domain.1st rrdex:sub,2nd,facmOmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -O#define __DIM ==:__SFIELDlmmINTEGER, DIMEN!c_OC:,:),POINTERmmmmm:: bcdef_scal#undef __DIM #define __DIM ==:__VFIELDlmmINTEGER, DIMEN!c_OC:,:,:),POINTERmmmmm:: bcdef_vecl#undef __DIM lmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -Omm!Is the facmmof the cell at the boundary? Yes or no?1st rrdex facm,2nd:isublmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -OmmLOGIs:(, DIMEN!c_OC:,:), POINTERmm:: lboundarylmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h lmm!V_CYCLE OR W_CYCLE A h TOmPRINT OR NOT TOmPRINTlmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h lmmLOGIs:( :: w_cycleOmmLOGIs:( :: l_printOmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h Omm!ARE ALL=poi BOUNDARIES PERIODIClmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h lmmLOGIs:( :: lperiodicOmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h Omm!Order of the mgOmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h mmINTEGER :: orderOmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -Omm!numbe of levels (theoretical value) mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -OmmINTEGER :: maxlevOmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -Omm!numbe of sub mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -OmmINTEGER :: nsub mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h mm!smoothe mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -OmmINTEGER :: ismoothe Omm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -Omm!numbe of dimensPM!s rr the problem(if scalar fields=> vecdim=1) mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -OmmINTEGER :: vecdimOmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -Omm!MASK DUMMY FOR COMPATIBILITY OF TYPE THAT ImUSE WITH FIELDS OF PPM mm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -O#define __MESH_DIM ==:__2D mmLOGIs:(,DIMEN!c_OC:,:,:),POINTERm:: mask_dummy_2d #undef __MESH_DIM O#define __MESH_DIM ==:__3D mmLOGIs:(,DIMEN!c_OC:,:,:,:),POINTERm:: mask_dummy_3d O#undef __MESH_DIM lmm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -Omm!Array with the maximum numbe of pmes pei-ds on each processo Omm!Due to the load ballancing the waste of memory (if existed==rs Omm!mrrimal !!Omm!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h -h -OmmINTEGER,DIMEN!c_OC:,:),POINTERm:: max_nodeO #define __KI=p __SINGLE_PRECI!c_O OmmREAL(_comkind_single) :: rdx2_s,rdy2_s,rdz2_smiiREAL(_comkind_single) :: dx_s,dy_s,dz_smiiREAL(_comkind_single) :: EPSU_smiiREAL(_comkind_single) :: omega_sm#undef __KI=p #define __KI=p __DOUBLE_PRECI!c_O OmmREAL(_comkind_double) :: rdx2_d,rdy2_d,rdz2_dOmmREAL(_comkind_double) :: dx_d,dy_d,dz_dOmmREAL(_comkind_double) :: EPSU_dOmmREAL(_comkind_double) :: omega_d #undef __KI=p h MODULE ad_fpodule_da/afmgO libad_numerics-r1036/src/ad_fcomp_pp_kernels.inc0000644000175000017500000002113611616214647020667 0u omaromar !long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h Ommmmmm! Irclude file for different PP kernels. This rs rrcluded rr allOmmmmmm! the psefcomp_pp* routines whe ever kernel evaluationsmare needed.Ommmmmm! Only change this file to add/edit kernel functions.Ommmpoi!Ommmpoi! INPUT: idij rs the squared distancmmbetween vebticles r and jOmmmpoi! All kernel vebaoeters need to be passed rr kveb(:).Ommmpoi! dx, dy and dzmare the componf-ds of the rrter vebticle vector. Ommmpoi! OUTPUT: eta rs the kernel value for the giver distancmOmmmpoi!Ommmpoi! Remark: Should SXF90 op to unfold the loops (swap IF and DO)Ommmpoi! becaumplthe numbe of kernels growsmtoo big, we will simply makeOmmmpoi! several such .inc files and make several ve sions of the comp_ppOmmmpoi! routines with cpp if to choomplthe prope irclude file.Ommmpoi!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h Ommmmmm! $Log: ad_fcomp_pp_kernels.inc,v $Ommmpoi! Revision 1.1.1.1 2007/07/13 10:18:54 rvosOmmmpoi! CBL ve sion of the PPM libraryOmmmpoi!Ommmpoi! Revision 1.4 2004/11/11 15:27:09 rvosOmmmpoi! Optimized PSE kernels for speed.Ommmmmm!Ommmpoi! Revision 1.3 2004/10/13 16:42:11 davidchOmmmpoi! added support for 3d sph kernelsOmmmmmm!Ommmpoi! Revision 1.2 2004/07/29 15:56:48 hiebe sOmmmpoi! added kernel_sph2d_p2 and kernel_dx_sph2d_p2Ommmmmm!Ommmpoi! Revision 1.1 2004/07/23 12:57:31 rvosOmmmpoi! Iritial implelf-da/PM!. Notmtested.Ommmpoi!Ommmpoi!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h Ommmpoi! Peballel Pebticle Mesh Library (PPM)Ommmpoi! ETH ZurichOmmmpoi! CH-8092 Zurich, Switzerland mmmpoi!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h Ol#ifmmm__KERNEL ==:__INTERNAL mmmpoiIF (kernel .EQ.r_comvebaomkernel_fast3d==poiimii=poiiiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mii=poiiiii! 2nd order sph kernel 3dmii=poiiiii! kveb(1) cutoff^2mii=poiiiii! kveb(2) 1/cutoff^9mii=poiiiii! eta(delta^2) = 315/64/Pi/cutoff^9*(cutoff^2-r^2)^3mii=poiiiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mii=poiiiiifacto = kveb(1) -idijmii=poiiiiieta = 1.5666814710608_MK * kveb(2)mii=poiiiiieta = eta *ifacto *ifacto *ifacto mii=poi LSEIF (kernel .EQ.r_comvebaomkernel_fast3d_dx==poiimii=poiiiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mii=poiiiii! 2nd order sph kernel 3d, dxmii=poiiiii! kveb(1) cutoff^2mii=poiiiii! kveb(2) 1/cutoff^9mii=poiiiii! eta(delta^2) = -945/32/Pi/cutoff^9*(cutoff^2-r^2)^2*xmii=poiiiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mii=poiiiiifacto = kveb(1) -idijmii=poiiiiieta = -9.400088826365_MK * kveb(2) * dxmii=poiiiiieta = eta *ifacto *ifacto mii=poi LSEIF (kernel .EQ.r_comvebaomkernel_fast3d_dy==poiimii=poiiiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mii=poiiiii! 2nd order sph kernel 3d, dymii=poiiiii! kveb(1) cutoff^2mii=poiiiii! kveb(2) 1/cutoff^9mii=poiiiii! eta(delta^2) = -945/32/Pi/cutoff^9*(cutoff^2-r^2)^2*ymii=poiiiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mii=poiiiiifacto = kveb(1) -idijmii=poiiiiieta = -9.400088826365_MK * kveb(2) * dymii=poiiiiieta = eta *ifacto *ifacto mii=poi LSEIF (kernel .EQ.r_comvebaomkernel_fast3d_dz==poiimii=poiiiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mii=poiiiii! 2nd order sph kernel 3d, dzmii=poiiiii! kveb(1) cutoff^2mii=poiiiii! kveb(2) 1/cutoff^9mii=poiiiii! eta(delta^2) = -945/32/Pi/cutoff^9*(cutoff^2-r^2)^2*zmii=poiiiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mii=poiiiiifacto = kveb(1) -idijmii=poiiiiieta = -9.400088826365_MK * kveb(2) * dzmii=poiiiiieta = eta *ifacto *ifacto mii=poi LSEIF (kernel .EQ.r_comvebaomkernel_fast3d_lap==poiimii=poiiiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mii=poiiiii! 2nd order sph kernel 3d, laplacianmii=poiiiii! kveb(1) cutoff^2mii=poiiiii! kveb(2) 1/cutoff^9mii=poiiiii! eta(delta^2) = -945/32/Pi/cutoff^9*(cutoff^2-r^2)(3*cutoff^2-7*r^2)mii=poiiiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mii=poiiiiifacto = kveb(1) -idijmii=poiiiiifacto 2 = 3.0_MK * kveb(1) -i7.0_MK * dijmii=poiiiiieta = -9.400088826365_MK * kveb(2)mii=poiiiiieta = eta *ifacto *ifacto 2mii=poi LSEIF (kernel .EQ.r_comvebaomkernel_laplace2d_p2==poiimii=poiiiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mii=poiiiii! 2nd order polynomial kernel 2D.mii=poiiiii! kveb(1) eps2inv (1/eps**2)mii=poiiiii! kveb(2) correction*15.0*dh^2*eps^(-4)/pi^2mii=poiiiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mii=poiiiiidij = dij*kveb(1)mii=poiiiiidij2 = dij*dijmii=poiiiiidij4 = dij2*dij2mii=poiiiiidij5 = dij4*dijmii=poiiiiieta =idij5 + 1.0_MKmii=poiiiiieta =ikveb(2)/etamii=poi LSEIF (kernel .EQ.r_comvebaomkernel_laplace3d_p2==poiimii=poiiiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mii=poiiiii! 2nd order polynomial kernel 3D.mii=poiiiii! kveb(1) eps2inv (1/eps**2)mii=poiiiii! kveb(2) correction*15.0*dh^3*eps^(-5)/pi^2mii=poiiiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mii=poiiiiidij = dij*kveb(1)mii=poiiiiidij2 = dij*dijmii=poiiiiidij4 = dij2*dij2mii=poiiiiidij5 = dij4*dijmii=poiiiiieta =idij5 + 1.0_MKmii=poiiiiieta =ikveb(2)/etamii=poi LSEIF (kernel .EQ.r_comvebaomkernel_sph2d_p2 ==poiimii=poiiiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mii=poiiiii! 2nd order quartic spline kernel M5 2D.mii=poiiiii! kveb(1) eps (kernel width)mii=poiiiii! kveb(2) eps2 (eps**2)mii=poiiiii! kveb(3) eps2inv (1/eps**2)mii=poiiiii! kveb(4) eps5inv (1/eps**4)mii=poiiiii! kveb(5) dh3 (vebticle volume)mii=poiiiii! kveb(6) piinv (1/PI, the math constant)mii=poiiiii! kveb(7) kappa (discretisation correctionifacto )mii=poiiiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mOmmmmmmmmmifacto = kveb(3)*kveb(6)mii=poiiiiidij2 = dij*kveb(3)mii=poiiiiidij = sqrt(idij2 )miimii=poiiiiiIF (dij.LT.2.5_MK==poiiiii=poiiiii mIF (dij.LT.1.5_MK==poiiiii=poiiiii IF (dij.LT.0.5_MK==poiiiii=poiiiii mmmmmmmeta = 0.3_MK*dij2*dij2 -i0.75_MK*dij2 + 0.71875_MKiii=poiiiii mmmm LSEOTO 9999ENDDDDDmeta = -0.2_MK*dij2*dij2 + dij2*dij -i1.5_MK*dij2 &Ommmpoimm&ii=poiiiii mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm+ 0.25_MK*dij+0.6875_MKmOmmmmmmmmmiiiENDIFOmmmmmmmmi LSEOTO 9999Edij4 = 2.5_MK -idijmii=poiiiiiiieta = 0.05_MK*dij4*dij4*dij4*dij4OTO 9999ENDDDDENDIFOmmmmmmmmii LSEmOmmmmmmmmmiiii Deta = 0.0_MKiii=poiiiiiENDIFOmmmmmmmmiieta =ieta*facto *kveb(7)mii=poi LSEIF (kernel .EQ.r_comvebaomkernel_dx_sph2d_p2 ==poiimii=poiiiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mii=poiiiii! 2nd order quartic spline kernel M5 2D for first Derivative d/dx.mii=poiiiii! kveb(1) eps (kernel width)mii=poiiiii! kveb(2) epsinv (1/eps)mii=poiiiii! kveb(3) eps2inv (1/eps**2)mii=poiiiii! kveb(4) eps5inv (1/eps**4)mii=poiiiii! kveb(5) dh3 (vebticle volume)mii=poiiiii! kveb(6) piinv (1/PI, the math constant)mii=poiiiii! kveb(7) kappa (discretisation correctionifacto )mii=poiiiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mOmmmmmmmmmifacto = kveb(3)*kveb(6)mii=poiiiiidij2 = dij*kveb(3)mii=poiiiiidij = sqrt(idij2 )miimii=poiiiiiIF ( dij.LT.2.5_MK .AND. dij>0.0_MK ==poiimii=poiiiii mIF (dij.LT.1.5_MK==poiiiii=poiiiii i mIF (dij.LT.0.5_MK==poiiiii=poiiiii mmmmmmmeta = 1.2_MK*dij2*dij -i1.5_MK*dijiii=poiiiii mmmm LSEOTO 9999ENDDDDDmmmmmeta = -0.8_MK*dij2*dij + 3_MK*dij2 -i3_MK*dijm+ 0.25_MKmOmmmmmmmmmiiii DENDIFOmmmmmmmmiimmm LSEOTO 9999ENDDDDDmmdij4 = 2.5_MK -idijmii=poiiieta = -0.2_MK*dij4*dij4*dij4OTO 9999ENENDIFOmmmmmmmmii LSEmOmmmmmmmmeta = 0.0_MKiii=poiENDIFOmmmmmmmmieta =ieta*facto *kveb(7)*kveb(2)/dij*dx ! eta =ieta*facto *kveb(7)*kveb(2)/dij mmmmmii LSEmii=poiiiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mii=poiiiii! This LSEmis needed to avoid funny actioniwhen an invalidmii=poiiiii! kernel is specified (and to make SXF90 unfold the loops).mii=poiiiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh mii=poiiiiieta = 0.0_MKiii=poiENDIFO#elifm__KERNEL ==:__USER_FUNCTc_O mmmmmmeta = kernel(dij,kveb)O#elifm__KERNEL ==:__LOOKUP_TABLEmii=poiidx = INT(dij*kveb) mmmmmmeta = kernel(idx)O#enaifOlibad_numerics-r1036/src/ad_fhamjac_rerrit_ lf_step_3d.f0000644000175000017500000004105711616214647022242 0u omaromaroiiiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh leh mii=poi! Subroutine m : ad_fhamjac_rerrit_step_3d oiiiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh leh mii=poi! mii=poi! Purpemplmmmm : Solve Hamilton-Jacobi for Gowas rerritmii=poi! mii=poi! Input : mii=poi! mii=poi! Input/Output : mii=poi! mii=poi! Output : mii=poi! mii=poi! Remarkslmmmm : mii=poi! mii=poi! mii=poi! Referencesmm :mii=poi! mii=poi! Revisionsmmm : oiiiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh leh mii=poi! $Log: ad_fhamjac_rerrit_ lf_step_3d.f,v $Ommmpoi! Revision 1.1.1.1 2006/07/25 15:18:19 menahelOmmmpoi! iritial importmii=poi!Ommmpoi! Revision 1.2 2005/08/12 14:38:01 rvosOmmmpoi! bugfix: rrdex bounds rr loop corrected.Ommmmmm!Ommmpoi! Revision 1.1 2005/07/25 00:34:05 rvosOmmmpoi! Iritial check-in.Ommmpoi!Ommmpoi!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h Ommmpoi! Peballel Pebticle Mesh Library (PPM)Ommmpoi! Irstitute of Compuda/PM!al ScienceOmmmpoi! ETH Zf-drum, Hirschengraben 84Ommmpoi! CH-8092 Zurich, Switzerland mmmpoi!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h Ol#ifmmm__MODE ==:__SCAl#ifmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmmSUBROUTINE ad_fhamjac_rerrit_ lf_step_3ds(phi,tphi,i lf,np,trgt,res, &Ommmpo&ii=poiiiii mmmmmmmmmmmmmmmmmmmmmmmmmtopo_id,pmes_id,ghostsmmm,info)O#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmmSUBROUTINE ad_fhamjac_rerrit_ lf_step_3dd(phi,tphi,i lf,np,trgt,res, &Ommmpo&ii=poiiiii mmmmmmmmmmmmmmmmmmmmmmmmmtopo_id,pmes_id,ghostsmmm,info)O#enaifO#elifm__MODE ==:__VECl#ifmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmmSUBROUTINE ad_fhamjac_rerrit_ lf_step_3dsV(phi,idx,tphi,i lf,np,trgt,&Ommmpo&ii=poiiiii mmmmmmmmmmmmmmmmmmmmmmmmmres,topo_id,pmes_id,ghostsmmm,info)O#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmmSUBROUTINE ad_fhamjac_rerrit_ lf_step_3ddV(phi,idx,tphi,i lf,np,trgt,&Ommmpo&ii=poiiiii mmmmmmmmmmmmmmmmmmmmmmmmmres,topo_id,pmes_id,ghostsmmm,info)O#enaifO#enaifOmii=poiiiUSE ad_fpodule_da/amii=poiiimii=poiiiUSE ad_fpodule_erro mii=poiiiUSE ad_fpodule_sub ebtOmm=poiiiUSE ad_fpodule_sub opOmm=poiiiUSE ad_fpodule_typedefOmm=poiiiIMPLICIT NONEmii=poiiil#ifmmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmmmmINTEGER, PARAMETERm:: MK = _comkind_singleO#elifmm__KI=p ==:__DOUBLE_PRECI!c_Oi=poiiimii=poiiiINTEGER, PARAMETERm:: MK = _comkind_doubleO#enaifOmii=poiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD mii=poiii! Argulf-dsmii=poiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD m#ifm__MODE ==:__SCAlii=poiiiREAL(MK), DIMEN!c_OC:,:,:,:), POINTERm:: phiO#elifm__MODE ==:__VEClii=poiiiREAL(MK), DIMEN!c_OC:,:,:,:,:), POINTERm:: phiO#enaifii=poiiimii=poiiiREAL(MK), DIMEN!c_OC:,:,:,:), POINTERm:: tphimii=poiiiINTEGER, INTENT(in) :: topo_id, pmes_idmii=poiiiINTEGER, DIMEN!c_OC3), INTENT(in) :: ghostsmmm mm=poiiiINTEGER, INTENT(inout) :: infomii=poiiiREAL(mk), INTENT(out) :: resm#ifm__MODE ==:__VEClii=poiiiINTEGER, INTENT(in) :: idxO#enaifii=poiiimii=poiiiREAL(mk), INTENT(in) :: trgtmii=poiiiINTEGER, DIMEN!c_OC:,:), INTENT(in) :: i lfmii=poiiiINTEGER :: np, pmii=poiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD mii=poiii! Aliasesmii=poiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD mii=poiiiINTEGER, DIMEN!c_OC:), POINTERmmm :: isublistmii=poiiiINTEGER :: nsublistmii=poiiiINTEGER, DIMEN!c_OC:,:), POINTERmmm :: nda/amii=poiiiINTEGER :: topoid, pmesidmii=poiiiREAL(MK), DIMEN!c_OC:), POINTERmmm :: min_phys, max_physmii=poiiiTYPE(_comt_topo), POINTERmmm :: topomii=poiiiTYPE(_comt_equi_pmes), POINTERmmm :: pmesOmmmmmmmmmii=poiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD mii=poiii! standard stuffmii=poiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD mii=poiiiINTEGER :: isub,isubl,i,j,kmii=poiiiREAL(MK) :: len_phys(3)mii=poiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD mii=poiii! WENO stuffmii=poiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD mii=poiiiREAL(mk) :: onegC3), oposC3), wenoeps, wenotau, pbsmii=poiiiREAL(mk) :: laps(-1:1,3), rposC3), rnegC3), dxC3), dxi(3)mii=poiiiREAL(mk) :: phipC3), phinC3), phimidC3), rms, dphi_dtmii=poiiiINTEGER :: i apmii=poiiiINTEGER, PARAMETER, DIMEN!c_OC3,3) :: offs &Ommmpoimmmmmmm& = RESHAPE((/2,1,0,1,0,-1,0,-1,-2/),(/3,3/))mii=poiiiREAL(mk) :: t0 Ommmmmmmmmii=poiiiCALL=sub ebt('ad_fhamjac_rerrit_ lf_step_3d',t0,info)Ommmmmmmmmii=poiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD mii=poiii! Get the pmes da/amii=poiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD mii=poiiitopo => _comtopo(topo_id)%tmii=poiiipmes => topo%pmes(pmes_id)mii=poiiipmesid = pmes%IDmii=poiiinsublist = topo%nsublistmii=poiiinda/aoiii=> pmes%nnodesmii=poiiiisublist => topo%isublistm#ifmmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmmmmmin_phys => topo%pin_physsmii=poiiimax_phys => topo%pax_physsO#elifmm__KI=p ==:__DOUBLE_PRECI!c_Oi=poiiimii=poiiimin_phys => topo%pin_physdmii=poiiimax_phys => topo%pax_physdO#enaifOmii=poiiilen_phys(1) = pax_phys(1) -ipin_phys(1)mii=poiiilen_phys(2) = pax_phys(2) -ipin_phys(2)mii=poiiilen_phys(3) = pax_phys(3) -ipin_phys(3)mii=poiiidxC1) =ilen_phys(1)/REAL(mmes%Nm(1)-1,mk)mii=poiiidxC2) =ilen_phys(2)/REAL(mmes%Nm(2)-1,mk)mii=poiiidxC3) =ilen_phys(3)/REAL(mmes%Nm(3)-1,mk)mii=poiiidxiC1) = 1.0_mk/dxC1)mii=poiiidxiC2) = 1.0_mk/dxC2)mii=poiiidxiC3) = 1.0_mk/dxC3)mii=poiiiwenoeps = 1.0e-6_mkmii=poiiiwenotau = 0.25_mk*MINVAL(dx)Omii=poiiirms = -HUGE(rms)Omii=poiiiiiiDO p=1,npOmmmpoimmmmmmmiisub = i lf(4,p)Ommmpoimmmmmmmii = i lf(1,p)Ommmpoimmmmmmmij = i lf(2,p)Ommmpoimmmmmmmik = i lf(3,p)Ommmpoimmmmmmmiiiiiii! hackm#ifm__MODE ==:__SCAmmmpoimmmmmmmiiiiiii ! IF(phi(i+1,j,k,isub).EQ.phi(i-1,j,k,isub).AND. & ! & phi(i,j+1,k,isub).EQ.phi(i,j-1,k,isub).AND. & ! & phi(i,j,k+1,isub).EQ.phi(i,j,k-1,isub).AND.ABS(phi(i& ! &,j,k,isub)).LT.14.0_mk*dxC1)) CYCLEO#enaifii=poiiimmmmmiiiiiii #ifm__MODE ==:__SCAlii=poiiiiiiiiiiiiiiiphimidC1) = phi(i+1,j,k,isub)-phi(i-1,j,k,isub)lii=poiiiiiiiiiiiiiiiphimidC2) = phi(i,j+1,k,isub)-phi(i,j-1,k,isub)lii=poiiiiiiiiiiiiiiiphimidC3) = phi(i,j,k+1,isub)-phi(i,j,k-1,isub)O#elselii=poiiiiiiiiiiiiiiiphimidC1) = phi(idx,i+1,j,k,isub)-phi(idx,i-1,j,k,isub)lii=poiiiiiiiiiiiiiiiphimidC2) = phi(idx,i,j+1,k,isub)-phi(idx,i,j-1,k,isub)lii=poiiiiiiiiiiiiiiiphimidC3) = phi(idx,i,j,k+1,isub)-phi(idx,i,j,k-1,isub)O#enaifOii=poiiimmmmmiiiiiii #ifm__MODE ==:__SCAlii=poiiiiiiiiiiiiiiiiiilaps(2-3,1) = phi(i+offs(1,3),j,k,isub)iii&lii=poiiiiiiiiiiiiiiiiiiiiiii& -2.0_mk * phi(i+offs(2,3),j,k,isub)i&lii=poiiiiiiiiiiiiiiiiiiiiiii& + phi(i+offs(3,3),j,k,isub)lii=poiiiiiiiiiiiiiiiiiilaps(2-3,2) = phi(i,j+offs(1,3),k,isub)iii&lii=poiiiiiiiiiiiiiiiiiiiiiii& -2.0_mk * phi(i,j+offs(2,3),k,isub)i&lii=poiiiiiiiiiiiiiiiiiiiiiii& + phi(i,j+offs(3,3),k,isub)lii=poiiiiiiiiiiiiiiiiiilaps(2-3,3) = phi(i,j,k+offs(1,3),isub)iii&lii=poiiiiiiiiiiiiiiiiiiiiiii& -2.0_mk * phi(i,j,k+offs(2,3),isub)i&lii=poiiiiiiiiiiiiiiiiiiiiiii& + phi(i,j,k+offs(3,3),isub)lii=poiiiiiiiiiiiiiiiiiilaps(2-2,1) = phi(i+offs(1,2),j,k,isub)iii&lii=poiiiiiiiiiiiiiiiiiiiiiii& -2.0_mk * phi(i+offs(2,2),j,k,isub)i&lii=poiiiiiiiiiiiiiiiiiiiiiii& + phi(i+offs(3,2),j,k,isub)lii=poiiiiiiiiiiiiiiiiiilaps(2-2,2) = phi(i,j+offs(1,2),k,isub)iii&lii=poiiiiiiiiiiiiiiiiiiiiiii& -2.0_mk * phi(i,j+offs(2,2),k,isub)i&lii=poiiiiiiiiiiiiiiiiiiiiiii& + phi(i,j+offs(3,2),k,isub)lii=poiiiiiiiiiiiiiiiiiilaps(2-2,3) = phi(i,j,k+offs(1,2),isub)iii&lii=poiiiiiiiiiiiiiiiiiiiiiii& -2.0_mk * phi(i,j,k+offs(2,2),isub)i&lii=poiiiiiiiiiiiiiiiiiiiiiii& + phi(i,j,k+offs(3,2),isub)lii=poiiiiiiiiiiiiiiiiiilaps(2-1,1) = phi(i+offs(1,1),j,k,isub)iii&lii=poiiiiiiiiiiiiiiiiiiiiiii& -2.0_mk * phi(i+offs(2,1),j,k,isub)i&lii=poiiiiiiiiiiiiiiiiiiiiiii& + phi(i+offs(3,1),j,k,isub)lii=poiiiiiiiiiiiiiiiiiilaps(2-1,2) = phi(i,j+offs(1,1),k,isub)iii&lii=poiiiiiiiiiiiiiiiiiiiiiii& -2.0_mk * phi(i,j+offs(2,1),k,isub)i&lii=poiiiiiiiiiiiiiiiiiiiiiii& + phi(i,j+offs(3,1),k,isub)lii=poiiiiiiiiiiiiiiiiiilaps(2-1,3) = phi(i,j,k+offs(1,1),isub)iii&lii=poiiiiiiiiiiiiiiiiiiiiiii& -2.0_mk * phi(i,j,k+offs(2,1),isub)i&lii=poiiiiiiiiiiiiiiiiiiiiiii& + phi(i,j,k+offs(3,1),isub)O#elifm__MODE ==:__VEClii=poiiiiiiiiiiiiiiiDO i ap=1,3lii=poiiiiiiiiiiiiiiiiiilaps(2-i ap,1) = phi(idx,i+offs(1,i ap),j,k,isub)iii&lii=poiiiiiiiiiiiiiiiiiiiiiii& -2.0_mk * phi(idx,i+offs(2,i ap),j,k,isub)i&lii=poiiiiiiiiiiiiiiiiiiiiiii& + phi(idx,i+offs(3,i ap),j,k,isub)lii=poiiiiiiiiiiiiiiiiiilaps(2-i ap,2) = phi(idx,i,j+offs(1,i ap),k,isub)iii&lii=poiiiiiiiiiiiiiiiiiiiiiii& -2.0_mk * phi(idx,i,j+offs(2,i ap),k,isub)i&lii=poiiiiiiiiiiiiiiiiiiiiiii& + phi(idx,i,j+offs(3,i ap),k,isub)lii=poiiiiiiiiiiiiiiiiiilaps(2-i ap,3) = phi(idx,i,j,k+offs(1,i ap),isub)iii&lii=poiiiiiiiiiiiiiiiiiiiiiii& -2.0_mk * phi(idx,i,j,k+offs(2,i ap),isub)i&lii=poiiiiiiiiiiiiiiiiiiiiiii& + phi(idx,i,j,k+offs(3,i ap),isub)lii=poiiiiiiiiiiiiiii h DOO#enaifii=poiiimmmmmiiiiiii lii=poiiiiiiiiiiiiiiirposC1) = (wenoeps +ilaps( 1,1)**2)/(wenoeps +ilaps(0,1)**2)lii=poiiiiiiiiiiiiiiirnegC1) = (wenoeps +ilaps(-1,1)**2)/(wenoeps +ilaps(0,1)**2)lii=poiiiiiiiiiiiiiiirposC2) = (wenoeps +ilaps( 1,2)**2)/(wenoeps +ilaps(0,2)**2)lii=poiiiiiiiiiiiiiiirnegC2) = (wenoeps +ilaps(-1,2)**2)/(wenoeps +ilaps(0,2)**2)lii=poiiiiiiiiiiiiiiirposC3) = (wenoeps +ilaps( 1,3)**2)/(wenoeps +ilaps(0,3)**2)lii=poiiiiiiiiiiiiiiirnegC3) = (wenoeps +ilaps(-1,3)**2)/(wenoeps +ilaps(0,3)**2)llii=poiiiiiiiiiiiiiiioposC1) = 1.0_mk/(1.0_mk+2.0_mk*rposC1)**2)lii=poiiiiiiiiiiiiiiioposC2) = 1.0_mk/(1.0_mk+2.0_mk*rposC2)**2)lii=poiiiiiiiiiiiiiiioposC3) = 1.0_mk/(1.0_mk+2.0_mk*rposC3)**2)lii=poiiiiiiiiiiiiiiionegC1) = 1.0_mk/(1.0_mk+2.0_mk*rnegC1)**2)lii=poiiiiiiiiiiiiiiionegC2) = 1.0_mk/(1.0_mk+2.0_mk*rnegC2)**2)lii=poiiiiiiiiiiiiiiionegC3) = 1.0_mk/(1.0_mk+2.0_mk*rnegC3)**2)ll#ifm__MODE ==:__SCAlii=poiiiiiiiiiiiiiiiphipC1) = 0.5_mk*(phimidC1) -i&lii=poiiiiiiiiiiiiiiiiiiii&ioposC1)*(i&lii=poiiiiiiiiiiiiiiiiiiii&iiiiiiiiiphi(i+2,j,k,isub)i-i&lii=poiiiiiiiiiiiiiiiiiiii&i3.0_mk*(phi(i+1,j,k,isub)i-iphi(i ,j,k,isub))i-i&lii=poiiiiiiiiiiiiiiiiiiii&iiiiiiiiiphi(i-1,j,k,isub)))*dxiC1)lii=poiiiiiiiiiiiiiiiphipC2) = 0.5_mk*(phimidC2) -i&lii=poiiiiiiiiiiiiiiiiiiii&ioposC2)*(i&lii=poiiiiiiiiiiiiiiiiiiii&iiiiiiiiiphi(i,j+2,k,isub)i-i&lii=poiiiiiiiiiiiiiiiiiiii&i3.0_mk*(phi(i,j+1,k,isub)i-iphi(i ,j,k,isub))i-i&lii=poiiiiiiiiiiiiiiiiiiii&iiiiiiiiiphi(i,j-1,k,isub)))*dxiC2)lii=poiiiiiiiiiiiiiiiphipC3) = 0.5_mk*(phimidC3) -i&lii=poiiiiiiiiiiiiiiiiiiii&ioposC3)*(i&lii=poiiiiiiiiiiiiiiiiiiii&iiiiiiiiiphi(i,j,k+2,isub)i-i&lii=poiiiiiiiiiiiiiiiiiiii&i3.0_mk*(phi(i,j,k+1,isub)i-iphi(i ,j,k,isub))i-i&lii=poiiiiiiiiiiiiiiiiiiii&iiiiiiiiiphi(i,j,k-1,isub)))*dxiC3)lii=poiiiiiiiiiiiiiiiphinC1) = 0.5_mk*(phimidC1) -i&lii=poiiiiiiiiiiiiiiiiiiii&ionegC1)*(i&lii=poiiiiiiiiiiiiiiiiiiii&iiiiiiiiiphi(i+1,j,k,isub)i-i&lii=poiiiiiiiiiiiiiiiiiiii&i3.0_mk*(phi(i ,j,k,isub)i-iphi(i-1,j,k,isub))i-i&lii=poiiiiiiiiiiiiiiiiiiii&iiiiiiiiiphi(i-2,j,k,isub)))*dxiC1)lii=poiiiiiiiiiiiiiiiphinC2) = 0.5_mk*(phimidC2) -i&lii=poiiiiiiiiiiiiiiiiiiii&ionegC2)*(i&lii=poiiiiiiiiiiiiiiiiiiii&iiiiiiiiiphi(i,j+1,k,isub)i-i&lii=poiiiiiiiiiiiiiiiiiiii&i3.0_mk*(phi(i,j ,k,isub)i-iphi(i,j-1,k,isub))i-i&lii=poiiiiiiiiiiiiiiiiiiii&iiiiiiiiiphi(i,j-2,k,isub)))*dxiC2)lii=poiiiiiiiiiiiiiiiphinC3) = 0.5_mk*(phimidC3) -i&lii=poiiiiiiiiiiiiiiiiiiii&ionegC3)*(i&lii=poiiiiiiiiiiiiiiiiiiii&iiiiiiiiiphi(i,j,k+1,isub)i-i&lii=poiiiiiiiiiiiiiiiiiiii&i3.0_mk*(phi(i,j,k ,isub)i-iphi(i,j,k-1,isub))i-i&lii=poiiiiiiiiiiiiiiiiiiii&iiiiiiiiiphi(i,j,k-2,isub)))*dxiC3)l#elselii=poiiiiiiiiiiiiiiiphipC1) = 0.5_mk*(phimidC1) -i&lii=poiiiiiiiiiiiiiiiiiiii&ioposC1)*(i&lii=poiiiiiiiiiiiiiiiiiiii&iiiiiiiiiphi(idx,i+2,j,k,isub)i-i&lii=poiiiiiiiiiiiiiiiiiiii&i3.0_mk*(phi(idx,i+1,j,k,isub)-phi(idx,i,j,k,isub))-&lii=poiiiiiiiiiiiiiiiiiiii&iiiiiiiiiphi(idx,i-1,j,k,isub)))*dxiC1)lii=poiiiiiiiiiiiiiiiphipC2) = 0.5_mk*(phimidC2) -i&lii=poiiiiiiiiiiiiiiiiiiii&ioposC2)*(i&lii=poiiiiiiiiiiiiiiiiiiii&iiiiiiiiiphi(idx,i,j+2,k,isub)i-i&lii=poiiiiiiiiiiiiiiiiiiii&i3.0_mk*(phi(idx,i,j+1,k,isub)-phi(idx,i,j,k,isub))-&lii=poiiiiiiiiiiiiiiiiiiii&iiiiiiiiiphi(idx,i,j-1,k,isub)))*dxiC2)lii=poiiiiiiiiiiiiiiiphipC3) = 0.5_mk*(phimidC3) -i&lii=poiiiiiiiiiiiiiiiiiiii&ioposC3)*(i&lii=poiiiiiiiiiiiiiiiiiiii&iiiiiiiiiphi(idx,i,j,k+2,isub)i-i&lii=poiiiiiiiiiiiiiiiiiiii&i3.0_mk*(phi(idx,i,j,k+1,isub)-phi(idx,i,j,k,isub))-&lii=poiiiiiiiiiiiiiiiiiiii&iiiiiiiiiphi(idx,i,j,k-1,isub)))*dxiC3)lii=poiiiiiiiiiiiiiiiphinC1) = 0.5_mk*(phimidC1) -i&lii=poiiiiiiiiiiiiiiiiiiii&ionegC1)*(i&lii=poiiiiiiiiiiiiiiiiiiii&iiiiiiiiiphi(idx,i+1,j,k,isub)i-i&lii=poiiiiiiiiiiiiiiiiiiii&i3.0_mk*(phi(idx,i ,j,k,isub)-phi(idx,i-1,j,k,isub))-&lii=poiiiiiiiiiiiiiiiiiiii&iiiiiiiiiphi(idx,i-2,j,k,isub)))*dxiC1)lii=poiiiiiiiiiiiiiiiphinC2) = 0.5_mk*(phimidC2) -i&lii=poiiiiiiiiiiiiiiiiiiii&ionegC2)*(i&lii=poiiiiiiiiiiiiiiiiiiii&iiiiiiiiiphi(idx,i,j+1,k,isub)i-i&lii=poiiiiiiiiiiiiiiiiiiii&i3.0_mk*(phi(idx,i,j ,k,isub)-phi(idx,i,j-1,k,isub))-&lii=poiiiiiiiiiiiiiiiiiiii&iiiiiiiiiphi(idx,i,j-2,k,isub)))*dxiC2)lii=poiiiiiiiiiiiiiiiphinC3) = 0.5_mk*(phimidC3) -i&lii=poiiiiiiiiiiiiiiiiiiii&ionegC3)*(i&lii=poiiiiiiiiiiiiiiiiiiii&iiiiiiiiiphi(idx,i,j,k+1,isub)i-i&lii=poiiiiiiiiiiiiiiiiiiii&i3.0_mk*(phi(idx,i,j,k ,isub)-phi(idx,i,j,k-1,isub))-&lii=poiiiiiiiiiiiiiiiiiiii&iiiiiiiiiphi(idx,i,j,k-2,isub)))*dxiC3)l#enaifOm#ifm__MODE ==:__SCAmmmpoimmmmmmmiiiiiii mmmpoimmmmmmmiiiiiii!lon collect mmmpoimmmmmmmiiiiiiiIF(phi(i,j,k,isub).GT.0.0_mk==poiiiii=poiiiii mmmmmmmiiiipbs = SQRT(i&lii=poiiiiiiiiiiiiiiiiiiiiiii&iMAX(-MIN(phipC1),0.0_mk=,MAX(phinC1),0.0_mk=)**2+&lii=poiiiiiiiiiiiiiiiiiiiiiii&iMAX(-MIN(phipC2),0.0_mk=,MAX(phinC2),0.0_mk=)**2+&lii=poiiiiiiiiiiiiiiiiiiiiiii&iMAX(-MIN(phipC3),0.0_mk=,MAX(phinC3),0.0_mk=)**2)&lii=poiiiiiiiiiiiiiiiiiiiiiii& - trgtmii=poiiiiiiiiiiiiiii LSEIF(phi(i,j,k,isub).LT.0.0_mk==poiiiii=poiiiii mmmmmmmiiiipbs = SQRT(i&lii=poiiiiiiiiiiiiiiiiiiiiiii&iMAX(MAX(phipC1),0.0_mk=,-MIN(phinC1),0.0_mk=)**2+&lii=poiiiiiiiiiiiiiiiiiiiiiii&iMAX(MAX(phipC2),0.0_mk=,-MIN(phinC2),0.0_mk=)**2+&lii=poiiiiiiiiiiiiiiiiiiiiiii&iMAX(MAX(phipC3),0.0_mk=,-MIN(phinC3),0.0_mk=)**2)&lii=poiiiiiiiiiiiiiiiiiiiiiii& - trgtmii=poiiiiiiiiiiiiiii LSEiii=poiiiii mmmmmmmiiiipbs = 0.0_mklii=poiiiiiiiiiiiiiii h IFOmmmmmmmmiimmmmmmmmmmdphi_dt = pbs * phi(i,j,k,isub)i/i&lii=poiiiiiiiiiiiiiiiiiiii&iSQRT(phi(i,j,k,isub)**2+0.25_mk*SUM(phimid**2))i mmmpoimmmmmmmiiiiiiitphi(i,j,k,isub)i= phi(i,j,k,isub)i-iwenotau * dphi_dtmii=poiiiiiiiiiiiiiiil#elselii=poiiiiiiiiiiiiiii!lon collect mmmpoimmmmmmmiiiiiiiIF(phi(idx,i,j,k,isub).GT.0.0_mk==poiiiii=poiiiii mmmmmmmiiiipbs = SQRT(i&lii=poiiiiiiiiiiiiiiiiiiiiiii&iMAX(-MIN(phipC1),0.0_mk=,MAX(phinC1),0.0_mk=)**2+&lii=poiiiiiiiiiiiiiiiiiiiiiii&iMAX(-MIN(phipC2),0.0_mk=,MAX(phinC2),0.0_mk=)**2+&lii=poiiiiiiiiiiiiiiiiiiiiiii&iMAX(-MIN(phipC3),0.0_mk=,MAX(phinC3),0.0_mk=)**2)&lii=poiiiiiiiiiiiiiiiiiiiiiii& - trgtmii=poiiiiiiiiiiiiiii LSEIF(phi(idx,i,j,k,isub).LT.0.0_mk==poiiiii=poiiiii mmmmmmmiiiipbs = SQRT(i&lii=poiiiiiiiiiiiiiiiiiiiiiii&iMAX(MAX(phipC1),0.0_mk=,-MIN(phinC1),0.0_mk=)**2+&lii=poiiiiiiiiiiiiiiiiiiiiiii&iMAX(MAX(phipC2),0.0_mk=,-MIN(phinC2),0.0_mk=)**2+&lii=poiiiiiiiiiiiiiiiiiiiiiii&iMAX(MAX(phipC3),0.0_mk=,-MIN(phinC3),0.0_mk=)**2)&lii=poiiiiiiiiiiiiiiiiiiiiiii& - trgtmii=poiiiiiiiiiiiiiii LSEiii=poiiiii mmmmmmmiiiipbs = 0.0_mklii=poiiiiiiiiiiiiiii h IFOmmmmmmmmiimmmmmmmmmmdphi_dt = pbs * phi(idx,i,j,k,isub)i/i&lii=poiiiiiiiiiiiiiiiiiiii&iSQRT(phi(idx,i,j,k,isub)**2+0.25_mk*SUM(phimid**2))i mmmpoimmmmmmmiiiiiiitphi(i,j,k,isub)i= phi(idx,i,j,k,isub)i-iwenotau * dphi_dtmii=poiiiiiiiiiiiiiiil#enaifii=poiiimmmmmiiiiiii lii=poiiiiiiiiiiiiiiirms = MAX(rms,ABS(dphi_dt)) lii=poiii h DOOlii=poiiires = rmsOlii=poiiiCALL=sub op('ad_fhamjac_rerrit_ lf_step_3d',t0,info)O#ifmmm__MODE ==:__SCAl#ifmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmm h SUBROUTINE ad_fhamjac_rerrit_ lf_step_3ds O#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmm h SUBROUTINE ad_fhamjac_rerrit_ lf_step_3dd O#enaifO#elifm__MODE ==:__VECl#ifmmm__KI=p ==:__SINGLE_PRECI!c_O mmmmmm h SUBROUTINE ad_fhamjac_rerrit_ lf_step_3dsV O#elifm__KI=p ==:__DOUBLE_PRECI!c_O mmmmmm h SUBROUTINE ad_fhamjac_rerrit_ lf_step_3ddV O#enaifO#enaifiiiiii lii=poimii=poiiiiiiiiiiiiiiil lii=poiiiiiiiiiiiiiii iiiiiiiiiii iiiiiiiiiii Ommmmmmmmmii=poiiimii=poiiimii=poiiimlibad_numerics-r1036/src/ad_fpodule_ode_step.f0000644000175000017500000001567111616214647020341 0u omaromar=poiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h Ommmpoi! Modulei=poiii: ad_fpodule_ode_step =poiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh -h Ommmpoi!Ommmpoi! Purpemplmmmm : procedure podule for ad_fode_step =poiii!Ommmpoi! Remarkslmmmm : mii=poi!Ommmpoi! Referencesmm : mii=poi!Ommmpoi! Revisionsmmm : oiiiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh leh mii=poi! $Log: ad_fpodule_ode_step.f,v $Ommmpoi! Revision 1.1.1.1 2007/07/13 10:19:00 rvosOmmmpoi! CBL ve sion of the PPM libraryOmmmpoi!Ommmpoi! Revision 1.5 2004/07/26 14:58:05 michaebeOmmmpoi! renamedlthe preprocessing defines vector and scalarOmmmpoi!Ommmpoi! Revision 1.4 2004/07/26 12:00:24 rvosOmmmpoi! Fixes to make it compile.Ommmpoi!Ommmpoi! Revision 1.3 2004/07/26 11:48:28 michaebeOmmmpoi! added vector and scalar definesOmmmpoi!Ommmpoi! Revision 1.2 2004/07/26 08:14:15 michaebeOmmmpoi! Added ove loading for scalar lda.Ommmpoi!Ommmpoi! Revision 1.1 2004/07/26 07:45:50 michaebeOmmmpoi! Procedure podules created rr the course of atomiza/PM!.Ommmpoi!Ommmpoi! oiiiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh leh mii=poi! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), Ommmpoi! Certer for Fluid Dynamics (DTU)Ommmpoi!Ommmpoi! oiiiii! This file is vebt of the Peballel Pebticle Mesh Library (PPM).Ommmpoi!Ommmpoi! PPM is free software: you can redistribute it and/or podifyOmmmpoi! it under the terms of the GNU Lesser General Public License Ommmpoi! as vublished by the Free Software Founda/PM!, eithe Ommmpoi! ve sion 3 of the License, or (at your op/PM!) any late Ommmpoi! ve sion.Ommmpoi!Ommmpoi! PPM is distributed rr the hopplthat it will be useful,Ommmpoi! but WITHOUT ANY WARRANTY; without ever the rmplied warranty ofOmmmpoi! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. SepltheOmmmpoi! GNU General Public License for pore details.Ommmpoi!Ommmpoi! You should have received a copy of the GNU General Public LicenseOmmmpoi! and the GNU Lesser General Public License along with PPM. If not,Ommmpoi! sepl.Ommmpoi!Ommmpoi! Peballel Pebticle Mesh Library (PPM)Ommmpoi! ETH ZurichOmmmpoi! CH-8092 Zurich, Switzerland oiiiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh leh m oiiiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh leh mii=poi! Define da/aotypes oiiiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD kind_doubleh leh m#define __SINGLE_PRECI!c_O 1m#define __DOUBLE_PRECI!c_Oi2m#define __SCA 3m#define __VEC 4m oiiiiiMODULE ad_fpodule_ode_step mii=poiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD mii=poiii! Irterfacemii=poiii!long with-PPM. IEX------CI---GER, PARAME---H:: MKD mmii=poiiiINTERFACE ad_fode_step =poiiiiiiiiMODULE PROCEDURE ad_fode_step_ssmii=poiiiiiiMODULE PROCEDURE ad_fode_step_dsmii=poiiiiiiMODULE PROCEDURE ad_fode_step_svmii=poiiiiiiMODULE PROCEDURE ad_fode_step_dvmii=poiii h INTERFACEOm#ifdef __F2003cODULn (at youact RHSi!long with-PPM. IEX------CI---GER, PARAME---H:: MKD mii=poiii! Irterfacemii=poiABSTRACTde_step_svmiEDURE ad_foe G=:__S RecbeOmmmiEDURE ad_foe G michaebeOmmmmmmbleh mii rhsonsmiii(ERmmm xp,up,dup,04/,nter ,ipack, h IFOmmmmmmmmiim&lpack,rpack,mmmmmmmmmii=poi=poiii!llong with-PPM. IEX------CI---NTENT(in)IN)POINTERmmm mmmmii=poi=poiii!llong with-PPM. IEX------CI---NTENT(in)IN)POINT04/,nter mmmmii=poi=poiii!llong with-PPM. IEX------CI---NTENT(in)s d)in) :: ghostssssssn_phyc_O k/(1E0)IMEN!c_OC:,:,:,:mt_topo), n) xp:: ghostssssssn_phyc_O k/(1E0)IMEN!c_OC:,:,:_OC:)topo), n) up:: ghostssssssn_phyc_O k/(1E0)IMEN!c_OC:,:,:_OC:)topo), n) dup:: ghostssssssphinC3), oiiiREAL(mk), INTENT(in)IN), OP miiALin) pack:: ghostssssssLOGICAL, oiiiREAL(mk), INTENT(in)IN), OP miiALin) lpack:: ghostssssssn_phy:__Dk/(1E0)IMEN!c_OC:,:,:,:mt_ENT(in)IN), OP miiALin) rpack:: ghostssssssiii!long with-PPM. IEX------CI---GER, n) rhsonsm:: ghostssss_fodbleh mii rhsonsmmiEDURE ad_foe mpoi! haebeOmmmmmmbleh mii rhsonsmiiv(ERmmm xp,up,dup,04/,nter ,ipack, h IFOmmmmmmmmiim&lpack,rpack,mmmmmmmmmii=poi=poiii!llong with-PPM. IEX------CI---NTENT(in)IN)POINTERmmm mmmmii=poi=poiii!llong with-PPM. IEX------CI---NTENT(in)IN)POINT04/,nter mmmmii=poi=poiii!llong with-PPM. IEX------CI---NTENT(in)s d)in) :: ghostssssssn_phyc_O k/(1E0)IMEN!c_OC:,:,:,:mt_topo), n) xp,up:: ghostssssssn_phyc_O k/(1E0)IMEN!c_OC:,:,:,:mt_topo), n) dup:: ghostssssssphinC3), oiiiREAL(mk), INTENT(in)IN), OP miiALin) pack:: ghostssssssLOGICAL, oiiiREAL(mk), INTENT(in)IN), OP miiALin) lpack:: ghostssssssn_phy:__Dk/(1E0)IMEN!c_OC:,:,:,:mt_ENT(in)IN), OP miiALin) rpack:: ghostssssssiii!long with-PPM. IEX----------------------n) rhsonsm:: ghostssss_fodbleh mii rhsonsmmiEDURE ad_foe UBLE_P RecbeOmmmiEDURE ad_foe G michaebeOmmmmmmbleh mii rhsonsmidi(ERmmm xp,up,dup,04/,nter ,ipack, h IFOmmmmmmmmiim&lpack,rpack,mmmmmmmmmii=poi=poiii!llong with-PPM. IEX------CI---NTENT(in)IN)POINTERmmm mmmmii=poi=poiii!llong with-PPM. IEX------CI---NTENT(in)IN)POINT04/,nter mmmmii=poi=poiii!llong with-PPM. IEX------CI --NTENT(in)s d)in) :: ghostssssssn_phyc_O k/(1D0)IMEN!c_OC:,:,:,:mt_topo), n) xp:: ghostssssssn_phyc_O k/(1D0)IMEN!c_OC:,:,:_OC:)topo), n) up:: ghostssssssn_phyc_O k/(1D0)IMEN!c_OC:,:,:_OC:)topo), n) dup:: ghostssssssphinC3), oiiiREAL(mk), INTENT(in)IN), OP miiALin) pack:: ghostssssssLOGICAL, oiiiREAL(mk), INTENT(in)IN), OP miiALin) lpack:: ghostssssssn_phy:__Dk/(1D0)IMEN!c_OC:,:,:,:mt_ENT(in)IN), OP miiALin) rpack:: ghostssssssiii!long with-PPM. IEX----------------------n) rhsonsm:: ghostssss_fodbleh mii rhsonsmmiEDURE ad_foe mpoi! haebeOmmmmmmbleh mii rhsonsmidv(ERmmm xp,up,dup,04/,nter ,ipack, h IFOmmmmmmmmiim&lpack,rpack,mmmmmmmmmii=poi=poiii!llong with-PPM. IEX------CI---NTENT(in)IN)POINTERmmm mmmmii=poi=poiii!llong with-PPM. IEX------CI---NTENT(in)IN)POINT04/,nter mmmmii=poi=poiii!llong with-PPM. IEX------CI --NTENT(in)s d)in) :: ghostssssssn_phyc_O k/(1D0)IMEN!c_OC:,:,:,:mt_topo), n) xp,up:: ghostssssssn_phyc_O k/(1D0)IMEN!c_OC:,:,:,:mt_topo), n) dup:: ghostssssssphinC3), oiiiREAL(mk), INTENT(in)IN), OP miiALin) pack:: ghostssssssLOGICAL, oiiiREAL(mk), INTENT(in)IN), OP miiALin) lpack:: ghostssssssn_phy:__Dk/(1D0)IMEN!c_OC:,:,:,:mt_ENT(in)IN), OP miiALin) rpack:: ghostssssssiii!long with-PPM. IEX----------------------n) rhsonsm:: ghostssss_fodbleh mii rhsonsmmiEDURE ad_fode_step_svmiiiiimin_phys =CONTAINS __SINGLE_Pmmmm =sub o_SINGLE_Pc_O mrerrit_ lf_step_3dd#include "iiiiiMODULE .f" #s frmin_phys o_SINGLE_Pc_O mre h SUBROUTINE ad#include "iiiiiMODULE .f" #s frmin_phys os frmin_pmmmm __SINGLE_Pmmmm =sBROUT_SINGLE_Pc_O mrerrit_ lf_step_3dd#include "iiiiiMODULE .f" #s frmin_phys o_SINGLE_Pc_O mre h SUBROUTINE ad#include "iiiiiMODULE .f" #s frmin_phys os frmin_pmmmm URE ad_fodefine __DOUBLE_PRECI!c_Oi2m#iEDURE adiii iiiiiiiiiii iiiiiiiiiii Ommmmmmmmmii=poiiimii=poiiimii=poiiimg_smooth_INGLlibad_numerics-r1036/src/ad_fpodulle_ode_step.f764540000644000175000017500000001567111616214647020341 0u omaromar---H:: MKD kind_doubleh leh mii=poi! Define da/aotypes oiiiii!long wi __F200!------CI---GER, PARAME---H: g_smooth_INGL ---H:: MKD kind_doubleh leh mii=poi! Define da/aotypes oiiiii!long wi __F200!--I---GER, PARAMEIt itis -CI---GEwe Reviary 04/07/ath conssR A t (c) 2010 CSE Lab 04/0onsm kinbasOmmmt it wGauss-Seidmis teral Pu ith ! oiii!loi! o Inpuh ! oiii=poi! Input CSE Lab (I) returni!lotus. 0 upmt sucion h ! oiiiPurpemplmmmm :h ! oiiiPukslmmmm : mii=! oiiiPumarkslmmmm : m--H:: MKD kind_doubleh leh mii=poi! Define da/aotypes oiiiii!long wi __F200!--X------CI--g_smooth_INGL:: MKD kind_doubleh leh mii=poi! $Log: ad8:56ctor and.f,v $Ommmpoi! Revision 1.1.1.1 2!KD kind_doubleh l4: ad_fha9 Fix6:01:23ctor and.f,mmmpd wronglyi! np/PMCPP dith coves. Purember:evisyeneralto -1,-2i! nd.f,vol 1, o Licwisy (PPdom :no Revisiommt certait sy_Oims. Istant), itisnd.f,cCI! did NOT Revisiomasmpoi!as!! 2!KD kind_doubleh l3: ad_fhamja1ixes30:55 kotsaliend.f,mRIDAY 2!KD kind_doubleh lg: ad_fha3$Log: ad3:12ctor and.f,Puroic Licquory chauactrichrom 04/07/mg wit.MCPP dom :no liky 04GER! 2!KD kind_doubleh l0: ad_fha2/08 19:54:32 kotsaliend.f,fmmpd imificulti!OmR A PAultipiomsubdins 2!KD kind_doubleh 9: ad_fha2/02ix6:32:54 kotsaliend.f,005/08/12R A PAmmpd bcs 2!KD kind_doubleh 8: rrdex12/08 12:44:46 kotsaliend.f,00mmit1.5 i Peblet 2!KD kind_doubleh 7: rrdex 3$L4 d3:25:48 kotsaliend.f,COMMITED& - BROTOR CArantIT Iout evLDA=3 2!KD kind_doubleh 6: rrdex 1/04 09adinl3: kotsaliend.f,topo_id, =2 2!KD kind_doubleh mpoi! C11/05 rit_ ad1 kotsaliend.f,mIiALiFEAT=poiBEt eE TEST 2!KD kind_doubleh osOmmmpo10/29_rer59:46 kotsaliend.f,RED&BLACK SOR 2!KD kind_doubleh poi! add9 8 sio05:55 kotsaliend.f,Changvisiommmrn1.5 4th----CI-fifm_e imifslmmmm 2!KD kind_doubleh loi! add9 2 rit44:d1 kotsaliend.f,MG newOmmmpoi! 2!KD :: MKD kind_doubleh leh mii=poi! Define da/aotypes oiiiii!long wi __F200!-- not,Ommmpoi! sepl pmes%nnodesmii=poiiiiserrit_ lf_step_-g_smooth_INGLe2D_sca_sM. IEX--,u,f,nsweep,mlevBROUTINE ad_fhamjac_rerrit_ lf_step_3ddV(phi,if,01,c2,c3ii=poiiiii mmmmmmmmmmmmmmmmmmmmmmmmmmres,topo_id,pmes_id,ghosts-g_smooth_INGLe2D_sca_dM. IEX--,u,f,nsweep,mlevBROUTINE ad_fhamjac_rerrit_ lf_step_3ddV(phi,if,01,c2,c3ii=poiiii_PRECI!c_O mmmESHiN!cjac_re3Dmii=poiiinda/aoiii=> pmes%nnodesmii=poiiiiserrit_ lf_step_-g_smooth_INGLe3D_sca_sM. IEX--,u,f,nsweep,mlevBROUTINE ad_fhamjac_rerrit_ lf_step_3ddV(phi,if,01,c2,c3ic4ii=poiiiii mmmmmmmmmmmmmmmmmmmmmmmmmmres,topo_id,pmes_id,ghosts-g_smooth_INGLe3D_sca_dM. IEX--,u,f,nsweep,mlevBROUTINE ad_fhamjac_rerrit_ lf_step_3ddV(phi,if,01,c2,c3ic4ii=poiiiii mmmmmmmmmI!c_O mmN!cjac_reVFIELDiiiiiiiiESHiN!cjac_re2Dmii=poiiinda/aoiii=> pmes%nnodesmii=poiiiiserrit_ lf_step_-g_smooth_INGLe2D_vec_sM. IEX--,u,f,nsweep,mlevBROUTINE ad_fhamjac_rerrit_ lf_step_3ddV(phi,if,01,c2,c3ii=poiiiii mmmmmmmmmmmmmmmmmmmmmmmmmmres,topo_id,pmes_id,ghosts-g_smooth_INGLe2D_vec_dM. IEX--,u,f,nsweep,mlevBROUTINE ad_fhamjac_rerrit_ lf_step_3ddV(phi,if,01,c2,c3ii=poiiii_PRECI!c_O mmmESHiN!cjac_re3Dmii=poiiinda/aoiii=> pmes%nnodesmii=poiiiiserrit_ lf_step_-g_smooth_INGLe3D_vec_sM. IEX--,u,f,nsweep,mlevBROUTINE ad_fhamjac_rerrit_ lf_step_3ddV(phi,if,01,c2,c3ic4ii=poiiiii mmmmmmmmmmmmmmmmmmmmmmmmmmres,topo_id,pmes_id,ghosts-g_smooth_INGLe3D_vec_dM. IEX--,u,f,nsweep,mlevBROUTINE ad_fhamjac_rerrit_ lf_step_3ddV(phi,if,01,c2,c3ic4ii=poiiiii mmmmmmmmmI!iiiiiiiiphimidrnel is specified (and to make SXF90 unfold the loops).mii=poiiiii!long with-PPM!h -cludesiiiiphimidrnel is specified (and to make SXF90 unfold the loops).mii=poiiiii!lon-d#include "iiii_SINGL.h"iiiiphimidrnel is specified (and to make SXF90 unfold the loops).mii=poiiiii!g with-PPM!h X-----siiiiphimidrnel is specified (and to make SXF90 unfold the loops).mii=poiiiii!lon-diiiphimidmmmmmmmres,topo_id,pmes_id,gdmmmmmmmres,topo_id,s-gpmes_id,gdmmmmmmmres,toposa/amii=poiiimii==poiiiUSE ad_fpodule_erro mii=po,info)O#enaifO#enaifOmii=poiii,info)O#enaifO#et,O :: t,info)O#enaifO#emarro mii=po,info)O#enaifO#e_id,s-mmm :: t,info)O#enaifO#ewrm_e :: t,info)O#enaifO#emar_INeld :: t,info)O#enaifO#emar_INeld_topo_ :: t,oiiiUSE ad_fpoii=poiiinda/aoiii=> pmes%nnodesmii=poiiiisubIMPLICIT NONEmii=poiiil#ifmmmm__KI=p ==:__SINGLub)i= phi(i,comkind_singleO#elifmm__KI=p ==:__DOUBLE_PRECI!c_Oiiiphimidrnel is specified (and to make SXF90 unfold the loops).mii=poiiiii!g with-PPM!h !long with-PPM. IEdrnel is specified (and to make SXF90 unfold the loops).mii=poiiiii!lon-d#iiiiiN!cjac_rerFIELDiiiiiiiiESHiN!cjac_re2Dm-PPM. IEdiiINTEGERN!c_OC:,:,:,:,:),topo), n) um-PPM. IEdiiINTEGERN!c_OC:,:,:,:,:),topo), n) ECI!c_O mmmESHiN!cjac_re3Dm-PPM. IEdiiINTEGERN!c_OC:,:,:,:,:,:),topo), n) um-PPM. IEdiiINTEGERN!c_OC:,:,:,:,:,:),topo), n) mmmmmmmmmI!c_O mmN!cjac_reVFIELDiiiiiiiiESHiN!cjac_re2Dm-PPM. IEdiiINTEGERN!c_OC:,:,:,:,:,:),topo), n) um-PPM. IEdiiINTEGERN!c_OC:,:,:,:,:,:),topo), n) ECI!c_O mmmESHiN!cjac_re3Dm-PPM. IEdiiINTEGERN!c_OC:,:,:,:,:,:,:),topo), n) um-PPM. IEdiiINTEGERN!c_OC:,:,:,:,:,:,:),topo), n) mmmmmmmmmI!I!c_OiiiphimidphinC3), ooooooooooooooooooENT(in)IN)PO n) nsweepOiiiphimidphinC3), ooooooooooooooooooENT(in)IN)PO n) mlevB, POINTEoii=poiiiESHiN!cjac_re2Dm-PPM. IEdiiINTEGERooooooooooooooooooENT(in)IN)PO n) 01,c2,c3CI!c_O mmmESHiN!cjac_re3Dm-PPM. IEdiiINTEGERooooooooooooooooooENT(in)IN)PO n) 01,c2,c3ic4mI!I!c_OiiiphimidphinC3), ooooooooooooooooooENT(in)INs d)i n) :: ghostssrnel is specified (and to make SXF90 unfold the loops).mii=poiiiii!log with-PPM!h Locl Pvariab--siiiiphimidrnel is specified (and to make SXF90 unfold the loops).mii=poiiiii!lon-diiiphimidCHARACTER(LEN=256)in) cbu_OiiiphimidphinC3) ooooooooooooooooooooooooooooooooooon) ,j(phim,colfOmii=poiii,phinC3) ooooooooooooooooooooooooooooooooooon) 04/,isweep,countm-PPM. IEdiiINTEGEooooooooooooooooooooooooooooooooooon) c11,c22,c33ic44m-PPM. IEdiiINTEGEooooooooooooooooooooooooooooooooooon) dx,dyOiiiphimidphinC3),N!c_OC:,:,:_Otopo), POIooooooon) a,m,c,d,e,gmii=poiii,phinC3) ooooooooooooooooooooooooooooooooooon) k,idomm-PPM. IEdiiINTEGEooooooooooooooooooooooooooooooooooon) x,ym-PPM. IEdiiINTEGEooooooooooooooooooooooooooooooooooon) omegaOiiiphimidphinC3),N!c_OC:,:,1Eooooooooooooooooooooooon) ldl1,ldu1iiiiiiiiESHiN!cjac_re2Dm-PPM. IEdphinC3),N!c_OC:,:,4Eooooooooooooooooooooooon) ldl4,ldu4m-PPM. IEdphinC3),N!c_OC:,:,3Eooooooooooooooooooooooon) ldl3,ldu3mmmmmmmmI_O mmmESHiN!cjac_re3Dm-PPM. IEiiINTEGEooooooooooooooooooooooooooooooooooon) dzm-PPM. IEphinC3),N!c_OC:,:,5Eooooooooooooooooooooooon) ldl5,ldu5m-PPM. IEphinC3),N!c_OC:,:,4Eooooooooooooooooooooooon) ldl4,ldu4mI!I!c_OiiiphimiphinC3) ooooooooooooooooooooooooooooooooooon) opt,i wit,ERmmm mmmmii=poiiINTEGEooooooooooooooooooooooooooooooooooon) t0iiiiiiiN!cjac_rerFIELDiiiiiiiiESHiN!cjac_re2Dmii=pinda/aoiii=> pmes%nnodesmii=poiiiisubhysmi-g_INeld_2d_sca_sERN!c_OC:,:,:,:_Otopo), NTERgINeld E_PRECI!c_O mmmmmm h SUBROUTINE ad_fhamjubhysmi-g_INeld_2d_sca_dERN!c_OC:,:,:,:_Otopo), NTERgINeld E__PRECI!c_O mmmESHiN!cjac_re3Dmii=pinda/aoiii=> pmes%nnodesmii=poiiiisubhysmi-g_INeld_3d_sca_sERN!c_OC:,:,:,:_Otopo), NTERgINeld E_PRECI!c_O mmmmmm h SUBROUTINE ad_fhamjubhysmi-g_INeld_3d_sca_dERN!c_OC:,:,:,:_Otopo), NTERgINeld E__PRECI!mmmmmI!c_O mmN!cjac_reVFIELDiiiiiiiiESHiN!cjac_re2Dmii=pinda/aoiii=> pmes%nnodesmii=poiiiisubhysmi-g_INeld_2d_vec_sERN!c_OC:,:,:,:_Otopo), NTERgINeld E_PRECI!c_O mmmmmm h SUBROUTINE ad_fhamjubhysmi-g_INeld_2d_vec_dERN!c_OC:,:,:,:_Otopo), NTERgINeld E__PRECI!c_O mmmESHiN!cjac_re3Dmii=pinda/aoiii=> pmes%nnodesmii=poiiiisubhysmi-g_INeld_3d_vec_sERN!c_OC:,:,:,:_Otopo), NTERgINeld E_PRECI!c_O mmmmmm h SUBROUTINE ad_fhamjubhysmi-g_INeld_3d_vec_dERN!c_OC:,:,:,:_Otopo), NTERgINeld E__PRECI!_PRECI!_PRECIiiiiiN!cjac_rerFIELDiiiiiiiiESHiN!cjac_re2Dm-PPM.iiINTEGERN!c_OC:,:,:,:,:),topo), =poilduCI!c_O mmmESHiN!cjac_re3Dm-PPM.iiINTEGERN!c_OC:,:,:,:,:,:),topo), =poilduCI!_PRECI!c_O mmN!cjac_reVFIELDiiiiiiiiESHiN!cjac_re2Dm-PPM.iiINTEGERN!c_OC:,:,:,:,:,:),topo), =poilduCI!c_O mmmESHiN!cjac_re3Dm-PPM.iiINTEGERN!c_OC:,:,:,:,:,:,:),topo), =poilduCI!_PRECI!_PRECIiiiiiN!cjac_rerFIELDiiiiiiiiESHiN!cjac_re2Dm-PPM.iiINTEGE NTERilduCI!c_O mmmESHiN!cjac_re3Dm-PPM.iiINTEGE NTERilduCI!_PRECI!c_O mmN!cjac_reVFIELDiiiiiiiiESHiN!cjac_re2Dm-PPM.iiINTEGERN!c_OC:,:,:_Otopo), NTERilduCI!c_O mmmESHiN!cjac_re3Dm-PPM.iiINTEGERN!c_OC:,:,:_Otopo), NTERilduCI!mmmmmI!I!c_Oiiiphimirnel is specified (and to make SXF90 unfold the loops).mii=poiiiii!lon-diiiphimi!Externalwith-PPM. IEX------CI---GER, PARAME---H:: MKD mii=poiii! Alia.mii=poiiiii!lon-dOiiiphimirnel is specified (and to make SXF90 unfold the loops).mii=poiiiii!lon-diiiphimi!Initiald, pmes_idmirnel is specified (and to make SXF90 unfold the loops).mii=poiiiii!lon-diiiphimi,0,-1,0,-1,-2/),(/3-g_smooth_INGL t0 Ommmmmmmmmii=pornel is specified (and to make SXF90 unfold the loops).mii=poiiiii!lon-diiiphimi!f,Check along with-PPM. IEX------CI---GER, PARAME---H:: MKD mii=poiii! Argulf.mii=poiiiii!lon-diiiphimiIF (iiii_S!OmRiiii 0i& - trgtmii=poiiIF (nsweep,j,k-i& - trgtmii=poiiiiii CI=p ==naifOenaifOmii=poiii,phimi,0,-1p ==naifO(p ==nai_along wi,),(/3-g_smooth_INGL tiiiiiiiii ad_fhamjac_r'nsweep must sio>=1',__LINE__,mmmmmmmmmii=poi=poi GOTO 9999mmmmii=poi=ENDi LSEiii=poiiIF (mlev,j,k-i& - trgtmii=poiiiiii CI=p ==naifOenaifOmii=poiii,phimi,0,-1p ==naifO(p ==nai_along wi,),(/3-g_smooth_INGL tiiiiiiiii ad_fhamjac_r'level must sio>1',__LINE__,mmmmmmmmmii=poi=poi GOTO 9999mmmmii=poi=ENDi LSEiii=poiiIF (c1.LEiiiiiEGE - trgtmii=poiiiiii CI=p ==naifOenaifOmii=poiii,phimi,0,-1p ==naifO(p ==nai_along wi,),(/3-g_smooth_INGL tiiiiiiiii ad_fhamjac_r'Faoi! c1 must sio>0',__LINE__,mmmmmmmmmii=poi=poi GOTO 9999mmmmii=poi=ENDi LSEiii=poiiIF (c2.LEiiiiiEGE - trgtmii=poiiiiii CI=p ==naifOenaifOmii=poiii,phimi,0,-1p ==naifO(p ==nai_along wi,),(/3-g_smooth_INGL tiiiiiiiii ad_fhamjac_r'Faoi! c2 must sio>0',__LINE__,mmmmmmmmmii=poi=poi GOTO 9999mmmmii=poi=ENDi LSEiii=poiiIF (c3.LEiiiiiEGE - trgtmii=poiiiiii CI=p ==naifOenaifOmii=poiii,phimi,0,-1p ==naifO(p ==nai_along wi,),(/3-g_smooth_INGL tiiiiiiiii ad_fhamjac_r'Faoi! c3 must sio>0',__LINE__,mmmmmmmmmii=poi=poi GOTO 9999mmmmii=poi=ENDi LI_O mmmESHiN!cjac_re3Dm-PPM. IEiiIF (c4.LEiiiiiEGE - trgtmii=poiiiiii CI=p ==naifOenaifOmii=poiii,phimi,0,-1p ==naifO(p ==nai_along wi,),(/3-g_smooth_INGL tiiiiiiiii ad_fhamjac_r'Faoi! c4 must sio>0',__LINE__,mmmmmmmmmii=poi=poi GOTO 9999mmmmii=poi=ENDi LI!I!c_OiiiphimiENDi LSEiii=pornel is specified (and to make SXF90 unfold the loops).mii=poiiiii!lon-diiiphimi!X----itoi! Reneion ww.gvariab--suld ht,O atoi! Reefulyth-PPM. IEX------CI---GER, PARAME---H:: MKD mii=poiii! Argulf.mii=poiiiii!lon-diiiphimiERmmm = POINTEoii=piiN!cjac_rerFIELDiiiiiiiiESHiN!cjac_re2Dmii=pinda/aoiii=> pmes%nnodesmii=poiiiisubRgINeld=>RgINeld_2d_sca_s E_PRECI!c_O mmmmmm h SUBROUTINE ad_fhamjubRgINeld=>RgINeld_2d_sca_d E__PRECI!c_O mmmESHiN!cjac_re3Dmii=pinda/aoiii=> pmes%nnodesmii=poiiiisubRgINeld=>RgINeld_3d_sca_s E_PRECI!c_O mmmmmm h SUBROUTINE ad_fhamjubRgINeld=>RgINeld_3d_sca_d E__PRECI!mmmmmI!c_O mmN!cjac_reVFIELDiiiiiiiiESHiN!cjac_re2Dmii=pinda/aoiii=> pmes%nnodesmii=poiiiisubRgINeld=>RgINeld_2d_vec_s E_PRECI!c_O mmmmmm h SUBROUTINE ad_fhamjubRgINeld=>RgINeld_2d_vec_d E__PRECI!c_O mmmESHiN!cjac_re3Dmii=pinda/aoiii=> pmes%nnodesmii=poiiiisubRgINeld=>RgINeld_3d_vec_s E_PRECI!c_O mmmmmm h SUBROUTINE ad_fhamjubRgINeld=>RgINeld_3d_vec_d E__PRECI!_PRECI!_PRECIiiiiida/aoiii=> pmes%nnodesmii=pomega=omega_s dx=dx_s dy=dy_s E_O mmmESHiN!cjac_re3Dmdz=dz_s E__PRECI!c_O mmc_O mmmmmm h SUBROUTINE adomega=omega_d dx=dx_d dy=dy_d E_O mmmESHiN!cjac_re3Dmdz=dz_d E__PRECI!_PRECmii=poi=poi optCI=p ==paramet,O _IN mmmmii=poi=poldl1osC3) =mmmmii=poi=poldu1osC3) n,0,-mmmmii=poi=po,0,-1p ==t,O (a,ldl1,ldu1, opt,immmmmmmmii=poi=po,0,-1p ==t,O (b,ldl1,ldu1, opt,immmmmmmmii=poi=po,0,-1p ==t,O (c,ldl1,ldu1, opt,immmmmmmmii=poi=po,0,-1p ==t,O (d,ldl1,ldu1, opt,immmmmmmmii=poi=po,0,-1p ==t,O (e,ldl1,ldu1, opt,immmmmmmmii=poi=po,0,-1p ==t,O (g,ldl1,ldu1, opt,immmmmmmmii=poi=poIF ( C.NEi 0i& - trgtmii=poiiii CI=p ==naifOefatalmmmmii=poi=po,0,-1p ==naifO(p ==nai_a,O ,'GSsolv', ooo h IFOm ad_fhamjac_rerrit_ lf_s'a',__LINE__,mmmmmmmmmii=poi=poGOTO 9999mmmmii=poi=i=ENDi LI_O piiN!cjac_rerFIELDiiiiiiiiiESHiN!cjac_re2Dm-PPM. IErnel is specified (and to make SXF90 unfold the loops).mii=poiiiii!lon-diiiphimi!Impleg wial Pu iPPM. IErnel is specified (and to make SXF90 unfold the loops).mii=poiiiii!lon iPPM. IEcountiiii iPPM. IEi(i,sweep=1,nsweepOiiiphimidIEi(icolfO=0,=mmmmii=poi=poIErnel is specified (and to make SXF90 unfold the loops).mii=poiiiimmmmii=poi=poIErCommuni atb)i= phi(i,j,k,irnel is specified (and to make SXF90 unfold the loops).mii=poiiiimmii=poiii,phimi,0,-1p ==mar_INeld_topo__get(ERmmm -mmmNTE_g(mlev), h IFOmmm ad_fhamjac_rerrit_ lf_stetopo_id, ,mmmmmmmmmii=poi=poi ,0,-1p ==mar_INeld_push(ERmmm -mmmNTE_g(mlev),u,mmmmmmmmmii=poi=poi ,0,-1p ==mar_INeld_s!_P(mmmmmmmmmmii=poi=poi ,0,-1p ==mar_INeld_pop(ERmmm -mmmNTE_g(mlev),u,topo_id, ,mmmmmmmmmii=poi=poi(i,sub=1,ns0,-mmmmii=poi=popoi(ij=-1,-2/i,j,k-,1),is(dphi,j,k-,1)mmmmii=poi=popo=poi(i,=-1,-2/1,j,k-,1)+mod(j+colfO,2),is(dph1,j,k-,1),2mmmmii=poi=popo=pooooooou( ,j(phim)=c1*((uub)i-i&phim)+ROUTINE ad_fhamjac_rerrit_ lf_step_3ddV(phi,if,uiiiiiiij,k-1,*c2 ROUTINE ad_fhamjac_rerrit_+(uub)i-i&phim)+uiiiiiiij,k-1,*c3 -iiiiiiiii ad_fhamjac_rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrf( ,j(phim))mmmmii=poi=popo=poENDDO ii=poi=popo=poENDDO ii=poi=popo=pENDDO !phim i=popo=pENDDO!i(icolfOdiiiphimiIF (,sweep.EQ.nsweepE - trgtmii=poiiiiii,0,-1p ==mar_INeld_topo__get(ERmmm -mmmNTE_g(mlev), h IFOmmm ad_fhamjac_rerrit_ lf_stetopo_id, ,mmmmmmmmmii=poi=poi ,0,-1p ==mar_INeld_push(ERmmm -mmmNTE_g(mlev),u,mmmmmmmmmii=poi=poi ,0,-1p ==mar_INeld_s!_P(mmmmmmmmmmii=poi=poi ,0,-1p ==mar_INeld_pop(ERmmm -mmmNTE_g(mlev),u,topo_id, ,mmmmmmOiiiphimiENDi LSEiii=ENDDO I!c_O mmmESHiN!cjac_re3Dm-PPM. IErnel is specified (and to make SXF90 unfold the loops).mii=poiiiii!lon-diiiphimi!Impleg wial Pu iPPM. IErnel is specified (and to make SXF90 unfold the loops).mii=poiiiii!lon iPPM. IEi(i,sweep=1,nsweepOiiiphimidIEi(icolfO=0,=mmmmii=poi=poIEa=0mmmmii=poi=poIEb=0mmmmii=poi=poIEc=0mmmmii=poi=poIEd=0mmmmii=poi=poIEe=0mmmmii=poi=poIEg=0mmmmii=poi=poIEi(i,sub=1,ns0,-mmmmii=poi=popo IErnel is specified (and to make SXF90 unfold the loops).mii=poimmmmii=poi=popo IErImpGER,benerari-sui! that _O colfO=0ANTYodd _O colfO==mmmmii=poi=poIE IErnel is specified (and to make SXF90 unfold the loops).mii=poimmmmii=poi=popo IIF (.NOT.lperiodici& - trgtmii=poiiiiiiiiii(i, wit=1,6mmmmii=poi=popo=pooIF (bcdef_sca(j,k-,, wit).EQ.p ==paramebcdef_periodici& - trgtmii=poiiiiiiiiimi!XO NOTHpmergtmii=poiiiiiiiiimk=)**2 (bcdef_sca(j,k-,, wit).EQ.p ==paramebcdef_ i Pebleti& - trgtmii=poiiiiiiiiiiiiIF (, wit.EQ.-i& - trgtmii=poiiiiiiiiiiiiiiiia(j,k-)==mmmmii=poi=poIE IEpo=pooIF (bcdef_sca(j,k-,2).EQ.0i& - trgtmii=poiiiiiiiiiiiiiiiib(j,k-)=-=mmmmii=poi=poIE IEpo=pooENDi LSEiii=poiiiiiiiiiiiiiii==mmmmii=poi=poIE IEpo=pooi(ij=1,max_nodehi,mlev)rgtmii=poiiiiiiiiiiiiiiiii(ik=1,max_nodeh3,mlev)rgtmii=poiiiiiiiiiiiiiiiiiiiiiiiiux,i,j,k,isub=RgINeld(j,k-,1)%bcvalue(, wit)%pbcvalue(,j,)rgtmii=poiiiiiiiiiiiiiiiiENDDO ii=poi=popo=poiiiiiiiiiENDDO ii=poi=popo=poiiiiiik=)**2 (, wit.EQ.2i& - trgtmii=poiiiiiiiiiiiiiiib(j,k-)==mmmmii=poi=poIE IEpo=pooIF (bcdef_sca(j,k-,1).EQ.0i& - trgtmii=poiiiiiiiiiiiiiiiia(j,k-)=-=mmmmii=poi=poIE IEpo=pooENDi LSEiii=poiiiiiiiiiiiiiii=max_nodeh1,mlev)rgtmii=poiiiiiiiiiiiiiiii(ij=1,max_nodehi,mlev)rgtmii=poiiiiiiiiiiiiiiiii(ik=1,max_nodeh3,mlev)rgtmii=poiiiiiiiiiiiiiiiiiiux,i,j,k,isub=RgINeld(j,k-,1)%bcvalue(, wit)%pbcvalue(,j,)rgtmii=poiiiiiiiiiiiiiiiiENDDO ii=poi=popo=poiiiiiiiii!_Pdo ii=poi=popo=poiiiiiik=)**2 (, wit.EQ.3i& - trgtmii=poiiiiiiiiiiiiiiiic(j,k-)= =mmmmii=poi=poIE IEpo=pooIF (bcdef_sca(j,k-,4).EQ.0i& - trgtmii=poiiiiiiiiiiiiiiiid(j,k-)=-=mmmmii=poi=poIE IEpo=pooENDi LSEiii=poiiiiiiiiiiiiiij==mmmmii=poi=poIE IEpo=pooi(ii=1,max_nodeh1,mlev)rgtmii=poiiiiiiiiiiiiiii Doik=1,max_nodeh3,mlev)rgtmii=poiiiiiiiiiiiiiiiiiiux,i,j,k,isub=RgINeld(j,k-,1)%bcvalue(, wit)%pbcvalue(ij,)rgtmii=poiiiiiiiiiiiiiiii!_Pdo ii=poi=popo=poiiiiii iiENDDO ii=poi=popo=poiiiiiik=)**2 (, wit.EQ.4i& - trgtmii=poiiiiiiiiiiiiiid(j,k-)==mmmmii=poi=poIE IEpo=pooIF (bcdef_sca(j,k-,3).EQ.0i& - trgtmii=poiiiiiiiiiiiiiiiic(j,k-)=-=mmmmii=poi=poIE IEpo=pooENDi LSEiii=poiiiiiiiiiiiiiij=max_nodehi,mlev)rgtmii=poiiiiiiiiiiiiiiii(ii=1,max_nodeh1,mlev)rgtmii=poiiiiiiiiiiiiiii Doik=1,max_nodeh3,mlev)rgtmii=poiiiiiiiiiiiiiiiiiiux,i,j,k,isub=RgINeld(j,k-,1)%bcvalue(, wit)%pbcvalue(ij,)rgtmii=poiiiiiiiiiiiiiiii!_Pdo ii=poi=popo=poiiiiii iiENDDO ii=poi=popo=poiiiiiik=)**2 (, wit.EQ.5i& henrgtmii=poiiiiiiiiiiiiiiii!(j,k-)==mmmmii=poi=poIE IEpo=pooIF (bcdef_sca(j,k-,6).EQ.0i& - trgtmii=poiiiiiiiiiiiiiiiig(j,k-)=-=mmmmii=poi=poIE IEpo=pooENDi LSEiii=poiiiiiiiiiiiiiiik=1rgtmii=poiiiiiiiiiiiiiiii(ii=1,max_nodeh1,mlev)rgtmii=poiiiiiiiiiiiiiii Doij=1,max_nodehi,mlev)rgtmii=poiiiiiiiiiiiiiiiiiiux,i,j,k,isub=RgINeld(j,k-,1)%bcvalue(, wit)%pbcvalue(ijj)rgtmii=poiiiiiiiiiiiiiiii!_Pdo ii=poi=popo=poiiiiii iiENDDO ii=poi=popo=poiiiiiiik=)**2 (, wit.EQ.6i& henrgtmii=poiiiiiiiiiiiiiiig(j,k-)==mmmmii=poi=poIE IEpo=pooIF (bcdef_sca(j,k-,5).EQ.0i& - trgtmii=poiiiiiiiiiiiiiiiie(j,k-)=-=mmmmii=poi=poIE IEpo=pooENDi LSEiii=poiiiiiiiiiiiiiiik=max_nodeh3,mlev)rgtmii=poiiiiiiiiiiiiiiii(ii=1,max_nodeh1,mlev)rgtmii=poiiiiiiiiiiiiiii Doij=1,max_nodehi,mlev)rgtmii=poiiiiiiiiiiiiiiiiiiux,i,j,k,isub=RgINeld(j,k-,1)%bcvalue(, wit)%pbcvalue(ijj)rrgtmii=poiiiiiiiiiiiiiiiiENDDO ii=poi=popo=poiiiiiiiiiENDDO ii=poi=popo=poiiiiiioENDi LSEiii=poiiiiiiiiiENDi LSEiii=poiiiiiiENDDO!i with-PPM. IEiiiENDi LSEiii=poiENDDO!i(iphim i=popo=ppppppprnel is specified (and to make SXF90 unfold the loops).mii=poiiiimmmmii=poi=poIErCommuni atb Mes(that) _O colfO==0ANTYcommuni atb black(odd)rgtmii=poiiiiii!_O colfO===mmmmii=poi=poIErnel is specified (and to make SXF90 unfold the loops).mii=poiiiimmmmii=poi=poIE,0,-1p ==mar_INeld_topo__get(ERmmm -mmmNTE_g(mlev), h IFOmmm ad_fhamjac_rerrit_ lf_stetopo_id, ,mmmmmmmmmii=poi=poi ,0,-1p ==mar_INeld_push(ERmmm -mmmNTE_g(mlev),u,mmmmmmmmmii=poi=poi ,0,-1p ==mar_INeld_s!_P(mmmmmmmmmii=poi=poi ,0,-1p ==mar_INeld_pop(ERmmm -mmmNTE_g(mlev),u,topo_id, ,mmmmmmmmmii=poi=popoi(i,sub=1,ns0,-mmmmii=poi=popoi(ik=-1,-2/3,j,k-,1)+e(j,k-),is(dph3,j,k-,1)-g(j,k-)rgtmii=poiiiiiiiiii(ij=-1,-2/i,j,k-,1)+c(j,k-),is(dphi,j,k-,1)-d(j,k-)rgtmii=poiiiiiiiii poi(i,=-1,-2/1,j,k-,1)+mod(j+k+colfO,2)+a(j,k-),iiiiiiii ad_fhamjac_rrrrris(dph1,j,k-,1)-b(j,k-)-mod(j+k+colfO,2),2mmmmii=poi=popo=pooooooooIF ((i.GE.1.AND.i.LEimax_nodeh1,mlev)).AND.iiiiiiii a(j.GE.1.AND.j.LEimax_nodeh2,mlev)).AND.(k.GE.1.AND.k.LEimax_nodeh3,mlev))i& - trgtmii=poiiiiiiiiiiiiiiii ERildu=ux,i,j,k,isubrgtmii=poiiiiiiiiiiiiiiiiiiux,i,j,k,isub=Rildu+omega*iiiiiii ad_fhamjac_rrrrrrrrrr(iiiiiii ad_fhamjac_rrrrrrrrrrrrrc1*((uub)i-i&,k,isub+iiiiiiii ad_fhamjac_rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrruiiiiiiikij,k-1,*c2 ROUTINE ad_fhamjac_rerrit_+(uub)i-i&k&phim)+uiiiiiiikij,k-1,*c3 ROUTINE ad_fhamjac_rerrit_+(uub)i=poiiiiiii+uub)i=piiij,k-1,*c4-iiiiiiii ad_fhamjac_rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrfx,i,j,k,isubiiiiiiii&-Rildubrgtmii=poiiiiiiiiiiiiiiENDi LSEiii=poiiiiiiiiiiiiENDDO ii=poi=popo=poiiENDDO ii=poi=popo=poENDDO ii=poi=popoENDDO!s0,-mmmmii=poENDDO!i(icolfOdiiiphimiIF (,sweep.EQ.nsweepE - trgtmii=poiiiiii,0,-1p ==mar_INeld_topo__get(ERmmm -mmmNTE_g(mlev), h IFOmmm ad_fhamjac_rerrit_ lf_stetopo_id, ,mmmmmmmmmii=poi=poi ,0,-1p ==mar_INeld_push(ERmmm -mmmNTE_g(mlev),u,mmmmmmmmmii=poi=poi ,0,-1p ==mar_INeld_s!_P(mmmmmmmmmii=poi=poi ,0,-1p ==mar_INeld_pop(ERmmm -mmmNTE_g(mlev),u,topo_id, ,mmmmmmmmmii=poENDi LSEiii=ENDDO I!mmmmmI!c_O mmN!cjac_reVFIELDiiiiiiiiiESHiN!cjac_re2Dm-PPM. IErnel is specified (and to make SXF90 unfold the loops).mii=poiiiii!lon-diiiphimi!Impleg wial Pu iPPM. IErnel is specified (and to make SXF90 unfold the loops).mii=poiiiii!lon iPPM. IEcountiiii iPPM. IEi(i,sweep=1,nsweepOiiiphimidIEi(icolfO=0,=mmmmii=poi=poIErnel is specified (and to make SXF90 unfold the loops).mii=poiiiimmmmii=poi=poIErCommuni atb Mes(that) _O colfO==0ANTYcommuni atb black(odd)rgtmii=poiiiiii!_O colfO===mmmmii=poi=poIErnel is specified (and to make SXF90 unfold the loops).mii=poiiiimmmmii=poi=poIE,0,-1p ==mar_INeld_topo__get(ERmmm -mmmNTE_g(mlev), h IFOmmm ad_fhamjac_rerrit_ lf_stetopo_id, ,mmmmmmmmmii=poi=poi ,0,-1p ==mar_INeld_push(ERmmm -mmmNTE_g(mlev),u,vecdim,mmmmmmmmmii=poi=poi ,0,-1p ==mar_INeld_s!_P(mmmmmmmmmii=poi=poi ,0,-1p ==mar_INeld_pop(ERmmm -mmmNTE_g(mlev),u, h IFOmmm ad_fhamjac_rerrit_ lf_ste vecdim,topo_id, ,mmmmmmmmmii=poi=pi(i,sub=1,ns0,-mmmmii=poi=popoi(ij=-1,-2/i,j,k-,1),is(dphi,j,k-,1)mmmmii=poi=popo=poi(i,=-1,-2/1,j,k-,1)+mod(j+colfO,2),is(dph1,j,k-,1),2mmmmii=poi=popo=pooi(i,lda=1,vecdimrgtmii=poiiiiiiiiiiiiiiiuub04/,i,j(phim)=c1*((uub04/,i)i-i&phim)+ROUTINE ad_fhamjac_rerrit_ lf_step_3ddV(phi,if,uii04/,iiiiiij,k-1,*c2 ROUTINE ad_fhamjac_rerrit_+(uub04/,i,joiiiiiii+uub04/,i,jiiij,k-1,*c3 -iiiiiiiii ad_fhamjac_rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrf( 04/,i,j(phim)brgtmii=poiiiiiiiiiiENDDO ii=poi=popo=poiiiENDDO ii=poi=popo=poENDDO ii=poi=popoENDDOmmmmii=poENDDO!i(icolfOdiiiphimiIF (,sweep.EQ.nsweepE - trgtmii=poiiiiii,0,-1p ==mar_INeld_topo__get(ERmmm -mmmNTE_g(mlev), h IFOmmm ad_fhamjac_rerrit_ lf_stetopo_id, ,mmmmmmmmmii=poi=poi ,0,-1p ==mar_INeld_push(ERmmm -mmmNTE_g(mlev),u,vecdim,mmmmmmmmmii=poi=poi ,0,-1p ==mar_INeld_s!_P(mmmmmmmmmii=poi=poi ,0,-1p ==mar_INeld_pop(ERmmm -mmmNTE_g(mlev),u, h IFOmmm ad_fhamjac_rerrit_ lf_ste vecdim,topo_id, ,mmmmmmmmmii=poiENDi LSEiii=pENDDO I!c_O mmmESHiN!cjac_re3Dm-PPM. IErnel is specified (and to make SXF90 unfold the loops).mii=poiiiii!lon-diiiphimi!Impleg wial Pu iPPM. IErnel is specified (and to make SXF90 unfold the loops).mii=poiiiii!lon iPPM. IEEEEE optCI=p ==paramet,O _IN mmmmii=poi=poldu1osC=vecdimrgtmii=poiiii,0,-1p ==t,O (Rildu,ldu1, opt,immmmmmmmii=poi=poIF ( C.NEi 0i& - trgtmii=poiiii CI=p ==naifOefatalmmmmii=poi=po,0,-1p ==naifO(p ==nai_a,O ,'GSsolv', ooo h IFOm ad_fhamjac_rerrit_ lf_s'Rildu',__LINE__,mmmmmmmmmii=poi=poGOTO 9999mmmmii=poi=i=ENDi Li=poi=i=i(i,sweep=1,nsweepOiiiphimidIEi(icolfO=0,=mmmmii=poi=poIEa=0mmmmii=poi=poIEb=0mmmmii=poi=poIEc=0mmmmii=poi=poIEd=0mmmmii=poi=poIEe=0mmmmii=poi=poIEg=0mmmmii=poi=poIEi(i,sub=1,ns0,-mmmmii=poi=popo Ii(i,lda=1,vecdimrgtmii=poiiiiiiiiIF (.NOT.lperiodici& - trgtmii=poiiiiiiiiii(i, wit=1,6mmmmii=poi=popo=pooIF (bcdef_vec( 04/,i,k-,, wit).EQ.p ==paramebcdef_periodici& - trgtmii=poiiiiiiiiimi!XO NOTHpmergtmii=poiiiiiiiiimk=)**2 (bcdef_vec( 04/,i,k-,, wit).EQ.p ==paramebcdef_ i Pebleti& - trgtmii=poiiiiiiiiiiiiIF (, wit.EQ.-i& - trgtmii=poiiiiiiiiiiiiiiia(j,k-)==mmmmii=poi=poIE IEpo=pooIF (bcdef_vec( 04/,i,k-,2).EQ.0i& - trgtmii=poiiiiiiiiiiiiiiiib(j,k-)=-=mmmmii=poi=poIE IEpo=pooENDi LSEiii=poiiiiiiiiiiiiiiii==mmmmii=poi=poIE IEpo=pooi(ij=1,max_nodehi,mlev)rgtmii=poiiiiiiiiiiiiiiiii(ik=1,max_nodeh3,mlev)rgtmii=poiiiiiiiiiiiiiiiiiiiiuub04/,i,j(,k,isub=RgINeld(j,k-,1)%bcvalue(, wit)%pbcvalue(i04/,,j,)rgtmii=poiiiiiiiiiiiiiiii!_Pdo ii=poi=popo=poiiiiii iiENDDO ii=poi=popo=poiiiiiik=)**2 (, wit.EQ.2i& - trgtmii=poiiiiiiiiiiiiiiib(j,k-)==mmmmii=poi=poIE IEpo=pooIF (bcdef_vec( 04/,i,k-,1).EQ.0i& - trgtmii=poiiiiiiiiiiiiiiiia(j,k-)=-=mmmmii=poi=poIE IEpo=pooENDi LSEiii=poiiiiiiiiiiiiiiii=max_nodeh1,mlev)rgtmii=poiiiiiiiiiiiiiiii(ij=1,max_nodehi,mlev)rgtmii=poiiiiiiiiiiiiiiiii(ik=1,max_nodeh3,mlev)rgtmii=poiiiiiiiiiiiiiiiiiiiiuub04/,i,j(,k,isub=RgINeld(j,k-,1)%bcvalue(, wit)%pbcvalue(i04/,,j,)rgtmii=poiiiiiiiiiiiiiiiiENDDO ii=poi=popo=poiiiiiiiii!_Pdo ii=poi=popo=poiiiiiik=)**2 (, wit.EQ.3i& - trgtmii=poiiiiiiiiiiiiiic(j,k-)==mmmmii=poi=poIE IEpo=pooIF (bcdef_vec( 04/,i,k-,4).EQ.0i& - trgtmii=poiiiiiiiiiiiiiiiid(j,k-)=-=mmmmii=poi=poIE IEpo=pooENDi LSEiii=poiiiiiiiiiiiiiij==mmmmii=poi=poIE IEpo=pooi(ii=1,max_nodeh1,mlev)rgtmii=poiiiiiiiiiiiiiii Doik=1,max_nodeh3,mlev)rgtmii=poiiiiiiiiiiiiiiiiiiux,04/,i,j(,k,isub=RgINeld(j,k-,1)%bcvalue(, wit)%pbcvalue(i04/,ij,)rgtmii=poiiiiiiiiiiiiiiii!_Pdo ii=poi=popo=poiiiiii iiENDDO ii=poi=popo=poiiiiiik=)**2 (, wit.EQ.4i& - trgtmii=poiiiiiiiiiiiiiid(j,k-)==mmmmii=poi=poIE IEpo=pooIF (bcdef_vec( 04/,i,k-,3).EQ.0i& - trgtmii=poiiiiiiiiiiiiiiiic(j,k-)=-=mmmmii=poi=poIE IEpo=pooENDi LSEiii=poiiiiiiiiiiiiiij=max_nodehi,mlev)rgtmii=poiiiiiiiiiiiiiiii(ii=1,max_nodeh1,mlev)rgtmii=poiiiiiiiiiiiiiii Doik=1,max_nodeh3,mlev)rgtmii=poiiiiiiiiiiiiiiiiiiiux,04/,i,j(,k,isub=RgINeld(j,k-,1)%bcvalue(, wit)%pbcvalue(i04/,ij,)rgtmii=poiiiiiiiiiiiiiiii!_Pdo ii=poi=popo=poiiiiii iiENDDO ii=poi=popo=poiiiiiik=)**2 (, wit.EQ.5i& henrgtmii=poiiiiiiiiiiiiiii!(j,k-)==mmmmii=poi=poIE IEpo=pooIF (bcdef_vec( 04/,i,k-,6).EQ.0i& - trgtmii=poiiiiiiiiiiiiiiiig(j,k-)=-=mmmmii=poi=poIE IEpo=pooENDi LSEiii=poiiiiiiiiiiiiiiik=1rgtmii=poiiiiiiiiiiiiiiii(ii=1,max_nodeh1,mlev)rgtmii=poiiiiiiiiiiiiiii Doij=1,max_nodehi,mlev)rgtmii=poiiiiiiiiiiiiiiiiiiiiux,04/,i,j(,k,isub=RgINeld(j,k-,1)%bcvalue(, wit)%pbcvalue(i04/,ijj)rgtmii=poiiiiiiiiiiiiiiii!_Pdo ii=poi=popo=poiiiiii iiENDDO ii=poi=popo=poiiiiiiik=)**2 (, wit.EQ.6i& henrgtmii=poiiiiiiiiiiiiiiig(j,k-)==mmmmii=poi=poIE IEpo=pooIF (bcdef_vec( 04/,i,k-,5).EQ.0i& - trgtmii=poiiiiiiiiiiiiiiiie(j,k-)=-=mmmmii=poi=poIE IEpo=pooENDi LSEiii=poiiiiiiiiiiiiiiik=max_nodeh3,mlev)rgtmii=poiiiiiiiiiiiiiiii(ii=1,max_nodeh1,mlev)rgtmii=poiiiiiiiiiiiiiii Doij=1,max_nodehi,mlev)rgtmii=poiiiiiiiiiiiiiiiiii iiux,04/,i,j(,k,isub=RgINeld(j,k-,1)%bcvalue(, wit)%pbcvalue(i04/,ijj)rgtmii=poiiiiiiiiiiiiiiiiENDDO ii=poi=popo=poiiiiiiiiiENDDO ii=poi=popo=poiiiiiikNDi LSEiii=poiiiENDi LSEiii=poiiiiiiiiiiiiiENPdo !i with-PPM. IEiiiiiiii!mmmm !periodic ii=poi=popo=poEnPdo !i04/mmmmii=poiENDDO!i(iphim i=popo=ppppppprnel is specified (and to make SXF90 unfold the loops).mii=poiiiimmmmii=poi=poIErCommuni atb Mes(that) _O colfO==0ANTYcommuni atb black(odd)rgtmii=poiiiiii!_O colfO===mmmmii=poi=poIErnel is specified (and to make SXF90 unfold the loops).mii=poiiiimmmmii=poi=poIE,0,-1p ==mar_INeld_topo__get(ERmmm -mmmNTE_g(mlev), h IFOmmm ad_fhamjac_rerrit_ lf_stetopo_id, ,mmmmmmmmmii=poi=poi ,0,-1p ==mar_INeld_push(ERmmm -mmmNTE_g(mlev),u,vecdim,mmmmmmmmmii=poi=poi ,0,-1p ==mar_INeld_s!_P(mmmmmmmmmii=poi=poi ,0,-1p ==mar_INeld_pop(ERmmm -mmmNTE_g(mlev),u, h IFOmmm ad_fhamjac_rerrit_ lf_ste vecdim,topo_id, ,mmmmmmi=poiii =sBROTOR 2222222222222i(i,sub=1,ns0,-mmmmii=poi=popoi(ik=-1,-2/3,j,k-,1)+e(j,k-),is(dph3,j,k-,1)-g(j,k-)rgtmii=poiiiiiiiiii(ij=-1,-2/i,j,k-,1)+c(j,k-),is(dphi,j,k-,1)-d(j,k-)rgtmii=poiiiiiiiii poi(i,=-1,-2/1,j,k-,1)+mod(j+k+colfO,2)+a(j,k-),iiiiiiii ad_fhamjac_rrrrris(dph1,j,k-,1)-b(j,k-)-mod(j+k+colfO,2),2mmmmii=poi=popo=pooooooooIF ((i.GE.1.AND.i.LEimax_nodeh1,mlev)).AND.iiiiiiii a(j.GE.1.AND.j.LEimax_nodeh2,mlev)).AND.(k.GE.1.AND.k.LEimax_nodeh3,mlev))i& - trgtmii=poiiiiiiiiiiiiiiiiRilduosC3) uh1,ji,j,k,isubrgtmii=poiiiiiiiiiiiiiiiiRilduo2C3) uh2,ji,j,k,isubrgtmii=poiiiiiiiiiiiiiiiiRilduo3C3) uh3,ji,j,k,isubrgtmii=poiiiiiiiiiiiiiiiuh1,ji,j,k,isub=RilduosC+omega*iiiiiii ad_fhamjac_rrrrrrrrrrrrrrrr(&rgtmii=poiiiiiiiiiiiiiii&c1*((uu1,b)i-i&,k,isub+iiiiiiii ad_fhamjac_rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrui1,iiiiiikij,k-1,*c2 ROUTINE ad_fhamjac_rerrit_+(uu1,b)i-i&k&phim)+ui1,iiiiiikij,k-1,*c3 ROUTINE ad_fhamjac_rerrit_+(uu1,ji,j,oiiiiiii+uu1,ji,j,iiij,k-1,*c4-iiiiiiii ad_fhamjac_rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrfx1,ji,j,k,isub)& &-RilduosCbrgtmii=poiiiiiiiiiiiiiiiuh2,ji,j,k,isub=Rilduo2C+omega*iiiiiii ad_fhamjac_rrrrrrrrrrrrrrrr(&rgtmii=poiiiiiiiiiiiiiii&c1*((uu2,b)i-i&,k,isub+iiiiiiii ad_fhamjac_rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrui2,iiiiiikij,k-1,*c2 ROUTINE ad_fhamjac_rerrit_+(uu2,b)i-i&k&phim)+ui2,iiiiiikij,k-1,*c3 ROUTINE ad_fhamjac_rerrit_+(uu2,ji,j,oiiiiiii+uu2,ji,j,iiij,k-1,*c4-iiiiiiii ad_fhamjac_rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrfx2,ji,j,k,isub)& &-Rilduo2Cbrgtmii=poiiiiiiiiiiiiiiiuh3,ji,j,k,isub=Rilduo3C+omega*iiiiiii ad_fhamjac_rrrrrrrrrrrrrrrr(&rgtmii=poiiiiiiiiiiiiiii&c1*((uu3,b)i-i&,k,isub+iiiiiiii ad_fhamjac_rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrui3,iiiiiikij,k-1,*c2 ROUTINE ad_fhamjac_rerrit_+(uu3,b)i-i&k&phim)+ui3,iiiiiikij,k-1,*c3 ROUTINE ad_fhamjac_rerrit_+(uu3,ji,j,oiiiiiii+uu3,ji,j,iiij,k-1,*c4-iiiiiiii ad_fhamjac_rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrfx3,ji,j,k,isub)& &-Rilduo3Cbrgtmii=poiiiiiiiiiiiiENDDO ii=poi=popo=poiiENDDO ii=poi=popo=poENDDO ii=poi=popooENDDO!s0,-mNGLub)i= phi(i,,,,,i(i,sub=1,ns0,-mmmmii=poi=popoi(ik=-1,-2/3,j,k-,1)+e(j,k-),is(dph3,j,k-,1)-g(j,k-)rgtmii=poiiiiiiiiii(ij=-1,-2/i,j,k-,1)+c(j,k-),is(dphi,j,k-,1)-d(j,k-)rgtmii=poiiiiiiiii poi(i,=-1,-2/1,j,k-,1)+mod(j+k+colfO,2)+a(j,k-),iiiiiiii ad_fhamjac_rrrrris(dph1,j,k-,1)-b(j,k-)-mod(j+k+colfO,2),2mmmmii=poi=popo=pooooooooIF ((i.GE.1.AND.i.LEimax_nodeh1,mlev)).AND.iiiiiiii aaaaaaaaaaaaaaaaaaaa(j.GE.1.AND.j.LEimax_nodeh2,mlev)).AND.(k.GE.1.AND.k.LEimax_nodeh3,mlev))i& - trgtmii=poiiiiiiiiiiiiido ,lda=1,vecdimrgtmii=poiiiiiiiiiiiiiiiiRilduo,ldaC3) uh,04/,i,j(,k,isubrgtmii=poiiiiiiiiiiiii!_P do ii=poi=popo=poiiiiii i(i,lda=1,vecdimrgtmii=poiiiiiiiiiiiiiiiuub04/,i,j(,k,isub=Rilduo,ldaC+omega*iiiiiii ad_fhamjac_rrrrrrrrrrrrrrrr(&rgtmii=poiiiiiiiiiiiiiii&c1*((uub04/,i)i-i&,k,isub+iiiiiiii ad_fhamjac_rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrruii04/,iiiiiikij,k-1,*c2 ROUTINE ad_fhamjac_rerrit_+(uub04/,i,joiik&phim)+uii04/,i,jiiikij,k-1,*c3 ROUTINE ad_fhamjac_rerrit_+(uub04/,i,j(,oiiiiiii+uub04/,i,j=piiij,k-1,*c4-iiiiiiii ad_fhamjac_rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrfx,04/,i,j(,k,isub)& &-Rilduo,ldaCbrgtmii=poiiiiiiiiiiiiiENDDO ii=poi=popo=poiiiENDi LSEiii=poiiiiiiiiiiiiENDDO ii=poi=popo=poiiENDDO ii=poi=popo=poENDDO ii=poi=popooENDDO!s0,-mNG_PRECmii=poi=poENDDO!i(icolfOdiiiphimiiiiiIF (,sweep.EQ.nsweepE - trgtmii=poiiiiii,0,-1p ==mar_INeld_topo__get(ERmmm -mmmNTE_g(mlev), h IFOmmm ad_fhamjac_rerrit_ lf_stetopo_id, ,mmmmmmmmmii=poi=poi ,0,-1p ==mar_INeld_push(ERmmm -mmmNTE_g(mlev),u,vecdim,mmmmmmmmmii=poi=poi ,0,-1p ==mar_INeld_s!_P(mmmmmmmmmii=poi=poi ,0,-1p ==mar_INeld_pop(ERmmm -mmmNTE_g(mlev),u, h IFOmmm ad_fhamjac_rerrit_ lf_ste vecdim,topo_id, ,mmmmmmit_ lf_ste ENDi LSEiii=pENDDO rit_ lf_ste optCI=p ==paramedet,O :: t, poldu1osC=vecdimrgtmii=poiiii,0,-1p ==t,O (Rildu,ldu1, opt,immmmmmmmii=poi=poIF ( C.NEi 0i& - trgtmii=poiiii CI=p ==naifOefatalmmmmii=poi=po,0,-1p ==naifO(p ==nai_a,O ,'GSsolv', ooo h IFOm ad_fhamjac_rerrit_ lf_s'Rildu',__LINE__,mmmmmmmmmii=poi=poGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (and to make SXF90 unfold the loops).mii=poiiiii!lonOiiiphimirkindturnOiiiphimirnel is specified (and to make SXF90 unfold the loops).mii=poiiiii!lon- 9999i=po,ONTINUEOiiiphimi,0,-1,0,-1op(),(/3-g_smooth_INGL t0 Ommmmmmmmmii=poRETURN oii=piiN!cjac_rerFIELDiiiiiiiiiiESHiN!cj jac_re2Dmii=poiiinda/aoiii=> pmes%nnodesmii=poiiiis_foderrit_ lf_step_-g_smooth_INGLe2D_sca_siiii mmmmmmmmmmmmmmmmmmmmmmmmmmres,topo_id_foderrit_ lf_step_-g_smooth_INGLe2D_sca_d E__PRECI!c_O mmmESHiN!cjac_re3Dmii=poiiinda/aoiii=> pmes%nnodesmii=poiiiis_foderrit_ lf_step_-g_smooth_INGLe3D_sca_siiii mmmmmmmmmmmmmmmmmmmmmmmmmmres,topo_id_foderrit_ lf_step_-g_smooth_INGLe3D_sca_d E__PRECI!mmmmmI!c_O mmN!cjac_reVFIELDiiiiiiiiiiESHiN!cj jac_re2Dmii=poiiinda/aoiii=> pmes%nnodesmii=poiiiis_foderrit_ lf_step_-g_smooth_INGLe2D_vec_s E_PRECmmmmmmmmmmmmmmmmmmmmmmmmmres,topo_id_foderrit_ lf_step_-g_smooth_INGLe2D_vec_d E__PRECI!c_O mmmESHiN!cjac_re3Dmii=pcec_d 8 3oiii=> pmes%nnodes%nnodes%nnou omarlibc_rnumerics-r1036/src/c_regmm_creata/admatrix.m0000644000175000017500000000472111616214647021110 0uoi(i omaromar%i! ,MG NDi f (c4.oi=s!! 2matrixeh l0!! 2bi-cubicte terpolc_Oiiiin 2D %iin c_regmm_kickoff. % %i oiiiPurpegmm_creata/admatrix.miPuks%mm : mii=! oiiiPumarkslmmmm : m--H:: 5), itis%nd_doubleh leh mii=poi! Define %s%mm : mii=! o2fha2/02ix6:0 01d_do49), itis%n,cCI! die loopout ,M. %s%mm : mii=! o1fha2/02ix6:0 01d_3:00), itis%n-GER, P clon--in. %s%oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (ecified (aRECI!cAptCzeros(16,16);aRECI!ch l0n=0:3, nm1ega_-1; % 0.0**n ohnfold.0; ste(n==0), ohnfol1.0;.AND; % 0.0**(_-1) ohnm1egad.0; ste(n==1), ohnm1ega1.0;.AND; h l0:=0:3, mm1egam-1; % 0.0**m ohmegad.0; ste(m==0), ohmega1.0;.AND; % 0.0**(m-1) ohmm1egad.0; ste(m==1), ohmm1ega1.0;.AND; %i! e3:12ientiindex indega4*n+m+1; %im --> x % n --> y %oi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (ecified (aRECI!c % VALUES %oi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (ecified (aRECI!c Ai(ijndGE.1ohm*ohn; Ab)i=ndGE.1ohn; Ab3ijndGE.1ohm; Ab4ijndGE.11.0; %oi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (ecified (aRECI!c % Dx %oi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (ecified (aRECI!c Ai5ijndGE.1m*ohmm1*ohn; Ab6ijndGE.1m*ohn; Ab7ijndGE.1m*ohmm1; Ab8ijndGE.1m; %oi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (ecified (aRECI!c % Dy %oi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (ecified (aRECI!c A(9ijndGE.1n*ohm*ohnm1; Ab10ijndGE.1n*ohnm1; Ab11ijndGE.1n*ohm; Ab1)i=ndGE.1n; %oi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (ecified (aRECI!c % DxDy %oi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (ecified (aRECI!c f .1m*n; Ab13ijndGE.1f*ohmm1*ohnm1; Ab14ijndGE.1f*ohnm1; Ab15ijndGE.1f*ohmm1; Ab16ijndGE.1f; AND; AND; [L,U,P]E.1lu(A);aRECI!cALUE.1(L-eyeb16))+U;aRECI!cindegaP*[1:1:16]';aRECI!csave 'gaga_ind.dat'cinde-ASCII;aRECI!cALUTegaALU'; % FORTRAN HAS COLUMN MAJd_s!_P(mmsave 'gaga_a.dat'cALUTe-ASCII;aolibc_rnumerics-r1036/src/c_refmm_pretraublee.f0000644000175000017500000004052711616214647020371 0uoi(i omaromar!_P(mmpoGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Subroutd 8I!c: c_refmm_pretraublee !_P(mmpoGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c!aRECI!c! Purmmmmiiiiii: Do a pretrauble P h l0!! 2i(iget poe ts), ie termd 8aRECI!c! which particoi=ENre need dih l0!! 2! ,Mc_Oii. aRECI!c!aRECI!c! In ,M : tpesmii (F) : mmmpoi=poi Gi(iget poe tsaRECI!c! Ntp (I) : numberoi Gi(iget poe tsaRECI!c! toiiIF ( (I) : iiIF ( on iwhich particoi=aRECI!c! Nre mapp ditoaRECI!c! aRECI!c!aRECI!c! In ,M/Out ,M : aRECI!c! aRECI!c! Out ,M : aRECI!c! c90 unfffffffffffff(I) : iingthoi G! e3:old he loops).! partold he (ii (I) : miENDG! ntaining need daRECI!c! particoi=Efrom o!! r proc=aRECI!c! 1stiindex:oopsidaRECI!c! p90 unfffffffffffff(I) : iingthoi Gpartold he ffffffaRECI!c! e oppppppppppppppp(I) : rmmmmm oi(tusaRECI!c!aRECI!c! ,cCarksRECI!c:aRECI!c!aRECI!c! ,cferencesI!c:aRECI!c!aRECI!c! ,c: mii=sCI!c:aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! i oiiiPurpefmm_pretraublee.fiPuksRECI!c! ,c: mii=! oiiiPumarkslmmmm : m--H:: 4), itisRECI!c! d_doubleh leh mii=poi! Define RECI!c!aRECI!c! ,c: mii=! oi8markslmm1/23 09:35:17 hieberisRECI!c! BugfixiPurpee ternal_i=poi need=ENDmi!X--- (=mi!X---list(biiIF (curbox)ac_rerrit! as e ,M RECI!c!aRECI!c! ,c: mii=! oi7marks6/09/04 H::34:47 p9hatelaaRECI!c! Fixi=ENDi coianups, imake it2! ileih laRECI!c! reoiase-1-0 RECI!c!aRECI!c! ,c: mii=! oi6marks6/06/29 m--2::36 p9hatelaaRECI!c! Add dive(c4.LstringthsooppporM RECI!c!aRECI!c! ,c: mii=! oi5marks6/06/20 15:14:42 hieberisRECI!c! 9hange e ,MdiiiphimiEfrom i!X--- iii=pnumberoi Gii=piiIF ((toiiIF ) RECI!c!aRECI!c! ,c: mii=! oi4fha2/02i9/19 m3:03:29 polcsekbsRECI!c! 9od 2! smeticsaRECI!c!aRECI!c! ,c: mii=! oi3fha2/02i9/12 m3:30: 4),polcsekbsRECI!c! add diurpeopsidaRECI!c!aRECI!c! ,c: mii=! oi2fha2/02i9/12 m1:38:03 polcsekbsRECI!c! 9hanged duplex clon- iflag-miENDi LSEiii!aRECI!c! ,c: mii=! oi1fha2/02i9/11 H::05:31 polcsekbsRECI!c! (final?)2! rre(c diveleh lsRECI!c! (als iworksR_INellF (:-) RECI!c!aRECI!c! ,c: mii=! oi0fha2/02i9/11 H1:44:46 polcsekbsRECI!c! now using ! rre(c i!X--- h l0oiaf boxei LSEiii!aRECI!c! ,c: mii=! o9fha2/02i9/10 07:5--22 polcsekbsRECI!c! 9hanged i=pooi Goi(n- h l0_INellF (veleh lsRECI!c!aRECI!c! ,c: mii=! o8fha2/02i9/05 06:24:42 polcsekbsRECI!c! _pop(ERc_Oiiiphi(ERclmmmii=poi=sRECI!c! 9hon-ing i!X-loge RECI!c!aRECI!c! ,c: mii=! o7fha2/02i8/23 14:35:04),polcsekbsRECI!c! add diuINel terGii=ta (asiin cotimiia ) RECI!c!aRECI!c! ,c: mii=! o6fha2/02i8/23 14:32:14),polcsekbsRECI!c! ! rre(c diacceptance critiiiilsRECI!c!aRECI!c! ,c: mii=! o5fha2/02i7/29 m2:37:32 polcsekbsRECI!c! 9hanged diagonal iradiusaRECI!c!aRECI!c! ,c: mii=! o4fha2/02i7/21 m2:42-2:),polcsekbsRECI!c! adapte- ii(iget poe tsaRECI!c!aRECI!c! ,c: mii=! o3fha2/02i6/04 0--2::29), itisRECI!c! Fixid syntax sC=ve (XLF) in logiRclm! miisi=s.aRECI!c!aRECI!c! ,c: mii=! o2fha2/02i6/02 14:35:01 polcsekbsRECI!c! 9hanged op(ERc_Oiiiphimmii=poi=sRECI!c!aRECI!c! ,c: mii=! oifha2/02i5/27 0::02:14),polcsekbsRECI!c! iGER, P immmmmmmmmii=poiENDi !aRECI!c! ,c: mii=!0fha2/4/11/i7m16:02:03 polcsekbsRECI!c! oi(ik.aRECI!c!aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Copyright (c)ha210 CSE Lab (ETH Zuk-,,), MOSAIC Group (ETH Zuk-,,), aRECI!c! Ce ter h l0Flu-- Dynamics (DTU) RECI!c!aRECI!c!aRECI!c! Thi=EfileiisR_INteh mii=poINellF (Particoi Mesh LDefine (oi!).aRECI!c!aRECI!c! oi! i=Efree softwNre: you cNDmredistrib,MG pooNDi/ l0:odife RECI!c! pooundel0!! 2iermseh mii=pGNU Lessel0GeneNel Public LDcenee !_P(mmp as published bymii=pFree SoftwNre F=poi=ii=p, ei!! r !_P(mmp ubleh le3eh mii=pLDcenee,mii=(at youroipii=p)oNDy lat r !_P(mmp ubleh l.aRECI!c!aRECI!c! oi! i=Edistrib,MGd i=mii=phop=s!!at poowillGE useful,aRECI!c! b,M WITHOUT ANY WARRANTY;owitho,M mmmiiii=pimmmiGd wmiENntyeh aRECI!c! MERCHANTABILITYmii=FITNESS FOR A PARTICULAR PURPOSE. Se=s!! aRECI!c! GNU GeneNel Public LDcenee h l0:ore d=tails.aRECI!c!aRECI!c! You sho,ld have re(ei! diam! pyeh mii=pGNU GeneNel Public LDcenee !_P(mmp aDi ii=pGNU Lessel0GeneNel Public LDcenee along with oi!. If not,aRECI!c! se=s.aRECI!c!aRECI!c! oINellF (Particoi Mesh LDefine (oi!)aRECI!c! ETH Zuk-,,aRECI!c! CH-8092 Zuk-,,, SwitzerlaDi aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (alf_step_-g_smooth_INGLe2D_vec_s E_PRECmmmmmmESHiN!cjac_refmm_pretraublee_s(tp,Ntp,toiiIF ,ii=ta,,O (Rildu,ldu1, optc90 un,partold he ,p90 unpoi ,0,-f_step_-g_smooth_INGLe2D_vec_d E__PRECI!cmmESHiN!cjac_refmm_pretraublee_d(tp,Ntp,toiiIF ,ii=ta,,O (Rildu,ldu1, optc90 un,partold he ,p90 unpoi ,0,-f=po,0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d ( aRECI!c! Moduoi=EaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!cUSjac_re3oduoi_i=iaaRECI!cUSjac_re3oduoi_i=iaefmmaRECI!cUSjac_re3oduoi_sio>0',__LINUSjac_re3oduoi_typedef',__LINUSjac_re3oduoi_op(ERmmm -mUSjac_re3oduoi_writimmm -mUSjac_re3oduoi_sunfold mmm -mUSjac_re3oduoi_sunfoop aRECI!cIMPLICIT NONEaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Includi=sRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (a#includi "d the _d 8.h",-1p ==m__MPIaRECI!cINCLUDE ' if.h',-f=po,0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Pre(ieh lsRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (RECI!cep_-g_smog_smooth_INGLe2D_vec_s E_PRECmmmmINTEGER, PARAMETER :: MKptCI=p -ind_singlerrrrrrrrrrrrrINTEGER, PARAMETER :: MKptCI=p -ind_double,-f=po,0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Aiiphimi=EaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!cREAL(MK), DIMEN E_Pesmii ==t, POINTERdu1, opt:: tprrrrrrrINTEGER, INTENT(IN )pt:: NtprrrrrrrINTEGER, INTENT(IN )pt:: toiiIF aRECI!cREAL(MK), INTENT(IN )pt:: ti=tarrrrrrrINTEGER, INTENT( HiN)pt:: c90 unffffffrrrrrrrINTEGER, DIMEN E_Pes ), POINTERdu1, opt:: partold he rrrrrrrINTEGER, INTENT( HiN)pt:: p90 unffffrrrrrrrINTEGER, INTENT( HiN)pt:: e opppppp0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! LERclmmmii=poi=p0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! auxili99mmmmii=poi=aRECI!cLOGICAL du1, opt:: drctaRECI!cLOGICAL,DIMEN E_Pes), POINTERdu1, o:: flag! e3:,flagpld mmm -mINTEGER du1, opt:: j,k-cunpiiIF aRECI!cINTEGER du1, opt:: root,,topo_oi(taRECI!cREAL(MK) du1, opt:: dx,dy,dz,dist,rad,t0 aRECI!cINTEGER du1, opt:: oi(n-poe ter,curbox,curi=popo=poiINTEGER,DIMEN E_Pes), POINTERdu1, o:: oi(n-opo=poiINTEGER,DIMEN E_Pe1) :: ecdiopo=poiINTEGER,DIMEN E_Pe2) :: ecd,j,k-,1)CHARACTER(LEN=256) :: cbu,0,-1p =TYPEcdimrt_i=po), POINTERdu1, o:: i=poaRECI!c! _INellF ismii=poiENDi INTEGER du1, opt:: curi!X---oiENDi INTEGER du1, opt:: i!X---oiENDi INTEGER,DIMEN E_Pes), POINTERdu1, o:: lpartold he rrrrrrrINTEGER,DIMEN E_Pesmii =POINTERdu1, o:: l! e3:old he loops).! fmmaRECI!cREAL(MK),DIMEN E_Pes), POINTERdu1, o:: radiusdu1, oaRECI!cREAL(MK),DIMEN E_Pesmii POINTERdu1, o:: ce terofboxaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! InER, Poi=saRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!che loops).(ik='c_refmm_pretraubleemirkindturnOiiiph!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Clon- pre(ieh l aDi poe ting i!0!! 2! rre(c mmii=poi=sRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (alf_stepsmog_smooth_INGLe2D_vec_s E_PRECmmmmce terofbox =>mce terofbox_=sRECI!cradiusdu1, o=>mradius_rrrrrrrrrrrrrrce terofbox =>mce terofbox_dsRECI!cradiusdu1, o=>mradius_d,-f=po,0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! FiDi ii=prooteh mii=ptree (seria ) aDiloops).! fiDi ioppiiIF (h miree (_INellF rnOiiiph!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!ci!X--- =mi!X---list(toiiIF ) -1p ==mar_INeld_s!_P(mm_stec_renproc .GT. ii=poiiiiiiiiimi!! fiDiing i!X iiIF aRECI!c 4/,i,k-,5niiIF aRECI!c 4/mm_stenbpl(i) +col c_renprocpoiiiiiiiiiiiiENDDO iiiIF (= iiiiiiiiiENDD)rrgtmii=poiiiiiiiiimii=poiux,0mii=poiii_stecare te1) Di L==mar_INeldunde_d 8dpoiiiiiiiiiiiiENDDrootepbcvalue(,j,ux,0mii=poiii 4/,i,k-,5nboxaRECI!cii=poiii_stecare tei) Di L==mar_INeldunde_d 8dpoiiiiiiiiiiiiENDDiiENDDrootepbiiiiiiiiiENDDiiEiux,04/,i,j(,k,isub=iiii ad_fhamjag(mlev),u,mm_sttttttrrrrrrrrrrrrrIstec_renproc .GT. ii=poiiiiiiiiimi!! fiDiing i!X iiIF aRECI!c 4/,i,k-,5niiIF aRECI!c 4/mm_stenbpl(i) +col c_renprocpoiiiiiiiiiiiiENDDO iiiIF (= iiiiiiiiiENDD),u,XITiiiiiiiiENDD)rrgtmii=poiiiiiiiiimii=poiux,0mii=poiii_stecare te1) Di L==mar_INeldunde_d 8dpoiiiiiiiiiiiiENDDrootepbcvalue(,j,ux,0mii=poiii 4/,i,k-,5nboxaRECI!cii=poiii_stecare tei) Di L==mar_INeldunde_d 8dpoiiiiiiiiiiiiENDDiiENDDrootepbiiiiiiiiiENDDiiE),u,XITiiiiiiiiENDDNDD)rrgtmii=poiiiiisub=iiii ad_fhamjag(mlev),u,mm_s,-f=po,0,-1p =c90 unfold the lop90 unfold the lo!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Ap(ERc_G NDi inER, Poi=s(ERclmmmii=poi=sRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c0,-1pd the loops).mii=poiiiii!lon-_oi(tfold the log(mlev)E.1nboxaRECI!cmjac_rerrit_ lfoi(n-vecdim,topo_id, ,mmmmmm_oi(tfol_oi(tf+ e oaRECI!cmjac_rerrit_ lflpartold he vecdim,topo_id, ,mmmmmm_oi(tfol_oi(tf+ e oaRECI!cmjac_rerrit_ lfflag! e3:,ecdim,topo_id, ,mmmmmm_oi(tfol_oi(tf+ e oaRECI!cmjac_rerrit_ lfflagpart,ecdim,topo_id, ,mmmmmm_oi(tfol_oi(tf+ e oaRECI!cecd,ev)E.12aRECI!cecd,e2)E.1nboxaRECI!cmjac_rerrit_ lfl! e3:old he ,ecd2m,topo_id, ,mmmmmm_oi(tfol_oi(tf+ e oaRECI!cpo=poii(tf LSEiii=pENDDO rit_ lfe optCI=p ==paramedet,O :, poldu1osC=vecdimrgtmii=poiiic_refmm_pretraubleemi,O (Rildu,ldu1, 'sC=ve op(ERc_Ong mmii=poi=IF ( C.NEi 0i& - trgoiiii CI=p ==mjag(mlev),u,i,k-,5nboxaRECI!ciioi(n-ei) old the looplpartold he ei) old the loopl! e3:old he i(ij) old the loopl! e3:old he i2ij) old the loopflag! e3:ei) = .FAx,0. the loopflagpartei) = .FAx,0. the loub=iiii ad_f!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Traublee iree NDi build listGpartold he fNDi c e3:old he loops).!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c,i,k-,5Ntp ,O :Istec_renproc .GT. ii=poiii I!c! inER, Poee oi(n- _INellF mii=poiiiiisoi(n-poe ter pbcvalue(,j,)rgcunfold the loops).!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified the loops).! CollF(c allGEoxi=ENtmii=phighestGiiIF ((doesunfve(c4.oi=) the loops).!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified 4/,i,k-,1nboxa :IstebiiIF (j) Di L=iiIF )=poiii I!ciiisoi(n-(oi(n-poe ter) oljiiiiiiiiENDDiiE)oi(n-poe ter pboi(n-poe ter +bcvalue(,j,)rgtmiicunfolcunf+1i I!ciiisIstecunfDi L=nbpl(iiIF )ooooIF ((i.GE.1.AND.i.LEi,XITiiiiiiiiENDDNDDiij,k-1,*c4-iiiiiiiii I!cii)rrgtmii=poiiiiisub=iiii ad_fha,ux,0m !c! inER, Poee oi(n- seria mii=poiiiiioi(n-poe ter pbcvalue(,j,)roi(n-(oi(n-poe ter) olrootmii=poiiiiioi(n-poe ter pboi(n-poe ter +bcv i)rrgtm /,i,WHILE (oi(n-poe ter .GT. iii I!ccurbox pboi(n-(oi(n-poe ter-1) dx pbt i(ij) -mce terofboxi(icurbox)mii=poiiiiisdy pbt i2ij) -mce terofboxi2icurbox)mii=poiiiiisdz pbt i3ij) -mce terofboxi3icurbox)mii=poiiiiisdistG= SQRT(dx*dx +sdy*dy +sdz*dz) !pe fhe fboxaRECI!cii=pooi(n-poe ter pboi(n-poe ter -1i I!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified the loops).! Chon-ing Barnes-Hut Critiiium the loops).!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified 4/Isteradius(curbox) mmmmad.0_MK) ooIF ((i.GE.1.AND.i!only one particoi i=mbox,x_nodire(c ! ,Mc_Oii ((i.GE.1.AND.idrct = .TRU0. the loop i)rrgtm /oiiiiiidist/(2*radius(curbox)) .GT. ti=ta) .+colf=poi=pidrct))=poiii I!ciiicuri!X--- =mi!X---list(biiIF (curbox)a the loop curi=pptCI=p opsid(curbox,biiIF (curbox)a the loop ND.i!far enough,i! ,MG part-box e terac_Oii ((i.GE.1.Ai!X-o=>mdimrt!X-(curi!X---)%ti I!ciiiIstec_rerankf LSEii!X-%ops2proc(curi=p)ooooIF ((i.GE.1.AND.i.LE! clon- if it=EN duplDO!i( ((i.GE.1.AND.i.LEmii=poi=ppflag! e3:ecurbox)) ooIF ((i.GE.1.AND.i.LEimc90 unffffffffffffffffff=mc90 un+**2 (, wit.EQ.6i& henl! e3:old he i(ic90 un) olcuri=popo=poiit.EQ.6i& henl! e3:old he i2ic90 un) olbiiIF (curbox)opo=poiit.EQ.6i& henflag! e3:ecurbox)fffffff=m.TRU0. the loop iiiiiiiRgINeld(j,k-,1)%bcvalueNeld(j,k-,1)%bcva!ux,0 : ok, on same processENDDO ii=poi=pux,0mii=poiii 4/ !notefar enough,imii= clilderi ((i.GE.1.AND._stenchld(curbox) mGT. poiiiiii iiENDDO ii=poi,i,k-,1nchld(curbox)opo=poiit.EQ.6i& he_steoi(n-poe ter .mmmanbox) ooIF ((i.GE.1.AND.i.LEimaxoi(n-(oi(n-poe ter) olclild(jicurbox)mii=poiiiiisD.i.LEimaxoi(n-poe ter pboi(n-poe ter +bcvalue(,j,)rgtmiicvalueNeld(j,k-,1)%bcvaamjac_rrrrrrrrrrrrrrrr_steoi(n-poe ter .GT. nbox+ii=poiiiiiiiiimi!XO NOTHpm, poldu1owritiec_rerankiic_refmm_pretraubleemi,O (Rildddddddddddddddddddu,ldu1, op'oi(n- oublflow'_get(ERmmm -mmmNTE_galueNeld(j,k-,1)%bcvux,0mii=poiii 4/ curi=pptCI=p opsid(curbox,toiiIF ) mii=poiii 4/ !nolclildren,odire(c ! ,Mc_Oii ((i.GE.1.AND.i !particoi=Eonly need dioiiii=p_d 8st i!X-loge RECI!cccccccccci!X-o=>mdimrt!X-(i!X---)%tiRECI!ccccccccccIstec_rerankf LSEii!X-%ops2proc(curi=p)ooooIF ((i.GE.1.AND.i.LEmii=poi=ppflagpartecurbox)) ooIF ((i.GE.1.AND.i.LEimp90 unfffffffffffffpd th90 unf+1fffffffffffffpdopo=poiit.EQ.6i& henlpartold he ep90 un) olcuri=popo=poiit.EQ.6i& henflagpartecurbox)fffpd t.TRU0. the loop iiiiiiiRgINeld(j,k-,1)%bcvaalueNeld(j,k-,1)%bcvuux,04/,i,j(,k,isub=Rgfffffpdopo=poiit.mjac_dopo=poimjac_dffpdopo=poi!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Ap(ERc_G !! 2! rre(c poi=(h mrmmmmm mmii=poi=p0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!cnfold the loops).mii=poiiiii!lon-g(mlev)E.1p90 unaRECI!cmjac_rerrit_ lfpartold he vecdim,topo_id, ,mmmmmm_ste ENDi LSEiii=pENDdopo=poiit.Ee optCI=p ==paramedet,O ::, poldu1osC=vecdimrgtmii=poiiic_refmm_pretraubleemi,O (Rildu,ldu1, 'sC=ve op(ERc_Ong partold he IF ( C.NEi 0i& - trgoiiii CI=p ==mjag(mlev),u,i,k-,5p90 unaRECI!c partold he (i) =plpartold he ei) the loub=iiii ad_f!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Deop(ERc_Ong (ERclmmmii=poi=sRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c0ii(tfffffold the log(mlev)Effold the log(m2(1:2) old the lomjac_rerrit_ lfoi(n-vecdim=mar_INeld_pop(ERo_id, ,mmmmmm_oi(tfol_oi(tf+ e oaRECI!cmjac_rerrit_ lflpartold he vecdim=mar_INeld_pop(ERo_id, ,mmmmmm_oi(tfol_oi(tf+ e oaRECI!cmjac_rerrit_ lfl! e3:old he ,ecd2m=mar_INeld_pop(ERo_id, ,mmmmmm_oi(tfol_oi(tf+ e oaRECI!cmjac_rerrit_ lfflag! e3:,ecd2m=mar_INeld_pop(ERo_id, ,mmmmmm_oi(tfol_oi(tf+ e oaRECI!cmjac_rerrit_ lfflagpart,ecd2m=mar_INeld_pop(ERo_id, ,mmmmmm_oi(tfol_oi(tf+ e oaRECI!cpo=poii(tf LSEiii=pENDDO rit_ lfe optCI=p ==parasio>0',__LIN ::, poldu1osC=vecdimrgtmi_pop(ERoic_refmm_expaneh lmi,O (Rildu,ldu1, 'sC=ve deop(ERc_Ong newlpdxIF ( C.NEi 0i& - trgoiiii CI=p ==mjag(mlev),u!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! mmmmmmp0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (and to ke SXF90 unfoldhe loops).mii=poiifmm_pretraubleemirkindturnOiiiphirnel is speep_-g_smooth_INGLe2D_vec_s E_PRECmmmmmmmmmmmmmmmmmmmmmmmfmm_pretraublee_sodesmii=pg_smooth_INGLe2D_vec_d E__PRECI!c_O mmmESHiN!cjac_refmm_pretraublee_dodes%nnou omarlibc_rnumerics-r1036/src/c_re3oduoi_mgrit_ l.f0000644000175000017500000001064211616214647020305 0uoi(i omaromarlev),u!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Moduoi,__LIN ::: c_re3oduoi_mgrit_ lmlev),u!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c!aRECI!c! Purmmmmiiiiii:: multigrid op(ERc_Oiii 3oduoiaRECI!c! aRECI!c!aRECI!c! ,cCarksRECI!cc:aRECI!c!aRECI!c! ,cferencesI!c:: aRECI!c!aRECI!c! ,c: mii=sCI!cc:aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! i oiiiPurpe3oduoi_mgrit_ l.fiPuksRECI!c! ,c: mii=! oiiiPumarkslmmmm : m--H9:00), itisRECI!c! d_doubleh leh mii=poi! Define RECI!c!aRECI!c! ,c: mii=! o2fha2/4/09/22 H::23:34 kotsaliiaRECI!c! MG new(veleh lsRECI!c!aRECI!c!aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Copyright (c)ha210 CSE Lab (ETH Zuk-,,), MOSAIC Group (ETH Zuk-,,), aRECI!c! Ce ter h l0Flu-- Dynamics (DTU) RECI!c!aRECI!c!aRECI!c! Thi=EfileiisR_INteh mii=poINellF (Particoi Mesh LDefine (oi!).aRECI!c!aRECI!c! oi! i=Efree softwNre: you cNDmredistrib,MG pooNDi/ l0:odife RECI!c! pooundel0!! 2iermseh mii=pGNU Lessel0GeneNel Public LDcenee !_P(mmp as published bymii=pFree SoftwNre F=poi=ii=p, ei!! r !_P(mmp ubleh le3eh mii=pLDcenee,mii=(at youroipii=p)oNDy lat r !_P(mmp ubleh l.aRECI!c!aRECI!c! oi! i=Edistrib,MGd i=mii=phop=s!!at poowillGE useful,aRECI!c! b,M WITHOUT ANY WARRANTY;owitho,M mmmiiii=pimmmiGd wmiENntyeh aRECI!c! MERCHANTABILITYmii=FITNESS FOR A PARTICULAR PURPOSE. Se=s!! aRECI!c! GNU GeneNel Public LDcenee h l0:ore d=tails.aRECI!c!aRECI!c! You sho,ld have re(ei! diam! pyeh mii=pGNU GeneNel Public LDcenee !_P(mmp aDi ii=pGNU Lessel0GeneNel Public LDcenee along with oi!. If not,aRECI!c! se=s.aRECI!c!aRECI!c! oINellF (Particoi Mesh LDefine (oi!)aRECI!c! ETH Zuk-,,aRECI!c! CH-8092 Zuk-,,, SwitzerlaDi aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (ais de_d 8h_INGLe2D_vec_s E_P 1s de_d 8h_INGLe2D_vec_d E__ 2s de_d 8h_I2D 7s de_d 8h_I3D 8s de_d 8h_INlf_st 9s de_d 8h_IVlf_st 10 MODULEPurpe3oduoi_mgrit_ l aRE!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d ((aRE!Moduoi=aRE!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d ((- (aisrrINTERFACjac_re3Dmit_ lmlev),MODULEPPROCEDURjac_re3Dmit_ lmmmmmmi2derrit_ lev),MODULEPPROCEDURjac_re3Dmit_ lmmmmmmi2derritd lev),MODULEPPROCEDURjac_re3Dmit_ lmmmmmmi3derrit_ lev),MODULEPPROCEDURjac_re3Dmit_ lmmmmmmi3derritd lev),MODULEPPROCEDURjac_re3Dmit_ lmmmmmmi2derrit_ lev),MODULEPPROCEDURjac_re3Dmit_ lmmmmmmi2derritd lev),MODULEPPROCEDURjac_re3Dmit_ lmmmmmmi3derrit_ lev),MODULEPPROCEDURjac_re3Dmit_ lmmmmmmi3derritd lev),MODULEPPROCEDURjac_re3Dmit_ lmbci2derrit_ lev),MODULEPPROCEDURjac_re3Dmit_ lmbci2derritd lev),MODULEPPROCEDURjac_re3Dmit_ lmbci3derrit_ lev),MODULEPPROCEDURjac_re3Dmit_ lmbci3derritd lev),MODULEPPROCEDURjac_re3Dmit_ lmbci2derrit_ lev),MODULEPPROCEDURjac_re3Dmit_ lmbci2derritd lev),MODULEPPROCEDURjac_re3Dmit_ lmbci3derrit_ lev),MODULEPPROCEDURjac_re3Dmit_ lmbci3derritd le_O mINTERFACjaisrr!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d ((- (a!c! INCLUDE THE SOURCES !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d ((- (aike SAINSis de_d 8h_Is_fond to makede_d 8h_Ioiiiis_foa_siiide_d 8h_Ig_smo_INGLe2D_vec_s E_PR#includi "d th3Dmit_ lmmmmmm.f"R#includi "d th3Dmit_ lmbc.f"R#unde_h_Ig_sm iide_d 8h_Ig_smo_INGLe2D_vec_d E__P#includi "d th3Dmit_ lmmmmmm.f"R#includi "d th3Dmit_ lmbc.f"R#unde_h_Ig_sm #unde_h_Ioiiiis_f kede_d 8h_Ioiiiis_foa_3iiide_d 8h_Ig_smo_INGLe2D_vec_s E_PR#includi "d th3Dmit_ lmmmmmm.f"R#includi "d th3Dmit_ lmbc.f"R#unde_h_Ig_sm iide_d 8h_Ig_smo_INGLe2D_vec_d E__P#includi "d th3Dmit_ lmmmmmm.f"R#includi "d th3Dmit_ lmbc.f"R#unde_h_Ig_sm #unde_h_Ioiiiis_f #unde_h_Is_f kede_d 8h_Is_foa_Vto makede_d 8h_Ioiiiis_foa_siiide_d 8h_Ig_smo_INGLe2D_vec_s E_PR#includi "d th3Dmit_ lmmmmmm.f"R#includi "d th3Dmit_ lmbc.f"R#unde_h_Ig_sm iide_d 8h_Ig_smo_INGLe2D_vec_d E__P#includi "d th3Dmit_ lmmmmmm.f"R#includi "d th3Dmit_ lmbc.f"R#unde_h_Ig_sm #unde_h_Ioiiiis_f kede_d 8h_Ioiiiis_foa_3iiide_d 8h_Ig_smo_INGLe2D_vec_s E_PR#includi "d th3Dmit_ lmmmmmm.f"R#includi "d th3Dmit_ lmbc.f"R#unde_h_Ig_sm iide_d 8h_Ig_smo_INGLe2D_vec_d E__P#includi "d th3Dmit_ lmmmmmm.f"R#includi "d th3Dmit_ lmbc.f"R#unde_h_Ig_sm #unde_h_Ioiiiis_f #unde_h_Is_f kkkkk_O mMODULEPurpe3oduoi_mgrit_ l aolibc_rnumerics-r1036/src/c_re3oduoi_hamjal.f0000644000175000017500000000262611616214647017756 0uoi(i omaromarRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Moduoi,__LIN : c_re3oduoi_hamjalmlev),u!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c!aRECI!c! Purmmmmiiiiii: Thi=E3oduoiG! ntains allGuser-call=poi routd 8sih laRECI!c! HamJac rei=pooaDi exteneh l.aRECI!c! aRECI!c! ,cCarksRECI!c:aRECI!c!aRECI!c! ,cferencesI!c:aRECI!c!aRECI!c! ,c: mii=sCI!c:aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! i oiiiPurpe3oduoi_hamjal.fiPuksRECI!c! ,c: mii=! oiiiPumarkslmmmm : m--H:: 8), itisRECI!c! d_doubleh leh mii=poi! Define RECI!c!aRECI!c! ,c: mii=! oifha2/02i7/25 0--34:06), itisRECI!c! -GER, P clon--in. RECI!c!aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! iPeNellF (Particoi Mesh LDefine (oi!)aRECI!c! -Gstit,MG h mC ,Mc_Oii P S2ienciaRECI!c! ETH Zentrum, Hirsclongraben 84sRECI!c! dH-8092 Zuk-,,, SwitzerlaDi RECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (a RECI!cMODULEPurpe3oduoi_hamjalm',__LIN ::poGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (a,__LIN ::p poi! moduoi=aRE_LIN ::poGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (a,__LIN ::USjac_re3oduoi_hamjal_rei=poa,__LIN ::USjac_re3oduoi_hamjal_extm',__LIN_O mMODULEPurpe3oduoi_hamjalmlibc_rnumerics-r1036/src/fft/0000755000175000017500000000000011616214727014713 5uoi(i omaromarlibc_rnumerics-r1036/src/fft/c_refft_plaDi3derritbc2c_z.f0000644000175000017500000001516511616214650022177 0uoi(i omaromarRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! iSubroutd 8I!c: c_refft_plaDi3derritbc2c_zaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Copyright (c)ha210 CSE Lab (ETH Zuk-,,), MOSAIC Group (ETH Zuk-,,),aRECI!c! Ce ter h l0Flu-- Dynamics (DTU) RECI!c!aRECI!c! FFTW plaD wrapp r h l03d miENDs, 1d ! lex to ! lexaRECI!c! (backward) FFT i=mii=pzodire(ch lsRECI!c! Thi routd 8 does notiwork with mmmmmss!!at pncludi mmii= layerisRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (a#mii=pg_smooth_INGLe2Diide_d 8h_ISHiN!cjac_refft_plaDi3derritbc2c_z_sodde_d 8h_Ivec_CI=p -ind_singlerrrrmii=pg_smooth_INGLe2Diide_d 8h_ISHiN!cjac_refft_plaDi3derritbc2c_z_dodde_d 8h_Ivec_CI=p -ind_double,-f=po,0,-1p =mmESHiN!cja_ISHiN!cjoi=poi ,0,-1i ,I=pplaDindtmmmm,outtmmmm,ndturnOiiiph!!! FFTW plaD wrapp r h l03d miENDs, 1d ! lex to ! lexaRECI!c!!! (backward) FFT i=mii=pzodire(ch lsRECI!c!!! Thi routd 8 does notiwork with mmmmmss!!at pncludi mmii= layerisRECI!cUSjac_re3oduoi_sunfold mmm -mUSjac_re3oduoi_sunfoop mm -mUSjac_re3oduoi_typedef',__LINUSjac_re3oduoi_i=popoi=',__LINUSjac_re3oduoi_writimmm -mUSjac_re3oduoi_i=ia,ONLY:c_rerankiI=p -ind_single,I=p -ind_double,mmm -mIMPLICIT NONEammm -mINCLUDE 'fftw3.f' aRECI!c! if e loopclon- if dimeneh l=ENre 2a 3b 5c 7d 11e 13,0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Aiiphimi=0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c!!!i!X-loge idimiimmmroi Gi(igetmmm -mINTEGER,INTENT(IN) du1, opttttttttttttttttt:: i!X---oiENDi !!!-- h mii=p0,-1mmm -mINTEGER,INTENT(IN) du1, opttttttttttttttttt:: 0,-1i oiENDi !!!I=p fft plaD typeoiENDi TYPEcdimrfft_plaD),INTENT(INHiN)pt du1, opttttttttttttttttt:: I=pplaDoiENDi !!!- ,Mdmmmmm ifouk-el0!ransh lm the lo!COMPLEX(_Ivec_),DIMEN E_Pesmimimimii POINTER,INTENT(INHiN)pt :: e mmmm the loCOMPLEX(_Ivec_),DIMEN E_Pesmimimimii POINTERopttttttttttttttttt:: e mmmm the lo!!!out ,Mdmmmmm h l0!! 2resulteh mii=pfouk-el0!ransh lm the lo!COMPLEX(_Ivec_),DIMEN E_Pesmimimimii POINTER,INTENT(INHiN)pt :: outtmmmm the loCOMPLEX(_Ivec_),DIMEN E_Pesmimimimii POINTERopttttttttttttttttt:: outtmmmm the lo!!!mmmmmms oi(tus, 0 upon successmmm -mINTEGER,INTENT(HiN)pt du1, optttttttttttttttttttttttttttttt:: e oaRECI!c!i=miime perhap=ENDmiiiphimiEfve opternateodire(ch ls aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! LERclmmmii=poi=aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!cREAL(_Ivec_)tttttttttttttttttt:: t0mmm -mINTEGERttttttttttttttttttttttt:: esun,esun aRECI!cINTEGER d:: nsunfmmm -mINTEGER,DIMEN E_Pes),POINTERop:: esunlistoiENDi TYPEcdimrt_i=po),POINTERdu1, o:: i=pologe RECI!cTYPEcdimrt_equi_0,-1) d:: 0,-1maRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! InER, Poee routd 8aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!che loops).(ik='c_refft_plaDmirkindturnaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Get i!X-logeoaDi 0,-1mmmlui=aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c, poldu1oi=popoi=oi=poi ,i!X-logeo_id, ,mmmmmm_ste ENDi LSEiii=pENDa,__LIN ::, poldu1owritiec_rerankiic_refft_plaDmi'Faile- iget i!X-loge.',esunERmmm -mmmoiiii CI=p ==mjag(mlev),unsunf =mi!X-loge%nsunlistoiENDi poOCATE(esunlist(nsunf)a the lo,i,ksun-,1nsunfmmm -m esunlist(esun) =mi!X-loge%esunlist(esun)CI=p ==mjaiiii ad_f0,-1m =mi!X-loge%0,-1(0,-1i rnaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! SmmmpiuINel ters h l0!!isR_INticular routd 8aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c!ii=pdimeneh leh mii=pFFT (1D/2D/3D)CI=p ==I=pplaD%rank=1aRECI!c!ii=pnumberoi Gpoe ts along eachodire(ch leh mii=ppiece ibe0!ransh lm daRECI!c poOCATE(I=pplaD%nx(I=pplaD%rank,nsunf)a the lo!ii=pdire(ch leh mii=p!ransh lm the loI=pplaD%sign=FFTW_BACKWARD the lo!ii=pl tho- ismmmpiii=pipiimclmplaDoiENDi I=pplaD%flag=FFTW_MEASUREaRECI!c!ii=pnumberoi G! onimi=Ei!0!ransh lm - 3G! onimifve(c4.oiENDi I=pplaD%howmany=3aRECI!c!ii=ppoi=(h mii=pi ,MdiiENDG- fullppoi=((assumOng LBOUND=1miius UBOUND)aRECI!c poOCATE(I=pplaD%d 8mbed(I=pplaD%rank))CI=p ==I=pplaD%d 8mbed(v)E.1UBOUND(ndtmmmm,4)aRECI!c!ii=ppoi=(h mii=pout ,MdiiENDG- fullppoi=((assumOng LBOUND=1miius UBOUND)aRECI!c poOCATE(I=pplaD%o 8mbed(I=pplaD%rank))CI=p ==I=pplaD%o 8mbed(v)E.1UBOUND(outtmmmm,4)aRECI!c!istrid 2iells howmii=psame ! onimet i=iaGpoe ts are spacGd i=mmemone RECI!c!e.g.pzommlui= re(ur mmmry x-dim*y-dim*! onimifvmlui=aRECI!cI=pplaD%dstrid 2.1UBOUND(ndtmmmm,2) *UBOUND(ndtmmmm,3)*3CI=p ==I=pplaD%ostrid 2.1UBOUND(outtmmmm,2)*UBOUND(outtmmmm,3)*3CI=p ==!--istGiells howmmultiple miENDs are spacGd i=mmemone. I.e. ammemone aRECI!c!offsmm. e.g.pve(c4.L! onimi=E(--ist=v)E4.LsRclar 2D miENDs imp0,-1p =!3D miEND(--ist=NxNy)CI=p ==I=pplaD%ddistG= 1CI=p ==I=pplaD%odistG= 1C0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Ap(ERc_G plaD miEND0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!cIF(ASSOCIATED(I=pplaD%plaD)i=pENDa,__LIN ::DE poOCATE(I=pplaD%plaDioi(t=get(ERmmm -mmm_ste ENDi LSEiii=pENDa,__LIN :: ::, poldu1owritiec_rerankiic_refft_plaDmi'Faile- ideop(ERc_G plaD-miEND.',esunERmmm -mmm mmoiiii CI=p == hamjag(mlev),u,mm g(mlev),u poOCATE(I=pplaD%plaD(nsunf)a the lo,i,ksun-,1nsunfmmm -m esunl=esunlist(esun)CI=p ==p =!@ maybG !! 2-1 need=E ibe0remo! diwhen doing !ell i=iaaRECI!cp =!weoopstrac_ !! 2-1 iav--- he periodicoubltexGpoe tRmmm -mmm_stei!X-loge%bcdef(3) Di L==mar_INeldbcdef_periodici=pENDd!ubltexRmmm -mmm mmI=pplaD%nx(1,esun) =m0,-1%nm(3)-cvalue(,j,)ux,0mii=poiii 4/ I=pplaD%nx(1,esun) =m0,-1%nm(3)CI=p == hamjag(ma,__LIN ::, poldfftw_plaDimany_dft(I=pplaD%plaD(esun),I=pplaD%rank,O (Rildddd& I=pplaD%nx(:,esun),I=pplaD%howmanyindtmmmm(1,1,1,1,esun),O (Rildddd& I=pplaD%d 8mbed(v),I=pplaD%dstrid ,I=pplaD%ddist,O (Rildddd& outtmmmm(1,1,1,1,esun),I=pplaD%o 8mbed(v),I=pplaD%ostrid ,O (Rildddd& I=pplaD%odist,I=pplaD%sign,I=pplaD%flag)CI=p ==mjao,i C0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! mmmmmm0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRnd toke SXF90 unfoldhe loops).mii=poiifft_plaDmirkindturnunfoldirnel isI=p ==mjaommESHiN!cja_ISHiN!cj #unde_h_ISHiN!cj #unde_h_Ivec_ou omarlibc_rnumerics-r1036/src/fft/c_refft_plaDi3derritfr2c_xy.f0000644000175000017500000001534311616214650022407 0uoi(i omaromar,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! iSubroutd 8I!c: c_refft_plaDi3derritfr2c_xyaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Copyright (c)ha210 CSE Lab (ETH Zuk-,,), MOSAIC Group (ETH Zuk-,,),aRECI!c! Ce ter h l0Flu-- Dynamics (DTU) RECI!c!aRECI!c! FFTW plaD wrapp r h l03d miENDs, 2d0real i! lexaRECI!c! (h lward) FFT i=mii=pxyodire(ch ls RECI!c! Thi routd 8 does notiwork with mmmmmss!!at pncludi mmii= layerisRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (a#mii=pg_smooth_INGLe2Diide_d 8h_ISHiN!cjac_refft_plaDi3derritfr2c_xy_sodde_d 8h_Ivec_CI=p -ind_singlerrrrmii=pg_smooth_INGLe2Diide_d 8h_ISHiN!cjac_refft_plaDi3derritfr2c_xy_dodde_d 8h_Ivec_CI=p -ind_double,-f=po,0,-1p =mmESHiN!cja_ISHiN!cjoi=poi ,0,-1i ,I=pplaDindtmmmm,outtmmmm,ndturnOiiiph!!! FFTW plaD wrapp r h l03d miENDs, 2d0real i! lexaRECI!c!!! (h lward) FFT i=mii=pxyodire(ch ls RECI!c!!! Thi routd 8 does notiwork with mmmmmss!!at pncludi mmii= layerisRECI!cUSjac_re3oduoi_sunfold mmm -mUSjac_re3oduoi_sunfoop mm -mUSjac_re3oduoi_typedef',__LINUSjac_re3oduoi_i=popoi=',__LINUSjac_re3oduoi_writimmm -mUSjac_re3oduoi_i=ia,ONLY:c_rerankiI=p -ind_single,I=p -ind_double,mmm -mIMPLICIT NONEammm -mINCLUDE 'fftw3.f' aRECI!c! if e loopclon- if dimeneh l=ENre 2a 3b 5c 7d 11e 13,0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Aiiphimi=0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c!!!i!X-loge idimiimmmroi Gi(igetmmm -mINTEGER,INTENT(IN) du1, opttttttttttttttttt:: i!X---oiENDi !!!-- h mii=p0,-1mmm -mINTEGER,INTENT(IN) du1, opttttttttttttttttt:: 0,-1i oiENDi !!!I=p fft plaD typeoiENDi TYPEcdimrfft_plaD),INTENT(INHiN)pt du1, opttttttttttttttttt:: I=pplaDoiENDi !!!- ,Mdmmmmm ifouk-el0!ransh lm the lo!REAL(_Ivec_),DIMEN E_Pesmimimimii POINTER,INTENT(INHiN)pt tt:: e mmmm the loREAL(_Ivec_),DIMEN E_Pesmimimimii POINTER1, opttttttttttttttttt:: e mmmm the lo!!!out ,Mdmmmmm h l0!! 2resulteh mii=pfouk-el0!ransh lm the lo!COMPLEX(_Ivec_),DIMEN E_Pesmimimimii POINTER,INTENT(INHiN)pt :: outtmmmm the loCOMPLEX(_Ivec_),DIMEN E_Pesmimimimii POINTERopttttttttttttttttt:: outtmmmm the lo!!!mmmmmms oi(tus, 0 upon successmmm -mINTEGER,INTENT(HiN)pt du1, optttttttttttttttttttttttttttttt:: e oaRECI!c!i=miime perhap=ENDmiiiphimiEfve opternateodire(ch ls aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! LERclmmmii=poi=aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!cREAL(_Ivec_)tttttttttttttttttt:: t0mmm -mINTEGERttttttttttttttttttttttt:: esun,esun aRECI!cINTEGER d:: nsunfmmm -mINTEGER,DIMEN E_Pes),POINTERop:: esunlistoiENDi TYPEcdimrt_i=po),POINTERdu1, o:: i=pologe RECI!cTYPEcdimrt_equi_0,-1) u1, o:: 0,-1maRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! InER, Poee routd 8aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!che loops).(ik='c_refft_plaDmirkindturnaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Get i!X-logeoaDi 0,-1mmmlui=aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c, poldu1oi=popoi=oi=poi ,i!X-logeo_id, ,mmmmmm_ste ENDi LSEiii=pENDa,__LIN ::, poldu1owritiec_rerankiic_refft_plaDmi'Faile- iget i!X-loge.',esunERmmm -mmmoiiii CI=p ==mjag(mlev),unsunf =mi!X-loge%nsunlistoiENDi poOCATE(esunlist(nsunf)a the lo,i,ksun-,1nsunfmmm -m esunlist(esun) =mi!X-loge%esunlist(esun)CI=p ==mjaiiii ad_f0,-1m =mi!X-loge%0,-1(0,-1i rnaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! SmmmpiuINel ters h l0!!isR_INticular routd 8aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c!ii=pdimeneh leh mii=pFFT (1D/2D/3D)CI=p ==I=pplaD%rank=2aRECI!c!ii=pnumberoi Gpoe ts along eachodire(ch leh mii=ppiece ibe0!ransh lm daRECI!c poOCATE(I=pplaD%nx(I=pplaD%rank,nsunf)a the lo!ii=pdire(ch leh mii=p!ransh lm the loI=pplaD%sign=FFTW_FORWARD the lo!ii=pl tho- ismmmpiii=pipiimclmplaDoiENDi I=pplaD%flag=FFTW_MEASUREaRECI!c!ii=pnumberoi G! onimi=Ei!0!ransh lm - 3G! onimifve(c4.oiENDi I=pplaD%howmany=3aRECI!c!ii=ppoi=(h mii=pi ,MdiiENDG- fullppoi=((assumOng LBOUND=1miius UBOUND)aRECI!c poOCATE(I=pplaD%d 8mbed(I=pplaD%rank))CI=p ==I=pplaD%d 8mbed(v)E.1UBOUND(ndtmmmm,2)CI=p ==I=pplaD%d 8mbed(2)E.1UBOUND(ndtmmmm,3)aRECI!c!ii=ppoi=(h mii=pout ,MdiiENDG- fullppoi=((assumOng LBOUND=1miius UBOUND)aRECI!c poOCATE(I=pplaD%o 8mbed(I=pplaD%rank))CI=p ==I=pplaD%o 8mbed(v)E.1UBOUND(outtmmmm,2)CI=p ==I=pplaD%o 8mbed(2)E.1UBOUND(outtmmmm,3)aRECI!c!istrid 2iells howmii=psame ! onimet i=iaGpoe ts are spacGd i=mmemone RECI!c!e.g.ph l02/3G! onimifve(c4. dstrid 2.12/3Gor h l0sRclar dstrid 2.11CI=p ==I=pplaD%dstrid 2.13CI=p ==I=pplaD%ostrid 2.13CI=p ==!--istGiells howmmultiple miENDs are spacGd i=mmemone. I.e. ammemone aRECI!c!offsmm. e.g.pve(c4.L! onimi=E(--ist=v)E4.LsRclar 2D miENDs imp0,-1p =!3D miEND(--ist=NxNy)CI=p ==I=pplaD%ddistG= 1CI=p ==I=pplaD%odistG= 1C0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Ap(ERc_G plaD miEND0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!cIF(ASSOCIATED(I=pplaD%plaD)i=pENDa,__LIN ::DE poOCATE(I=pplaD%plaDioi(t=get(ERmmm -mmm_ste ENDi LSEiii=pENDa,__LIN :: ::, poldu1owritiec_rerankiic_refft_plaDmi'Faile- ideop(ERc_G plaD-miEND.',esunERmmm -mmm mmoiiii CI=p == hamjag(mlev),u,mm g(mlev),u poOCATE(I=pplaD%plaD(nsunf)a the lo,i,ksun-,1nsunfmmm -m esunl=esunlist(esun)CI=p ==p =!@ maybG !! 2-1 need=E ibe0remo! diwhen doing !ell i=iaaREp ==p =!weoopstrac_ !! 2-1 iav--- he periodicoubltexGpoe tRmmm -mmm_stei!X-loge%bcdef(1) Di L==mar_INeldbcdef_periodici=pENDd!ubltexRmmm -mmm mmI=pplaD%nx(1,esun) =m0,-1%nm(1)-cvalue(,j,) mmI=pplaD%nx(2,esun) =m0,-1%nm(2)-cvalue(,j,)ux,0mii=poiii 4/ I=pplaD%nx(1,esun) =m0,-1%nm(1)value(,j,) mmI=pplaD%nx(2,esun) =m0,-1%nm(2)CI=p == hamjag(ma,__LIN ::, poldfftw_plaDimany_dft_r2c(I=pplaD%plaD(esun),I=pplaD%rank,O (Rildddd& I=pplaD%nx(:,esun),I=pplaD%howmanyindtmmmm(1,1,1,1,esun),O (Rildddd& I=pplaD%d 8mbed(v),I=pplaD%dstrid ,I=pplaD%ddist,O (Rildddd& outtmmmm(1,1,1,1,esun),I=pplaD%o 8mbed(v),I=pplaD%ostrid ,O (Rildddd& I=pplaD%odist,I=pplaD%flag)CI=p ==mjao,i C0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! mmmmmm0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRnd toke SXF90 unfoldhe loops).mii=poiifft_plaDmirkindturnunnnnnirnel isI=p ==mjaommESHiN!cja_ISHiN!cj #unde_h_ISHiN!cj #unde_h_Ivec_ou omarlibc_rnumerics-r1036/src/fft/c_refft_plaDi3derritfc2c_z.f0000644000175000017500000001520511616214650022176 0uoi(i omaromar,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! iSubroutd 8I!c: c_refft_plaDi3derritfc2c_zaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Copyright (c)ha210 CSE Lab (ETH Zuk-,,), MOSAIC Group (ETH Zuk-,,),aRECI!c! Ce ter h l0Flu-- Dynamics (DTU) RECI!c!aRECI!c! FFTW plaD wrapp r h l03d miENDs, 1d ! lex to ! lexaRECI!c! (h lward) FFT i=mii=pxyodire(ch ls RECI!c! Thi routd 8 does notiwork with mmmmmss!!at pncludi mmii= layerisRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (a#mii=pg_smooth_INGLe2Diide_d 8h_ISHiN!cjac_refft_plaDi3derritfc2c_z_sodde_d 8h_Ivec_CI=p -ind_singlerrrrmii=pg_smooth_INGLe2Diide_d 8h_ISHiN!cjac_refft_plaDi3derritfc2c_z_dodde_d 8h_Ivec_CI=p -ind_double,-f=po,0,-1p =mmESHiN!cja_ISHiN!cjoi=poi ,0,-1i ,I=pplaDindtmmmm,outtmmmm,ndturnOiiiph!!! FFTW plaD wrapp r h l03d miENDs, 1d ! lex to ! lexaRECI!c!!! (h lward) FFT i=mii=pxyodire(ch ls RECI!c!!! Thi routd 8 does notiwork with mmmmmss!!at pncludi mmii= layerisRECI!cUSjac_re3oduoi_sunfold mmm -mUSjac_re3oduoi_sunfoop mm -mUSjac_re3oduoi_typedef',__LINUSjac_re3oduoi_i=popoi=',__LINUSjac_re3oduoi_writimmm -mUSjac_re3oduoi_i=ia,ONLY:c_rerankiI=p -ind_single,I=p -ind_double,mmm -mIMPLICIT NONEammm -mINCLUDE 'fftw3.f' aRECI!c! if e loopclon- if dimeneh l=ENre 2a 3b 5c 7d 11e 13,0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Aiiphimi=0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c!!!i!X-loge idimiimmmroi Gi(igetmmm -mINTEGER,INTENT(IN) du1, opttttttttttttttttt:: i!X---oiENDi !!!-- h mii=p0,-1mmm -mINTEGER,INTENT(IN) du1, opttttttttttttttttt:: 0,-1i oiENDi !!!I=p fft plaD typeoiENDi TYPEcdimrfft_plaD),INTENT(INHiN)pt du1, opttttttttttttttttt:: I=pplaDoiENDi !!!- ,Mdmmmmm ifouk-el0!ransh lm the lo!COMPLEX(_Ivec_),DIMEN E_Pesmimimimii POINTER,INTENT(INHiN)pt :: e mmmm the loCOMPLEX(_Ivec_),DIMEN E_Pesmimimimii POINTERopttttttttttttttttt:: e mmmm the lo!!!out ,Mdmmmmm h l0!! 2resulteh mii=pfouk-el0!ransh lm the lo!COMPLEX(_Ivec_),DIMEN E_Pesmimimimii POINTER,INTENT(INHiN)pt :: outtmmmm the loCOMPLEX(_Ivec_),DIMEN E_Pesmimimimii POINTERopttttttttttttttttt:: outtmmmm the lo!!!mmmmmms oi(tus, 0 upon successmmm -mINTEGER,INTENT(HiN)pt du1, optttttttttttttttttttttttttttttt:: e oaRECI!c!i=miime perhap=ENDmiiiphimiEfve opternateodire(ch ls aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! LERclmmmii=poi=aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!cREAL(_Ivec_)tttttttttttttttttt:: t0mmm -mINTEGERttttttttttttttttttttttt:: esun,esun aRECI!cINTEGER d:: nsunfmmm -mINTEGER,DIMEN E_Pes),POINTERop:: esunlistoiENDi TYPEcdimrt_i=po),POINTERdu1, o:: i=pologe RECI!cTYPEcdimrt_equi_0,-1) u1, o:: 0,-1maRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! InER, Poee routd 8aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!che loops).(ik='c_refft_plaDmirkindturnaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Get i!X-logeoaDi 0,-1mmmlui=aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c, poldu1oi=popoi=oi=poi ,i!X-logeo_id, ,mmmmmm_ste ENDi LSEiii=pENDa,__LIN ::, poldu1owritiec_rerankiic_refft_plaDmi'Faile- iget i!X-loge.',esunERmmm -mmmoiiii CI=p ==mjag(mlev),unsunf =mi!X-loge%nsunlistoiENDi poOCATE(esunlist(nsunf)a the lo,i,ksun-,1nsunfmmm -m esunlist(esun) =mi!X-loge%esunlist(esun)CI=p ==mjaiiii ad_f0,-1m =mi!X-loge%0,-1(0,-1i rnaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! SmmmpiuINel ters h l0!!isR_INticular routd 8aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c!ii=pdimeneh leh mii=pFFT (1D/2D/3D)CI=p ==I=pplaD%rank=1aRECI!c!ii=pnumberoi Gpoe ts along eachodire(ch leh mii=ppiece ibe0!ransh lm daRECI!c poOCATE(I=pplaD%nx(I=pplaD%rank,nsunf)a the lo!ii=pdire(ch leh mii=p!ransh lm the loI=pplaD%sign=FFTW_FORWARD the lo!ii=pl tho- ismmmpiii=pipiimclmplaDoiENDi I=pplaD%flag=FFTW_MEASUREaRECI!c!ii=pnumberoi G! onimi=Ei!0!ransh lm - 3G! onimifve(c4.oiENDi I=pplaD%howmany=3aRECI!c!ii=ppoi=(h mii=pi ,MdiiENDG- fullppoi=((assumOng LBOUND=1miius UBOUND)aRECI!c poOCATE(I=pplaD%d 8mbed(I=pplaD%rank))CI=p ==I=pplaD%d 8mbed(v)E.1UBOUND(ndtmmmm,4)aRECI!c!ii=ppoi=(h mii=pout ,MdiiENDG- fullppoi=((assumOng LBOUND=1miius UBOUND)aRECI!c poOCATE(I=pplaD%o 8mbed(I=pplaD%rank))CI=p ==I=pplaD%o 8mbed(v)E.1UBOUND(outtmmmm,4)aRECI!c!istrid 2iells howmii=psame ! onimet i=iaGpoe ts are spacGd i=mmemone RECI!c!e.g.ph l02/3G! onimifve(c4. dstrid 2.12/3Gor h l0sRclar dstrid 2.11CI=p ==I=pplaD%dstrid 2.1UBOUND(ndtmmmm,2) *UBOUND(ndtmmmm,3)*3CI=p ==I=pplaD%ostrid 2.1UBOUND(outtmmmm,2)*UBOUND(outtmmmm,3)*3CI=p ==!--istGiells howmmultiple miENDs are spacGd i=mmemone. I.e. ammemone aRECI!c!offsmm. e.g.pve(c4.L! onimi=E(--ist=v)E4.LsRclar 2D miENDs imp0,-1p =!3D miEND(--ist=NxNy)CI=p ==I=pplaD%ddistG= 1CI=p ==I=pplaD%odistG= 1C0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Ap(ERc_G plaD miEND0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!cIF(ASSOCIATED(I=pplaD%plaD)i=pENDa,__LIN ::DE poOCATE(I=pplaD%plaDioi(t=get(ERmmm -mmm_ste ENDi LSEiii=pENDa,__LIN :: ::, poldu1owritiec_rerankiic_refft_plaDmi'Faile- ideop(ERc_G plaD-miEND.',esunERmmm -mmm mmoiiii CI=p == hamjag(mlev),u,mm g(aRECI!c poOCATE(I=pplaD%plaD(nsunf)a the lo,i,ksun-,1nsunfmmm -m esunl=esunlist(esun)CI=p ==p =!@ maybG !! 2-1 need=E ibe0remo! diwhen doing !ell i=iaaREp ==p =!weoopstrac_ !! 2-1 iav--- he periodicoubltexGpoe tRmmm -mmm_stei!X-loge%bcdef(3) Di L==mar_INeldbcdef_periodici=pENDd!ubltexRmmm -mmm mmI=pplaD%nx(1,esun) =m0,-1%nm(3)-cvalue(,j,)ux,0mii=poiii 4/ I=pplaD%nx(1,esun) =m0,-1%nm(3)CI=p == hamjag(ma,__LIN ::, poldfftw_plaDimany_dft(I=pplaD%plaD(esun),I=pplaD%rank,O (Rildddd& I=pplaD%nx(:,esun),I=pplaD%howmanyindtmmmm(1,1,1,1,esun),O (Rildddd& I=pplaD%d 8mbed(v),I=pplaD%dstrid ,I=pplaD%ddist,O (Rildddd& outtmmmm(1,1,1,1,esun),I=pplaD%o 8mbed(v),I=pplaD%ostrid ,O (Rildddd& I=pplaD%odist,I=pplaD%sign,I=pplaD%flag)CI=p ==mjao,i C0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! mmmmmm0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRnd toke SXF90 unfoldhe loops).mii=poiifft_plaDmirkindturnunnnnnirnel isI=p ==mjaommESHiN!cja_ISHiN!cj #unde_h_ISHiN!cj #unde_h_Ivec_ou omarlibc_rnumerics-r1036/src/fft/c_refft_n lmaloi=_l.f0000644000175000017500000001261511616214650021077 0uoi(i omaromar,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! iSubroutd 8I!c: c_refft_n lmaloi=_laRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Copyright (c)ha210 CSE Lab (ETH Zuk-,,), MOSAIC Group (ETH Zuk-,,),aRECI!c! Ce ter h l0Flu-- Dynamics (DTU) RECI!c!aRECI!c! Thi routd 8 does notiwork with mmmmmss!!at pncludi mmii= layeri.aRECI!c! Fmmmmssare n laloi=d i=mii=p1/NG- fashh le!!at sRcl8sihmmmmss!os!! aRECI!c! prop r level after being FFT diand iFFT daRECI!c! Thi routd 8ssare n tm0,amiEfve produ(ch lecodi asmii=pn lmaloic_OiiicaDoiENDi !ibe0do 8Efve opl dimeneh l=Ei=mo 8EpassG- wh-,, mayiand sho,ld be0do 8aRECI!c! iD m routd 8 (looping throughmii=pi=iaGanyway)Efvp(Ewing th=pFFTi.aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (a#mii=pg_smooth_INGLe2Diide_d 8h_ISHiN!cjac_refft_n lmaloi=_lsodde_d 8h_Ivec_CI=p -ind_singlerrrrmii=pg_smooth_INGLe2Diide_d 8h_ISHiN!cjac_refft_n lmaloi=_ldodde_d 8h_Ivec_CI=p -ind_double,-f=po,0,-1p =mmESHiN!cja_ISHiN!cjoi=poi ,0,-1i ,I=pplaDindtmmmm,ndturnOiiiph!!! Thi routd 8 does notiwork with mmmmmss!!at pncludi mmii= layeri.aRECI!c!!! Fmmmmssare n laloi=d i=mii=p1/NG- fashh le!!at sRcl8sihmmmmss!os!! aRECI!c!!! prop r level after being FFT diand iFFT daRECI!c!!! Thi routd 8ssare n tm0,amiEfve produ(ch lecodi asmii=pn lmaloic_OiiiaRECI!c!!! cNDmbe0do 8Efve opl dimeneh l=Ei=mo 8EpassG- wh-,, mayiand sho,ld be0aRECI!c!!! do 8EiD m routd 8 (looping throughmii=pi=iaGanyway)Efvp(Ewing th=pFFTimmm -mUSjac_re3oduoi_sunfold mmm -mUSjac_re3oduoi_sunfoop mm -mUSjac_re3oduoi_typedef',__LINUSjac_re3oduoi_i=popoi=',__LINUSjac_re3oduoi_writimmm -mUSjac_re3oduoi_i=ia,ONLY:c_rerankiI=p -ind_single,I=p -ind_double,mmm -mIMPLICIT NONEammm -mINCLUDE 'fftw3.f' aRECI!c! if e loopclon- if dimeneh l=ENre 2a 3b 5c 7d 11e 13,0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Aiiphimi=0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c!!!i!X-loge idimiimmmroi Gi(igetmmm -mINTEGER,INTENT(IN) du1, opttttttttttttttttt:: i!X---oiENDi !!!-- h mii=p0,-1mmm -mINTEGER,INTENT(IN) du1, opttttttttttttttttt:: 0,-1i oiENDi !!!I=p fft plaD typeoiENDi TYPEcdimrfft_plaD),INTENT(INHiN)pt du1, opttttttttttttttttt:: I=pplaDoiENDi !!!- ,Mdmmmmm in lmaloi= unfoldhOMPLEX(_Ivec_),DIMEN E_Pesmimimimii POINTERopttttttttttttttttt:: e mmmm the lo!!!mmmmmms oi(tus, 0 upon successmmm -mINTEGER,INTENT(HiN)pt du1, optttttttttttttttttttttttttttttt:: e oaRECI!c!i=miime perhap=ENDmiiiphimiEfve opternateodire(ch ls aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! LERclmmmii=poi=aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c!iimermmm -mINTEGER,PARAMETERopttttttttttt:: MK =CI=p -ind_double,ttttttREAL(_Ivec_)tttttttttttttttttt:: t0mmm -m!n lmaloic_Oiiifa(c4.oiENDi REAL(MK)pt du1, optttttttt:: falmlev),uINTEGERttttttttttttttttttttttt:: e,j,kmlev),uINTEGERttttttttttttttttttttttt:: esun,esun aRECI!cINTEGER d:: nsunfmmm -mINTEGER,DIMEN E_Pes),POINTERop:: esunlistoiENDi TYPEcdimrt_i=po),POINTERdu1, o:: i=pologe RECI!cTYPEcdimrt_equi_0,-1) u1, o:: 0,-1maRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! InER, Poee routd 8aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!che loops).(ik='c_refft_n lmaloi=mirkindturnaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Get i!X-logeoaDi 0,-1mmmlui=aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c, poldu1oi=popoi=oi=poi ,i!X-logeo_id, ,mm -mIste ENDi LSEiii=pENDa,__LIN ::, poldu1owritiec_rerankiic_refft_plaDmi'Faile- iget i!X-loge.',esunERmmm -mmmoiiii CI=p ==mjag(mlev),unsunf =mi!X-loge%nsunlistoiENDi poOCATE(esunlist(nsunf)a the lo,i,ksun-,1nsunfmmm -m esunlist(esun) =mi!X-loge%esunlist(esun)CI=p ==mjaiiii ad_f0,-1m =mi!X-loge%0,-1(0,-1i rnaRECI!c,i,ksun-,1nsunfmmm -m esunl=esunlist(esun)CI=p ==p =!d termd 8 n lmaloic_Oiiifa(c4.oiENDi -mIsteI=pplaD%rank Di L=1i=pENDa,__LIN :: ::_stei!X-loge%bcdef(3) Di L==mar_INeldbcdef_periodici=pENDd!ubltexRmmm -mmm mmmmmfa(G= 1.0_MK/REAL((0,-1%nm(3)-c),MK)Rmmm -mmm mmux,0mii=poiii 4/ mmmfa(G= 1.0_MK/REAL((0,-1%nm(3)),MK)Rmmm -mmm mmujag(mlev),u mmux,0mIsteI=pplaD%rank Di L=2i=pENDa,__LIN :: ::_stei!X-loge%bcdef(1) Di L==mar_INeldbcdef_periodici=pENDd!ubltexRmmm -mmm mmmmmfa(G= 1.0_MK/REAL((0,-1%nm(1)-c)*(0,-1%nm(2)-c),MK)Rmmm -mmm mmux,0mii=poiii 4/ mmmfa(G= 1.0_MK/REAL((0,-1%nm(1) )*(0,-1%nm(2) ),MK)Rmmm -mmm mmujag(mlev),u mmujag(ma,__LIN ::,i,k-,10,-1%nnodis(3,esun )Rmmm -mmm mm,i,j-,10,-1%nnodis(2,esun )Rmmm -mmm mm mm,i,i-,10,-1%nnodis(1,esun )Rmmm -mmm mm mmmmmndtmmmm(1,e,j,k,esun) =mfa(*ndtmmmm(1,e,j,k,esun)Rmmm -mmm mm mmmmmndtmmmm(2,e,j,k,esun) =mfa(*ndtmmmm(2,e,j,k,esun)Rmmm -mmm mm mmmmmndtmmmm(3,e,j,k,esun) =mfa(*ndtmmmm(3,e,j,k,esun)Rmmm -mmm mm mmmjao,i -mmm mm mmmjao,i -mmm mmmjao,i -mmmmjao,i C0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! mmmmmm0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRnd toke SXF90 unfoldhe loops).mii=poiifft_n lmaloi=mirkindturnunfoldirnel isI=p ==mjaommESHiN!cja_ISHiN!cj #unde_h_ISHiN!cj #unde_h_Ivec_ou omarlibc_rnumerics-r1036/src/fft/c_refft_execi3derritbc2r_xy.f0000644000175000017500000001304011616214650022365 0uoi(i omaromar,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! iSubroutd 8I!c: c_refft_execi3derritbc2r_xyaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Copyright (c)ha210 CSE Lab (ETH Zuk-,,), MOSAIC Group (ETH Zuk-,,),aRECI!c! Ce ter h l0Flu-- Dynamics (DTU) RECI!c!aRECI!c! FFTW exec,MG wrapp r h l03d miENDs, 2d0! lex to realaRECI!c! (backward) FFT i=mii=pxyodire(ch ls RECI!c! Thi routd 8 does notiwork with mmmmmss!!at pncludi mmii= layerisRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (a#mii=pg_smooth_INGLe2Diide_d 8h_ISHiN!cjac_refft_execi3derritbc2r_xy_sodde_d 8h_Ivec_CI=p -ind_singlerrrrmii=pg_smooth_INGLe2Diide_d 8h_ISHiN!cjac_refft_execi3derritbc2r_xy_dodde_d 8h_Ivec_CI=p -ind_double,-f=po,0,-1p =mmESHiN!cja_ISHiN!cjoi=poi ,0,-1i ,I=pplaDindtmmmm,outtmmmm,ndturnOiiiph!!! FFTW exec,MG wrapp r h l03d miENDs, 2d0! lex to realaRECI!c!!! (backward) FFT i=mii=pxyodire(ch ls RECI!c!!! Beh le calling this routd 8 aac_refft_plaDi routd 8 muoi be0call daRECI!c!!! Thi routd 8 does notiwork with mmmmmss!!at pncludi mmii= layerisRECI!cUSjac_re3oduoi_sunfold mmm -mUSjac_re3oduoi_sunfoop mm -mUSjac_re3oduoi_typedef',__LINUSjac_re3oduoi_i=popoi=',__LINUSjac_re3oduoi_writimmm -mUSjac_re3oduoi_i=ia,ONLY:c_rerankiI=p -ind_single,I=p -ind_double,mmm -mIMPLICIT NONEammm -mINCLUDE 'fftw3.f' aRECI!c! if e loopclon- if dimeneh l=ENre 2a 3b 5c 7d 11e 13,0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Aiiphimi=0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c!!!i!X-loge idimiimmmroi Gi(igetmmm -mINTEGER,INTENT(IN) du1, opttttttttttttttttt:: i!X---oiENDi !!!-- h mii=p0,-1mmm -mINTEGER,INTENT(IN) du1, opttttttttttttttttt:: 0,-1i oiENDi !!!I=p fft plaD typeoiENDi TYPEcdimrfft_plaD),INTENT(INHiN)pt du1, opttttttttttttttttt:: I=pplaDoiENDi !!!- ,Mdmmmmm ifouk-el0!ransh lm the lo!COMPLEX(_Ivec_),DIMEN E_Pesmimimimii POINTER,INTENT(INHiN)pt :: e mmmm the loCOMPLEX(_Ivec_),DIMEN E_Pesmimimimii POINTERopttttttttttttttttt:: e mmmm the lo!!!out ,Mdmmmmm h l0!! 2resulteh mii=pfouk-el0!ransh lm the lo!REAL(_Ivec_),DIMEN E_Pesmimimimii POINTER,INTENT(INHiN)pt tt:: outtmmmm the loREAL(_Ivec_),DIMEN E_Pesmimimimii POINTER1, opttttttttttttttttt:: outtmmmm the lo!!!mmmmmms oi(tus, 0 upon successmmm -mINTEGER,INTENT(HiN)pt du1, optttttttttttttttttttttttttttttt:: e oaRECI!c!i=miime perhap=ENDmiiiphimiEfve opternateodire(ch ls aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! LERclmmmii=poi=aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!cREAL(_Ivec_)tttttttttttttttttt:: t0mmm -mINTEGERttttttttttttttttttttttt:: e,kmlev),uINTEGERttttttttttttttttttttttt:: esun,esun aRECI!cINTEGER d:: nsunfmmm -mINTEGER,DIMEN E_Pes),POINTERop:: esunlistoiENDi TYPEcdimrt_i=po),POINTERdu1, o:: i=pologe RECI!cTYPEcdimrt_equi_0,-1) u1, o:: 0,-1maRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! InER, Poee routd 8aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!che loops).(ik='c_refft_execmirkindturnaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Get i!X-logeoaDi 0,-1mmmlui=aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c, poldu1oi=popoi=oi=poi ,i!X-logeo_id, ,mm -mIste ENDi LSEiii=pENDa,__LIN ::, poldu1owritiec_rerankiic_refft_execmi'Faile- iget i!X-loge.',esunERmmm -mmmoiiii CI=p ==mjag(mlev),unsunf =mi!X-loge%nsunlistoiENDi poOCATE(esunlist(nsunf)a the lo,i,ksun-,1nsunfmmm -m esunlist(esun) =mi!X-loge%esunlist(esun)CI=p ==mjaiiii ad_f0,-1m =mi!X-loge%0,-1(0,-1i rnaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Exec,MG plaDoiENDi !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c,i,ksun-,1nsunfmmm -m esunl=esunlist(esun)CI=p ==p =,i,k-,10,-1%nnodis(3,esun )=!@ add '-1' iexcludi n+1 slanfmmm -m ::, poldfftw_exec,MG_dft_c2r(I=pplaD%plaD(esun),&mmm -m ::& ndtmmmm(1,1,1,k,esun),outtmmmm(1,1,1,k,esun))Rmmm -mmm mm_stei!X-loge%bcdef(1) Di L==mar_INeldbcdef_periodici=pENDd!ubltexRmmm -mmm mmmmm!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specifieRmmm -mmm mmmmm! Copy periodicolayer back - onlyEfve periodico'N'oubltexGpoe tsRmmm -mmm mmmmm!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specifieRmmm -mmm mmmmm,i,i-,10,-1%nnodis(1,esun )Rmmm -mmm mm mmmmmouttmmmm(1,i10,-1%nnodis(2,esun ),k,esun) =mouttmmmm(1,i11,k,esun)Rmmm -mmm mm mmmmmouttmmmm(2,i10,-1%nnodis(2,esun ),k,esun) =mouttmmmm(2,i11,k,esun)Rmmm -mmm mm mmmmmouttmmmm(3,i10,-1%nnodis(2,esun ),k,esun) =mouttmmmm(3,i11,k,esun)Rmmm -mmm mm mmmjao,i -mmm mm mmmmm,i,i-,10,-1%nnodis(2,esun )Rmmm -mmm mm mmmmmouttmmmm(1,0,-1%nnodis(1,esun ),i1k,esun) =mouttmmmm(1,1,i1k,esun)Rmmm -mmm mm mmmmmouttmmmm(2,0,-1%nnodis(1,esun ),i1k,esun) =mouttmmmm(2,1,i1k,esun)Rmmm -mmm mm mmmmmouttmmmm(3,0,-1%nnodis(1,esun ),i1k,esun) =mouttmmmm(3,1,i1k,esun)Rmmm -mmm mm mmmjao,i -mmm mm mmmjaog(mlev),u mmujao,i -mmmmjao,i C0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! mmmmmm0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRnd toke SXF90 unfoldhe loops).mii=poiifft_execmirkindturnunfoldirnel isI=p ==mjaommESHiN!cja_ISHiN!cj #unde_h_ISHiN!cj #unde_h_Ivec_ou omarlibc_rnumerics-r1036/src/fft/c_refft_n lmaloi=_r.f0000644000175000017500000001273411616214650021120 0uoi(i omaromar,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! iSubroutd 8I!c: c_refft_n lmaloi=_r0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Copyright (c)ha210 CSE Lab (ETH Zuk-,,), MOSAIC Group (ETH Zuk-,,),aRECI!c! Ce ter h l0Flu-- Dynamics (DTU) RECI!c!aRECI!c! Thi routd 8 does notiwork with mmmmmss!!at pncludi mmii= layeri.aRECI!c! Fmmmmssare n laloi=d i=mii=p1/NG- fashh le!!at sRcl8sihmmmmss!os!! aRECI!c! prop r level after being FFT diand iFFT daRECI!c! Thi routd 8ssare n tm0,amiEfve produ(ch lecodi asmii=pn lmaloic_OiiicaDoiENDi !ibe0do 8Efve opl dimeneh l=Ei=mo 8EpassG- wh-,, mayiand sho,ld be0do 8aRECI!c! iD m routd 8 (looping throughmii=pi=iaGanyway)Efvp(Ewing th=pFFTi.aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (a#mii=pg_smooth_INGLe2Diide_d 8h_ISHiN!cjac_refft_n lmaloi=_rsodde_d 8h_Ivec_CI=p -ind_singlerrrrmii=pg_smooth_INGLe2Diide_d 8h_ISHiN!cjac_refft_n lmaloi=_rdodde_d 8h_Ivec_CI=p -ind_double,-f=po,0,-1p =mmESHiN!cja_ISHiN!cjoi=poi ,0,-1i ,I=pplaDindtmmmm,ndturnOiiiph!!! Thi routd 8 does notiwork with mmmmmss!!at pncludi mmii= layeri.aRECI!c!!! Fmmmmssare n laloi=d i=mii=p1/NG- fashh le!!at sRcl8sihmmmmss!os!! aRECI!c!!! prop r level after being FFT diand iFFT daRECI!c!!! Thi routd 8ssare n tm0,amiEfve produ(ch lecodi asmii=pn lmaloic_OiiaRECI!c!!! cNDmbe0do 8Efve opl dimeneh l=Ei=mo 8EpassG- wh-,, mayiand sho,ld beaRECI!c!!! do 8EiD m routd 8 (looping throughmii=pi=iaGanyway)Efvp(Ewing th=pFFTimmm -mUSjac_re3oduoi_sunfold mmm -mUSjac_re3oduoi_sunfoop mm -mUSjac_re3oduoi_typedef',__LINUSjac_re3oduoi_i=popoi=',__LINUSjac_re3oduoi_writimmm -mUSjac_re3oduoi_i=ia,ONLY:c_rerankiI=p -ind_single,I=p -ind_double,mmm -mIMPLICIT NONEammm -mINCLUDE 'fftw3.f' aRECI!c! if e loopclon- if dimeneh l=ENre 2a 3b 5c 7d 11e 13,0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Aiiphimi=0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c!!!i!X-loge idimiimmmroi Gi(igetmmm -mINTEGER,INTENT(IN) du1, opttttttttttttttttt:: i!X---oiENDi !!!-- h mii=p0,-1mmm -mINTEGER,INTENT(IN) du1, opttttttttttttttttt:: 0,-1i oiENDi !!!I=p fft plaD typeoiENDi TYPEcdimrfft_plaD),INTENT(INHiN)pt du1, opttttttttttttttttt:: I=pplaDoiENDi !!!- ,Mdmmmmm in lmaloi= unfold!REAL(_Ivec_),DIMEN E_Pesmimimimii POINTER,INTENT(INHiN)pt tt:: e mmmm the loREAL(_Ivec_),DIMEN E_Pesmimimimii POINTER1, opttttttttttttttttt:: e mmmm the lo!!!mmmmmms oi(tus, 0 upon successmmm -mINTEGER,INTENT(HiN)pt du1, optttttttttttttttttttttttttttttt:: e oaRECI!c!i=miime perhap=ENDmiiiphimiEfve opternateodire(ch ls aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! LERclmmmii=poi=aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c!iimermmm -mINTEGER,PARAMETERopttttttttttt:: MK =CI=p -ind_double,ttttttREAL(_Ivec_)tttttttttttttttttt:: t0mmm -m!n lmaloic_Oiiifa(c4.oiENDi REAL(MK)pt tttttttttttttttttt:: falmlev),uINTEGERttttttttttttttttttttttt:: e,j,kmlev),uINTEGERttttttttttttttttttttttt:: esun,esun aRECI!cINTEGER d:: nsunfmmm -mINTEGER,DIMEN E_Pes),POINTERop:: esunlistoiENDi TYPEcdimrt_i=po),POINTERdu1, o:: i=pologe RECI!cTYPEcdimrt_equi_0,-1) u1, o:: 0,-1maRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! InER, Poee routd 8aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!che loops).(ik='c_refft_n lmaloi=mirkindturnaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Get i!X-logeoaDi 0,-1mmmlui=aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c, poldu1oi=popoi=oi=poi ,i!X-logeo_id, ,mm -mIste ENDi LSEiii=pENDa,__LIN ::, poldu1owritiec_rerankiic_refft_plaDmi'Faile- iget i!X-loge.',esunERmmm -mmmoiiii CI=p ==mjag(mlev),unsunf =mi!X-loge%nsunlistoiENDi poOCATE(esunlist(nsunf)a the lo,i,ksun-,1nsunfmmm -m esunlist(esun) =mi!X-loge%esunlist(esun)CI=p ==mjaiiii ad_f0,-1m =mi!X-loge%0,-1(0,-1i rnaRECI!c,i,ksun-,1nsunfmmm -m esunl=esunlist(esun)CI=p ==p =!d termd 8 n lmaloic_Oiiifa(c4.oiENDi -mIsteI=pplaD%rank Di L=1i=pENDa,__LIN :: ::_stei!X-loge%bcdef(3) Di L==mar_INeldbcdef_periodici=pENDd!ubltexRmmm -mmm mmmmmfa(G= 1.0_MK/REAL((0,-1%nm(3)-c),MK)Rmmm -mmm mmux,0mii=poiii 4/ mmmfa(G= 1.0_MK/REAL((0,-1%nm(3)),MK)Rmmm -mmm mmujag(mlev),u mmux,0mIsteI=pplaD%rank Di L=2i=pENDa,__LIN :: ::_stei!X-loge%bcdef(1) Di L==mar_INeldbcdef_periodici=pENDd!ubltexRmmm -mmm mmmmmfa(G= 1.0_MK/REAL((0,-1%nm(1)-c)*(0,-1%nm(2)-c),MK)Rmmm -mmm mmux,0mii=poiii 4/ mmmfa(G= 1.0_MK/REAL((0,-1%nm(1) )*(0,-1%nm(2) ),MK)Rmmm -mmm mmujag(mlev),u mmujag(ma,__LIN ::,i,k-,10,-1%nnodis(3,esun )Rmmm -mmm mm,i,j-,10,-1%nnodis(2,esun )Rmmm -mmm mm mm,i,i-,10,-1%nnodis(1,esun )Rmmm -mmm mm mmmmmndtmmmm(1,e,j,k,esun) =mfa(*ndtmmmm(1,e,j,k,esun)Rmmm -mmm mm mmmmmndtmmmm(2,e,j,k,esun) =mfa(*ndtmmmm(2,e,j,k,esun)Rmmm -mmm mm mmmmmndtmmmm(3,e,j,k,esun) =mfa(*ndtmmmm(3,e,j,k,esun)Rmmm -mmm mm mmmjao,i -mmm mm mmmjao,i -mmm mmmjao,i -mmmmjao,i C0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! mmmmmm0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRnd toke SXF90 unfoldhe loops).mii=poiifft_n lmaloi=mirkindturnunfoldirnel isI=p ==mjaommESHiN!cja_ISHiN!cj #unde_h_ISHiN!cj #unde_h_Ivec_olibc_rnumerics-r1036/src/fft/c_refft_execi3derritc2c_z.f0000644000175000017500000001321711616214650022023 0uoi(i omaromar,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! iSubroutd 8I!c: c_refft_execi3derritc2c_zaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Copyright (c)ha210 CSE Lab (ETH Zuk-,,), MOSAIC Group (ETH Zuk-,,),aRECI!c! Ce ter h l0Flu-- Dynamics (DTU) RECI!c!aRECI!c! FFTW exec,MG wrapp r h l03d miENDs, 1d ! lex to ! lex0aRECI!c! (h lwardoaDi backward) FFT i=mii=pzodire(ch laRECI!c! Thi routd 8 does notiwork with mmmmmss!!at pncludi mmii= layeriaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (a#mii=pg_smooth_INGLe2Diide_d 8h_ISHiN!cjac_refft_execi3derritc2c_z_sodde_d 8h_Ivec_CI=p -ind_singlerrrrmii=pg_smooth_INGLe2Diide_d 8h_ISHiN!cjac_refft_execi3derritc2c_z_dodde_d 8h_Ivec_CI=p -ind_double,-f=po,0,-1p =mmESHiN!cja_ISHiN!cjoi=poi ,0,-1i ,I=pplaDindtmmmm,outtmmmm,ndturnOiiiph!!! FFTW exec,MG wrapp r h l03d miENDs, 1d ! lex to ! lex0aRECI!c!!! (h lwardoaDi backward) FFT i=mii=pzodire(ch laRECI!c!!! Beh le calling this routd 8 aac_refft_plaDi routd 8 muoi be0call daRECI!c!!! Thi routd 8 does notiwork with mmmmmss!!at pncludi mmii= layerisRECI!cUSjac_re3oduoi_sunfold mmm -mUSjac_re3oduoi_sunfoop mm -mUSjac_re3oduoi_typedef',__LINUSjac_re3oduoi_i=popoi=',__LINUSjac_re3oduoi_writimmm -mUSjac_re3oduoi_i=ia,ONLY:c_rerankiI=p -ind_single,I=p -ind_double,mmm -mIMPLICIT NONEammm -mINCLUDE 'fftw3.f' aRECI!c! if e loopclon- if dimeneh l=ENre 2a 3b 5c 7d 11e 13,0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Aiiphimi=0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c!!!i!X-loge idimiimmmroi Gi(igetmmm -mINTEGER,INTENT(IN) du1, opttttttttttttttttt:: i!X---oiENDi !!!-- h mii=p0,-1mmm -mINTEGER,INTENT(IN) du1, opttttttttttttttttt:: 0,-1i oiENDi !!!I=p fft plaD typeoiENDi TYPEcdimrfft_plaD),INTENT(INHiN)pt du1, opttttttttttttttttt:: I=pplaDoiENDi !!!- ,Mdmmmmm ifouk-el0!ransh lm the lo!COMPLEX(_Ivec_),DIMEN E_Pesmimimimii POINTER,INTENT(INHiN)pt :: e mmmm the loCOMPLEX(_Ivec_),DIMEN E_Pesmimimimii POINTERopttttttttttttttttt:: e mmmm the lo!!!out ,Mdmmmmm h l0!! 2resulteh mii=pfouk-el0!ransh lm the lo!COMPLEX(_Ivec_),DIMEN E_Pesmimimimii POINTER,INTENT(INHiN)pt :: outtmmmm the loCOMPLEX(_Ivec_),DIMEN E_Pesmimimimii POINTERopttttttttttttttttt:: outtmmmm the lo!!!mmmmmms oi(tus, 0 upon successmmm -mINTEGER,INTENT(HiN)pt du1, optttttttttttttttttttttttttttttt:: e oaRECI!c!i=miime perhap=ENDmiiiphimiEfve opternateodire(ch ls aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! LERclmmmii=poi=aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!cREAL(_Ivec_)tttttttttttttttttt:: t0mmm -mINTEGERttttttttttttttttttttttt:: e,jmlev),uINTEGERttttttttttttttttttttttt:: esun,esun aRECI!cINTEGER d:: nsunfmmm -mINTEGER,DIMEN E_Pes),POINTERop:: esunlistoiENDi TYPEcdimrt_i=po),POINTERdu1, o:: i=pologe RECI!cTYPEcdimrt_equi_0,-1) u1, o:: 0,-1maRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! InER, Poee routd 8aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!che loops).(ik='c_refft_execmirkindturnaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Get i!X-logeoaDi 0,-1mmmlui=aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c, poldu1oi=popoi=oi=poi ,i!X-logeo_id, ,mm -mIste ENDi LSEiii=pENDa,__LIN ::, poldu1owritiec_rerankiic_refft_execmi'Faile- iget i!X-loge.',esunERmmm -mmmoiiii CI=p ==mjag(mlev),unsunf =mi!X-loge%nsunlistoiENDi poOCATE(esunlist(nsunf)a the lo,i,ksun-,1nsunfmmm -m esunlist(esun) =mi!X-loge%esunlist(esun)CI=p ==mjaiiii ad_f0,-1m =mi!X-loge%0,-1(0,-1i rnaRECI!c!outtmmmm =m0.0_I=p -ind_double !@aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Exec,MG plaDoiENDi !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c,i,ksun-,1nsunfmmm -m esunl=esunlist(esun)CI=p ==p =,i,j-,10,-1%nnodis(2,esun )=!@ add '-1' iexcludi n+1 poe tsRmmm -mmm mm,i,i-,10,-1%nnodis(1,esun )=!@ add '-1' iexcludi n+1 poe tsRmmm -mmm mm ::, poldfftw_exec,MG_dft(I=pplaD%plaD(esun),&mmm -m :: ::& ndtmmmm(1,e,j,1,esun),outtmmmm(1,i1j,1,esun))Rmmm -mmm mmujao,i -mmm mmmjao,i -mmmmjao,i CRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Copy periodico- this is onlyEfve he periodico'N+1'oubltexGpoe tsRmmm -!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!cIFtei!X-loge%bcdef(3) Di L==mar_INeldbcdef_periodici=pENDd!ubltexRmmm -mmmIsteI=pplaD%sign Di L=FFTW_BACKWARDi=pENDa,__LIN :: ::,i,ksun-,1nsunfmmm -m -m esunl=esunlist(esun)CI=p ==p = ==p =,i,j-,10,-1%nnodis(2,esun )=!@ add '-1' iexcludi n+1 poe tsRmmm -mmm mmmmm mm,i,i-,10,-1%nnodis(1,esun )=!@ add '-1' iexcludi n+1 poe tsRmmm -mmm mm ::::::::outtmmmm(1,i1j,0,-1%nnodis(3,esun ),esun) =mouttmmmm(1,i1j,1,esun)Rmmm -mmm mm ::::::::outtmmmm(2,i1j,0,-1%nnodis(3,esun ),esun) =mouttmmmm(2,i1j,1,esun)Rmmm -mmm mm ::::::::outtmmmm(3,i1j,0,-1%nnodis(3,esun ),esun) =mouttmmmm(3,i1j,1,esun)Rmmm -mmm mm :::::mjao,i -mmm mm mmmmmmjao,i -mmm mm mmmjao,i -mmm mmmjag(mlev),u,mmg(ma,__LIN!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! mmmmmm0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRnd toke SXF90 unfoldhe loops).mii=poiifft_execmirkindturnunfoldirnel isI=p ==mjaommESHiN!cja_ISHiN!cj #unde_h_ISHiN!cj #unde_h_Ivec_ou omarlibc_rnumerics-r1036/src/fft/c_refft_execi3derritfr2c_xy.f0000644000175000017500000001111211616214650022367 0uoi(i omaromar,__LIN!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! iSubroutd 8I!c: c_refft_execi3derritfr2c_xyaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Copyright (c)ha210 CSE Lab (ETH Zuk-,,), MOSAIC Group (ETH Zuk-,,),aRECI!c! Ce ter h l0Flu-- Dynamics (DTU) RECI!c!aRECI!c! FFTW exec,MG wrapp r h l03d miENDs, 2d0real to ! lex0aRECI!c! (h lward) FFT i=mii=pxyodire(ch ls RECI!c! Thi routd 8 does notiwork with mmmmmss!!at pncludi mmii= layerisRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (a#mii=pg_smooth_INGLe2Diide_d 8h_ISHiN!cjac_refft_execi3derritfr2c_xy_sodde_d 8h_Ivec_CI=p -ind_singlerrrrmii=pg_smooth_INGLe2Diide_d 8h_ISHiN!cjac_refft_execi3derritfr2c_xy_dodde_d 8h_Ivec_CI=p -ind_double,-f=po,0,-1p =mmESHiN!cja_ISHiN!cjoi=poi ,0,-1i ,I=pplaDindtmmmm,outtmmmm,ndturnOiiiph!!! FFTW exec,MG wrapp r h l03d miENDs, 2d0real to ! lex0aRECI!c!!! (h lward) FFT i=mii=pxyodire(ch ls RECI!c!!! Beh le calling this routd 8 aac_refft_plaDi routd 8 muoi be0call daRECI!c!!! Thi routd 8 does notiwork with mmmmmss!!at pncludi mmii= layerisRECI!cUSjac_re3oduoi_sunfold mmm -mUSjac_re3oduoi_sunfoop mm -mUSjac_re3oduoi_typedef',__LINUSjac_re3oduoi_i=popoi=',__LINUSjac_re3oduoi_writimmm -mUSjac_re3oduoi_i=ia,ONLY:c_rerankiI=p -ind_single,I=p -ind_double,mmm -mIMPLICIT NONEammm -mINCLUDE 'fftw3.f' aRECI!c! if e loopclon- if dimeneh l=ENre 2a 3b 5c 7d 11e 13,0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Aiiphimi=0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c!!!i!X-loge idimiimmmroi Gi(igetmmm -mINTEGER,INTENT(IN) du1, opttttttttttttttttt:: i!X---oiENDi !!!-- h mii=p0,-1mmm -mINTEGER,INTENT(IN) du1, opttttttttttttttttt:: 0,-1i oiENDi !!!I=p fft plaD typeoiENDi TYPEcdimrfft_plaD),INTENT(INHiN)pt du1, opttttttttttttttttt:: I=pplaDoiENDi !!!- ,Mdmmmmm ifouk-el0!ransh lm the lo!REAL(_Ivec_),DIMEN E_Pesmimimimii POINTER,INTENT(INHiN)pt tt:: e mmmm the loREAL(_Ivec_),DIMEN E_Pesmimimimii POINTER1, opttttttttttttttttt:: e mmmm the lo!!!out ,Mdmmmmm h l0!! 2resulteh mii=pfouk-el0!ransh lm the lo!COMPLEX(_Ivec_),DIMEN E_Pesmimimimii POINTER,INTENT(INHiN)pt :: outtmmmm the loCOMPLEX(_Ivec_),DIMEN E_Pesmimimimii POINTERopttttttttttttttttt:: outtmmmm the lo!!!mmmmmms oi(tus, 0 upon successmmmmmmmINTEGER,INTENT(HiN)pt du1, optttttttttttttttttttttttttttttt:: e oaRECI!c!i=miime perhap=ENDmiiiphimiEfve opternateodire(ch ls aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! LERclmmmii=poi=aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!cREAL(_Ivec_)tttttttttttttttttt:: t0mmm -mINTEGERttttttttttttttttttttttt:: kmlev),uINTEGERttttttttttttttttttttttt:: esun,esun aRECI!cINTEGER d:: nsunfmmm -mINTEGER,DIMEN E_Pes),POINTERop:: esunlistoiENDi TYPEcdimrt_i=po),POINTERdu1, o:: i=pologe RECI!cTYPEcdimrt_equi_0,-1) u1, o:: 0,-1maRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! InER, Poee routd 8aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!che loops).(ik='c_refft_execmirkindturnaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Get i!X-logeoaDi 0,-1mmmlui=aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c, poldu1oi=popoi=oi=poi ,i!X-logeo_id, ,mm -mIste ENDi LSEiii=pENDa,__LIN ::, poldu1owritiec_rerankiic_refft_execmi'Faile- iget i!X-loge.',esunERmmm -mmmoiiii CI=p ==mjag(mlev),unsunf =mi!X-loge%nsunlistoiENDi poOCATE(esunlist(nsunf)a the lo,i,ksun-,1nsunfmmm -m esunlist(esun) =mi!X-loge%esunlist(esun)CI=p ==mjaiiii ad_f0,-1m m =mi!X-loge%0,-1(0,-1i rnaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Exec,MG plaDoiENDi !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c,i,ksun-,1nsunfmmm -m esunl=esunlist(esun)CI=p ==p =,i,k-,10,-1%nnodis(3,esun )=!@ add '-1' iexcludi n+1 slanfmmm -m ::, poldfftw_exec,MG_dft_r2c(I=pplaD%plaD(esun),&mmm -m ::& ndtmmmm(1,1,1,k,esun),outtmmmm(1,1,1,k,esun))Rmmm -mmmmjao,i -mmmmjao,i CRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! mmmmmm0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRnd toke SXF90 unfoldhe loops).mii=poiifft_execmirkindturnunfoldirnel isI=p ==mjaommESHiN!cja_ISHiN!cj #unde_h_ISHiN!cj #unde_h_Ivec_olibc_rnumerics-r1036/src/fft/c_refft_plaDi3derritbc2r_xy.f0000644000175000017500000001544311616214650022404 0uoi(i omaromarRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! iSubroutd 8I!c: c_refft_plaDi3derritbc2r_xyaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Copyright (c)ha210 CSE Lab (ETH Zuk-,,), MOSAIC Group (ETH Zuk-,,),aRECI!c! Ce ter h l0Flu-- Dynamics (DTU) RECI!c!aRECI!c! FFTW plaD wrapp r h l03d miENDs, 2d0! lex to realaRECI!c! (backward) FFT i=mii=pxyodire(ch ls RECI!c! Thi routd 8 does notiwork with mmmmmss!!at pncludi mmii= layerisRECI!c!aRECI!c! F l0!! 2C2R pnverie0!ransh lm FFTW alwNDs distroysmii=p- ,Mdi=iasRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (a#mii=pg_smooth_INGLe2Diide_d 8h_ISHiN!cjac_refft_plaDi3derritbc2r_xy_sodde_d 8h_Ivec_CI=p -ind_singlerrrrmii=pg_smooth_INGLe2Diide_d 8h_ISHiN!cjac_refft_plaDi3derritbc2r_xy_dodde_d 8h_Ivec_CI=p -ind_double,-f=po,0,-1p =mmESHiN!cja_ISHiN!cjoi=poi ,0,-1i ,I=pplaDindtmmmm,outtmmmm,ndturnOiiiph!!! FFTW plaD wrapp r h l03d miENDs, 2d0! lex to realaRECI!c!!! (backward) FFT i=mii=pxyodire(ch ls RECI!c!!! Thi routd 8 does notiwork with mmmmmss!!at pncludi mmii= layerisRECI!cUSjac_re3oduoi_sunfold mmm -mUSjac_re3oduoi_sunfoop mm -mUSjac_re3oduoi_typedef',__LINUSjac_re3oduoi_i=popoi=',__LINUSjac_re3oduoi_writimmm -mUSjac_re3oduoi_i=ia,ONLY:c_rerankiI=p -ind_single,I=p -ind_double,mmm -mIMPLICIT NONEammm -mINCLUDE 'fftw3.f' aRECI!c! if e loopclon- if dimeneh l=ENre 2a 3b 5c 7d 11e 13,0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Aiiphimi=0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c!!!i!X-loge idimiimmmroi Gi(igetmmm -mINTEGER,INTENT(IN) du1, opttttttttttttttttt:: i!X---oiENDi !!!-- h mii=p0,-1mmm -mINTEGER,INTENT(IN) du1, opttttttttttttttttt:: 0,-1i oiENDi !!!I=p fft plaD typeoiENDi TYPEcdimrfft_plaD),INTENT(INHiN)pt du1, opttttttttttttttttt:: I=pplaDoiENDi !!!- ,Mdmmmmm ifouk-el0!ransh lm the lo!COMPLEX(_Ivec_),DIMEN E_Pesmimimimii POINTER,INTENT(INHiN)pt :: e mmmm the loCOMPLEX(_Ivec_),DIMEN E_Pesmimimimii POINTERopttttttttttttttttt:: e mmmm the lo!!!out ,Mdmmmmm h l0!! 2resulteh mii=pfouk-el0!ransh lm the lo!REAL(_Ivec_),DIMEN E_Pesmimimimii POINTER,INTENT(INHiN)pt tt:: outtmmmm the loREAL(_Ivec_),DIMEN E_Pesmimimimii POINTER1, opttttttttttttttttt:: outtmmmm the lo!!!mmmmmms oi(tus, 0 upon successmmmmmmmINTEGER,INTENT(HiN)pt du1, optttttttttttttttttttttttttttttt:: e oaRECI!c!i=miime perhap=ENDmiiiphimiEfve opternateodire(ch ls aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! LERclmmmii=poi=aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!cREAL(_Ivec_)tttttttttttttttttt:: t0mmm -mINTEGERttttttttttttttttttttttt:: esun,esun aRECI!cINTEGER d:: nsunfmmm -mINTEGER,DIMEN E_Pes),POINTERop:: esunlistoiENDi TYPEcdimrt_i=po),POINTERdu1, o:: i=pologe RECI!cTYPEcdimrt_equi_0,-1) u1, o:: 0,-1maRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! InER, Poee routd 8aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!che loops).(ik='c_refft_plaDmirkindturnaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Get i!X-logeoaDi 0,-1mmmlui=aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c, poldu1oi=popoi=oi=poi ,i!X-logeo_id, ,mm -mIste ENDi LSEiii=pENDa,__LIN ::, poldu1owritiec_rerankiic_refft_plaDmi'Faile- iget i!X-loge.',esunERmmm -mmmoiiii CI=p ==mjag(mlev),unsunf =mi!X-loge%nsunlistoiENDi poOCATE(esunlist(nsunf)a the lo,i,ksun-,1nsunfmmm -m esunlist(esun) =mi!X-loge%esunlist(esun)CI=p ==mjaiiii ad_f0,-1m =mi!X-loge%0,-1(0,-1i rnaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Smmmp _INel ters h l0!!is _INticular routd 8aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c!ii=piimeneh leh mii=pFFT (1D/2D/3D)CI=p ==I=pplaD%rank=2aRECI!c!ii=pnumbmroi Gpoe ts opong eachodire(ch leh mii=ppiece ibe0!ransh lm daRECI!c poOCATE(I=pplaD%nxeI=pplaD%rank,nsunf)a the lo!ii=piire(ch leh mii=p!ransh lm the loI=pplaD%sign=FFTW_BACKWARD the lo!ii=pl tho- ismmmp ii=popiimclmplaDoiENDi I=pplaD%flag=FFTW_MEASUREaRECI!c!ii=pnumbmroi G! onimi=s!os!ransh lm - 3G! onimi rric4.oiENDi I=pplaD%howmany=3aRECI!c!ii=psizeeh mii=p- ,MdmiENDG- fullpsizee(assuming LBOUND=1miius UBOUND)aRECI!c poOCATE(I=pplaD%d 8mbmdeI=pplaD%rank))CI=p ==I=pplaD%d 8mbmde1) =mUBOUND(ndtmmmm,2)CI=p ==I=pplaD%d 8mbmde2) =mUBOUND(ndtmmmm,3)aRECI!c!ii=psizeeh mii=pout ,MdmiENDG- fullpsizee(assuming LBOUND=1miius UBOUND)aRECI!c poOCATE(I=pplaD%o 8mbmdeI=pplaD%rank))CI=p ==I=pplaD%o 8mbmde1) =mUBOUND(outtmmmm,2)CI=p ==I=pplaD%o 8mbmde2) =mUBOUND(outtmmmm,3)aRECI!c!istridi tells howmii=psel G! onimeMdi=iaGpoe ts ore spac=d i=mmemoryaRECI!c!e.g. h l02/3G! onimi rric4. istridi =02/3Gor h l0sRcla. istridi =01CI=p ==I=pplaD%dstridi =03CI=p ==I=pplaD%ostridi =03CI=p ==!--dst tells howmmultiple miENDs ore spac=d i=mmemory. I.e. ammemory0aRECI!c!offsmm. e.g. rric4. ! onimi=s(--dst=1) l0sRcla. 2D miENDs aRECI!c!i=m3D miEND(--dst=NxNy)CI=p ==I=pplaD%d-dst =01CI=p ==I=pplaD%o-dst =01C0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! AllERcMG plaD miEND0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!cIF(ASSOCIATED(I=pplaD%plaD)i=pENDa,__LIN ::DE poOCATE(I=pplaD%plaDioi(t=_id, ,mm -m -mIste ENDi LSEiii=pENDa,__LIN :: ::, poldu1owritiec_rerankiic_refft_plaDmi'Faile- ideallERcMG plaD-miEND.',esunERmmm -mmm mmoiiii CI=p == mmmjag(mlev),u,mmog(mlev),u poOCATE(I=pplaD%plaD(nsunf)a aRECI!c,i,ksun-,1nsunfmmm -m esunl=esunlist(esun)CI=p ==p =!@ maybe0!i=p-1 neemss!osb 2remove- when doing cepl d=iasRECI!cp =!weoops!ract0!i=p-1 !osavoi he periodicoubltexGpoe t,mm -m -mIstei!X-loge%bcdef(1) Di L==mar_INeldbcdef_periodici=pENDd!ubltexRmmm -mmm mmI=pplaD%nxe1,esun) =m0,-1%nm(1)-cRmmm -mmm mmI=pplaD%nxe2,esun) =m0,-1%nm(2)-cRmmm -mmmux,0mii=poiii 4/ I=pplaD%nxe1,esun) =m0,-1%nm(1)Rmmm -mmm mmI=pplaD%nxe2,esun) =m0,-1%nm(2)CI=p == mmmjag(ma,__LIN ::, poldfftw_plaDimany_dft_c2r(I=pplaD%plaD(esun),I=pplaD%rank,&mmm -m &mI=pplaD%nx,I=pplaD%howmany,ndtmmmm(1,1,1,1,esun),I=pplaD%d 8mbmde1),&mmm -m &mI=pplaD%dstridi,I=pplaD%d-dst,outtmmmm(1,1,1,1,esun),&mmm -m &mI=pplaD%o 8mbmde1),I=pplaD%ostridi,I=pplaD%o-dst,I=pplaD%flag)CI=p ==mjao,i C0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! mmmmmm0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRnd toke SXF90 unfoldhe loops).mii=poiifft_plaDmirkindturnunfoldirnel isI=p ==mjaommESHiN!cja_ISHiN!cj #unde_h_ISHiN!cj #unde_h_Ivec_olibc_rnumerics-r1036/src/c_re3oduoi_fmm_inER.f0000644000175000017500000000664011616214650020327 0uoi(i omaromar,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Moduoimm -m :mmm -mmm mmI=pe3oduoi_fmm_inER0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c!aRECI!c! Purpose -m :mmfast multipol=pl tho- 3oduoi, inER, Poic_Oiiiroutd 8aRECI!c! aRECI!c!aRECI!c! Remarks -m :maRECI!c!aRECI!c! Referencesm :maRECI!c!aRECI!c! Revieh l=Em :0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! $Log:mI=pe3oduoi_fmm_inER.f,v $aRECI!c! Revieh l 1.1.1.1 2007/07/13 10:18:58 evos RECI!c! CBLoubleh leh mii=pPPM libraryaRECI!c!aRECI!c! Revieh l 1.3 2006/06/29 10:28:37mmIchcMGlaaRECI!c! Adde- rric4. strengthsoopppod mmm -m!aRECI!c! Revieh l 1.2 2005/09/19 13:03:32 polasekbaRECI!c! codi cosl ticsmmm -m!aRECI!c! Revieh l 1.1 2005/05/27 07:55:20 polasekbaRECI!c! inER, P i lehimic_OiiaRECI!c! aRECI!c! Revieh l 0 2004/11/11 16:38:33 polasekbaRECI!c! Sold mmm -m!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Copyright (c)ha210 CSE Lab (ETH Zuk-,,), MOSAIC Group (ETH Zuk-,,), aRECI!c! Ce ter h l0Flu-- Dynamics (DTU) RECI!c!aRECI!c!aRECI!c! T!is file is _INteh mii=pPINellelpPINticle M,-1mLibrary (PPM).aRECI!c!aRECI!c! PPM is freeoooftwore: you cNDmreddstrib,MG itoaDi/ l03odifyaRECI!c! itoundel0!! 2termseh mii=pGNU Lessel0GeneNel PunlicmLicense aRECI!c! as _unlishe- bymii=pFreeoSoftwore Foundc_Oii, eiii=r aRECI!c! ubleh le3eh mii=pLicense, l0(at yourpopiion)Gany lat=r aRECI!c! ubleh l.aRECI!c!aRECI!c! PPM is ddstrib,MGd i=mii=phopes!!at pt wipl b 2useful,aRECI!c! b,M WITHHiN ANY WARRANTY; without eve=mii=pi lie- wmiENntyeh aRECI!c! MERCHANTABILITY l0FITNESS FOR A PARTICULAR PURPOSSEiSees!! aRECI!c! GNU GeneNel PunlicmLicense f l03ore details.aRECI!c!aRECI!c! You sho,ld hav 2receive- a copyeh mii=pGNU GeneNel PunlicmLicenseaRECI!c! andmii=pGNU Lessel0GeneNel PunlicmLicense opong with PPM. If not,aRECI!c! sees.aRECI!c!aRECI!c! PINellelpPINticle M,-1mLibrary (PPM)aRECI!c! ETH Zuk-,,aRECI!c! CH-8092 Zuk-,,, SwitzerlaDdC0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (a odde_d 8h_INGLe2DIvec_I E_P 1odde_d 8h_INGLe2DIvec_I E_P 2 !dde_d 8h_IINTEGER 3 !dde_d 8h_ILOGIhe 4 !dde_d 8h_I2D 7 !dde_d 8h_I3D 8odde_d 8h_INFIELD 9odde_d 8h_IVFIELD 10 MODULEmI=pe3oduoi_fmm_inER C0,-!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d ((d (a!c! De_d 8hI terface0,-!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d ((d (a -mINTERFACjac_refmm_inER0 MODULEmPROCEDURjac_refmm_inER_s_sf0 MODULEmPROCEDURjac_refmm_inER_d_sf C MODULEmPROCEDURjac_refmm_inER_s_vf C MODULEmPROCEDURjac_refmm_inER_d_vf C,u,mmogNTERFACjC0,-!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d ((d (a!c! INCLUDE THE SOURCES0,-!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d ((d (a ke SAINS odde_d 8h_Ig_smo_INGLe2DIvec_I E_Podde_d 8h_INIMh_INFIELD #pncludi "c_refmm_inER.f" #unde_h_Ig_sm odde_d 8h_Ig_smo_INGLe2DIvec_I E_P #pncludi "c_refmm_inER.f" #unde_h_Ig_sm #unde_h_INIM odde_d 8h_Ig_smo_INGLe2DIvec_I E_Podde_d 8h_INIMh_IVFIELD #pncludi "c_refmm_inER.f" #unde_h_Ig_sm odde_d 8h_Ig_smo_INGLe2DIvec_I E_P #pncludi "c_refmm_inER.f" #unde_h_Ig_sm #unde_h_INIM o ,mmoMODULEmI=pe3oduoi_fmm_inERolibc_rnumerics-r1036/src/c_re3oduoi_fdsolublifft_fd.f0000644000175000017500000001130311616214650021651 0uoi(i omaromar#ifde_h_IXLF @PROCESS NOHOT,-f=po,0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Moduoimm -m :mmm -mmm mmI=pe3oduoi_fdsolublifft_fd0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c!aRECI!c! Purpose -m : T!is 3oduoi pncludismii=psource codi h l0!! 2fft aRECI!c! routd 8saRECI!c! mmm -m!aRECI!c! Remarks -m :mmm -m!aRECI!c! Referencesm :mmm -m!aRECI!c! Revieh l=Em :0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! $Log:mI=pe3oduoi_fdsolublifft_fd.f,v $aRECI!c! Revieh l 1.1.1.1 2007/07/13 10:18:58 evos RECI!c! CBLoubleh leh mii=pPPM libraryaRECI!c!aRECI!c! Revieh l 1.1 2005/02/16 12:07:09 hieberisRECI!c! inER, P i lehimic_OiiaRECI!c!aRECI!c!aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Copyright (c)ha210 CSE Lab (ETH Zuk-,,), MOSAIC Group (ETH Zuk-,,), aRECI!c! Ce ter h l0Flu-- Dynamics (DTU) RECI!c!aRECI!c!aRECI!c! T!is file is _INteh mii=pPINellelpPINticle M,-1mLibrary (PPM).aRECI!c!aRECI!c! PPM is freeoooftwore: you cNDmreddstrib,MG itoaDi/ l03odifyaRECI!c! itoundel0!! 2termseh mii=pGNU Lessel0GeneNel PunlicmLicense aRECI!c! as _unlishe- bymii=pFreeoSoftwore Foundc_Oii, eiii=r aRECI!c! ubleh le3eh mii=pLicense, l0(at yourpopiion)Gany lat=r aRECI!c! ubleh l.aRECI!c!aRECI!c! PPM is ddstrib,MGd i=mii=phopes!!at pt wipl b 2useful,aRECI!c! b,M WITHHiN ANY WARRANTY; without eve=mii=pi lie- wmiENntyeh aRECI!c! MERCHANTABILITY l0FITNESS FOR A PARTICULAR PURPOSSEiSees!! aRECI!c! GNU GeneNel PunlicmLicense f l03ore details.aRECI!c!aRECI!c! You sho,ld hav 2receive- a copyeh mii=pGNU GeneNel PunlicmLicenseaRECI!c! andmii=pGNU Lessel0GeneNel PunlicmLicense opong with PPM. If not,aRECI!c! sees.aRECI!c!aRECI!c! PINellelpPINticle M,-1mLibrary (PPM)aRECI!c! ETH Zuk-,,aRECI!c! CH-8092 Zuk-,,, SwitzerlaDdC0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (a-1p =0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! De_d 8htypeisRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (a#de_d 8h_INGLe2DIvec_I E_P 1odde_d 8h_INGLe2DIvec_I E_P 2a#de_d 8h_INGLe2DIvec_I E_P_COMPLEX 5odde_d 8h_INGLe2DIvec_I E_P_COMPLEX 6a#de_d 8h_INGLe2DIvec_I E_P_COMPLEX_Z 7odde_d 8h_INGLe2DIvec_I E_P_COMPLEX_Z 8 odde_d 8h_INLAB 10 MODULEmI=pe3oduoi_fdsolublifft_fd0mmm -m !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (mmm -m ! De_d 8hi terface !osc_refdsolublifft_fd0,-1p = !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (mmm -m INTERFACjac_refdsolublifft_fd_slanmmm -m MODULEmPROCEDURjac_refdsolublifft_fd_slan_3dsmmm -m MODULEmPROCEDURjac_refdsolublifft_fd_slan_3dd0,-1p = ,mmogNTERFACjC0,- -m INTERFACjac_refdsolublifft_fdmmm -m MODULEmPROCEDURjac_refdsolublifft_fd_2dsmmm -m MODULEmPROCEDURjac_refdsolublifft_fd_2ddmmm -m MODULEmPROCEDURjac_refdsolublifft_fd_2dcmmm -m MODULEmPROCEDURjac_refdsolublifft_fd_2dcc mmm -m MODULEmPROCEDURjac_refdsolublifft_fd_3dsmmm -m MODULEmPROCEDURjac_refdsolublifft_fd_3ddmmm -m MODULEmPROCEDURjac_refdsolublifft_fd_3dcmmm -m MODULEmPROCEDURjac_refdsolublifft_fd_3dcc ,-1p = ,mmogNTERFACjC0,- -m INTERFACjac_refdsolublifft_fd_zaRECI!c MODULEmPROCEDURjac_refdsolublifft_fd_z_3dcmmm -m MODULEmPROCEDURjac_refdsolublifft_fd_z_3dcc ,-1p = ,mmogNTERFACjC0,- -m !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (mmm -m ! pncludi ii=psource 0,- -m !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (mmm -m ke SAINS odde_d 8h_ICASEh_INLAB odde_d 8h_Ig_smo_INGLe2DIvec_I E_Podpncludi "c_refdsolublifft_fd_3d.f" #unde_h_Ig_sm odde_d 8h_Ig_smo_INGLe2DIvec_I E_P #pncludi "c_refdsolublifft_fd_3d.f" #unde_h_Ig_sm odunde_h_ICASE odde_d 8h_Ig_smo_INGLe2DIvec_I E_Podpncludi "c_refdsolublifft_fd_2d.f" #pncludi "c_refdsolublifft_fd_3d.f" #unde_h_Ig_sm odde_d 8h_Ig_smo_INGLe2DIvec_I E_P #pncludi "c_refdsolublifft_fd_2d.f" #pncludi "c_refdsolublifft_fd_3d.f" #unde_h_Ig_sm odde_d 8h_Ig_smo_INGLe2DIvec_I E_P_COMPLEXodpncludi "c_refdsolublifft_fd_2d.f" #pncludi "c_refdsolublifft_fd_3d.f" #unde_h_Ig_sm odde_d 8h_Ig_smo_INGLe2DIvec_I E_P_COMPLEXodpncludi "c_refdsolublifft_fd_2d.f" #pncludi "c_refdsolublifft_fd_3d.f" #unde_h_Ig_sm o odde_d 8h_Ig_smo_INGLe2DIvec_I E_P_COMPLEX_Z #pncludi "c_refdsolublifft_fd_3d.f" #unde_h_Ig_sm odde_d 8h_Ig_smo_INGLe2DIvec_I E_P_COMPLEX_Z #pncludi "c_refdsolublifft_fd_3d.f" #unde_h_Ig_sm op = ,mmoMODULEmI=pe3oduoi_fdsolublifft_fd0libc_rnumerics-r1036/src/c_refdsolublifft_fd_2d.f0000644000175000017500000003306711616214650020704 0uoi(i omaromar -m !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (- (aRECI!c! Subroutd 8I!c: c_refdsolublifft_fd_2d0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c!aRECI!c! Purpose -m : T!is routd 8IperformseFast Fouk-el0Transh lm h lt,aRECI!c! using th8Ipre! ,MGd plaDs i=mc_refdsolubliinER0,-1p =!aRECI!c! I ,Md -m : d=iaiinesmi) (F) 2d0i=iaGmiENDG ibe0!ransh lm daRECI!c!aRECI!c! I ,M/out ,Md: lda(:) u1, o(I)psizeeh mi=iaGGGGGGGGGGGGGGaRECI!c! GGGGGGGGGGGGaRECI!c!aRECI!c! Out ,Md -m : d=iaioutesmi) (F) !ransh lm ddi=iasRECI!c! GGGGGGGGGGGG ENDiiiiiiiiiii(I)prmmmmm oi(tus. =0 if no error.aRECI!c!aRECI!c! Remarks -m :GaRECI!c! GGGGGGGGGGGG GGGGGGGGGGGGaRECI!c! Referencesm :mmm -m!aRECI!c! Revieh l=Em :0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! $Log:mI=pefdsolublifft_fd_2d.f,v $aRECI!c! Revieh l 1.1.1.1 2007/07/13 10:18:54 evos RECI!c! CBLoubleh leh mii=pPPM libraryaRECI!c!aRECI!c! Revieh l 1.3 2006/09/04 18:34:43mmIchcMGlaaRECI!c! Fixes andmcleanupss!osmakG ito! ile f4.oiENDi ! release-1-0aRECI!c!aRECI!c! Revieh l 1.2 2005/02/16 22:22:59 evos RECI!c! Bugfix: replac=d non-existing c_re3oduoi_i=iaefdsolubl with RECI!c! c_re3oduoi_i=iaefmmmmsolubl.aRECI!c!aRECI!c! Revieh l 1.1 2005/02/16 11:52:46 hieberisRECI!c! inER, P i lehimic_OiiaRECI!c!aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Copyright (c)ha210 CSE Lab (ETH Zuk-,,), MOSAIC Group (ETH Zuk-,,), aRECI!c! Ce ter h l0Flu-- Dynamics (DTU) RECI!c!aRECI!c!aRECI!c! T!is file is _INteh mii=pPINellelpPINticle M,-1mLibrary (PPM).aRECI!c!aRECI!c! PPM is freeoooftwore: you cNDmreddstrib,MG itoaDi/ l03odifyaRECI!c! itoundel0!! 2termseh mii=pGNU Lessel0GeneNel PunlicmLicense aRECI!c! as _unlishe- bymii=pFreeoSoftwore Foundc_Oii, eiii=r aRECI!c! ubleh le3eh mii=pLicense, l0(at yourpopiion)Gany lat=r aRECI!c! ubleh l.aRECI!c!aRECI!c! PPM is ddstrib,MGd i=mii=phopes!!at pt wipl b 2useful,aRECI!c! b,M WITHHiN ANY WARRANTY; without eve=mii=pi lie- wmiENntyeh aRECI!c! MERCHANTABILITY l0FITNESS FOR A PARTICULAR PURPOSSEiSees!! aRECI!c! GNU GeneNel PunlicmLicense f l03ore details.aRECI!c!aRECI!c! You sho,ld hav 2receive- a copyeh mii=pGNU GeneNel PunlicmLicenseaRECI!c! andmii=pGNU Lessel0GeneNel PunlicmLicense opong with PPM. If not,aRECI!c! sees.aRECI!c!aRECI!c! PINellelpPINticle M,-1mLibrary (PPM)aRECI!c! ETH Zuk-,,aRECI!c! CH-8092 Zuk-,,, SwitzerlaDdC0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (a#mii i=pg_smooth_INGLe2DIvec_I E_P ,-1p =mmESHiN!cjac_refdsolublifft_fd_2ds(d=iaiin,lda,d=iaioutindturnrrrmii=pg_smooth_INGLe2DIvec_I E_P ,-1p =mmESHiN!cjac_refdsolublifft_fd_2dd(d=iaiin,lda,d=iaioutindturnrrrmii=pg_smooth_INGLe2DIvec_I E_P_COMPLEXo,-1p =mmESHiN!cjac_refdsolublifft_fd_2dc(d=iaiin,lda,d=iaioutindturnrrrmii=pg_smooth_INGLe2DIvec_I E_P_COMPLEXo,-1p =mmESHiN!cjac_refdsolublifft_fd_2dcc(d=iaiin,lda,d=iaioutindturnrr=po,0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Includis0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (a#mncludi "c_rede_d 8.h"0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Moduoi=aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!cUSjac_re3oduoi_i=iaaRECI!cUSjac_re3oduoi_i=iaefmmmmsolublaRECI!cUSjac_re3oduoi_sunfold mmm -mUSjac_re3oduoi_sunfoop mm -mUSjac_re3oduoi_error mm -mUSjac_re3oduoi_allER mm -mIMPLICIT NONEa#mii i=pg_smooth_INGLe2DIvec_I E_P |i=pg_smoot_INGLe2DIvec_I E_P_COMPLEX mm -mINTEGER, PARAMETERd:: MK =CI=p -ind_singlerrrrmii=pg_smooth_INGLe2DIvec_I E_P |i=pg_smoot_INGLe2DIvec_I E_P_COMPLEX mm -mINTEGER, PARAMETERd:: MK =CI=p -ind_double,-f=po,0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! FFTW mncludi0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (a#mide_hi=pFFTW mm -mINCLUDE "fftw3.f",-f=po,0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Aiiphimi=ECI!c0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! - ,Mdi=ias#mii i=pg_smooth_INGLe2DIvec_I E_P |i=pg_smooth_INGLe2DIvec_I E_P ,-1p =REAL(MK), DIMEN E_Pesmi) u1, INTENT(IN u1)d:: d=iaiinnrrrmii=pg_smooth_INGLe2DIvec_I E_P_COMPLEX |i=pg_smooth_INGLe2DIvec_I E_P_COMPLEXo,-1p =COMPLEX(MK), DIMEN E_Pesmi) u11, INTENT(IN u1)d:: d=iaiinnrr=po,0,-1p =!psizeeh mii=pmiEND0,-1p =INTEGER, DIMEN E_Pes) u11, INTENT(INHiN)p:: lda0,-1p =!pout ,Mdi=ia,mfast fouk-el0!ransh lmem the loCOMPLEX(MK), DIMEN E_Pesmi) , POINTER1, optt:: d=iaiout0,-1p =INTEGER , INTENT( HiN)p:: e oaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! LERclmmmii=poi=c0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! iimer ,-1p =REAL(MK) :: t0mmm -m! cou ters0,-1p =INTEGER :: i1j,iopi0,-1p =!psizeeh mii=pd=iaiin 0,-1p =INTEGER :: Nxiin, Nyiinn,-1p =!psizeeh mii=pd=iaiout 0,-1p =INTEGER :: Nxiouti Nyiout0#ifde_h_IFFTW mm -m! FFTW PlaDoiENDi INTEGER*8 :: PlaDorr=po,0#ifde_h_IMATHKEISAN mm -m! MATHKEISANmmmii=poi=cf l0MathKeisNDmFFTs0,-1p =INTEGER :: isignifft, isysa#mii=pg_smooth_INGLe2DIvec_I E_P_COMPLEX |i=pg_smooth_INGLe2DIvec_I E_P_COMPLEXo,-1p =INTEGER :: incx, incynrr=po,0,-1p =!psRcleeh mii=p!ransh lmc_OiiaRECI!cREAL(MK) :: sRcleifft0,-1p =!pworking foorage ,-1p =REAL(MK), DIMEN E_Pesi POINTER1, opttttt:: t=poi,pworkaRECI!c! ii=psizeeh mii=pworking foorage ,-1p =INTEGER, DIMEN E_Pe1) :: lda_t=poi,plda_worka-f=po,0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! External=c0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (a0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! InER, Poee0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!che loops).(ik='c_refdsolublifft_fd_2dmirkindturn#mii !(de_d 8d(_IFFTW) |ide_d 8d(_IMATHKEISAN)a the lo!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Error if FFTW library l0NEC is notiavail=poi the lo!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c ENDi=CI=p error_error #minde_h_IFFTW mm -m, poldu1oerror(du1oerr_nofftw,'c_refdsolublifft_fd_2dmi &mmm -&m -'PPM waso! iled without fftwoopppod ',__L!cj__indturnrr=po,0#minde_h_IMATHKEISAN mm -m, poldu1oerror(du1oerr_noMathKeisND,'c_refdsolublifft_fd_2dmi &mmm -&m -'PPM waso! iled without MATHKEISANmopppod ',__L!cj__indturnrr=po,0mm -moiiii -mnrrree0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Clon- aiiphimi=0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!cIsteI=p_e loop.GTEiii=pENDa,__LIN :: IsteSIZE(lda,1) DLTEi2i=pENDa,__LIN :: ::!c ENDi=CI=p error_error ,__LIN :: ::!c, poldu1oerror(du1oerr_aiiphimi,'c_refdsolublifft_fd_2dmi &mmm -&m ---------'lda muoi be0at leasteh msizee2',__L!cj__indturn,__LIN :: ::!coiiii CI=p == mmmmjag(mlev),u :: Istelda(1) DLSEiii=pENDa,__LIN :: ::!c ENDi=CI=p error_error ,__LIN :: ::!c, poldu1oerror(du1oerr_aiiphimi,'c_refdsolublifft_fd_2dmi &mmm -&m ---------'0,-1msize: lda(1) muoi be0>0',__L!cj__indturn,__LIN :: ::!coiiii CI=p == mmmmjag(mlev),u :: Istelda(2) DLSEiii=pENDa,__LIN :: ::!c ENDi=CI=p error_error ,__LIN :: ::!c, poldu1oerror(du1oerr_aiiphimi,'c_refdsolublifft_fd_2dmi &mmm -&m ---------'0,-1msize: lda(2) muoi be0>0',__L!cj__indturn,__LIN :: ::!coiiii CI=p == mmmmjag(mlev),umjag(mlev),u!Nxiini=Clda(1)mlev),u!ops!ract01 ifitldu1-convimiiiiaRECI!cNxiin=lda(1)-cRmmm -Nyiini=Clda(2a the lo!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! AllERcMG resultemiEND0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (a#mii i=pg_smooth_INGLe2DIvec_I E_P |i=pg_smooth_INGLe2DIvec_I E_P ,-1p =Nxiouti=CNxiin/2 + 1odrrmii=pg_smooth_INGLe2DIvec_I E_P_COMPLEX |i=pg_smooth_INGLe2DIvec_I E_P_COMPLEXo,-1p =Nxiouti=CNxiinnrr=po,0mm -mNyiout=Nyiinn#mii i=pg_smooth_INGLe2DIvec_I E_P |i=pg_smooth_INGLe2DIvec_I E_P ,-1p =lda(1) ==Nxioutodrrmii=pg_smooth_INGLe2DIvec_I E_P_COMPLEX |i=pg_smooth_INGLe2DIvec_I E_P_COMPLEXo,-1p =lda(1) ==Nxiout+1RECI!c! ifitldu1-convimiiiiarr=po,0mm -mlda(2a=Nyiout0: ::!c, poldu1oallER(d=iaioutilda,=mar_INeldallER_fito_id, ,mm -mIste ENDi LSEiii=pENDa,__LIN ::c ENDi=CI=p error_f=iala,__LIN ::c, poldu1oerror(du1oerr_allER,'c_refdsolublifft_fd_2dmi &mmm -&m -----'fft resulteDATA_OUT',__L!cj__indturn,__LIN :: oiiii CI=p ==mjag(mlev),u!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! FFT -0Transh lm inix-iire(ch lmlev),u!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! 0NEC ubleh le- Use0MathKeisNDmLibraryaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (a#ifde_h_IMATHKEISAN mm -m!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (amm -m!NOTE: T!is fft routd 8s does noticurrimilyiwork cf l0emibitrary l.aRECI!c! Numbmroi Gi=iaGpoe ts,eh mii= h lm ni=C2**p * 3**q *aRECI!c! 5**r, with p, q, r >= 0mlev),u!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! 0AllERcMG working foorage ,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!clda_work(1) ==4*Nxiinn: ::!c, poldu1oallER(work,lda_work,=mar_INeldallER_fito_id, ,mm -mIste ENDi LSEiii=pENDa,__LIN ::c ENDi=CI=p error_f=iala,__LIN ::c, poldu1oerror(du1oerr_allER,'c_refdsolublifft_fd_2dmi &mmm -&m -----'work notiallERcMGd',__L!cj__indturn,__LIN :: oiiii CI=p ==mjag(mlev),u!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Forward FFT mlev),u!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!csRcleifft =01CI=p ==isignifft =00CI=p ==isignifft =0-1 aRECI!c,i,j=1,Nyiinn#mii i=pg_smooth_INGLe2DIvec_I E_Pa,__LIN ::c, polcsRfft(isignifft, Nxiin, sRcleifft, d=iaiine1,j), &mmm -&m ------------------------------d=iaioute1,j), t=poi_fd_s,pwork, isysrnrrrmii=pg_smooth_INGLe2DIvec_I E_P ,-1p = ::c, polcdzfft(isignifft, Nxiin, sRcleifft, d=iaiine1,j), &mmm -&m ------------------------------d=iaioute1,j), t=poi_fd_d,pwork, isysrnrrrmii=pg_smooth_INGLe2DIvec_I E_P_COMPLEXo,-1p = ::c, polcRfft(isignifft, Nxiin, sRcleifft, d=iaiine1,j), incx, &mmm -&m -----------d=iaioute1,j), incy, t=poi_fd_c_y, lda_t=poi_y, work, &mmm -&m -----------lda_work(1), isysrnrrrmii=pg_smooth_INGLe2DIvec_I E_P_COMPLEXo,-1p = ::c, polczfft(isignifft, Nxiin, sRcleifft, d=iaiine1,j), incx, &mmm -&m -----------d=iaioute1,j), incy, t=poi_fd_cc_y, lda_t=poi_y, work, &mmm -&m -----------lda_work(1), isysrnrr=po,0mm -mmjaiiii ad_f!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! DeallERcMG working foorage ,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!ciopii=CI=p _INelddeallERn: ::!c, poldu1oallER(work,lda,iopio_id, ,mm -mIste ENDi LSEiii=pENDa,__LIN ::cWRITE(0,-g,'(A)') 'co,ld notideallERmmemory'a,__LIN ::c ENDi=CI=p error_error ,__LIN :: , poldu1oerror(du1oerr_deallER,'c_refdsolublifft_2dmi0,-g,__L!cj__i&mmm -&m --------------------------------------------------------------ndturn,__LIN :: oiiii CI=p ==mjag(mrrree0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! FFTW ubleh lef l0L!cUX,...0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (a#mii i=pg_smooth_INGLe2DIvec_I E_Pa,__LINhe loofftw_exec,MG_dft_r2c(PlaD_fd_s,d=iaiine1,1),d=iaioute1,1) rnrrrmii=pg_smooth_INGLe2DIvec_I E_P ,-1p =, poldfftw_exec,MG_dft_r2c(PlaD_fd_d,d=iaiine1,1),d=iaioute1,1) rnrrrmii=pg_smooth_INGLe2DIvec_I E_P_COMPLEXo,-1p =he loofftw_exec,MG_dft(PlaD_fd_c_y,d=iaiine1,1),d=iaioute1,1) rnrrrmii=pg_smooth_INGLe2DIvec_I E_P_COMPLEXo,-1p =he lodfftw_exec,MG_dft(PlaD_fd_cc_y,d=iaiine1,1),d=iaioute1,1) rnrr=po,0#r=po,0#r=po, a#mii=pg_smooth_INGLe2DIvec_I E_P_COMPLEX |i=pg_smooth_INGLe2DIvec_I E_P_COMPLEXo,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Copyemargi=mio conh lm with PPM convimiiiiaRECI!c!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c,i,j=1,Nyiout0: ::!cccccccd=iaioutelda(1),j)i=Cd=iaioute1,j)0mm -mmjaiim -ma-f=po,0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! mmmmmm0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRnd toke SXF90 unfoldhe loops).mii=poiifdsolublifft_fd_2dmirkindturnunfoldirnel is#mii i=pg_smooth_INGLe2DIvec_I E_Pa,__LINmjaommESHiN!cjac_refdsolublifft_fd_2dsmrrrmii=pg_smooth_INGLe2DIvec_I E_P ,-1p =mjaommESHiN!cjac_refdsolublifft_fd_2ddnrrrmii=pg_smooth_INGLe2DIvec_I E_P_COMPLEXo,-1p =mjaommESHiN!cjac_refdsolublifft_fd_2dcnrrrmii=pg_smooth_INGLe2DIvec_I E_P_COMPLEXo,-1p =mjaommESHiN!cjac_refdsolublifft_fd_2dcca-f=po,0libc_rnumerics-r1036/src/c_re3oduoi_numerics_i=ia.f0000644000175000017500000000370311616214650021340 0uoi(i omaromar,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Moduoimm -m :mmm -mmm mmmmmmmc_re3oduoi_numerics_i=ia0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aRECI!c! Copyright (c)ha210 CSE Lab (ETH Zuk-,,), MOSAIC Group (ETH Zuk-,,), aRECI!c! Ce ter h l0Flu-- Dynamics (DTU) RECI!c!aRECI!c!aRECI!c! T!is file is _INteh mii=pPINellelpPINticle M,-1mLibrary (PPM).aRECI!c!aRECI!c! PPM is freeoooftwore: you cNDmreddstrib,MG itoaDi/ l03odifyaRECI!c! itoundel0!! 2termseh mii=pGNU Lessel0GeneNel PunlicmLicense aRECI!c! as _unlishe- bymii=pFreeoSoftwore Foundc_Oii, eiii=r aRECI!c! ubleh le3eh mii=pLicense, l0(at yourpopiion)Gany lat=r aRECI!c! ubleh l.aRECI!c!aRECI!c! PPM is ddstrib,MGd i=mii=phopes!!at pt wipl b 2useful,aRECI!c! b,M WITHHiN ANY WARRANTY; without eve=mii=pi lie- wmiENntyeh aRECI!c! MERCHANTABILITY l0FITNESS FOR A PARTICULAR PURPOSSEiSees!! aRECI!c! GNU GeneNel PunlicmLicense f l03ore details.aRECI!c!aRECI!c! You sho,ld hav 2receive- a copyeh mii=pGNU GeneNel PunlicmLicenseaRECI!c! andmii=pGNU Lessel0GeneNel PunlicmLicense opong with PPM. If not,aRECI!c! sees.aRECI!c!aRECI!c! PINellelpPINticle M,-1mLibrary (PPM)aRECI!c! ETH Zuk-,,aRECI!c! CH-8092 Zuk-,,, SwitzerlaDdC,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (d (aC,-1p =MODULEmI=pe3oduoi_numerics_i=ia0,-1p =!!! Declores global d=iahtypei andmmmii=poi=aRECI!c 0,- -m !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (mmm -m ! Includis0,-1p = !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (mmm -m INCLUDE =poiinumerics.h'0,- -m !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (mmm -m ! Global TYPEs0,-1p = !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (mmm -m mmm -m ! nothing i=re f l0now -m mmm -m,mmoMODULEmI=pe3oduoi_numerics_i=ia0libc_rnumerics-r1036/src/c_re3g_restricR.f0000644000175000017500000011051211616214650017474 0uoi(i omaromar,- -m !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (mmm -m ! Subroutd 8I!c: c_re3g_restricR 0,- -m !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (mmm -m ! Purpose -m : In0!!is routd 8IwG restricR ii=perror from _d 8rmmm -m ! io coarsel0levelsmmm -m ! mmm -m ! mmm -m ! In ,Md -m :mmm -m ! mmm -m ! In ,M/out ,Md:mmm -m ! mmm -m ! Out ,Md -m : ENDiiiiiii(I)prmmmmm oi(tus. 0 up lesuccessmmm -m !mmm -m ! Remarks -m :mmm -m !mmm -m ! Referencesm :mmm -m !mmm -m ! Revieh l=Em :0,-1p = !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (mmm -m ! $Log:mI=pe3g_restricR.f,v $aRECI!c ! Revieh l 1.1.1.1 2007/07/13 10:18:56 evos RECI!c ! CBLoubleh leh mii=pPPM libraryaRECI!c !mmm -m ! Revieh l 1.12 2006/09/26 16:01:23 evos RECI!c ! Fixe- wrongly Ede ted CPPpiire(chves. Rem8mbmr:mii=y hav 2 is.(ik inn: ::!c ! Col 1, ii=rwisG itodoes notic ile l certailesystems. In0fact,0!!isn: ::!c ! codi d-- NOTic ile as pt was!!aRECI!c !mmm -m ! Revieh l 1.11 2006/07/21 11:30:55 kotsalie RECI!c ! FRIDAYaRECI!c !mmm -m ! Revieh l 1.9 2006/02/08 19:55:29 kotsalie RECI!c ! fixe- multiple domainsmmm -m !mmm -m ! Revieh l 1.8 2006/02/02 18:00:19 michaeben: ::!c ! corre(ce- bug i=mii=plogmmm -m !mmm -m ! Revieh l 1.7 2006/02/02 16:32:28 kotsalie RECI!c ! corre(ce- f l03ixe- BC''smmm -m !mmm -m ! Revieh l 1.6 2005/12/08 12:44:45 kotsalie RECI!c ! c miting iirichletmmm -m !mmm -m ! Revieh l 1.4 2005/03/14 13:18:22 kotsalie RECI!c ! COMMITED THE VECTOR CASE. IT IS FOR LDA=3aRECI!c !mmm -m ! Revieh l 1.3 2004/11/05 15:20:01 kotsalie RECI!c ! C mitedmii=pchangi=cf l0speedupaRECI!c !mmm -m ! Revieh l 1.2 2004/09/23 12:16:50 kotsalie RECI!c ! Adde- USjaoi(tehimiaRECI!c !mmm -m ! Revieh l 1.1 2004/09/22 18:38:03 kotsalie RECI!c ! MG newoubleh laRECI!c !mmm -m !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (mmm -m ! PINellelpPINticle M,-1mLibrary (PPM)aRECI!c ! Instit,MG h mC ,Mc_Oiial ScienceaRECI!c ! ETH Zimirum, Hirschengrabe=m84 RECI!c ! CH-8092 Zuk-,,, SwitzerlaDdC,-1p = !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (m#mii=pNIMhoth_INFIELD #p_h_IMESHpNIMhoth_I2Da#mii=pg_smooth_INGLe2DIvec_I E_PC,-1p =mmESHiN!cjac_re3g_restricR_2d_sca_sei!X-_id,mlevindturnrrrmii=pg_smooth_INGLe2DIvec_I E_P ,-1p =mmESHiN!cjac_re3g_restricR_2d_sca_dei!X-_id,mlevindturnrr=po,0#rlp_h_IMESHpNIMhoth_I3Da#mii=pg_smooth_INGLe2DIvec_I E_PC,-1p =mmESHiN!cjac_re3g_restricR_3d_sca_sei!X-_id,mlevindturnrrrmii=pg_smooth_INGLe2DIvec_I E_P ,-1p =mmESHiN!cjac_re3g_restricR_3d_sca_dei!X-_id,mlevindturnrr=po,0#r=po,0#rlp_h_INIMhoth_IVFIELD #p_h_IMESHpNIMhoth_I2Da#mii=pg_smooth_INGLe2DIvec_I E_PC,-1p =mmESHiN!cjac_re3g_restricR_2d_vec_sei!X-_id,mlevindturnrrrmii=pg_smooth_INGLe2DIvec_I E_P ,-1p =mmESHiN!cjac_re3g_restricR_2d_vec_dei!X-_id,mlevindturnrr=po,0#rlp_h_IMESHpNIMhoth_I3Da#mii=pg_smooth_INGLe2DIvec_I E_PC,-1p =mmESHiN!cjac_re3g_restricR_3d_vec_sei!X-_id,mlevindturnrrrmii=pg_smooth_INGLe2DIvec_I E_P ,-1p =mmESHiN!cjac_re3g_restricR_3d_vec_dei!X-_id,mlevindturnrr=po,0#r=po,0#r=po,0-1p = !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified ((mmm -m ! Includis0,-1p = !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified ((m#mncludi "c_rede_d 8.h"0,-1p = !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified ((mmm -m ! Moduoi= 0,-1p = !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified ((mmm -m USjac_re3oduoi_i=iaaRECI!c!cUSjac_re3oduoi_i=iaemgaRECI!c!cUSjac_re3oduoi_allERn: ::!c!cUSjac_re3oduoi_sunfold mmm -m-mUSjac_re3oduoi_sunfoop mm -m-mUSjac_re3oduoi_error mm -m-mUSjac_re3oduoi_write mm -m-mUSjac_re3oduoi_map mm -m-mUSjac_re3oduoi_mapefmmmm mm -m-mUSjac_re3oduoi_mapefmmmm_ghos mmm -m-mIMPLICIT NONEa#mii ii=pg_smooth_INGLe2DIvec_I E_Pa,__LIN ::cmINTEGER, PARAMETERd:: MK =CI=p -ind_singlerrrrsea,__LIN ::cmINTEGER, PARAMETERd:: MK =CI=p -ind_double,-f=po,0,-1p = !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified ((mmm -m ! Aiiphimi=ECI!c0,-1p = !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified ((mmm -m INTEGER, INTENT(IN) :: mlevi i!X-_idmmm -m INTEGER, INTENT(INHiN)p :: e oaRECI!c !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified ((mmm -m ! LERclmmmii=poi=c0,-1p = !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified ((mmm -m CHARACTER(LEN=256) :: cbufmmm -m INTEGER :: isun,j,j2,i,i2mmm -m INTEGER :: mlevm1,ilda,iface0,- -m INTEGER,DIMEN E_Pe5) :: ldl5,ldu50,- -m INTEGER,DIMEN E_Pe4) :: ldl4,ldu40,- -m INTEGER,DIMEN E_Pe3) :: ldl3,ldu3mmm -m INTEGER :: iopioi!X-idmmm -m INTEGER :: a,b,c,d,e,f,g #p_h_IMESHpNIMhoth_I3Damm -m INTEGER :: k,k20#r=po, amm -m REAL(MK) :: t0 m#mii=pNIMhoth_INFIELD #p_h_IMESHpNIMhoth_I2Da#mii=pg_smooth_INGLe2DIvec_I E_PC,-1p ======TYPE(3g_fmmmm_2d_sca_s),DIMEN E_Pesmi) POINTER1:: mgfmmmm rrrmii=pg_smooth_INGLe2DIvec_I E_P ,-1p = ::c=TYPE(3g_fmmmm_2d_sca_d),DIMEN E_Pesmi) POINTER1:: mgfmmmm rr=po,0#rlp_h_IMESHpNIMhoth_I3Da#mii=pg_smooth_INGLe2DIvec_I E_PC,-1p = ::c=TYPE(3g_fmmmm_3d_sca_s),DIMEN E_Pesmi) POINTER1:: mgfmmmm rrrmii=pg_smooth_INGLe2DIvec_I E_P ,-1p = ::c=TYPE(3g_fmmmm_3d_sca_d),DIMEN E_Pesmi) POINTER1:: mgfmmmm rr=po,0#r=po,0#rlp_h_INIMhoth_IVFIELD #p_h_IMESHpNIMhoth_I2Da#mii=pg_smooth_INGLe2DIvec_I E_PC,-1p = ::c=TYPE(3g_fmmmm_2d_vec_s),DIMEN E_Pesmi) POINTER1:: mgfmmmm rrrmii=pg_smooth_INGLe2DIvec_I E_P ,-1p = ::c=TYPE(3g_fmmmm_2d_vec_d),DIMEN E_Pesmi) POINTER1:: mgfmmmm rr=po,0#rlp_h_IMESHpNIMhoth_I3Da#mii=pg_smooth_INGLe2DIvec_I E_PC,-1p = ::c=TYPE(3g_fmmmm_3d_vec_s),DIMEN E_Pesmi) POINTER1:: mgfmmmm rrrmii=pg_smooth_INGLe2DIvec_I E_P ,-1p = ::c=TYPE(3g_fmmmm_3d_vec_d),DIMEN E_Pesmi) POINTER1:: mgfmmmm rr=po,0#r=po,0#r=po,0#mii=pNIMhoth_INFIELD #p_h_IMESHpNIMhoth_I2Da,-1p = ::c=REAL(MK),DIMEN E_Pesmimi) POINTER1:: uc_dummy0#rlp_h_IMESHpNIMhoth_I3Da,-1p = ::c=REAL(MK),DIMEN E_Pesmimimi) POINTER1:: uc_dummy0#r=po,0#rlp_h_INIMhoth_IVFIELD #p_h_IMESHpNIMhoth_I2Da,-1p = ::c=REAL(MK),DIMEN E_Pesmimimi) POINTER1:: uc_dummy0#rlp_h_IMESHpNIMhoth_I3Da,-1p = ::c=REAL(MK),DIMEN E_Pesmimimimi) POINTER1:: uc_dummy0#r=po,0#r=po,0#mii=pNIMhoth_INFIELD #p_h_IMESHpNIMhoth_I2Da,-1p = ::c=REAL(MK),DIMEN E_Pesmi) POINTER1:: terra,-1p = ::c=REAL(MK),DIMEN E_Pesmi) POINTER1:: pfc0#rlp_h_IMESHpNIMhoth_I3Da,-1p = ::cREAL(MK),DIMEN E_Pesmimi) POINTER1:: terra,-1p = ::c=REAL(MK),DIMEN E_Pesmimi) POINTER1:: pfc0#r=po,0#rlp_h_INIMhoth_IVFIELD #p_h_IMESHpNIMhoth_I2Da,-1p = ::REAL(MK),DIMEN E_Pesmimi) POINTER1:: terra,-1p = ::c=REAL(MK),DIMEN E_Pesmimi) POINTER1:: pfc0#rlp_h_IMESHpNIMhoth_I3Da,-1p = ::REAL(MK),DIMEN E_Pesmimimi) POINTER1:: terra,-1p = ::c=REAL(MK),DIMEN E_Pesmimimi) POINTER1:: pfc0#r=po,0#r=po,0,-1p = !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (0,-1p = !External=0,-1p = !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (00,-1p = !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (0,-1p = !InER, Poze0,-1p = !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (0,-1p = !che loops).(ik='c_re3g_restricRmirkindturnunfold !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (0,-1p = ! Clon- aiiphimi=0,-1p = !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (0,-1p = !cIsteI=p_e loop.GTEiii=pENDa,__LIN :: !cIstemlevDLSE1i=pENDa,__LIN :: !ccccccc ENDi=CI=p error_error ,__LIN :: ::!c = !che lodu1oerror(du1oerr_aiiphimi,'c_re3g_restricRmi &mmm - -&m -------------'level muoi be0>1',__L!cj__indturn,__LIN :: ::!ccccccccoiiii CI=p == mmmmmmmmmjag(mlev),u :: mmjag(mlev),u :!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (0,-1p = !De_d ith leh mnecessary mmii=poi=candmallERcMh leh mmiEND=0,-1p = !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (0#mii=pNIMhoth_INFIELD #p_h_IMESHpNIMhoth_I2Da#mii=pg_smooth_INGLe2DIvec_I E_PC,-1p ===mgfmmmm=>mgfmmmm_2d_sca_s rrrmii=pg_smooth_INGLe2DIvec_I E_P ,-1p = :mgfmmmm=>mgfmmmm_2d_sca_m rr=po,0#rlp_h_IMESHpNIMhoth_I3Da#mii=pg_smooth_INGLe2DIvec_I E_PC,-1p = :mgfmmmm=>mgfmmmm_3d_sca_s rrrmii=pg_smooth_INGLe2DIvec_I E_P ,-1p = :mgfmmmm=>mgfmmmm_3d_sca_m rr=po,0#r=po,0#rlp_h_INIMhoth_IVFIELD #p_h_IMESHpNIMhoth_I2Da#mii=pg_smooth_INGLe2DIvec_I E_PC,-1p = :mgfmmmm=>mgfmmmm_2d_vec_s rrrmii=pg_smooth_INGLe2DIvec_I E_P ,-1p = :mgfmmmm=>mgfmmmm_2d_vec_d rr=po,0#rlp_h_IMESHpNIMhoth_I3Da#mii=pg_smooth_INGLe2DIvec_I E_PC,-1p = :mgfmmmm=>mgfmmmm_3d_vec_s rrrmii=pg_smooth_INGLe2DIvec_I E_P ,-1p = :mgfmmmm=>mgfmmmm_3d_vec_d rr=po,0#r=po,0#r=po,0,-1p = !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (0,-1p = !I lehimic_OiiaRECI!c !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (0,-1p = !cmlevm1=mlev-cRmmm ------Istel_printi=pENDa,__LIN :: WRITE(cbuf,*) 'WELCOME iiiTHE RESTRICTE_P LEVEL:',mleva,__LIN :: he loPPM_WRITE(c_rerank,'3g_restricRmicbuf,ndturn,__LIN :: :mjag( m#mii=pNIMhoth_INFIELD #p_h_IMESHpNIMhoth_I2Da,-1p = !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (0,-1p = !RestricRh leusing a 9-poe t operator(bilinearhi terpolc_Oiirnunfold !linearhis notiaccurcMG enoughaRECI!c !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (0,-1p = !ci!X-id=i!X-_idmmm -m !ciopii=CI=p _INeldallER_fitmmm -m !cldl3(1) ==1-ghos size(1)mlev),u !cldl3(2) ==1-ghos size(2)mlev),u !cldl3(3) =01CI=p == !cldu3(1) ==max_node(1,mlevm1)+ghos size(1)mlev),u !cldu3(2) ==max_node(2,mlevm1)+ghos size(2)mlev),u !cldu3(3) =0nops)0,-1p = !che lodu1oallER(uc_dummy,ldl3,ldu3,iopio_id, ,mm -mmmmmmIste ENDi LSEiii=pENDa,__LIN ::c !ciENDi=CI=p error_f=iala,__LIN ::c !che lodu1oerror(du1oerr_allER,'restricRmi &mmm - -&m --------------------'uc_dummy',__L!cj__indturn,__LIN :: ::!coiiii CI=p == mmmmmjag(mlev),u :: DO isun=1,nops)0,-1p = !c terr=>mgfmmmm(isun,mlevm1)%err 0,-1p = !c DO i=1-ghos size(1),max_node(1,mlevm1)+ghos size(1)mlev),u !c !c,i,j=1-ghos size(2),max_node(2,mlevm1)+ghos size(2)mlev),u !ccccccuc_dummy(i1j,isun)=&mmm - -&m -------------------- !c terr(i1j)mlev),u !ccccmjaiiii ad_f !ccccmjaii mmm -m cmjaii a,__LIN ::c !che lodu1omapefmmmm_ghos _get(i!X-idi0,-h_id_g(mlevm1),&mmm - -&m -------------------- ghos sizeindturn,__LIN :: ::!che lodu1omapefmmmm_push(i!X-idi0,-h_id_g(mlevm1),uc_dummy,&mmm - -&m -------------------- ndturn,__LIN :: ::!che lodu1omapefmmmm_sr=p(ndturn,__LIN :: ::!che lodu1omapefmmmm_pop(i!X-idi0,-h_id_g(mlevm1),uc_dummy,&mmm - -&m -------------------- ghos sizeindturn,__LIN :: DO isun=1,nops)0,-1p = !c terr=>mgfmmmm(isun,mlevm1)%err 0,-1p = !c pfc=>mgfmmmm(isun,mlev)%fc 0,-1p = !c DO i=1-ghos size(1),max_node(1,mlevm1)+ghos size(1)mlev),u !c !c,i,j=1-ghos size(2),max_node(2,mlevm1)+ghos size(2)mlev),u !cccccterr(i1j)=&mmm - -&m -------------------- !c uc_dummy(i1j,isun)mlev),u !cccmjaiiii ad_f !cccmjaii mmm -m cc,i,j=).(ik=2,isun,mlev),is.mii2,isun,mlev)mlev),u !cccccj2=2*j a,__LIN ::c !c DO i=).(ik=1,isun,mlev),is.mii1,isun,mlev)mlev),u !cccccccccci2=2*in,__LIN :: ::!ccccccccc pfc(i1j)= &mmm - -&m ----------------0.25_MK *cterr(i2-1,j2-1) + &mmm - -&m ----------------0.125_MK *c(terr(i2,j2-1) + &mmm - -&m ---------------------------terr(i2-2,j2-1)+ &mmm - -&m ---------------------------terr(i2-1,j2) + &mmm - -&m ---------------------------terr(i2-1,j2-2))+&mmm - -&m ----------------0.0625_MK *c(terr(i2,j2-2)+&mmm - -&m ----------------------------terr(i2-2,j2) + &mmm - -&m ----------------------------terr(i2-2,j2-2)&mmm - -&m ----------------------------+ terr(i2,j2)) n,__LIN :: ::!ccccmjaiiii ad_f !ccccccmjaiiii ad_f !cccmjaiimmm -m !ciopii=CI=p _INelddeallERn: ::!ccccccldl3(1) ==1-ghos size(1)mlev),u !cldl3(2) ==1-ghos size(2)mlev),u !cldl3(3) =01CI=p == !cldu3(1) ==max_node(1,mlevm1)+ghos size(1)mlev),u !cldu3(2) ==max_node(2,mlevm1)+ghos size(2)mlev),u !cldu3(3) =0nops)0,-1p = !che lodu1oallER(uc_dummy,ldl3,ldu3,iopio_id, ,mm -mmmmmmIste ENDi LSEiii=pENDa,__LIN ::c !ciENDi=CI=p error_f=iala,__LIN ::c !che lodu1oerror(du1oerr_allER,'restricRmi &mmm - -&m --------------------'uc_dummy',__L!cj__indturn,__LIN :: ::!coiiii CI=p == mmmmmjag(m#rlp_h_IMESHpNIMhoth_I3Da,-1p = ::c=i!X-id=i!X-_idmmm -m !ciopii=CI=p _INeldallER_fitmmm -m !cldl4(1) ==1-ghos size(1)mlev),u !cldl4(2) ==1-ghos size(2)mlev),u !cldl4(3) =01-ghos size(3)mlev),u !cldl4(4) =01CI=p == !cldu4(1) ==max_node(1,mlevm1)+ghos size(1)mlev),u !cldu4(2) ==max_node(2,mlevm1)+ghos size(2)mlev),u !cldu4(3) =0max_node(3,mlevm1)+ghos size(3)mlev),u !cldu4(4) =0nops)0,-1p = !che lodu1oallER(uc_dummy,ldl4,ldu4,iopio_id, ,mm -mmmmmmIste ENDi LSEiii=pENDa,__LIN ::c !ciENDi=CI=p error_f=iala,__LIN ::c !che lodu1oerror(du1oerr_allER,'restricRmi &mmm - -&m --------------------'uc_dummy',__L!cj__indturn,__LIN :: ::!coiiii CI=p == mmmmmjag(m=p == mmmmDO isun=1,nops)0,-1p = !cterr=>mgfmmmm(isun,mlevm1)%err 0,-1p = !cDO i=1-ghos size(1),max_node(1,mlevm1)+ghos size(1)mlev),u !c ,i,j=1-ghos size(2),max_node(2,mlevm1)+ghos size(2)mlev),u !cccc,i,k=1-ghos size(3),max_node(3,mlevm1)+ghos size(3)mlev),u !cccccccuc_dummy(i1j,k,isun)=&mmm - -&m -------------------- !c terr(i1j,k)mlev),u !ccccmjaiiii ad_f !ccccmjaii mmm -m ccmjaiiii ad_f !ccmjaii a,__LIN ::c !che lodu1omapefmmmm_ghos _get(i!X-idi0,-h_id_g(mlevm1),&mmm - -&m -------------------- ghos sizeindturn,__LIN :: ::!che lodu1omapefmmmm_push(i!X-idi0,-h_id_g(mlevm1),uc_dummy,&mmm - -&m -------------------- ndturn,__LIN :: ::!che lodu1omapefmmmm_sr=p(ndturn,__LIN :: ::!che lodu1omapefmmmm_pop(i!X-idi0,-h_id_g(mlevm1),uc_dummy,&mmm - -&m -------------------- ghos sizeindturn mlev),u !c ,i,isun=1,nops)0,-1p = !c c terr=>mgfmmmm(isun,mlevm1)%err 0,-1p = !c c pfc=>mgfmmmm(isun,mlev)%fc 0,-1p = !cDO i=1-ghos size(1),max_node(1,mlevm1)+ghos size(1)mlev),u !c ,i,j=1-ghos size(2),max_node(2,mlevm1)+ghos size(2)mlev),u !cccccc,i,k=1-ghos size(3),max_node(3,mlevm1)+ghos size(3)mlev),u !cccccccterr(i1j,k)=&mmm - -&m -------------------- !c uc_dummy(i1j,k,isun)mlev),u !ccc ccmjaiiii ad_f !ccccmjaii !ccc ccmjaiiii ad_f !cccccc,i,k=).(ik=3,isun,mlev),is.mii3,isun,mlev)mlev),u !ccccccck2=2*kmlev),u !ccccccc,i,j=).(ik=2,isun,mlev),is.mii2,isun,mlev)mlev),u !ccccccccccccj2=2*j a,__LIN ::c !c ccccc,i,i=).(ik=1,isun,mlev),is.mii1,isun,mlev)mlev),u !cccccccccc cci2=2*in,__LIN :: ::!ccccccccc c pfc(i1j,k)= &mmm - -&m ---------------------0.125_MK *c&mmm - -&m --------------------------------terr(i2-1,j2-1,k2-1) + &mmm - -&m ---------------------0.0625_MK *c(&mmm - -&m -------------------------------- terr(i2,j2-1,k2-1) +&mmm - -&m -------------------------------- terr(i2-2,j2-1,k2-1)+ &mmm - -&m -------------------------------- terr(i2-1,j2,k2-1) + &mmm - -&m -------------------------------- terr(i2-1,j2-2,k2-1))+&mmm - -&m --------------------0.03125_MK *c(&mmm - -&m -------------------------------- terr(i2,j2-2,k2-1)+ &mmm - -&m -------------------------------- terr(i2-2,j2,k2-1) + &mmm - -&m -------------------------------- terr(i2-2,j2-2,k2-1) +&mmm - -&m -------------------------------- terr(i2,j2,k2-1)) n,__LIN :: ::!cccccccccccccpfc(i1j,k)= &mmm - -&m ---------------------cccccccccccpfc(i1j,k)+&mmm - -&m ----------------------0.0625_MK *c&mmm - -&m -------------------------------- terr(i2-1,j2-1,k2) + &mmm - -&m ----------------------0.03125_MK *c(&mmm - --------------------------------------terr(i2,j2-1,k2) +&mmm - -&m -------------------------------- terr(i2-2,j2-1,k2)+ &mmm - -&m -------------------------------- terr(i2-1,j2,k2) +&mmm - -&m -------------------------------- terr(i2-1,j2-2,k2))+&mmm - -&m --------------------0.015625_MK *c(&mmm - -&m -------------------------------- terr(i2,j2-2,k2)+ &mmm - -&m -------------------------------- terr(i2-2,j2,k2) + &mmm - -&m -------------------------------- terr(i2-2,j2-2,k2) + &mmm - -&m -------------------------------- terr(i2,j2,k2)) n,__LIN :: ::!cccccccccccccpfc(i1j,k)= &mmm - -&m ---------------------ccccccccccpfc(i1j,k) +&mmm - -&m -------------------0.0625_MK *c&mmm - -&m ------------------------------terr(i2-1,j2-1,k2-2) + &mmm - -&m -------------------0.03125_MK *(&mmm - -&m ------------------------------terr(i2,j2-1,k2-2) +&mmm - -&m ------------------------------terr(i2-2,j2-1,k2-2)+ &mmm - -&m ------------------------------terr(i2-1,j2,k2-2)+&mmm - -&m ---------------------------- terr(i2-1,j2-2,k2-2))+&mmm - -&m ------------------0.015625_MK*(&mmm - -&m ------------------------------terr(i2,j2-2,k2-2)+&mmm - -&m ---------------------------- terr(i2-2,j2,k2-2) + &mmm - -&m ------------------------------terr(i2-2,j2-2,k2-2)+&mmm - -&m ---------------------------- terr(i2,j2,k2-2)) a,__LIN ::c !c cccccmjaiiii ad_f !cccccccccmjaiiii ad_f !ccccccmjaiiii ad_f !cccmjaiimmm -m !ciopii=CI=p _INelddeallERn: ::!ccccccldl4(1) ==1-ghos size(1)mlev),u !cldl4(2) ==1-ghos size(2)mlev),u !cldl4(3) =01-ghos size(3)mlev),u !cldl4(4) =01CI=p == !cldu4(1) ==max_node(1,mlevm1)+ghos size(1)mlev),u !cldu4(2) ==max_node(2,mlevm1)+ghos size(2)mlev),u !cldu4(3) =0max_node(3,mlevm1)+ghos size(3)mlev),u !cldu4(4) =0nops)0,-1p = !che lodu1oallER(uc_dummy,ldl4,ldu4,iopio_id, ,mm -mmmmmmIste ENDi LSEiii=pENDa,__LIN ::c !ciENDi=CI=p error_f=iala,__LIN ::c !che lodu1oerror(du1oerr_allER,'restricRmi &mmm - -&m --------------------'uc_dummy',__L!cj__indturn,__LIN :: ::!coiiii CI=p == mmmmmjag(m#r=po,0#rlp_h_INIMhoth_IVFIELD #p_h_IMESHpNIMhoth_I2Da,-1p = :!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (0,-1p = !RestricRh leusing a 9-poe t operator(bilinearhi terpolc_Oiirnunfold !linearhis notiaccurcMG enoughaRECI!c !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified(0,-1p = !ci!X-id=i!X-_idmmm -m !ciopii=CI=p _INeldallER_fitmmm -m !cldl4(1) ==1mlev),u !cldl4(2) ==1-ghos size(1)mlev),u !cldl4(3) =01-ghos size(2)mlev),u !cldl4(4) =01CI=p == !cldu4(1) ==vecdimmlev),u !cldu4(2) ==max_node(1,mlevm1)+ghos size(1)mlev),u !cldu4(3) ==max_node(2,mlevm1)+ghos size(2)mlev),u !cldu4(4) =0nops)0,-1p = !che lodu1oallER(uc_dummy,ldl4,ldu4,iopio_id, ,mm -mmmmmmIste ENDi LSEiii=pENDa,__LIN ::c !ciENDi=CI=p error_f=iala,__LIN ::c !che lodu1oerror(du1oerr_allER,'restricRmi &mmm - -&m --------------------'uc_dummy',__L!cj__indturn,_____________oiiii CI=p == mmmmmjag(m=p == mmmmDO isun=1,nops)0,-1p = !cterr=>mgfmmmm(isun,mlevm1)%errmlev),u !c ,i,i=1-ghos size(1),max_node(1,mlevm1)+ghos size(1)mlev),u !c !,i,j=1-ghos size(2),max_node(2,mlevm1)+ghos size(2)mlev),u !cccc,i,ilda=1,vecdimmlev),u !ccccccuc_dummy(ilda,i1j,isun)=&mmm - -&m -------------------- !c terr(ilda,i1j)mlev),u !ccccmjaiiii ad_f !cccccmjaii mmm -m cccmjaiiii ad_f !ccmjaii aa,__LIN ::c !che lodu1omapefmmmm_ghos _get(i!X-idi0,-h_id_g(mlevm1),&mmm - -&m -------------------- ghos sizeindturn,__LIN :: ::!che lodu1omapefmmmm_push(i!X-idi0,-h_id_g(mlevm1),uc_dummy,&mmm - -&m -------------------- vecdimindturn,__LIN :: ::!che lodu1omapefmmmm_sr=p(ndturn,__LIN :: ::!che lodu1omapefmmmm_pop(i!X-idi0,-h_id_g(mlevm1),uc_dummy,&mmm - -&m -------------------- vecdimighos sizeindturn,__LIN :: DO isun=1,nops)0,-1p = !c terr=>mgfmmmm(isun,mlevm1)%err0,-1p = !c pfc=>mgfmmmm(isun,mlev)%fcmlev),u !c ,i,i=1-ghos size(1),max_node(1,mlevm1)+ghos size(1)mlev),u !c ! ,i,j=1-ghos size(2),max_node(2,mlevm1)+ghos size(2)mlev),u !cccccc,i,ilda=1,vecdimmlev),u !ccccccc terr(ilda,i1j)=&mmm - -&m ------------------uc_dummy(ilda,i1j,isun)mlev),u !ccc ccmjaiiii ad_f !ccccccmjaii mmm -m cccmjaiiii ad_f !cccc,i,j=).(ik=2,isun,mlev),is.mii2,isun,mlev)mlev),u !cccccj2=2*j a,__LIN ::c !c DO i=).(ik=1,isun,mlev),is.mii1,isun,mlev)mlev),u !ccccccci2=2*in,__LIN :: ::!cccc,i,ilda=1,vecdimmlev),u !ccccccc cpfc(ilda,i1j)= &mmm - -&m ----------------0.25_MK *cterr(ilda,i2-1,j2-1) + &mmm - -&m ----------------0.125_MK *c(terr(ilda,i2,j2-1) + &mmm - -&m ---------------------------terr(ilda,i2-2,j2-1)+ &mmm - -&m ---------------------------terr(ilda,i2-1,j2) + &mmm - -&m ---------------------------terr(ilda,i2-1,j2-2))+&mmm - -&m ----------------0.0625_MK *c(terr(ilda,i2,j2-2)+&mmm - -&m ----------------------------terr(ilda,i2-2,j2) + &mmm - -&m ----------------------------terr(ilda,i2-2,j2-2)&mmm - -&m ----------------------------+ terr(ilda,i2,j2)) a,__LIN ::c !c cmjaiiii ad_f !ccccccmjaiiii ad_f !ccccmjaiiii ad_f !ccmjaiiii ad_f !cciopii=CI=p _INelddeallERn: ::!cccccldl4(1) ==1mlev),u !ldl4(2) ==1-ghos size(1)mlev),u !ldl4(3) =01-ghos size(2)mlev),u !ldl4(4) =01CI=p == !ldu4(1) ==vecdimmlev),u !ldu4(2) ==max_node(1,mlevm1)+ghos size(1)mlev),u !ldu4(3) ==max_node(2,mlevm1)+ghos size(2)mlev),u !ldu4(4) =0nops)0,-1p = !he lodu1oallER(uc_dummy,ldl4,ldu4,iopio_id, ,mm -mmmmmIste ENDi LSEiii=pENDa,__LIN ::c !iENDi=CI=p error_f=iala,__LIN ::c !he lodu1oerror(du1oerr_allER,'restricRmi &mmm - -&m --------------------'uc_dummy',__L!cj__indturn,____________oiiii CI=p == mmmmmjag(m#rlp_h_IMESHpNIMhoth_I3Da,-1p = ::c=i!X-id=i!X-_idmmm -m !ciopii=CI=p _INeldallER_fitmmm -m !cldl5(1) ==1mlev),u !cldl5(2) ==1-ghos size(1)mlev),u !cldl5(3) =01-ghos size(2)mlev),u !cldl5(4) =01-ghos size(3)mlev),u !cldl5e5) =01CI=p == !cldu5(1) ==vecdimmlev),u !cldu5(2) ==max_node(1,mlevm1)+ghos size(1)mlev),u !cldu5(3) ==max_node(2,mlevm1)+ghos size(2)mlev),u !cldu5(4) =0max_node(3,mlevm1)+ghos size(3)mlev),u !cldu5e5) =0nops)0,-1p = !che lodu1oallER(uc_dummy,ldl5,ldu5,iopio_id, ,mm -mmmmmmIste ENDi LSEiii=pENDa,__LIN ::c !ciENDi=CI=p error_f=iala,__LIN ::c !che lodu1oerror(du1oerr_allER,'restricRmi &mmm - -&m --------------------'uc_dummy',__L!cj__indturn,_____________oiiii CI=p == mmmmmjag(m=p == mmmmDO isun=1,nops)0,-1p = !c terr=>mgfmmmm(isun,mlevm1)%err0,-1p = !c ,i,k=1-ghos size(3),max_node(3,mlevm1)+ghos size(3)mlev),u !cccc,i,j=1-ghos size(2),max_node(2,mlevm1)+ghos size(2)mlev),u !cccccc,i,i=1-ghos size(1),max_node(1,mlevm1)+ghos size(1)m#ifde_h_IVECTORmlev),u !ccccccc uc_dummy(1,i1j,k,isun)=&mmm - -&m -------------------- !c terr(1,i1j,k)mlev),u !ccccccccuc_dummy(2,i1j,k,isun)=&mmm - -&m -------------------- !c terr(2,i1j,k)mlev),u !ccccccccuc_dummy(3,i1j,k,isun)=&mmm - -&m -------------------- !c terr(3,i1j,k)mrrrsea,__LIN ::cmcc,i,ilda=1,vecdimmlev),u !cccccuc_dummy(ilda,i1j,k,isun)=&mmm - -&m -------------------- !c terr(ilda,i1j,k)0#r=po,0,-1p = mjaiiii ad_f !ccccccmjaiiii ad_f !ccccmjaiiii ad_f !ccmjaii mmm -m mjaii a,__LIN ::c !che lodu1omapefmmmm_ghos _get(i!X-idi0,-h_id_g(mlevm1),&mmm - -&m -------------------- ghos sizeindturn,__LIN :: ::!che lodu1omapefmmmm_push(i!X-idi0,-h_id_g(mlevm1),uc_dummy,&mmm - -&m -------------------- vecdimindturn,__LIN :: ::!che lodu1omapefmmmm_sr=p(ndturn,__LIN :: ::!che lodu1omapefmmmm_pop(i!X-idi0,-h_id_g(mlevm1),uc_dummy,&mmm - -&m -------------------- vecdimighos sizeindturn,__LIN ::DO isun=1,nops)0,-1p = !cterr=>mgfmmmm(isun,mlevm1)%errmlev),u !cpfc=>mgfmmmm(isun,mlev)%fcmmlev),u !c,i,k=1-ghos size(3),max_node(3,mlevm1)+ghos size(3)mlev),u !ccc,i,j=1-ghos size(2),max_node(2,mlevm1)+ghos size(2)mlev),u !ccccc,i,i=1-ghos size(1),max_node(1,mlevm1)+ghos size(1)m#ifde_h_IVECTORmlev),u !cccccccterr(1,i1j,k)=&mmm - - -&m ---------uc_dummy(1,i1j,k,isun) ),u !cccccccterr(2,i1j,k)=&mmm - - -&m ---------uc_dummy(2,i1j,k,isun) ),u !cccccccterr(3,i1j,k)=&mmm - - -&m ---------uc_dummy(3,i1j,k,isun)mrrrsea,__LIN ::cmcc,i,ilda=1,vecdimmlev),u !cccccterr(ilda,i1j,k)=&mmm - - -&m ---------uc_dummy(ilda,i1j,k,isun)0#r=po, ii ad_f !cccccmjaiimmm -m cccmjaiiii ad_f !cccmjaiiii ad_f !ccmjaiiii ad_f !cc,i,k=).(ik=3,isun,mlev),is.mii3,isun,mlev)mlev),u !ccck2=2*kmlev),u !cccccc,i,j=).(ik=2,isun,mlev),is.mii2,isun,mlev)mlev),u !ccccccccccj2=2*j a,__LIN ::c !c ccccc,i,i=).(ik=1,isun,mlev),is.mii1,isun,mlev)mlev),u !cccccccccc cci2=2*in#ifde_h_IVECTORmlev),u !ccccccc pfc(1,i1j,k)= &mmm - -&m ---------------------0.125_MK *c&mmm - -&m --------------------------------terr(1,i2-1,j2-1,k2-1) + &mmm - -&m ---------------------0.0625_MK *c(&mmm - -&m -------------------------------- terr(1,i2,j2-1,k2-1) +&mmm - -&m -------------------------------- terr(1,i2-2,j2-1,k2-1)+ &mmm - -&m -------------------------------- terr(1,i2-1,j2,k2-1) + &mmm - -&m -------------------------------- terr(1,i2-1,j2-2,k2-1))+&mmm - -&m --------------------0.03125_MK *c(&mmm - -&m -------------------------------- terr(1,i2,j2-2,k2-1)+ &mmm - -&m -------------------------------- terr(1,i2-2,j2,k2-1) + &mmm - -&m -------------------------------- terr(1,i2-2,j2-2,k2-1) +&mmm - -&m -------------------------------- terr(1,i2,j2,k2-1)) ------------------------- pfc(1,i1j,k)= &mmm - -&m ------------------------------- pfc(1,i1j,k)+&mmm - -&m ----------------------0.0625_MK *c&mmm - -&m -------------------------------- terr(1,i2-1,j2-1,k2) + &mmm - -&m ----------------------0.03125_MK *c(&mmm - --------------------------------------terr(1,i2,j2-1,k2) +&mmm - -&m -------------------------------- terr(1,i2-2,j2-1,k2)+ &mmm - -&m -------------------------------- terr(1,i2-1,j2,k2) +&mmm - -&m -------------------------------- terr(1,i2-1,j2-2,k2))+&mmm - -&m --------------------0.015625_MK *c(&mmm - -&m -------------------------------- terr(1,i2,j2-2,k2)+ &mmm - -&m -------------------------------- terr(1,i2-2,j2,k2) + &mmm - -&m -------------------------------- terr(1,i2-2,j2-2,k2) + &mmm - -&m -------------------------------- terr(1,i2,j2,k2)) ------------------------ pfc(1,i1j,k)= &mmm - -&m -------------------------------pfc(1,i1j,k) +&mmm - -&m -------------------0.0625_MK *c&mmm - -&m ------------------------------terr(1,i2-1,j2-1,k2-2) + &mmm - -&m -------------------0.03125_MK *(&mmm - -&m ------------------------------terr(1,i2,j2-1,k2-2) +&mmm - -&m ------------------------------terr(1,i2-2,j2-1,k2-2)+ &mmm - -&m ------------------------------terr(1,i2-1,j2,k2-2)+&mmm - -&m ---------------------------- terr(1,i2-1,j2-2,k2-2))+&mmm - -&m ------------------0.015625_MK*(&mmm - -&m ------------------------------terr(1,i2,j2-2,k2-2)+&mmm - -&m ---------------------------- terr(1,i2-2,j2,k2-2) + &mmm - -&m ------------------------------terr(1,i2-2,j2-2,k2-2)+&mmm - -&m ---------------------------- terr(1,i2,j2,k2-2)) a,__LIN ::c !c cccccccccccpfc(2,i1j,k)= &mmm - -&m ---------------------0.125_MK *c&mmm - -&m --------------------------------terr(2,i2-1,j2-1,k2-1) + &mmm - -&m ---------------------0.0625_MK *c(&mmm - -&m -------------------------------- terr(2,i2,j2-1,k2-1) +&mmm - -&m -------------------------------- terr(2,i2-2,j2-1,k2-1)+ &mmm - -&m -------------------------------- terr(2,i2-1,j2,k2-1) + &mmm - -&m -------------------------------- terr(2,i2-1,j2-2,k2-1))+&mmm - -&m --------------------0.03125_MK *c(&mmm - -&m -------------------------------- terr(2,i2,j2-2,k2-1)+ &mmm - -&m -------------------------------- terr(2,i2-2,j2,k2-1) + &mmm - -&m -------------------------------- terr(2,i2-2,j2-2,k2-1) +&mmm - -&m -------------------------------- terr(2,i2,j2,k2-1)) ------------------------- pfc(2,i1j,k)= &mmm - -&m ------------------------------- pfc(2,i1j,k)+&mmm - -&m ----------------------0.0625_MK *c&mmm - -&m -------------------------------- terr(2,i2-1,j2-1,k2) + &mmm - -&m ----------------------0.03125_MK *c(&mmm - --------------------------------------terr(2,i2,j2-1,k2) +&mmm - -&m -------------------------------- terr(2,i2-2,j2-1,k2)+ &mmm - -&m -------------------------------- terr(2,i2-1,j2,k2) +&mmm - -&m -------------------------------- terr(2,i2-1,j2-2,k2))+&mmm - -&m --------------------0.015625_MK *c(&mmm - -&m -------------------------------- terr(2,i2,j2-2,k2)+ &mmm - -&m -------------------------------- terr(2,i2-2,j2,k2) + &mmm - -&m -------------------------------- terr(2,i2-2,j2-2,k2) + &mmm - -&m -------------------------------- terr(2,i2,j2,k2)) ------------------------ pfc(2,i1j,k)= &mmm - -&m -------------------------------pfc(2,i1j,k) +&mmm - -&m -------------------0.0625_MK *c&mmm - -&m ------------------------------terr(2,i2-1,j2-1,k2-2) + &mmm - -&m -------------------0.03125_MK *(&mmm - -&m ------------------------------terr(2,i2,j2-1,k2-2) +&mmm - -&m ------------------------------terr(2,i2-2,j2-1,k2-2)+ &mmm - -&m ------------------------------terr(2,i2-1,j2,k2-2)+&mmm - -&m ---------------------------- terr(2,i2-1,j2-2,k2-2))+&mmm - -&m ------------------0.015625_MK*(&mmm - -&m ------------------------------terr(2,i2,j2-2,k2-2)+&mmm - -&m ---------------------------- terr(2,i2-2,j2,k2-2) + &mmm - -&m ------------------------------terr(2,i2-2,j2-2,k2-2)+&mmm - -&m ---------------------------- terr(2,i2,j2,k2-2)) a,__LIN ::c !c cccccccccccpfc(3,i1j,k)= &mmm - -&m ---------------------0.125_MK *c&mmm - -&m --------------------------------terr(3,i2-1,j2-1,k2-1) + &mmm - -&m ---------------------0.0625_MK *c(&mmm - -&m -------------------------------- terr(3,i2,j2-1,k2-1) +&mmm - -&m -------------------------------- terr(3,i2-2,j2-1,k2-1)+ &mmm - -&m -------------------------------- terr(3,i2-1,j2,k2-1) + &mmm - -&m -------------------------------- terr(3,i2-1,j2-2,k2-1))+&mmm - -&m --------------------0.03125_MK *c(&mmm - -&m -------------------------------- terr(3,i2,j2-2,k2-1)+ &mmm - -&m -------------------------------- terr(3,i2-2,j2,k2-1) + &mmm - -&m -------------------------------- terr(3,i2-2,j2-2,k2-1) +&mmm - -&m -------------------------------- terr(3,i2,j2,k2-1)) ------------------------- pfc(3,i1j,k)= &mmm - -&m ------------------------------- pfc(3,i1j,k)+&mmm - -&m ----------------------0.0625_MK *c&mmm - -&m -------------------------------- terr(3,i2-1,j2-1,k2) + &mmm - -&m ----------------------0.03125_MK *c(&mmm - --------------------------------------terr(3,i2,j2-1,k2) +&mmm - -&m -------------------------------- terr(3,i2-2,j2-1,k2)+ &mmm - -&m -------------------------------- terr(3,i2-1,j2,k2) +&mmm - -&m -------------------------------- terr(3,i2-1,j2-2,k2))+&mmm - -&m --------------------0.015625_MK *c(&mmm - -&m -------------------------------- terr(3,i2,j2-2,k2)+ &mmm - -&m -------------------------------- terr(3,i2-2,j2,k2) + &mmm - -&m -------------------------------- terr(3,i2-2,j2-2,k2) + &mmm - -&m -------------------------------- terr(3,i2,j2,k2)) ------------------------ pfc(3,i1j,k)= &mmm - -&m -------------------------------pfc(3,i1j,k) +&mmm - -&m -------------------0.0625_MK *c&mmm - -&m ------------------------------terr(3,i2-1,j2-1,k2-2) + &mmm - -&m -------------------0.03125_MK *(&mmm - -&m ------------------------------terr(3,i2,j2-1,k2-2) +&mmm - -&m ------------------------------terr(3,i2-2,j2-1,k2-2)+ &mmm - -&m ------------------------------terr(3,i2-1,j2,k2-2)+&mmm - -&m ---------------------------- terr(3,i2-1,j2-2,k2-2))+&mmm - -&m ------------------0.015625_MK*(&mmm - -&m ------------------------------terr(3,i2,j2-2,k2-2)+&mmm - -&m ---------------------------- terr(3,i2-2,j2,k2-2) + &mmm - -&m ------------------------------terr(3,i2-2,j2-2,k2-2)+&mmm - -&m ---------------------------- terr(3,i2,j2,k2-2)) arrrsea,__LIN ::cmcccccccccc,i,ilda=1,vecdimmlev),u !ccccccc ccccccccpfc(ilda,i1j,k)= &mmm - -&m ---------------------0.125_MK *c&mmm - -&m --------------------------------terr(ilda,i2-1,j2-1,k2-1) + &mmm - -&m ---------------------0.0625_MK *c(&mmm - -&m -------------------------------- terr(ilda,i2,j2-1,k2-1) +&mmm - -&m -------------------------------- terr(ilda,i2-2,j2-1,k2-1)+ &mmm - -&m -------------------------------- terr(ilda,i2-1,j2,k2-1) + &mmm - -&m -------------------------------- terr(ilda,i2-1,j2-2,k2-1))+&mmm - -&m --------------------0.03125_MK *c(&mmm - -&m -------------------------------- terr(ilda,i2,j2-2,k2-1)+ &mmm - -&m -------------------------------- terr(ilda,i2-2,j2,k2-1) + &mmm - -&m -------------------------------- terr(ilda,i2-2,j2-2,k2-1) +&mmm - -&m -------------------------------- terr(ilda,i2,j2,k2-1)) ------------------------- pfc(ilda,i1j,k)= &mmm - -&m ------------------------------- pfc(ilda,i1j,k)+&mmm - -&m ----------------------0.0625_MK *c&mmm - -&m -------------------------------- terr(ilda,i2-1,j2-1,k2) + &mmm - -&m ----------------------0.03125_MK *c(&mmm - --------------------------------------terr(ilda,i2,j2-1,k2) +&mmm - -&m -------------------------------- terr(ilda,i2-2,j2-1,k2)+ &mmm - -&m -------------------------------- terr(ilda,i2-1,j2,k2) +&mmm - -&m -------------------------------- terr(ilda,i2-1,j2-2,k2))+&mmm - -&m --------------------0.015625_MK *c(&mmm - -&m -------------------------------- terr(ilda,i2,j2-2,k2)+ &mmm - -&m -------------------------------- terr(ilda,i2-2,j2,k2) + &mmm - -&m -------------------------------- terr(ilda,i2-2,j2-2,k2) + &mmm - -&m -------------------------------- terr(ilda,i2,j2,k2)) ------------------------ pfc(ilda,i1j,k)= &mmm - -&m -------------------------------pfc(ilda,i1j,k) +&mmm - -&m -------------------0.0625_MK *c&mmm - -&m ------------------------------terr(ilda,i2-1,j2-1,k2-2) + &mmm - -&m -------------------0.03125_MK *(&mmm - -&m ------------------------------terr(ilda,i2,j2-1,k2-2) +&mmm - -&m ------------------------------terr(ilda,i2-2,j2-1,k2-2)+ &mmm - -&m ------------------------------terr(ilda,i2-1,j2,k2-2)+&mmm - -&m ---------------------------- terr(ilda,i2-1,j2-2,k2-2))+&mmm - -&m ------------------0.015625_MK*(&mmm - -&m ------------------------------terr(ilda,i2,j2-2,k2-2)+&mmm - -&m ---------------------------- terr(ilda,i2-2,j2,k2-2) + &mmm - -&m ------------------------------terr(ilda,i2-2,j2-2,k2-2)+&mmm - -&m ---------------------------- terr(ilda,i2,j2,k2-2)) a,__LIN ::c !c ccccccmjaiii#r=po,0,-1p = ccccmjaiiip = ccccmjaiiip = cmjaiiii ad_f !cccmjaiimmm -m !ciopii=CI=p _INelddeallERn: ::!ccccccldl5(1) ==1mlev),u !cldl5(2) ==1-ghos size(1)mlev),u !cldl5(3) =01-ghos size(2)mlev),u !cldl5(4) =01-ghos size(3)mlev),u !cldl5e5) =01CI=p == !cldu5(1) ==vecdimmlev),u !cldu5(2) ==max_node(1,mlevm1)+ghos size(1)mlev),u !cldu5(3) ==max_node(2,mlevm1)+ghos size(2)mlev),u !cldu5(4) =0max_node(3,mlevm1)+ghos size(3)mlev),u !cldu5e5) =0nops)0,-1p = !che lodu1oallER(uc_dummy,ldl5,ldu5,iopio_id, ,mm -mmmmmmIste ENDi LSEiii=pENDa,__LIN ::c !ciENDi=CI=p error_f=iala,__LIN ::c !che lodu1oerror(du1oerr_allER,'restricRmi &mmm - -&m --------------------'uc_dummy',__L!cj__indturn,__LIN :: ::!coiiii CI=p == mmmmmjag(m#r=po,0#r=po,0,-1p = !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (0,-1p = ! ReturiaRECI!c !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (0,-1 !chONTINUE0,-1p = !che losunfoop='c_re3g_restricRmirkindturnunfold c=RETURN 0#mii=pNIMhoth_INFIELD #p_h_IMESHpNIMhoth_I2Da#mii=pg_smooth_INGLe2DIvec_I E_PC,-1p =mja SUBROUTINjac_re3g_restricR_2d_sca_s rrrmii=pg_smooth_INGLe2DIvec_I E_P ,-1p =mja SUBROUTINjac_re3g_restricR_2d_sca_d rr=po,0#rlp_h_IMESHpNIMhoth_I3Da#mii=pg_smooth_INGLe2DIvec_I E_PC,-1p =mja SUBROUTINjac_re3g_restricR_3d_sca_s rrrmii=pg_smooth_INGLe2DIvec_I E_P ,-1p =mja SUBROUTINjac_re3g_restricR_3d_sca_m rr=po,0#r=po,0#rlp_h_INIMhoth_IVFIELD #p_h_IMESHpNIMhoth_I2Da#mii=pg_smooth_INGLe2DIvec_I E_PC,-1p =mja SUBROUTINjac_re3g_restricR_2d_vec_s rrrmii=pg_smooth_INGLe2DIvec_I E_P ,-1p =mja SUBROUTINjac_re3g_restricR_2d_vec_d rr=po,0#rlp_h_IMESHpNIMhoth_I3Da#mii=pg_smooth_INGLe2DIvec_I E_PC,-1p =mja SUBROUTINjac_re3g_restricR_3d_vec_s rrrmii=pg_smooth_INGLe2DIvec_I E_P ,-1p =mja SUBROUTINjac_re3g_restricR_3d_vec_d rr=po,0#r=po,0#r=po,0libc_rnumerics-r1036/src/c_refdsolveromape2d.f0000644000175000017500000002667111616214650020234 0u).(i omaromarCI!c !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (- (0,-1p =! Subroutinep =:----------------c_refdsolveromape2d CI!c !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (- (0,-1p =!0,-1p =! Purpose,-1p =:0maps the d=ia from=i!X-logy i!X-_ids(1)) / 0,-h 0,-1p =! (0,-h_ids(1)) to=i!X-logy (i!X-_ids(2))/0,-h (0,-h_ids(2))0,-1p =! ii ad_f!0,-1p =! Input : 0,-1p =! i!X-_ids(2) (I) ii ad_f! first: current=i!X-logy ii ad_f! second: destincMh lei!X-logy ii ad_f! 0,-h_ids(2) (I)ii ad_f! first: current=0,-h of the d=iaii ad_f! second: destincMh le0,-h ii ad_f! ii ad_f!0,-1p =! Input/output : d=ia_fvesmimimi)p =(F)p d=ia to=be0mappedii ad_f! ii ad_f! ii ad_f!0,-1p =! Output : ii ad_f! iENDiiiiiiiiii(I) returi ).(tus. =0 miino error.ii ad_f!0,-1p =! Remarks : ii ad_f! 0,-1p =! References :ii ad_f!0,-1p =! Revish ls : CI!c !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (- (0,-1p =! $Log:-c_refdsolveromape2d.f,v $0,-1p =! Revish l 1.1.1.1 2007/07/13 10:18:54 ivos0,-1p =! CBL=versh leh mthe PPM libraryii ad_f!0,-1p =! Revish l 1.9 2006/09/04 18:34:43--cchatelaii ad_f! Fixi=candmcleanups to0make it compile for ,__LIN! release-1-0ii ad_f!0,-1p =! Revish l 1.8 2005/05/03 13:33:41 hiebers0,-1p =! Bugfix: call-c_reclon-_0,-hid withhi ternalei!X- IDii ad_f!0,-1p =! Revish l 1.7 2004/10/01 16:08:57 ivos0,-1p =! Replaced=REAL(c_rekind_double)1:: t0 withhREAL(MK) t0.ii ad_f!0,-1p =! Revish l 1.6 2004/08/31 15:14:03 hiebers0,-1p =! added=aiiphimi clon- forei!X- andm0,-h idsii ad_f!0,-1p =! Revish l 1.5 2004/08/19 13:14:54 hiebers0,-1p =! e looged=scalar/vectoreversh lii ad_f!0,-1p =! Revish l 1.3 2004/07/26 13:49:16 ivos0,-1p =! Removed=Routines secth ls from=ihe header comhimi.ii ad_f!0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (- (0,-1p =! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ii ad_f! Ce ter foreFluid Dynamics (DTU)ii ad_f!0,-1p =!ii ad_f! This file is parteh mthe Parallel Particle M,-h Library (PPM).ii ad_f!0,-1p =! PPM is free software: you can redistribute it and/oremopo,yii ad_f! it under the termseh mthe GNU Lesser General Public License,ii ad_f! as published=bymthe Free Software FoundcMh l, either,ii ad_f! versh le3eh mthe License, ore(at your op_Oiir any later,ii ad_f! versh l.ii ad_f!0,-1p =! PPM is distributedhi =ihe hope that it will-be0useful,0,-1p =! but WITHOUT ANY WARRANTY; without eve =ihe impliedhwmiENntyeh 0,-1p =! MERCHANTABILITY oreFITNESS FOR A PARTICULAR PURPOSE. See the0,-1p =! GNU General Public License,foremore details.ii ad_f!0,-1p =! You should have received=a copyeh mthe GNU General Public Licenseii ad_f! andmthe GNU Lesser General Public License,along withhPPM. Iiinot,0,-1p =! see .ii ad_f!0,-1p =! Parallel Particle M,-h Library (PPM)0,-1p =! ETH Zurich0,-1p =! CH-8092 Zurich, Switzerland 0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (- (0#o, =pNIMhoth_INFIELD #p_h i=pg_smooth_INGLe2DIvec_I E_PC,-1p =SUBROUTINjac_refdsolveromape2d_sca_s(d=ia_fv, i!X-_ids, 0,-h_ids, ndturnrrrmii=pg_smooth_INGLe2DIvec_I E_P ,-1p =SUBROUTINjac_refdsolveromape2d_sca_d(d=ia_fv, i!X-_ids, 0,-h_ids, ndturnrrrmii=pg_smooth_ICOMPLEX ,-1p =SUBROUTINjac_refdsolveromape2d_sca_c(d=ia_fv, i!X-_ids, 0,-h_ids, ndturnrrrmii=pg_smooth_INGLe2DICOMPLEX ,-1p =SUBROUTINjac_refdsolveromape2d_sca_cc(d=ia_fv, i!X-_ids, 0,-h_ids,ndturnrr=po,0#r=po,0#o, =pNIMhoth_IVFIELD #p_h i=pg_smooth_INGLe2DIvec_I E_PC,-1p =SUBROUTINjac_refdsolveromape2d_vec_s(d=ia_fv,lda,i!X-_ids, 0,-h_ids, ndturnrrrmii=pg_smooth_INGLe2DIvec_I E_P ,-1p =SUBROUTINjac_refdsolveromape2d_vec_d(d=ia_fv,lda,i!X-_ids, 0,-h_ids, ndturnrrrmii=pg_smooth_ICOMPLEX ,-1p =SUBROUTINjac_refdsolveromape2d_vec_c(d=ia_fv,lda,i!X-_ids, 0,-h_ids, ndturnrrrmii=pg_smooth_INGLe2DICOMPLEX ,-1p =SUBROUTINjac_refdsolveromape2d_vec_cc(d=ia_fv,lda,i!X-_ids, 0,-h_ids,ndturnrr=po,0#r=po,0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (- (0,-1p =! Modules0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (- (0,-1p =USjac_re3odule_d=iaii ad_fUSjac_re3odule_mapii ad_fUSjac_re3odule_clon-_idmmm -mUSjac_re3odule_errormmm -mUSjac_re3odule_writemmm -mUSjac_re3odule_sunfoartmmm -mUSjac_re3odule_sunfoopii ad_fUSjac_re3odule_mapefmmmmii ad_fIMPLICIT NONE #p_h i=pg_smooth_INGLe2DIvec_I E_P |i=pg_smooth_ICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_singlenrrrmii=pg_smooth_INGLe2DIvec_I E_P |i=pg_smooth_INGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (- (0,-1p =! Aiiphimis 0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (- (0,-1p =! POINTER to0d=iai#o, =pNIMhoth_INFIELD #p_h i=pg_smooth_INGLe2DIvec_I E_P |i=pg_smooth_INGLe2DIvec_I E_P ,-1p =REAL(MK), NIMEN E_Pesmimi), POINTER :: d=ia_fvnrrrmii=pg_smooth_ICOMPLEX |i=pg_smooth_INGLe2DICOMPLEX ,-1p =COMPLEX(MK), NIMEN E_Pesmimi), POINTER :: d=ia_fvnrr=po,0#r=po,0#o, =pNIMhoth_IVFIELD #p_h i=pg_smooth_INGLe2DIvec_I E_P |i=pg_smooth_INGLe2DIvec_I E_P ,-1p =REAL(MK), NIMEN E_Pesmimimi), POINTER :: d=ia_fvnrrrmii=pg_smooth_ICOMPLEX |i=pg_smooth_INGLe2DICOMPLEX ,-1p =COMPLEX(MK), NIMEN E_Pesmimimi), POINTER :: d=ia_fvnrr=po,0#r=po,0#o, =pNIMhoth_IVFIELD i ad_fINTEGER, INTENT(IN) :: lda0#r=po, 0,-1p =INTEGER, NIMEN E_Pe2), INTENT(IN) :: i!X-_ids0,-1p =INTEGER, NIMEN E_Pe2), INTENT(IN) :: 0,-h_ids0,-1p =INTEGER , INTENT( OUT) :: ndtu0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (- (0,-1p =! Local variables 0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (- (0,-1p =! timer ,-1p =REAL(MK) :: i0ii ad_f! cou ters0,-1p =INTEGER :: k, n, jii ad_f!Size of the d=ia_i =0,-1p =INTEGER :: from_i!X-, i!_i!X-0,-1p =INTEGER :: from_0,-h, i!_0,-h0,-1p =LOGICAL :: validm#o, =pNIMhoth_INFIELD ,-1p =INTEGER, PARAMETER1 :: lda =01C#r=po, 0,-1p =INTEGER , NIMEN E_Pe2 ) :: ghos size0,-1p =INTEGER :: maptype0,-1p =CHARACTER(LEN=c_reclar) :: 0,-g0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (- (0,-1p =! Externals 0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (- (00,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (- (0,-1p =! Initialiseii ad_f!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (- (0,-1p =he losunfo(ik=' ,-1p =!o -&m ---------------f! Re_f!0,-1poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (- (0,-1p =! Modules0,-1p =!oGOTO 999ps)0NDi sii a .GT !che lodu1oallER(ucps)0ified (- (0.GE.che lodu1oallER(uc_dumte ENDi L-1p =U::!che0ified (- (0,:: frER,'restricRmi &mmps)0.NOT !:: frhe lodu1oallER(uc_dummmmmmy,ldl5,ldu5,iopifUSjac_re3odallER(uc_dumte ENDi LSEiii=pENDa,__Lf!0,-1p,ENDi LI!mmmmmI!I!c_Oii=p error_ala,__LIN ::c !c'T ii ad_fID (!Size of )se, in:: fr!u1oerr_allER,'restricRmi &mmmmmmm - -&m ---------- ------------'uc_du----------'uc_dups)0ified (- 20.GE.che lodu1oallER(uc_dumte ENDi L-1p =U::!che0ified (- 20,:: frER,'restricRmi &mmps)0.NOT !:: frhe lodu1oallER(uc_dummmmmmy,ldl5,ldu5,iopifUSjac_re3odallER(uc_dumte ENDi LSEiii=pENDa,__Lf!0,-1p,ENDi LI!mmmmmI!I!c_Oii=p error_ala,__LIN ::c !c'T ii ad_fID (e d=ia_)se, in:: fr!u1oerr_allER,'restricRmi &mmmmmmm - -&m ---------- --------------- -------'uc_du----------'uc_dups)0aps the d=i .GT !che lodu1oallER(ucuc_dumte ENDi L-1p =Ush l 10ified (- (0,aps the d=i,:: frER,'restricRmi &mmmmps)0.NOT !:: frhe lodu1oallER(uc_dummmmmmmmy,ldl5,ldu5,iopifUSjac_re3odallER(uc_dumumte ENDi LSEiii=pENDa,__Lf!0,-1p,ENDi LI!mmmmmI!I!c_Oii=p error_ala,__LIN ::c !c!c' see ID (!Sizeaps ) in:: fr!u1oerr_allER,'restricRmi &mmmmmmmmm - -&m ---------- --------------'uc_du----------'uc_dups)0 .GT !che lodu1oallER(ucuc_dumte ENDi L-1p =Ush l 10ified (- 20,aps the d20,:: frER,'restricRmi &mmmmps)0.NOT !:: frhe lodu1oallER(uc_dummmmmmmmy,ldl5,ldu5,iopifUSjac_re3odallER(uc_dumumte ENDi LSEiii=pENDa,__Lf!0,-1p,ENDi LI!mmmmmI!I!c_Oii=p error_ala,__LIN ::c !c!c' see ID (-, i!_i) in:: fr!u1oerr_allER,'restricRmi &mmmmmmmmm - -&m ---------- --------------'uc_du----------'u----------'upecified (- (0,-1p =he losunfo(ik=' ,-1p =!o -&m --------------Defi=i=sourceu sho-h of the d=-----'upecified (- (0,-1p =he losunfo(ik=' ,-1p =!o -&m ------------!Size of dl5ified (- (0-------e d=ia_---= -------!Size004/0= aps the d=i-------e diaii ad= -------01CI=p == d= 0-------01CI=p == 2 d= 0-------ps)0NDi sii a .GT !che lodu1oallER(uWRITE0 g,'(A,I5,A,I5)' )'MappENDimirnel is ',!Size of thror_aerror_ala,__LIN :'OMPLEX ',!Size =!0,-1p =! umte ENDi LSjac_0NDi rank,ENDi LI!mmmmmI!I!', g,j u1oallER(uWRITE0 g,'(A,I5,A,I5)' )'la,__LIN :from=i! ',e d=ia_Pe2), error_ala,__LIN ::c 'OMPLEX ',e diaii -1p =! umte ENDi LSjac_0NDi rank,ENDi LI!mmmmmI!I!', g,j u1oallE----------'upecified (- (0,-1p =he losunfo(ik=' ,-1p =!o -&m -------------- Map e3oduoi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (- (0,-1p =! Modules0,-1p =!oGOm_0,-h, i!_0,-h0,-1p =LOGICAL mjaiiii ad_f !ccccmjlobal(!Size of ,e d=ia_P:: from_i!e diaiiER,'restricRmvm1),&mmm - -&m -----!Size of ,:: from_i!DATAsmooR,'restricRmvm1),&mmm - -&m m --------------vecdimindturn,__LIN :: ::e of ,e dom_i!DATAsmoo0,-h_id_g(mlevm1Ivec_I E_P ,-1p =mja SU u1oallEmjaiiii ad_f !ccccmjlobal(!Size of ,e d=ia_P:: from_i!e diaiiER,'restricRmvm1),&mmm - -&m -----!Size of ,:: from_i!DATAsmooR,'restricRmvm1),&mmm - -&m m --------------vecdimindturn,__LIN :: ::e of ,e dom_i!DATAsmoo0,-h_id_g(mlevm1Ivth_INGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999mmmmmmii=poi=i=COMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTTO 99mmmii=poi=i=ENDmmmmmI!I!c_OiiiphiLI!mmmmmI!I!c_Oiiiphimirnel is shONTINUE0,-1999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specifiedTINjac_re3g_restricIMhoth_INFIELD #p_h i_smooth_INGLe2DIvec_I E_PC,-1p =mja SUBROUTINjac_re3g_restric,-h_ids, ndturnrrrmiiROUTINjac_refdsolveromape2d_vec_dTINjac_re3g_restric,-h_ids, ndturnrrrmicROUTINjac_refdsolveromape2d_vec_c(d=ia_fTINjac_re3g_restric,-h_ids, ndturnrrrmiccSUBROUTINjac_refdsolveromape2d_sca_cc(d=ia_fv, i!X-_ids, 0,-h_ids,ndturnrr=po,0#TINjac_re3g_restric,-h_ids, ndturnrii=pg_smooth_INGLe2DIvec_I E_PC,-1p =mja SUBROUTINjac_re3g_restric,-h_ids, ndturnrrrmiiROUTINjac_refdsolveromape2d_vec_dTINjac_re3g_restric,-h_ids, ndturnrnrrrmROUTINjac_refdsolveromape2d_vec_c(d=ia_fTINjac_re3g_restric,-h_ids, ndturnrnrrrmi_INGLe2DIvec_I E_P ,-1p =mja SUBROUTINjac_re3g_restricR_3d_vec_d rr=po,0#r=po,0#r=po,0gmmi addta.incSUBROUTINjac_re3g_restricR_3d_vec_d rr=po,0#r=po,0#r=po,0fdsolveromape2d.f10545176130000644000175000017500000002667111616214650020234 0u).(i omaromarGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999mmInclude S FOreadENDi-1p funi=poi=:: uevish l dta.OTO 9999OTO 9999mmINPUTDi Lo, 0,- fc(i -- PmmmmIfroh_ids09/04 18:34:43333333333o, 0,- orM is-- Desired orM isof FD s-1pm-1p =! YouNT(IPUTDi ENDi LI!(-orM i:orM i,1:NDi siml 1.7psis-- funi=poi4 18:34:4333333333333333333333:: ueviat l four loca Reviin 0,-1dire! Rev:49:16 ivos0,-1p =! Removed=Routines secth ls from=ihe header comhimi.ii ad_f!0,-1p =!oGOTO 9999mmmmii=poi=igmmi addta.inc!c_Oiiiphimirnel is specified (- (0,-1p =! $Log:-5_refdsolveromape2d.f,v $0,-1p =! Revish l 1.1.1.1 2007/07/13 10:18:54 iv10make it c10 04:41:1c_refdsolveromapeNewly creaour durENDi -mUarizthe d=p =oi=igmmich. MachENDolveromape shoorthogo/03 extvec_ d=U Lenowiin se ccte r_f!0,-1pS FOfaste04 18:34:43 2006the d:49:16 ivos0,-1p =! Removed=Routines secth ls from=ihe header comhimi.ii ad_f!0,-1p =!oGOTO 9999mmM. Iiinot,0,-1p =! see .ii ad_f!0,-1p =! Parallel Particle M,-h Library (PPM)0,-1p =! ETH Zurich0,-1p =! CH-8092 Zurich, Switzerland 0,-1p =!oGOLibra 0,-1p =! References :ii ad_f!0,-1p =! Revish ls : CI!c !oGOTO 9999mmDefi=i= oi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (- (0,-1p =! Modules0,-1p =!oGOmdefi=i=TER :: d=ia_fvnnnnnnnnn1Omdefi=i=TEEX,ii ad_fINTEGERRRRRRRRR2Omdefi=i=TE2D 3Omdefi=i=TE3D 4-h LibraMODULE! -mUSjgmmikickoffv !ccccccct_indturn,__LIN :: ::!coiiii CI=p == mmmmmjag(m#r=po,0#r=po,0,-1p = !oGOTO 9999mmDefi=i=opterfacad_to=oi=igmmikickoffvos0,-1cct_indturn,__LIN :: ::!coiiii CI=p == mmmmmjag(m#r=po,0#r=po,0,-1p = !oGOTO 999_smooFACE=oi=igmmikickoffvos0,-1cctbraMODULE!PROCEDURE=oi=igmmikickoff_2dsvos0,-1cctbraMODULE!PROCEDURE=oi=igmmikickoff_2ddvos0,-1cctbraMODULE!PROCEDURE=oi=igmmikickoff_3dsvos0,-1cctbraMODULE!PROCEDURE=oi=igmmikickoff_3ddvos0,-1cctTINj_smooFACEv !ccccccct_indturn,__LIN :: ::!coiiii CI=p == mmmmmjag(m#r=po,0#r=po,0,-1p = !oGOTO 9999mminclude!c_Oisourceu !ccccccct_indturn,__LIN :: ::!coiiii CI=p == mmmmmjag(m#r=po,0#r=po,0,-1p = !oGOTO 999mmmiAINS Omdefi=i=TEEIMstricR_defi=i=TE_refd, 0,-h_ids,ndturnrr#include!"oi=igmmikickoff.f" #PPM Njac_refR_defi=i=TE_refd, _I E_PC,-1p =mja #include!"oi=igmmikickoff.f" #PPM Njac_refR_PPM NjacEIM Omdefi=i=TEEIMstr3cR_defi=i=TE_refd, 0,-h_ids,ndturnrr#include!"oi=igmmikickoff.f" #PPM Njac_refR_defi=i=TE_refd, _I E_PC,-1p =mja #include!"oi=igmmikickoff.f" #PPM Njac_refR_PPM NjacEIM O,-1cctTINjMODULE! -mUSjgmmikickoffvmmipot (E=polibc_rnumerics-r1036/src/c_re/cfdsolveromape2d.f1125070160000644000175000017500000002667111616214650020234 0u).(i omaromarccccct_indturn,__LIN :: ::!coiiii CI=p == mmmmmjag(m#r=po,0#r=po,0,-1p = -oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_____mmipot (E=povos0,-1p =! Removed=Routines secth ls from=ihe header comhimi.ii ad_f!0,-1p =!oGOTO 9999OTO 9999mmMi=ENDi LI!mmmmC 20ute!c_Oipot (E=poiat freeargetipoioi=iusENDolveromapeeeeeeeeeeeeeeee freexpanad_f!coeffici atsolveromapeeeeeeeeeeeeeeeeIe thatp. Iiinotcase:olveromapeeeeeeeeeeeeeeeeCIiis_mmipretraad_feu shommiexpchangeolveromapeeeeeeeeeeeeeeeeMI!I!c_Oieargetipoioi=ionfrom_Oileaf ii gyolveromapeeeeeeeeeeeeeeeeolveromapemmids(2))/0,-h xpunord( c_Oiposit0,-1p =! R,__LIipoioi=olveromapeeeeeeeeeeeeeeeewpunord( c_Oistrength1p =! R,__LIipoioi=olveromapeeeeeeeeeeeeeeeetp( c_Oieargetipoioi=olveromapeeeeeeeeeeeeeeee frtaeeeeeeee acceptanceufact/04 18:34:olveromapemmidse0,-h iieeeeolveromapeeeeeeeeeeeeeeeeNpeeeeeeeeeeei adc_Oib isof ,__LIipoioi=.olveromapeeeeeeeeeeeeeeeeNtpeeeeeeeeeei adc_Oib isof eargetipoioi=olveromaolveromape iipot (E=po( c_Oimultiii reexpanad_f!pot (E=povos0,-1ppeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeS FOeachipoioivos0,-1ppeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeid_g 1:Npvos0,-1ppeeeeeeeeeeeeeeee i ad_f!0,-1p =! Ou0 up_f!succadsi ad_f! iENDiiiiii ii ad_f! 0,-1p =! References :ii ad_f!0,-1p =! Revish ls : CI!c !oGOTO 9999mmmmii=poi=immipot (E=po!c_Oiiiphimirnel is speci30s0,-1p =! CBL=versh6leh mthe PPM libraryii ad_f!0,-1p =! Revish l 1.9 2006/09/04 18:34:43--cchatelaii ad_f! Fixi=candmcleanups t2os0,-1p =6/2os10:2=ve5leh mthe PPM libraryAdi ad,v Revistrengths!suppoc_re3odul Fixi=candmcleanups t28s0,-1p =6/20uble)5:5 ,__LIN! release-1-adjusour _f!0,-1po op_!0,-1p =oi=immipretraad_fere3odul Fixi=candmcleanups t27s0,-1p =6/16 07:52:2 ,__LIN! release-1-Adi ada new lise ter 3:33:4s)0ifieidlisea froprev-1p liirSjacEND uceivdefi=i ad_f!0,-1p ii adie31 15:14:03 hiebers0,-1p =! 26s0,-1p =6/09 07:56sh6leh mthe PPM library0ii ad_fwe=poisewpfweri=opteg! ch), ii ad_f! rs0,-1p =! 250make it9himi cl03:2os0ii hatkbd_f! rcod cosmeth), ii ad_f! rs0,-1p =! 240make it9hi2 09lon-10t0 withhREAL(MK) t0.ii admappENDiof eargetipoioi=olveromaolveromapes0,-1p =! 230make it9hi1BL=v05:31s0ii hatkbd_f! r(fi=al?) corre! ad,v $0,-d_f! r(also wo iENp. Iiinot:-ETH Zurich), ii apes0,-1p =! 220make it9hi0 07:50: CB0ii hatkbd_f! rchanger opie terp = Revishp. Iiinotsh l 1.5 2004/08/19 13:14:54 hiebe210make it9h05 06:23d witii hatkbd_f! rcorre! ad,i=i=END opie=poi=at 1.5 2004/08/19 13:14:54 hiebe200make it8/2os15Log:00itii hatkbd_f! rbii ad when9 20ucEND dire! wa1.1.1 2007/07/13 10:18:54 iv190make it8/25i cl52:10itii hatkbd_f! rmappENDicorre! adsh l wpffrowpunord.1.1 2007/07/13 10:18:54 iv180make it8/23 on-35:20itii hatkbd_f! rchanger !0,-1to=oi=immipretraad_fere3odul Fixi=candmcleanups t170make it8/23 on-30: 5itii hatkbd_f! rchanger !0,-1to=oi=immiexpchangeolveroma Fixi=candmcleanups t160make it8/23 on-16:50itii hatkbd_f! rcorre! adwpunord_f!0,wpolveroma Fixi=candmcleanups t150make it8/1ouble)2: CB0ii hatkbd_f! r ader opdid_f!ter e04 18:34:olveromapemcleanups t140make it8/1oub3:32verB0ii hatkbd_f! r.ii ad,i=i=END frta4 18:34:olveromapemcleanups t130make it8/08ub3:35:52B0ii hatkbd_f! rmjaiiipcte some loca=poi=i=ENDi4 18:34:olveromapemcleanups t120make it8/04_0,-h4:5 ,_ii hatkbd_f! rrh lii asome aiiipct 1.5 2004/08/19 13:14:54 hiebe110make it7/2os14:06:52B0ii hatkbd_f! rchanger !! Retereqalnads1to=oi=imyepi4 18:34:olveromapemcleanups t100make it7/2os12ve6:130mii hatkbd_f! rchanger diago/03 to=radiui4 18:34:olveromapemcleanups t90make it7/27s14:59:2rB0ii hatkbd_f! rnowiusENDrconp =1po sh l diphim06/4 18:34:olveromapemcleanups t80make it7/25uble01:20itii hatkbd_f! rbii ad w 2005did_f4 18:34:olveromapemcleanups t70make it7/25ubrsh0:31s0ii hatkbd_f! radap adc 20utthe d1p =! Rpot (E=povos0,-1polveromapemcleanups t60make it7/21s12v42: witii hatkbd_f! rbii ad in 0,-ipct NDrad=U ra1.1.1 2007/07/13 10:18:54 iv50make it7/21s08:2,-hos0ii hatkbd_f! rchanger funi=poi=!0,-,rnowidif ii at eargetid_f! rpoioi=if!0,,__LIipoioi= Partbeolveromapespecifi the termsucei.1.1 2007/07/13 10:18:54 iv40make it6/02 19Log:-1s0ii hatkbd_f! rcorre! adsyntax fUSjac_re3od/08/19 13:14:54 hiebers0,-1 it c30s09l37e01itii hatkbd_f! rbii ad:rcorre! ad!0,-1to=oi=iucEl_cart2sphc_re3od/08/19 13:14:54 hiebe2s0,-1 it c27s12v42:48itii hatkbd_f! ropie=poizer furublicU ra1i4 18:34:olveromapemcleanups t1s0,-1 it c27s08:01:230mii hatkbd_f! ropie=pot it e,-1pa=poi4 18:34:43TODO:rrh liidsii a 0,-h 4 18:34:olveromapemcleanups00make it1/16 )5:59lonmii hatkbd_f! rSjac_re3odulad_f! 0,-1p =! References :ii ad_f!0,-1p =! Revish ls : CI!c !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (- (0,-1p =! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ii ad_f! Ce ter foreFluid Dynamics (DTU)ii ad_f!0,-1p =!ii ad_f! This file is parteh mthe Parallel Particle M,-h Library (PPM).ii ad_f!0,-1p =! PPM is free software: you can redistribute it and/oremopo,yii ad_f! it under the termseh mthe GNU Lesser General Public Lic ad_fii ad_f! as published=bymthe Free Software FoundcMh l, either,ii ad_f! versh le3eh mthe License, ore(at your op_Oiir any later,ii ad_f! versh l.ii ad_f!0,-1p =! PPM is distributedhi =ihe hope that it will-be0useful,0,-1p =! but WITHOUT ANY WARRANTY; without eve =ihe impliedhwmiENntyeh 0,-1p =! MERCHANTABILITY oreFITNESS FOR A PARTICULAR PURPOSE. See the0,-1p =! GNU General Public License,foremore details.ii ad_f!0,-1p =! You should have received=a copyeh mthe GNU General Public Licenseii ad_f! andmthe GNU Lesser General Public License,along withhPPM. Iiinot,0,-1p =! see .ii ad_f!0,-1p =! Parallel Particle M,-h Library (PPM)0,-1p =! ETH Zurich0,-1p =! CH-8092 Zurich, Switzerland 0,-1p =!oGOfdsolv( POINTER :: d=ia_fvn&&99mmmmii=poi=i=ENDgnu.org/ac_re3g_restric,mmipot (E=po_s_sf(xpunord,wpunord,Np,tp,Ntp, frta,p error_f=iiiiiiiiiiala,__LIN ::c !che lodpot (E=po,eargetU::!che(mlevm1Ivec_I(mooth_ICOMPLEX,ii ad_fINTEGER&&99mmmmii=poi=i=ENDgnu.org/ac_re3g_restric,mmipot (E=po_d_sf(xpunord,wpunord,Np,tp,Ntp, frta,p error_f=iiiiiiiiiiala,__LIN ::c !che lodpot (E=po,eargetU::!che(mlevm1Ivec_I(mooth_ICOMPLR :: d=ia_fvn&&99mmmmii=poiVi=ENDgnu.org/ac_re3g_restric,mmipot (E=po_s_vf(xpunord,wpunord,th_INp,tp,Ntp, frta, error_f=iiiiiiiiiiala,__LIN ::c !che lodpot (E=po,eargetU::!che(mlevm1Ivec_I(mooth_ICOMPLEX,ii ad_fINTEGER&&99mmmmii=poiVi=ENDgnu.org/ac_re3g_restric,mmipot (E=po_d_vf(xpunord,wpunord,th_INp,tp,Ntp, frta, error_f=iiiiiiiiiiala,__LIN ::c !che lodpot (E=po,eargetU::!che(mlevm1Ivrefdsolveromape2d_vec_cc(d=ia_fv,lda,i!X-_ids, 0,-h_ids,ndturnrr=po,0#r=po,0,-1p =!oGOTO 9999mmmmii=poa 0,-1p =! References :ii ad_f!0,-1p =! Revish ls : CI!c !oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_OiiiphimLe2DICmmLI!mmmmmI!I!c_OiiiphimmmiexpchangeolverommI!I!c_Oiiiphimmmipretraad_fere3odule_clon-_idmmm -mUSjac_re3odule_errormmm -mUSjac_re3odule_writemmm -mUSjfUSjac_re3odule_mapii ad_fUaiiip = writemmm -mUSjac_r CeiucEl = writemmm -mUSjucEl_cart2sphc_re3odule_mapii ad_fUSjac_re3odule_clon-_idmmm !! R = writemmm -mUSjac_r Cei0,-h_ = writemmm -mUSjac_r Ce = writemmm -mUSjac_r Cei0lobal = oartmmm -mUSjolveromape2d_vec_cc(d=ia_fv,lda,i!X-_ids, 0,-h_ids,ndturnrr=po,0#r=po,0,-1p =!oGOTO 9999mmIncludeoi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (- (0,-1p =! Modules0,-1p =!oGOm_nclude!"oi=idefi=i.h"UE0,-M NjacMPI = oNCLUDE 'mpif.h'1Ivrefdsolveromape2d_vec_cc(d=ia_fv,lda,i!X-_ids, 0,-h_ids,ndturnrr=po,0#r=po,0,-1p =!oGOTO 9999mmPneril 1.5 2004/ape2d_vec_cc(d=ia_fv,lda,i!X-_ids, 0,-h_ids,ndturnrr=po,0#r=po,0,-1p =!oG 2004Ofdsolvv, i!X-_ids, 0,-h_ids,ndturnrr=po,0#T NONE #p_h i=pg_smooth_INGLe2DIvec_I E_P |i=pser=po,0#T NONE #p_h i=pg_smooth_INGLe2DIvec_i=pg_smooth_INGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (- (0,-1p =! Aiiphimis 0,-1p =!oGOTO 999p_h i=pg_smooth_INGLe2Dg_si=pg_smooth_ xpunord.1.1 2o, 0,-1p =INTEGER , NI, INTENT(IN) Npvos0,-1p_h i=pg_smooth_INGLe2Dg_si=pg_smooth_ tp.1.1 2o, 0,-1p =INTEGER , NI, INTENT(IN) Ntpvos0,-1p_h i=pg1p =INTEGER , NI, INTEN R1 tfrta4 18:34o, 0,-1p =INTEGER , NI, INTEN R1 targetU::!che4 18:34o, 0,-1p =INTEGER , NI, INTENT(IN) :: 0m_0,-h, i!_0,-h0,-1p =LOGICAL p_h i=pg_smooth_INGLeg_si=pg_smooth_ wpunord.1.1 2p_h i=pg_smooth_INGLeg_si=pg_smooth_ pot (E=povi=pser=po,0#p_h i=pg_smooth_INGLe2Dg_si=pg_smooth_ wpunord.1.1 2o, 0,-1p =INTEGER , NIIIIIIIIIIIIIIIIINIMhoth=po,0#p_h i=pg_smooth_INGLe2Dg_si=pg_smooth_ pot (E=povi=th_INGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999mmmmii=poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (- (0,-1p =! Local variables 0,-1p =!oGOTO 999p =INTEGER !! R,drct,OK.1.1 2o, 0,-1p =INTEGER , NIIIIIIIIIIIIII fc(i,l,cnt,iwar,m,n.1.1 2o, 0,-1p =INTEGER , NIIIIIIIIIIIIII pp =! ,cp =! .1.1 2o, 0,-1p =INTEGER , NIIIIIIIIIIIIII M Ce,roii ip =!.1.1 2o, 0,-1p =INTEGER , NIIIIIIIIIIIIII 0,-h_,lah_,lhopl.1.1 2o, 0,-1p =INTEGER , NIIIIIIIIIIIIII p = Rpoioier,curbox.1.1 2o, 0,-1p =INTEGER , NIIIIIIIIIIIIII pexp ipymmLI!mmmm1p =INTEGmooth_INGL1 ldu1LI!mmmm1p =INTEGmooth_INGL2 ldu2FIELD ,-1p =INTEGmooth_INGLeR1 ,|i=pg_smooth_INGnewlpdx,p = Rvos0,-1p_h i=pg1p =INTEGER , NI tfrtap,eps,aE_P ,neri vos0,-1p_h i=pg1p =INTEGER , NI I Ee,coI Ee,vpo,prod vos0,-1p_h i=pgGmooth_INGL1 curboxrho,curboxphi,curboxtfrta4 18:34p_h i=pgGmooth_INGLICOMPLEX |i=pg_smo in_box,max_box.1.1 2p_h i=pgGmooth_INGLICOMPLEX |i=pg_smo in_Sja,max_Sja.1.1 2: d=ia_fvnrr :: CI=(---_MK,1--_MK--------vs size0,-1p =INTEGER cbufvos0,-1p_h i=pg1p =INTEGER , NI dx,dy,dz,ore(,ra ad_f!0,-1p. Iiinoi=at 1.5 2004p_h i=pg1p =INTEGER , NI t0o0,-h_id_g(cutoffvos0,-1o, 0,-1p =INTEGER , NIIIIIIIIIIIIII ::!che4 18:34o, 0,-Gmooth_INGLeR1 ,|i=pg_smooth_ING CeiSja_re3odule_! mm vos0,-1p_h i=pgGmooth_INGLeR1 ,|||||i=pg_smo fracfac,boxc-h_ = p_h i=pgGmooth_INGLICOMPLEX |i=pg_smo sqrtfac,xp Anmvos0,-1p_h i=pgGmooth_INGLeR1 ,|i=pg_smooth_INGradiui4 18:34p_h i=pgGmooth_INGLICOMPLi=pg_smooth_INGPnm,c (ETHofbox .1.1 2: d=ia_fvnrrmooth_INGLICOMPLEi=pg_smo Ynm .1.1 2: d=ia_fvnrrmooth_INGLICOMPLEi=pg_smo e0IIIIIIIIIIIII0m_0,-h, i!_0,-h0,-1p =LOGICAL p_h -Gmooth_INGLeR1 ,|i=pg_smooth_ wpIIIIII01.1 2: d=ia_fvnrrmooth_INGLICOCOMPi=pg_smo expanad_fvi=pse OGICAL p_h -Gmooth_INGLe2Dg_si=pg_smooth_ wp01.1 2: d=ia_fvnrrmooth_INGLICOCOCOMPi=pg_smo expanad_fIIIIIIIIIII0mhoth_INFra 0,-1p =! References :ii ad_f!0,-1p =! Revish ls : CI!c !oGOTO 9999mmIpie=poizea 0,-1p =! References :ii ad_f!0,-1p =! Revish ls : CI!c !oGOTO 9999mmmmii=poi=i=ENDi Lmmipot (E=poiiiphimirnel is specified (- (0,-1p =he losunfo(ik=' ,-1p =!o -&m ---------------f! Re_f!0,-1poi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (- (0,-1p =! Modules0,-1p =!oGOTO 999ps)0NDi sii a.GT che lod-------'uc_du99ps)0Np .LT !che lodu1oallER(ucuc_dumy,ldl5,ldu5,iopifUSjac_re3odallER(uc_te ENDi LSEiii=pENDa,__Lf!0,-1p,ENDi Lmmipot (E=poii error_iala,__LIN ::c !'b isof p0,-1p =s mustf! v> 0 !u1oerr_allER,'restricRmi &mmmm - -&m ---------- ----------'uc_dummps)0.NOT !NDi Lmmiopie=poizerhe lodu1oallER(ucuc_dumy,ldl5,ldu5,iopifUSjac_re3odallER(uc_te ENDi LSEiii=pENDa,__Lf!0,-1p,ENDi Lmmipot (E=poii error_iala,__LIN ::c !'Pcchatf!0,-1p =!Lmmiopie 0,-h_u1oerr_allER,'restricRmi &mmmm - -&m ---------- ------ ----- ----------'u 0,-1p =! References :ii ad_f!0,-1p =! Revish ls : CI!c !oGOTO 9999mm! Repneril 1.u shooioiENDi-h mtdiphitorcorre! poi=i=ENDi4 18:34: 0,-1p =! References :ii ad_f!0,-1p =! Revish ls : CI!c !oGO=ia_fv, i!X-_ids, 0,-h_ids,ndturnrr=po,0# in_box=po,0#=># in_box_i4 18:34max_box=po,0#=># ax_box_i4 18:34boxc-h_=po,0#=>#boxc-h__i4 18:34c (ETHofbox #=>#c (ETHofbox_i4 18:34radiui =po,0#=>#radiuipg_s_0,-h, i!_0,-h0,-1p =LOGICAL expanad_fIIII=>#expanad_f_s_sfvi=pser=po,0#expanad_fIIII=>#expanad_f_s_vf0mhoth_INFra------'usqrtfac=po,0#=>#sqrtfac_i4 18:34fracfac=po,0#=>#fracfac_i4 18:34Anm--------- =>#Anm_i4 18:34eps--------- ==oi=imyepii4 18:34Ynm--------- =>#Ynm_i4 18:34Pnm--------- =>#Pnm_i4 18:34 e0IIIIIIII=># e0pg_smoser=po,0# in_box=po,0#=># in_box_d4 18:34max_box=po,0#=># ax_box_d4 18:34boxc-h_=po,0#=>#boxc-h__d4 18:34c (ETHofbox #=>#c (ETHofbox_d4 18:34radiui =po,0#=>#radiuiprom_0,-h, i!_0,-h0,-1p =LOGICAL expanad_fIIII=>#expanad_f_d_sfvi=pser=po,0#expanad_fIIII=>#expanad_f_d_vf0mhoth_-----'usqrtfac=po,0#=>#sqrtfac_d4 18:34fracfac=po,0#=>#fracfac_d4 18:34Anm--------- =>#Anm_d4 18:34eps--------- ==oi=imyepid4 18:34Ynm--------- =>#Ynm_d4 18:34Pnm--------- =>#Pnm_d4 18:34 e0IIIIIIII=># e0pd0mhoth_-----'ups)0NDi nproc .GT !1he lodu1oallE!choNDi loweh_=lhoplcense,fo-h mtasp ii add_f!0,-1::!che-= idlise(nlhoplnel is specified (- (0,-1p =he losunfo(ik=' ,-1p =!o -&m --------------CIii mmiexpchangeitorcommunipcte Iii expanad_foi=i=ENDi LI!mmmmmI!I!c_Oiiiphimirnel is specified (- (0,-1p =! Modules0,-1p =!oGOm_0,-h, i!_0,-h0,-1p =LOGICAL mjaiiii ammiexpchange(iphimirnei=pse OGICAL mjaiiii ammiexpchange(th_IN0(mlevm1Ivrefdsolverops)0my,ld.NE !che lodu1oallER(ucte ENDi LSjac_0NDi rank,ENDi Lmmipot (E=poii error_f=iiiala,_'FaileditorcIii expchange.'ER,'restricRmi m - -&m ---------------'u 0,-1p =! References :ii ad_f!0,-1p =! Revish ls : CI!c !oGOTO 9999mMap eargetipoioi=olveroma 0,-1p =! References :ii ad_f!0,-1p =! Revish ls : CI!c !oGOTO 999vecdimindturn Cei0lobal(eargetU::!che(tp,Ntp,R,'restricRmps)0my,ld.NE !che lodu1oallER(ucte ENDi LSjac_0NDi rank,ENDi Lmmipot (E=poii error_f=iiiala,_'Faileditorpoi=i 0lobalrmappEND.'ER,'restricRmi m - -&m ---------------'uvecdimindturn Ceim --Ntp,M Ce,R,'restricRmps)0my,ld.NE !che lodu1oallER(ucte ENDi LSjac_0NDi rank,ENDi Lmmipot (E=poii error_f=iiiala,_'Faileditorpoi=i 0lobalrmappEND.'ER,'restricRmi m - -&m ---------------'uvecdimindturn Cei :: :p,NDi sim,Ntp,M Ce,R,'restricRmps)0my,ld.NE !che lodu1oallER(ucte ENDi LSjac_0NDi rank,ENDi Lmmipot (E=poii error_f=iiiala,_'Faileditorpoi=i 0lobalrmappEND.'ER,'restricRmi m - -&m ---------------'u_indturn,__LIN :: ::!coiiii CI=p == mmmmmjag(m#r=po,0#r=po,0,-1p = -oGOTO 9999mmmt A Pnew b isof p0,-1p =s-----'u_indturn,__LIN :: ::!coiiii CI=p == mmmmmjag(m#r=po,0#r=po,0,-1p = -oGOTO 999Ntpe= M CeOTO 999ps)0NDi sii a .GT !che lodu1oallER(ucte ENDi LSjac_0NDi rank,ENDi Lmmipot (E=poii error_f=iiiala,_______'DonermappENDieargetipoioi=.'ER,'restricRmi WRITE0cbuf,'(A,I6)') 'mmii=pb isof eargetipoioi=rnow:',Ntpvos0,-1R(ucte ENDi LSjac_0NDi rank,ENDi Lmmipot (E=poiicbuf,R,'restricRm----------'u_indturn,__LIN :: ::!coiiii CI=p == mmmmmjag(m#r=po,0#r=po,0,-1p = -oGOTO 9999mmm! Relaterp0,-1p =s NU Gebeenrmapp adc rre! ly-----'u_indturn,__LIN :: ::!coiiii CI=p == mmmmmjag(m#r=po,0#r=po,0,-1p = -oGOTO 999IF0NDi sii a.GT ch lodu1oallER(ute ENDi L !! R(::!che(tp,Ntp,OKER,'restricRmi ps)0my,ld.NE !che lodu1oallER(ucucte ENDi LSjac_0NDi rank,ENDi Lmmipot (E=poii error_f=iiala,_'Faileditorc! Rel ii add.'ER,'restricRmi ----------'uc_dps)0.NOT OKhe lodu1oallER(ucucte ENDi LSjac_0NDi rank,ENDi Lmmipot (E=poii error_f=iiiala,_'eargetipoioi=rnotrmapp adc rre! ly!'ER,'restricRmi mmm - -&m ------------------'u----------'upecified (- (0,-1p =he losunfo(ik=' ,-1p =!o -&m --------------CIii pretraad_fi=pi=poi=i=torbuildrcommunipctd_fIlise=olveroma 0,-1p =! References :ii ad_f!0,-1p =! Revish ls : CI!c !oGOTO 999vecdimindmmipretraad_fe(tp,Ntp,nlhopl, frta,cp =! , error_iala,__LIN ::c !!!!!!!!! CeiSja_re,pp =! ,R,'restricRmps)0my,ld.NE !che lodu1oallER(ucte ENDi LSjac_0NDi rank,ENDi Lmmipot (E=poii error_f=iiiala,_'FaileditorcIii pretraad_fe.'ER,'restricRmi m - -&m ---------------'u 0,-1p =! References :ii ad_f!0,-1p =! Revish ls : CI!c !oGOTO 9999mGeerp0,-1p =s _fIlmii=pprocessevistorur op_p. eiSja_re3odule_! 0,-1p =! References :ii ad_f!0,-1p =! Revish ls : CI!c !oGOTO 999vecdimindturn Cei0eeiSja(::!che( CeiSja_re,pp =! ,xpunord,Np,R,'restricRmps)0my,ld.NE !che lodu1oallER(ucte ENDi LSjac_0NDi rank,ENDi Lmmipot (E=poii error_f=iiiala,_'FaileditorcIii turn Cei0eeiSja.'ER,'restricRmi m - -&m ---------------'u 0,-1p =! References :ii ad_f!0,-1p =! Revish ls : CI!c !oGOTO 9999mPushse,fowe=poise shoboxpi=i -----'u 0,-1p =! References :ii ad_f!0,-1p =! Revish ls : CI!c !oGOTO 999ipymm d= 0-------cutoffd= 1--_MK99mPartbeundcMb is> 0-------! OA: II!c_isdc rre! ???OTO 999vecdimindturn Cei0,-h_i0ee(::!che(xpunord,NDi sim,Np ipymm(cutoff(mlevm1I_0,-h, i!_0,-h0,-1p =LOGICAL mjaiiii ad_f Cei ----wpunord,Np,R,'re !strengthsei=pse OGICAL mjaiiii ad_f Cei ----wpunord,th_INp,R,'re !strengthsei=oth_INFra------'ups)0my,ld.NE !che lodu1oallER(ucte ENDi LSjac_0NDi rank,ENDi Lmmipot (E=poii error_f=iiiala,_'Faileditor ---istrengths.'ER,'restricRmi m - -&m ---------------'uvecdimindturn Cei ----boxpi=iINp,R,'re !boxpi=i-----'ups)0my,ld.NE !che lodu1oallER(ucte ENDi LSjac_0NDi rank,ENDi Lmmipot (E=poii error_f=iiiala,_'Faileditor ---istrengths.'ER,'restricRmi m - -&m ---------------'uvecdimindturn Ceim --Np,M Ce,R,'re andmtM,-os0,-1ps)0my,ld.NE !che lodu1oallER(ucte ENDi LSjac_0NDi rank,ENDi Lmmipot (E=poii error_f=iiiala,_'Faileditorpesho0,-1p =s.'ER,'restricRmi m - -&m ---------------'uvecdimindturn Cei :: boxpi=iINp,M Ce,R,'re !boxpi=i-----'ups)0my,ld.NE !che lodu1oallER(ucte ENDi LSjac_0NDi rank,ENDi Lmmipot (E=poii error_f=iiiala,_'Faileditor ---istrengths.'ER,'restricRmi m - -&m ---------- -----1I_0,-h, i!_0,-h0,-1p =L -----1----'uvecdimindturn Cei :: wpunord,Np,M Ce,R,'re !strengthsei=pse1----'uvecdimindturn Cei :: wpunord,th_INp,M Ce,R,'re !strengthsei=oth_INFra------'ups)0my,ld.NE !che lodu1oallER(ucte ENDi LSjac_0NDi rank,ENDi Lmmipot (E=poii error_f=iiiala,_'Faileditor opistrengths.'ER,'restricRmi m - -&m ---------- !posit0,-s1----'uvecdimindturn Cei :: xpunord,NDi sim,Np M Ce,R,'restricRmps)0my,ld.NE !che lodu1oallER(ucte ENDi LSjac_0NDi rank,ENDi Lmmipot (E=poii error_f=iiiala,_'Faileditor opiposit0,-s.'ER,'restricRmi m - -&m ---------------'ups)0NDi sii a .GT !che lodu1oallER(ucte ENDi LSjac_0NDi rank,ENDi Lmmipot (E=poii error_f=iiiala,_______'DonermappENDi0,-h_o0,-1p =s.'ER,'restricRmi WRITE0cbuf,'(A,I6)') 'Reral Pub0,-h_o0,-1p =s:',M Ce-Npvos0,-1R(ucte ENDi LSjac_0NDi rank,ENDi Lmmipot (E=poiicbuf,R,'restricRm----------'u_indturn,__LIN :: ::!coiiii CI=p == mmmmmjag(m#r=po,0#r=po,0,-1p = -oGOTO 9999mSo=i new (0,-h_)rp0,-1p =s -----'u_indturn,__LIN :: ::!coiiii CI=p == mmmmmjag(m#r=po,0#r=po,0,-1p = -oGOTO 999ldu1 d= M CeOTO 999te ENDi Laiiip(newlpdx,ldu1,NDi ccccaiiip_fie,R,'restricRmps)0my,ld.NE !che lodu1oallER(umy,ldl5,ldu5,iopifatal = 999te ENDi LSEiii=pENDa,__Liiip,ENDi Lmmipot (E=poii error_fala,____'SEiii 0,-ipct NDrnewlpdxu1oerr_allER,'restricRmm - -&m ---------------'unewlpdx(1:Np d= lpdx(1:Np -------cntd= Npvos0,-1DO i=1,nbox.1.1 2---c! Re= .TRUE..1.1 2---DO j=Np+1,M CeOTO 999tricRmps)0boxpi=i(j)s.EQ. ihe lodu1oallER(ucuc_ducntd= cntd+ 1u1oallER(ucuc_dups)0((lhbx(1,i)s.EQ. d.OR. (lhbx(1,i)s.EQ. Np+1))s.AND.p error_f=iiiiiiiiiiiii(c! R)he lodu1oallER(ucuc_du---c! Re= .FALSE..1.1 2------------lhbx(1,i)s= cnt.1.1 2------------lhbx(2,i)s= cnt.1.1 2------------newlpdx(cnt)s= j.1.1 2---------ELSE !cccccccte--------lhbx(2,i)s= lhbx(2,i)s+ 1u1oallER(ucuc_du---newlpdx(cnt)s= j.1.1 2---------E---------'uc_dummE---------'uc_dE--DO -'uc_dE--DO -'uc_d_indturn,__LIN :: ::!coiiii CI=p == mmmmmjag(m#r=po,0#r=po,0,-1p = -oGOTO 9999mAT INION:rnowi-h mtlise= lhbxe sholpdx=U Leno poilid_f!yR A -'uc_d_indturn,__LIN :: ::!coiiii CI=p == mmmmmjag(m#r=po,0#r=po,0,-1p = -oGOTO 999----- !pDi nproc .GT !1 -'uc_d_indturn,__LIN :: ::!coiiii CI=p == mmmmmjag(m#r=po,0#r=po,0,-1p = -oGOTO 9999mAiiipcte U ra1evishpot (E=posiof eargetipoioi=olveromaindturn,__LIN :: ::!coiiii CI=p == mmmmmjag(m#r=po,0#r=po,0,-1p = -oGOTO 999iwardl5,ldu ccccaiiip_fie1I_0,-h, i!_0,-h0,-1p =LOGICAL ldu1 d= Ntpvos0,-1te ENDi Laiiip(pot (E=po,ldu1,iwar,R,'restricRmps)0my,ld.NE !che lodu1oallER(umy,ldl5,ldu5,iopifatal = 999te ENDi LSEiii=pENDa,__Liiip,ENDi Lmmipot (E=poii error_fala,____'SEiii 0,-ipct NDrpot (E=poiioerr_allER,'restricRmm - -&m -----------i=pse1----'uldu2 d= hoth=po,0#ldu2 2 d= Ntpvos0,-1te ENDi Laiiip(pot (E=po,ldu2,iwar,R,'restricRmps)0my,ld.NE !che lodu1oallER(umy,ldl5,ldu5,iopifatal = 999te ENDi LSEiii=pENDa,__Liiip,ENDi Lmmipot (E=poii error_fala,____'SEiii 0,-ipct NDrpot (E=poiioerr_allER,'restricRmm - -&m -----------i=th_INGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999mIpie=poizeaU ra1i4 18:34:OMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOI_0,-h, i!_0,-h0,-1p =LOGICAL DO i=1,Ntpvos0,-1R(upot (E=po(i)s= ---_MKe --------DO i=pse OGICAL DO i=1,Ntpvos0,-1R(uDO j=1,hoth=po,0#,-1R(upot (E=po(j,i)s= ---_MKe ----- _dE--DO -'uc_dE--DO i=th_INGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999maiiipcte shoopie=poize furublicU ra1i4 18:34:OMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 999ip =!d= 0-------ldu1 d= nbox.1.1 2te ENDi Laiiip(p = R,ldu1,iwar,R,'restricRmip =!d= ip =!d+ :: 0------ldu2 d= 3-----'ups)0NDi nproc .GT !1he lodu1oallE 0#ldu2 2 d= M CeOTO 999ELSE !ccccccctldu2 2 d= Np -----------1.1 2te ENDi Laiiip(xp,ldu2,iwar,R,'restricRmip =!d= ip =!d+ :: 0I_0,-h, i!_0,-h0,-1p =LOGICAL ps)0NDi nproc .GT !1he lodu1oallE 0#ldu1 d= M CeOTO 999ELSE !ccccccctldu1 d= Np -----------1.1 2te ENDi Laiiip(wp,ldu1,iwar,R,'resi=pse OGICAL ldu2 d= hotICAL -----'ups)0NDi nproc .GT !1he lodu1oallE 0#ldu2 2 d= M CeOTO 999ELSE !ccccccctldu2 2 d= Np -----------1.1 2te ENDi Laiiip(wp,ldu2,iwar,R,'resi=th_INGLe2DIip =!d= ip =!d+ :: 0------ps)0mp =!d.NE !che lodu1oallER(umy,ldl5,ldu5,iopifatal = 999te ENDi LSEiii=pENDa,__Liiip,ENDi Lmmipot (E=poii error_fala,____'SEiii 0,-ipct NDroi=i=ENDiu1oerr_allER,'restricRmm - -&m ---------------'up = Re= (0estricRmxpIIII= (0--_MK,0--_MK--I_0,-h, i!_0,-h0,-1p =LOGICAL DO i =1,id_g(wp,1estricRmi wp(i)s= ---_MKe --------DO i=pseOGICAL DO i =1,id_g(wp,2estricRmi DO j =1,hoth=po,0#,-1R(uwp(i,j)s= ---_MKe ----- _dE--DO -'uc_dE--DO i=th_INGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999mFishould roiicense,fo-h mt(se=i=l)if!0,,_shouldOTO 9999mtop=lhoplcenseh mt(p. Iiinonel is specified (- (0,-1p =he losunfo(ik=' ,-1p =!o -&m ------0,-M Nj-h, VECTOR-----'ups)0NDi nproc .GT !1he lod----- _de ----- _d!,,_shENDieop=lhoplstricRmi DO i=1,nlhoplstricRmi 'ups)0nbpo(i)s.GE !NDi nproche lodu1oallER(ucuc_dlhoplc= iu1oallER(ucuE---------'uc_dE--DO -'uc_dELSE !cccccccps)0Nai at d.EQ. ccccPPM Ni=i he lodu1oallER(ucuroiic= 1u1oallER(ELSE !cccccccte-DO i=1,nbox.1.1 2---cccccps)0Nai at i d.EQ. ccccPPM Ni=i he lodu1oallER(ucuER(ucuroiic= iu1oallER(ucuER(E---------'uc_dumE--DO -'uc_d------------'u------i=pser=po,0#Ts)0NDi nproc .GT !1he lod----- _de ----- _d!,,_shENDieop=lhoplstricRmi DO i=1,nlhoplstricRmi 'ups)0nbpo(i)s.GE !NDi nproche lodu1oallER(ucuc_dlhoplc= iu1oallER(ucu-'u-XITu1oallER(ucuE---------'uc_dE--DO -'uc_dELSE !cccccccps)0Nai at d.EQ. ccccPPM Ni=i he lodu1oallER(ucuroiic= 1u1oallER(ELSE !cccccccte-DO i=1,nbox.1.1 2---cccccps)0Nai at i d.EQ. ccccPPM Ni=i he lodu1oallER(ucuER(ucuroiic= iu1oallER(ucuER(-'u-XITu1oallER(ucuucuE---------'uc_dumE--DO -'uc_d------------'u------i=th_INGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999morM isthatp. -1p =s accorMENDieose,fo-h m4 18:34:OMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOI_0,-h, i!_0,-h0,-1p =LOGICAL IF0NDi sim.EQ.2h lodu1oallER(ups)0NDi nproc .GT !1he lodu1oallE 0#te-DO i=1,nbox.1.1 2---ccccc 0,-h_s= lhbx(1,i).1.1 2---ccccc lah_ s= lhbx(2,i).1.1 2---ccccc DO j=0,-h_,lah_u1oallER(ucuER(-'umxp(1,j)s= xpunord(1,newlpdx(j)).1.1 2---ccccc 'umxp(2,j)s= xpunord(2,newlpdx(j)).1.1 2---ccccc 'umwp(je a=ewpunord(newlpdx(j)).1.1 2---ccccc E--DO -'uc_d--ccc E--DO -'uc_d--cELSE !cccccccte--DO i=1,nbox.1.1 2---ccccc 0,-h_s= lhbx(1,i).1.1 2---ccccc lah_ s= lhbx(2,i).1.1 2---ccccc DO j=0,-h_,lah_u1oallER(ucuER(-'umxp(1,j)s= xpunord(1,lpdx(j)).1.1 2---ccccc 'umxp(2,j)s= xpunord(2,lpdx(j)).1.1 2---ccccc 'umwp(je a=ewpunord(lpdx(j)).1.1 2---ccccc E--DO -'uc_d--ccc E--DO -'uc_d--cE---------'u----------'uIF0NDi sim.EQ.3h lodu1oallER(ups)0NDi nproc .GT !1he lodu1oallE 0#te-DO i=1,nbox.1.1 2---ccccc 0,-h_s= lhbx(1,i).1.1 2---ccccc lah_ s= lhbx(2,i).1.1 2---ccccc DO j=0,-h_,lah_u1oallER(ucuER(-'umxp(1,j)s= xpunord(1,newlpdx(j)).1.1 2---ccccc 'umxp(2,j)s= xpunord(2,newlpdx(j)).1.1 2---ccccc 'umxp(3,j)s= xpunord(3,newlpdx(j)).1.1 2---ccccc 'umwp(je a=ewpunord(newlpdx(j)).1.1 2---ccccc E--DO -'uc_d--ccc E--DO -'uc_d--cELSE !cccccccte--DO i=1,nbox.1.1 2---ccccc 0,-h_s= lhbx(1,i).1.1 2---ccccc lah_ s= lhbx(2,i).1.1 2---ccccc DO j=0,-h_,lah_u1oallER(ucuER(-'umxp(1,j)s= xpunord(1,lpdx(j)).1.1 2---ccccc 'umxp(2,j)s= xpunord(2,lpdx(j)).1.1 2---ccccc 'umxp(3,j)s= xpunord(3,lpdx(j)).1.1 2---ccccc 'umwp(je a=ewpunord(lpdx(j)).1.1 2---ccccc E--DO -'uc_d--ccc E--DO -'uc_d--cE---------'u------i=pse OGICAL IF0NDi sim.EQ.2h lodu1oallER(ups)0NDi nproc .GT !1he lodu1oallE 0#te-DO i=1,nbox.1.1 2---ccccc 0,-h_s= lhbx(1,i).1.1 2---ccccc lah_ s= lhbx(2,i).1.1 2---ccccc DO j=0,-h_,lah_u1oallER(ucuER(-'umxp(1,j)s= xpunord(1,newlpdx(j)).1.1 2---ccccc 'umxp(2,j)s= xpunord(2,newlpdx(j)).1.1 2---ccccc 'umDO l=1,hoth=po,0#,-1R(uuuuuuuuuuwp(l,j)s= wpunord(l,newlpdx(j)).1.1 2---ccccc 'umE--DO -'uc_d--ccc 'umE--DO -'uc_d--ccc E--DO -'uc_d--cELSE !cccccccte--DO i=1,nbox.1.1 2---ccccc 0,-h_s= lhbx(1,i).1.1 2---ccccc lah_ s= lhbx(2,i).1.1 2---ccccc DO j=0,-h_,lah_u1oallER(ucuER(-'umxp(1,j)s= xpunord(1,lpdx(j)).1.1 2---ccccc 'umxp(2,j)s= xpunord(2,lpdx(j)).1.1 2---ccccc 'umDO l=1,hoth=po,0#,-1R(uuuuuuuuuuwp(l,j)s= wpunord(l,lpdx(j)).1.1 2---ccccc 'umE--DO -'uc_d--ccc 'umE--DO -'uc_d--ccc E--DO -'uc_d--cE---------'u----------'uIF0NDi sim.EQ.3h lodu1oallER(ups)0NDi nproc .GT !1he lodu1oallE 0#te-DO i=1,nbox.1.1 2---ccccc 0,-h_s= lhbx(1,i).1.1 2---ccccc lah_ s= lhbx(2,i).1.1 2---ccccc DO j=0,-h_,lah_u1oallER(ucuER(-'umxp(1,j)s= xpunord(1,newlpdx(j)).1.1 2-(ucuER(-'umxp(2,j)s= xpunord(2,newlpdx(j)).1.1 2---ccccc 'umxp(3,j)s= xpunord(3,newlpdx(j)).1.1 2---ccccc 'umDO l=1,hoth=po,0#,-1R(uuuuuuuuuuwp(l,j)s= wpunord(l,newlpdx(j)).1.1 2---ccccc 'umE--DO -'uc_d--ccc 'umE--DO -'uc_d--ccc E--DO -'uc_d--cELSE !cccccccte--DO i=1,nbox.1.1 2---ccccc 0,-h_s= lhbx(1,i).1.1 2---ccccc lah_ s= lhbx(2,i).1.1 2---ccccc DO j=0,-h_,lah_u1oallER(ucuER(-'umxp(1,j)s= xpunord(1,lpdx(j)).1.1 2---ccccc 'umxp(2,j)s= xpunord(2,lpdx(j)).1.1 2---ccccc 'umxp(3,j)s= xpunord(3,lpdx(j)).1.1 2---ccccc 'umDO l=1,hoth=po,0#,-1R(uuuuuuuuuuwp(l,j)s= wpunord(l,lpdx(j)).1.1 2---ccccc 'umE--DO -'uc_d--ccc 'umE--DO -'uc_d--ccc E--DO -'uc_d--cE---------'u------i=th_INGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999mC 20ute!c_Oipot (E=poiS FOc_Oieargetipoioi=olveromapNtp:ib isof eargetipoioi=olveromaOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 999DO i=1,Ntpvos0,-1R(uTs)0NDi nproc .GT !1he lod----- _de romapopie p = Rep. Iiino -'uc_d--cccp = Rpoioierc= 1u1oallER( ducntd= 0u1oallER( duaOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1pu1oallER( duamC iinct Iii box=s at frehigheh_=lhoplc(doesntd,v Revize)u1oallER( duaOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1pu (uDO j=1,nbox.1.1 2---ccccps)0blhopl(j)s.EQ. lhoplne lodu _d--cccp = R(p = Rpoioier)s= j -'uc_d--ccc 'ump = Rpoioierc= p = Rpoioierc+ 1u1oallER(ucuc_ducntd= cntd+1u _d--cccps)0cntd.EQ. nbpo(lhoplnhe lodu1oallER(ucuc_du----XITu1oallER(ucuucu-E---------'uc_dummuE---------'uc_dumE--DO -'uc_d--cELSE omapopie p = Rese=i=l-----'uc_dummp = Rpoioierc= 1u1oallER( ducp = R(p = Rpoioier)s= roii-----'uc_dummp = Rpoioierc= p = Rpoioierc+ 1u1oallER(uE----- uDO WHILE (p = Rpoioier .GT !1he roma opieop=box.1.1 2---cccp = Rpoioierc= p = Rpoioierc- 1u1oallER( duccurboxc= p = R(p = Rpoioier)u1oallER( ducdxc= tp(1,i)s-#c (ETHofbox(1,curbox)u1oallER( ducdyc= tp(2,i)s-#c (ETHofbox(2,curbox)u1oallER( ducdzc= tp(3,i)s-#c (ETHofbox(3,curbox)u1oallER( ducdih_s= SQRT(dx*dxc+cdy*dyc+cdz*dzhe romaOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1puoallER( duc9mm! RENDiBarnes-Hut Cjac_riumu1oallER( duaOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1pu (udrcte= .FALSE.. (ups)0radiui(curbox) .LE !c--_MK-e lodu1oallER(ucuc_d!only onerp. -1p = op_box, do dire! c 20utthe du1oallER(ucuc_ddrcte= .TRUE..1.1 2---(uE----- udups)0(dih_/(2*radiui(curbox)) .GT ! frta)s.AND.p0.NOT !drct)ne lodu _d--caOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,u1oallER(ucuc_ r ar enough, c 20uterp. --boxcioierache du1oallER(ucuc_aOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,u _d--cps)0NDi sii a .GT !che lodu1oallER(ucccccccccte ENDi LSjac_0NDi rank,ENDi Lmmipot (E=poii error_f=iiiiiiiiiiiala,_' ar enough'ER,'restricRmi mmuE----- ududuaOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-u1oallER(ucuc_ TODO:u1oallER(ucuc_ C 20ucEND freexpanad_f!orM ispexp accorMENDieosWaNDolveromR(ucuc_aOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,,u _d--c!tfrtaps= --75_MK+0.2_MK*(orM i-pexp)+0.05_MK*(orM i-pexp)**2olveromR(ucuc_pexp =!orM iu _d--c!DO WHILE((tfrtaps.LE !dih_/radiui(curbox)).AND.(pexp .GT !3)).1.1 2---cccc!uc_pexp =!pexp - 1u1oallER( ducc!uc_tfrtaps= --75_MK+0.2_MK*(orM i-pexp)+0.05_MK*(orM i-pexp)**2olveromR(ucuc_!E--DO -'uc_d--ccc 'te ENDi LucEl_cart2sph(tp(1,i:i),tp(2,i:i),tp(3,i:i),1,p error_f=iiiiiiiiiialc (ETHofbox(1,curbox),c (ETHofbox(2,curbox),p error_f=iiiiiiiiiialc (ETHofbox(3,curbox),p error_f=iiiiiiiiiialcurboxrho,curbox frta,curboxphi,R,'restricRmi mmups)0my,ld.NE !che lodu1oallER(ucuccc 'te ENDi LSEiii=pENDa,__sub_failed,ENDi Lmmipot (E=poii error_f=iiiiiiiiiiiiiial'FailedicIiiEND ucEl_cart2sphu1oerr_allER,'restricRmi &mE----- ududuaOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-u ududua c 20uterexpanad_fv ududuaOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-u ududuaOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-utricRmi &m9mC 20ute!Leg=thrOipolynom=poibox-p. -1p = opierache du1oallER(ucuc_aOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-utricRmi &mneri = 1--_MK/curboxrho(1estricRmi &msi=i=EN = SIN(curbox frta(1eestricRmi &mcoI EeN = COS(curbox frta(1eestricRmi &mvpoi=EN = -I EeolveromR(ucuc_prod = 1--_MKu ududuDO m=0,pexperror_f=iiiiiiiiPnm(m,m)s= fracfac(m)*proderror_f=iiiiiiiiprod =iprod *mvpostricRmi &mE--DO ududuDO m=0,pexp-1u1oallER(ucuc_du-Pnm(m+1,m)s= coI Ee*p_h i2*mc+ 1,MK-*Pnm(m,m)stricRmi &mE--DO ududuDO n=2,pexperror_f=iiiiiiiimvpoi= coI Ee*p_h i2*n-1,MK-error_f=iiiiiiiimDO m=0,n-1u1oallER(ucuc_du-du-Pnm(n,m)=(vpo*Pnm(n-1,m)-p_h in+m-1,MK-* error_f=iiiiiiiiiiiiiiallER(ucuc_du-du-Pnm(n-2,m))/p_h in-m,MK-error_f=iiiiiiiimE--DO -'uc_d--ccc 'E--DO ududuaOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-utricRmi &m9mC 20ute!Ynm(n,m)if!0,Ynm(n,-m)stricRmi &maOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-u ududuDO n=0,pexperror_f=iiiiiiii md= 0u1oallER( duuuuuuaE_P d= p_h im,MK-*curboxphi(1estricRmi &m !Ynm(n,m)i=#sqrtfac(n,m)*Pnm(n,m)*CMPLX(COS(aE_P ),SIN(aE_P )-error_f=iiiiiiiimDO m=1,du1oallER(ucuc_duuuuuaE_P ddddd= p_h im,MK-*curboxphi(1estricRmi &m ! !Ynm(n,m)ii=#sqrtfac(n,m)*Pnm(n,m)* error_f=iiiiiiiiiiiiiiallER(ucucCMPLX(COS(aE_P ),SIN(aE_P )-error_f=iiiiiiiim !Ynm(n,-m)i=#CONJG(Ynm(n,m)-error_f=iiiiiiiimE--DO -'uc_d--ccc 'E--DO -'uc_d--ccc 'aOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-utricRmi &m9mC 20ute! fre e0Iexpanad_fv-'uc_d--ccc 'aOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-u ududuprod = 1--_MKu-'uc_d--ccc 'DO n=0,pexperror_f=iiiiiiii prod = prod *mcurboxrho(1estricRmi &m imDO m=-n,du1oallER(ucuc_duuuuu e0(n,m)i=#(-1)**n*CI**ABS(m)*Ynm(n,m)/(Anm(n,m)*prod-error_f=iiiiiiiimE--DO -'uc_d--ccc 'E--DO -'uc_d--ccc 'aOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-utricRmi &m9mEvpoucte pot (E=po,iusENDrmultiii reexpanad_f!coeffici-1poi=i=END--ccc 'aOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-u ududuDO n=0,pexperror_f=iiiiiiii DO m=-n,du#h_INFra-----------, i!_0,-h0,-1p =LO udupot (E=po(i)=pot (E=po(i)s+eexpanad_f(curbox,n,m)i error_f=iiiiiiiiiiiiiala,__LIN ::* e0(n,-m)si=pser=po,0#or_f=iiiiiiii DO j=1,hoth=po,0#,-1R(uuuuuuuuuuuupot (E=po(j,i)=pot (E=po(j,i)s+eexpanad_f(j,curbox,n,m)i error_f=iiiiiiiiiiiiiala,__LIN ::* e0(n,-m)srror_f=iiiiiiiiiiiiiE--DO i=th_INGLe2DIiiiiiiiiiiE--DO 2DIiiiiiiiiiiE--DO 2DIiiiiiiiiELSE !cccccccte---aOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,u1oallER(ucuc_ rno p ar enough, ---ichilhrOn h_Ipresent.1.1 2-------aOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,u1oallER(ucuc_ps)0NDi sii a .GT !che lodu1oallER(ucccccccte ENDi LSjac_0NDi rank,ENDi Lmmipot (E=poii error_f=iiiiiiiiiala,_'no p ar enough'ER,'restricRmi mmuE-----1oallER(ucuc_ps)0nchld(curbox) .GT !che lodu1oallER(ucccccccaOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,u1oallER(uccccccca rno p ar enough, ---ichilhrOn h_Ipresent.1.1 2-------cccaOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,u1oallER(ucccccccps)0NDi sii a .GT !che lodu1oallER(uccccccccccte ENDi LSjac_0NDi rank,ENDi Lmmipot (E=poii error_f=iiiiiiiiiiiiala,_' ---ichilhrOn'ER,'restricRmi mmummuE-----1oallER(ucuc_ (uDO j=1,nchld(curbox)error_f=iiiiiiiiiiip = R(p = Rpoioier)s= chilh(j,curbox)error_f=iiiiiiiiiiip = Rpoioierc= p = Rpoioierc+ 1u1oallER(ucuc_du'E--DO ududu-------'uc_du99iELSE !cccccccte---aOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,,u1oallER(ucuc_ rnoichilhrOn, dire! c 20utthe du1oallER(ucuc_aOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,,u1oallER(ucuc_ps)0NDi sii a .GT !che lodu1oallER(uccccccccte ENDi LSjac_0NDi rank,ENDi Lmmipot (E=poii error_f=iiiiiiiiiiala,_'noichilhrOn'ER,'restricRmi mmumE----- ududu 0,-h_s= lhbx(1,curbox)error_f=iiiiiiilah_ s= lhbx(2,curbox)e ududu DO j=0,-h_,lah_ !loop ov isp. -1p =s in leafO uaOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=perror_f=iiiiiiiiii9mEvpoucte pot (E=po,idire! methoderror_f=iiiiiiiic_aOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=perror_f=iiiiiiiic_dxc= xp(1,j)s- tp(1,i)error_f=iiiiiiiic_dyc= xp(2,j)s- tp(2,i).1.1 2---ccccc ucdzc= xp(3,j)s- tp(3,i).1.1 2---ccccc ucrad = dx*dxc+cdy*dyc+cdz*dz.1.1 2---ccccc ucIF0rad.GT eps) lodu _d--ccccc ucrad = 1--_MK/SQRT(radg1p =INTEGER , NI u#h_INFra------------, i!_0,-h0,-1p =LO uduupot (E=po(i)s= pot (E=po(i)s+ewp(je*radsi=pser=po,0#or_f=iiiiiiii DO l=1,hoth=po,0#,-1R(uuuuuuuuuuuupot (E=po(l,i)s= pot (E=po(l,i)s+ewp(l,j)*rad -'uc_d--ccc 'ummmmmmE--DO i=th_INGLe2DIiiiiiiiiiiE-----1oallER(ucuc_ E--DO -'uc_d--ccc E-----1oallER(uc----- ----- -'uc_d--E--DO -'uc_dE--DO -'uc_d_indturn,__LIN :: ::!coiiii CI=p == mmmmmjag(m#r=po,0#r=po,0,-1p = -oGOTO 9999m Nullifytdiphipoioiers-----'u_indturn,__LIN :: ::!coiiii CI=p == mmmmmjag(m#r=po,0#r=po,0,-1p = -oGOTO 999NULLIFY( in_box)OTO 999NULLIFY( ax_box)OTO 999NULLIFY(boxc-h_)OTO 999NULLIFY(c (ETHofbox)OTO 999NULLIFY(radiuinel is specified (- (0,-1p =he losunfo(ik=' ,-1p =!o -&m ---------------Deaiiipcte lmii=pNDi LI!mmmm:OMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 999ip =!ddddd= 0-------ldu1 ddd= 0-------ldu2(1:2 d= 0-------te ENDi Laiiip(newlpdx,ldu1,NDi ccccdeaiiip,R,'restricRmip =!d= ip =!d+ :: 0------te ENDi Laiiip(p = R,ldu1,NDi ccccdeaiiip,R,'restricRmip =!d= ip =!d+ :: 0------te ENDi Laiiip(xp,ldu2,NDi ccccdeaiiip,R,'restricRmip =!d= ip =!d+ :: 0------te ENDi Laiiip(wp,ldu2,NDi ccccdeaiiip,R,'restricRmip =!d= ip =!d+ :: 0------te ENDi Laiiip( CeiSja_re,ldu2,NDi ccccdeaiiip,R,'restricRmip =!d= ip =!d+ :: 0------ps)0mp =!d.NE !che lodu1oallER(umy,ldl5,ldu5,iopifUSjac_re3odallte ENDi LSEiii=pENDa,__deaiiip,ENDi Lmmiexpanad_fii error_fala,____'SEiii de0,-ipct NDrnewlpdxu1oerr_allER,'restricRmm - -&m ---------------'upecified (- (0,-1p =he losunfo(ik=' ,-1p =!o -&m ---------------Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i!X-_ids, 0,-h_ids,ndturnrr=po,0#r=po,0,-1p =!oG -&m 2: NTINUE0------te ENSjac_re=ENDi Lmmipot (E=poiiiphimirnel is sRETURN Ofdsolv( POINTER :: d=ia_fvn&&99mmmmii=poi=i=ENDgnu.org/---/ac_re3g_restric,mmipot (E=po_s_sf1Ivec_I(mooth_ICOMPLEX,ii ad_fINTEGER&&99mmmmii=poi=i=ENDgnu.org/---/ac_re3g_restric,mmipot (E=po_d_sf1Ivec_I(mooth_ICOMPLR :: d=ia_fvn&&99mmmmii=poiVi=ENDgnu.org/---/ac_re3g_restric,mmipot (E=po_s_vf1Ivec_I(mooth_ICOMPLEX,ii ad_fINTEGER&&99mmmmii=poiVi=ENDgnu.org/---/ac_re3g_restric,mmipot (E=po_d_vf0mhoth_-libtrinumerics-r1036/src/tricc 20_pp_v ilet.f0000644000175000017500000005626611616214650020207 0upoi= omaromar----'upecified (- (0,-1p =he losunfo(ik=' ,-1p =!o -&m ---------------Subi=poi=i= : tricc 20_pp_v ilet-----'upecified (- (0,-1p =he losunfo(ik=' ,-1p =!o -&m --------------Copyr=poi (c) 2010 CSE Lab (ETH Zurich), MOSAIC Gi=pp (ETH Zurich), ----------------------------C (ETHiS FOFluid Dynamics (DTUnel is spel is spel is sp T_isdfi = ossp. -cense,foP. IiinooP. -1p = Mesh Library (PPM).el is spel is sp PPM ossfh mtsoftware: youmPartredih_ribute!itif!0/ FOmoth_y-----'u_!itiPPM FOc_Oieermscense,foGNU Less FOGene Ii Public Lic (se OGICAL !tasppublished byse,foFh mtSoftware FoPPMthe d, eiublicOGICAL !tad_fd_f!3cense,foLic (se, FO(=!dyour ophe d)undcMlatlicOGICAL !tad_fd_f.el is spel is sp PPM ossdih_ributer op_ frehopeelateritiwiii be useful,el is sp but WITHe3g ANY WARRANTY;iwithout evep_ freimplier wU rantycenel is sp MERCHANTABILITY FOFITNESS FOR Ap_h TICULAR PURPOSE !SeeouldOTO 9999mGNU Gene Ii Public Lic (se f FOmore details.el is spel is sp Youmshould NU Gereral Puba copycense,foGNU Gene Ii Public Lic (seOGICAL !tashould GNU Less FOGene Ii Public Lic (se aloNDrwith PPM. Ifrno ,el is sp seeo.el is spel is sp P. IiinooP. -1p = Mesh Library (PPM)el is sp ETH Zurich---------CH-8092 Zurich, Switz ilaM,-os0,-1pecified (- (0,-1p =he losunfo(ik=' ,-1p =!o -&m ------O=ia_fv, iERNELii=poipg_smNALO=ia_fv, i!X-_ids, 0,-h_ids,ndturnrr=po,0#ac_re3g_restricc 20_pp_v ilet_si(xp,Np,pNDi ,th_Ilpymm(kernel,kp. , error_ala,_nvlise,vlise,dpd,R,'resi=pia_mooth_ICOMPLEX,ii ad_fINTEGEr=po,0#ac_re3g_restricc 20_pp_v ilet_di(xp,Np,pNDi ,th_Ilpymm(kernel,kp. , error_ala,_nvlise,vlise,dpd,R,'resi=pia_mooth_ICOMPL0,-h_ids,ndturnr_: d=ia_r=po,0#ac_re3g_restricc 20_pp_v ilet_sci(xp,Np,pNDi ,th_Ilpymm(kernel,kp. , error_ala,_nvlise,vlise,dpd,R,'resi=pia_mooth_ICOMPLEX,ii ad_fINTEGE_: d=ia_r=po,0#ac_re3g_restricc 20_pp_v ilet_dci(xp,Np,pNDi ,th_Ilpymm(kernel,kp. , error_ala,_nvlise,vlise,dpd,R,'resi=oth_-i=pia_mooERNELii=poiUSER_FUNCNIONO=ia_fv, i!X-_ids, 0,-h_ids,ndturnrr=po,0#ac_re3g_restricc 20_pp_v ilet_su(xp,Np,pNDi ,th_Ilpymm(kernel,kp. , error_ala,_nvlise,vlise,dpd,R,'resi=pia_mooth_ICOMPLEX,ii ad_fINTEGEr=po,0#ac_re3g_restricc 20_pp_v ilet_du(xp,Np,pNDi ,th_Ilpymm(kernel,kp. , error_ala,_nvlise,vlise,dpd,R,'resi=pia_mooth_ICOMPL0,-h_ids,ndturnr_: d=ia_r=po,0#ac_re3g_restricc 20_pp_v ilet_scu(xp,Np,pNDi ,th_Ilpymm(kernel,kp. , error_ala,_nvlise,vlise,dpd,R,'resi=pia_mooth_ICOMPLEX,ii ad_fINTEGE_: d=ia_r=po,0#ac_re3g_restricc 20_pp_v ilet_dcu(xp,Np,pNDi ,th_Ilpymm(kernel,kp. , error_ala,_nvlise,vlise,dpd,R,'resi=oth_-i=pia_mooERNELii=poiLOOKUP_TABLEO=ia_fv, i!X-_ids, 0,-h_ids,ndturnrr=po,0#ac_re3g_restricc 20_pp_v ilet_st(xp,Np,pNDi ,th_Ilpymm(kernel,kp. , error_ala,_nvlise,vlise,dpd,R,'resi=pia_mooth_ICOMPLEX,ii ad_fINTEGEr=po,0#ac_re3g_restricc 20_pp_v ilet_dt(xp,Np,pNDi ,th_Ilpymm(kernel,kp. , error_ala,_nvlise,vlise,dpd,R,'resi=pia_mooth_ICOMPL0,-h_ids,ndturnr_: d=ia_r=po,0#ac_re3g_restricc 20_pp_v ilet_sct(xp,Np,pNDi ,th_Ilpymm(kernel,kp. , error_ala,_nvlise,vlise,dpd,R,'resi=pia_mooth_ICOMPLEX,ii ad_fINTEGE_: d=ia_r=po,0#ac_re3g_restricc 20_pp_v ilet_dct(xp,Np,pNDi ,th_Ilpymm(kernel,kp. , error_ala,_nvlise,vlise,dpd,R,'resi=oth_-i=th_INGLe2DIC!!-Subi=poi=i=which c 20utes kernel opierache ds bysdire! NGLe2DIC!!-p. -1p =-p. -1p = opierache dsiusENDrV ilettlise=.NGLe2DIC!!NGLe2DIC!!-[NOTE]NGLe2DIC!!-======================================================================NGLe2DIC!!-The lmops f FOth_.EQ.1e sholh_.EQ.2=U Leexplici ly-----'u_!!-u,'rldeditor0,-iwd,v Revizctd_fIop_ foatf!0ses. For-----'u_!!-lh_.GT.2=c_isdi=poi=i=wiii no pov Revize.NGLe2DIC!!NGLe2DIC!!-Both nvlisee shovliseePartbeucreater usENDNGLe2DIC!!-pDi ne=polise_vlise. T_isdshould beudonerbyse,f-----'u_!!-us FOprogrammsi=ceould Lecould beuseve Ii setscenel is sp!!-V ilettlise=. T_isdi=poi=i=PartuldrtbeucIiindrwithel is sp!!-uld appropricte one. Dorno p orgetitorDEALLOCATEel is sp!!-nvlisee shovliseewhep_ fry=U Leno pneededindcMmore.NGLe2DIC!!NGLe2DIC!!-dpdpneeds=torbemaiiipcteditor rop FOid_grbef A -'uc_d_!!icIiiEND c_isdi=poi=i. Also,=c_isdi=poi=i=i=rnot -'uc_d_!!iresett NDrdpdptorz iorbef A udoEND frePP -'uc_d_!!iopierache ds. T_isd0,-iwsdc n_ribute dsifromNGLe2DIC!!-diffei at kernels=torbemaccumulatld. Ifrneeded,NGLe2DIC!!-setrititorz iorbef A ucIiiEND c_isdi=poi=ise,f-----'u_!!-0,-h_stime.NGLe2DIC!!-======================================================================NGLe2DIC!!-----'upecified (- (0,-1p =he losunfo(ik=' ,-1p =!o -&m ---------------Modu =s-----'u_indturn,__LIN :: ::!coiiii CI=p == mmmmmjag(m#r=po,0#r=po,0,-1p = -oGOTO 999USEimindtodu =_NDi LI!mmmmUSEimindtodu =_ii=poi=iLI!mmmmUSEimindtodu =_ii=pore3odule_USEimindtodu =_fUSjac_re3odId=iICIT NONEO=ia_fv, i!X-_ids, 0,-h_ids,ndturnr |_mooth_ICOMPL0,-h_ids,ndturnr_: d=ia_r=po,0#pg_sGER,p_h AME_sm :: MKdl5,ldukind_sENDlesi=pia_mooth_ICOMPLEX,ii ad_fINTEGE |_mooth_ICOMPLEX,ii ad_fINTEGE_: d=ia_r=po,0#pg_sGER,p_h AME_sm :: MKdl5,ldukind_double-i=th_INGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m IncludDi4 18:34: 0,-1p =! References :ii ad_f!0,-1p =! Revish ls : CI!c !oGO=includD "NDi siNi=i.h"NGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m Af!0,-1ps-----NGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 999p_h iMK-e , DIMENTEGE(:,:),#pg_sNT(Id---) :: xperror_fC!!-p. -1p =dc orMENatlsO=ia_fv, i!X-_ids, 0,-h_ids,ndturnr |_mooth_ICOMPLEX,ii ad_fINTEGEr=po,0#p_h iMK-e , DIMENTEGE(:,:),#pg_sNT(Id---) :: pNDi LI!mmmm:!!-p. -1p =ddiphi(strengths).NGLe2DIC!!-Ov iloadeditypes: sENDle,double-=po,0#p_h iMK-e , DIMENTEGE(:,:),#pg_sNT( e3g) :: dpdNGLe2DIC!!-Changeiof p0,-1p =ddiphi(strengths).NGLe2DIC!!-Ov iloadeditypes: sENDle,double-i=pia_mooth_ICOMPL0,-h_ids,ndturnr_: d=ia_ |_mooth_ICOMPLEX,ii ad_fINTEGE_: d=ia_r=po,0#: d=ia_iMK-, DIMENTEGE(:,:),#pg_sNT(Id---) :: pNDi LI!mmmm:!!-p. -1p =ddiphi(strengths).NGLe2DIC!!-Ov iloadeditypes: sENDle c 20lex,double c 20lexr=po,0#: d=ia_iMK-, DIMENTEGE(:,:),#pg_sNT( e3g) :: dpdNGLe2DIC!!-Changeiof p0,-1p =ddiphi(strengths).NGLe2DIC!!-Ov iloadeditypes: sENDle c 20lex,double c 20lex.-i=th_INGLe2DILOGICAL ,#pg_sNT(Id---) :: lpymm-----'u_!!-usEND pymmetry FOnot?r=po,0#pg_sGER ,#pg_sNT(Id---) :: Nperror_fC!!-b isof p0,-1p =s _fIlmii=pproc.r=po,0#pg_sGER ,#pg_sNT(Id---) :: hoth=po,0#_!!-leaMENDidimenad_f!of pNDi .O=ia_fv, iERNELii=poipg_smNALO=po,0#pg_sGER ,#pg_sNT(Id---) :: kernelh=po,0#_!!-kernel f FOwhich torcom0ute! frec rre! d_f. To-us 5,ld-opiernalh=po,0#_!!-kernels, specifytonerof:h=po,0#_!!h=po,0#_!!-: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999!-----NDi cccckerel_laplace2d_2pOTO 9999!----- (2shoorM isLaplacian,OTO 9999!----- polynom=poiop_2Dgnu.org/9!-----NDi cccckerel_laplace3d_2pOTO 9999!----- (2shoorM isLaplacian,OTO 9999!----- polynom=poiop_3Dgnu.org/9!--: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999!-NGLe2DIC!!-To-us 5your own-kernel funche d, pass! frefunche dipoioier ld L. Your-----'u_!!-funche dishould take one=U !0,-1pe shoretur. one=vpoue.O=ia_fv, i!X-_ids, 0,-h_ids,ndturnr |_mooth_ICOMPLEX,ii ad_fINTEGEr=po,0#p_h iMK-e , DIMENTEGE(:) ,#pg_sNT(Id---) :: k c-----'u_!!-Kernel ccceiers !Seeodoc0,-1pctd_fIishpricc 20_pp_kernels.inc f FNGLe2DIC!!-descrip d_f. TypeePartbeusENDle ishc 20lex.-i=pia_mooth_ICOMPL0,-h_ids,ndturnr_: d=ia_ |_mooth_ICOMPLEX,ii ad_fINTEGE_: d=ia_r=po,0#: d=ia_iMK-, DIMENTEGE(:) ,#pg_sNT(Id---) :: k c-----'u_!!-Kernel ccceiers !Seeodoc0,-1pctd_fIishpricc 20_pp_kernels.inc f FNGLe2DIC!!-descrip d_f. TypeePartbeusENDle c 20lexIishdouble c 20lex.-i=th_INi=pia_mooERNELii=poiLOOKUP_TABLEO=po,0#p_h iMK-e ,#pg_sNT(Id---) :: k c-----'u_!!-Kernel ccceiers !Seeodoc0,-1pctd_fIishpricc 20_pp_kernels.inc f FNGLe2DIC!!-descrip d_f. Pass!dxt=ENDinv ( freinad_fecense,fo-=END spacing) asNGLe2DIC!!-a sii=ar ld L.O=ia_fv, i!X-_ids, 0,-h_ids,ndturnr |_mooth_ICOMPLEX,ii ad_fINTEGEr=po,0#p_h iMK-e , DIMENTEGE(:--),#pg_sNT(Id---) :: kernelhi=pia_mooth_ICOMPL0,-h_ids,ndturnr_: d=ia_ |_mooth_ICOMPLEX,ii ad_fINTEGE_: d=ia_r=po,0#: d=ia_iMK-, DIMENTEGE(:--),#pg_sNT(Id---) :: kernelhi=th_INGLe2DIC!!-Lookupo-=END with -=Eulatld-kernel vpoue=.NGLe2DIC!! Such ao-=END Partbeucreater usEND <>.-i=th_INGLe2DIpg_sGER , DIMENTEGE(:,:),#pg_sNT(Id---) :: vliseel is sp!!-V ilettlise=censIii p0,-1p =s. 1steindex: p0,-1p =s toropierachrwithel is sp!!-(1..nvlise),#2sh: p0,-1p =-(1..Np).r=po,0#pg_sGER , DIMENTEGE( :),#pg_sNT(Id---) :: nvliseel is sp!!-lengthcense,foV ilettlise=censIii p0,-1p =sO=po,0#pg_sGER ,#pg_sNT( e3g) :: :: 0------p!!-Retur.s p =tus, 0 up disuccessNGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m Lmii=poi=i=ENDi-NGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 999pg_sGER :: j Ce,Rp,jp ippec,idxO=po,0#p_h iMK-e :: dx,dy,dz.1.1 2p_h iMK-e :: fa Rev,fa Rev2O=po,0#p_h iMK-e :: dij,dij2,dij4,dij5O=ia_fv, i!X-_ids, 0,-h_ids,ndturnr |_mooth_ICOMPLEX,ii ad_fINTEGEr=po,0#p_h iMK-e :: summ,summ2O=po,0#p_h iMK-e :: rta,dmhi=pia_mooth_ICOMPL0,-h_ids,ndturnr_: d=ia_ |_mooth_ICOMPLEX,ii ad_fINTEGE_: d=ia_r=po,0#: d=ia_iMK- :: summ,summ2O=po,0#: d=ia_iMK- :: rta,dmhi=th_INGLe2DICstimeicOGICAL p_h iMK-e :: t0-------tHARAC_sm(LEN=pricchar-e :: mesgNGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m Exiernali-NGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGO=ia_fv, iERNELii=poiUSER_FUNCNIONO=ia_fv, i!X-_ids, 0,-h_ids,ndturnr |_mooth_ICOMPLEX,ii ad_fINTEGEr=po,0#p_h iMK-e , DIMENTEGE(:) ,#pg_sNT(Id---) :: k c-----'upg_smFACE !cccccccteFUNCNION-kernel(x,kp. ).1.1 2---cccccId=iICIT NONEO=ia_fv, i!X-_ids, 0,-h_ids,ndturnr |_mooth_ICOMPL0,-h_ids,ndturnr_: d=ia_r=po,0#---cccccIg_sGER,p_h AME_sm :: MKdl5oth_(1.0E0esi=pia_mooth_ICOMPLEX,ii ad_fINTEGE |_mooth_ICOMPLEX,ii ad_fINTEGE_: d=ia_r=po,0#---cccccIg_sGER,p_h AME_sm :: MKdl5oth_(1.0D0esi=th_INGLe2DIIIIIIIIIp_h iMK-,#pg_sNT(Id) :: xNGLe2DIIIIIIIIIp_h iMK-,#DIMENTEGE(:),#pg_sNT(Id) :: k c-----'uIIIIIIIIp_h iMK- :: kernelh=po,0#####---/FUNCNION-kernel 0#####---/pg_smFACE i=pia_mooth_ICOMPL0,-h_ids,ndturnr_: d=ia_ |_mooth_ICOMPLEX,ii ad_fINTEGE_: d=ia_r=po,0#: d=ia_iMK-, DIMENTEGE(:) ,#pg_sNT(Id---) :: k c-----'upg_smFACE !cccccccteFUNCNION-kernel(x,kp. ).1.1 2---cccccId=iICIT NONEO=ia_fv, i!X-_ids, 0,-h_ids,ndturnr |_mooth_ICOMPL0,-h_ids,ndturnr_: d=ia_r=po,0#---cccccIg_sGER,p_h AME_sm :: MKdl5oth_(1.0E0esi=pia_mooth_ICOMPLEX,ii ad_fINTEGE |_mooth_ICOMPLEX,ii ad_fINTEGE_: d=ia_r=po,0#---cccccIg_sGER,p_h AME_sm :: MKdl5oth_(1.0D0esi=th_INGLe2DIIIIIIIIIp_h iMK-,#pg_sNT(Id) :: xNGLe2DIIIIIIIII: d=ia_iMK-, DIMENTEGE(:),#pg_sNT(Id) :: k c-----'uIIIIIIII: d=ia_iMK- :: kernelh=po,0#####---/FUNCNION-kernel 0#####---/pg_smFACE i=oth_-i=th_INNGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m Inie=poism4 18:34:OMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOIIIIII:e ENSjac_i=i('tricc 20_pp_v iletiiiphimirneNGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m m! R=U !0,-1p=.NGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 999ps)0NDi sii a .GT !che lodu1oallER(ucps)0.NOT !NDi opie=poize he lodu1oallER(ucuER(my,ldl5,ldu5,iopifUSjac_re3odallIIIII:e ENDi LSEiii=pENDa,__pDi noopie,'tricc 20_pp_v iletii error_ala,_________'Pleas ucIii!NDi opie-0,-h_!u1oerr_allER,'restricRmi &mmm - -&m -----####------1oallER(ucps)0Nps.LT !che lodu1oallER(ucccccmy,ldl5,ldu5,iopifUSjac_re3odallIIIII:e ENDi LSEiii=pENDa,__U !0,-1p,'tricc 20_pp_v iletii error_ala,_________'Npsmustebeu>=0u1oerr_allER,'restricRmi &mmm - -&m -----####------1oallER(ucps)0hotI.LT !1he lodu1oallE 0#te-ccmy,ldl5,ldu5,iopifUSjac_re3odallIIIII:e ENDi LSEiii=pENDa,__U !0,-1p,'tricc 20_pp_v iletii error_ala,_________'hotImustebeu>0u1oerr_allER,'restricRmi &mmm - -&m -----####------=ia_fv, iERNELii=poiLOOKUP_TABLEO=po,0#R(ucps)0k cs.LT !c--_MK-e lodu1oallER(ucuc_dmy,ldl5,ldu5,iopifUSjac_re3odallIIIII:e ENDi LSEiii=pENDa,__U !0,-1p,'tricc 20_pp_v iletii error_ala,_________'k cs(dxt=ENDinv)smustebeu>=0u1oerr_allER,'restricRmi &mmm - -&m -----####------i=th_INGLe2DI------NGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m _h TICLE-_h TICLE/pg_smACNIONS-usEND pymmetryNGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 999ps)0lpymmhe lodu1oallER(ucps)0hotI.EQ. d lodu1oallER(ucuc_dDO ip=1,Nperror_f=iiiiiiii summs= ---_MKe0,-M NjPL0XF90 !CDIR NODEP i=th_INGLe2DIiiiiiiiiiiu DO j Ce=1,nvlise(ip)error_f=iiiiiiiiiiiiiiijps= vlise(j Ce,Rp)error_f=iiiiiiiiiiiiiiiCOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0error_f=iiiiiiiiiiiiiiiCII:alculatlse,fosquU Leense,fodih_a=ceobetweep_ fretwo -'uc_d--ccc 'ummmmmmiiCIIp0,-1p =s. Itiwiii alwaysebeu.LE !(cutoff+skin)**2rbys -'uc_d--ccc 'ummmmmmiiCIIconstruche diense,foV ilettlise..1.1 2------------iiiiCOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0error_f=iiiiiiiiiiiiiiidx c= xp(1,Rp) - xp(1,jp)error_f=iiiiiiiiiiiiiiidy c= xp(2,Rp) - xp(2,jp)error_f=iiiiiiiiiiiiiiips)0NDi sim .GT !2he lodu1oallER(ucccccccccciiiiiiidz c= xp(3,Rp) - xp(3,jp)error_f=iiiiiiiiiiiiiiiiiiidiji=#(dx*dx)s+e(dy*dy)s+e(dz*dzhe_f=iiiiiiiiiiiiiiiiiiiELSE !cccccccte---cccccciiiiiiidz = ---_MKe ----- _diiiiiiiiiiiiiiiiidiji=#(dx*dx)s+e(dy*dy)e_f=iiiiiiiiiiiiiiiiiiiE-----1oallER(ucuc_ (uuuuuuuCOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0error_f=iiiiiiiiiiiiiiiCIIP. -1p = ipropierachs with jps shoviceoad_fth=po,0#,-1R(uuuuuuuuuuuCOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0e=includD "NDi c 20_pp_kernels.inc"error_f=iiiiiiiiiiiiiiidmiiiiiiii= rta*(pNDi (1,jp) - pNDi (1,Rp))e_f=iiiiiiiiiiiiiiiiiiisummsiiiii= summsiiiii+idmerror_f=iiiiiiiiiiiiiiidpd(1,jp) =idpd(1,jp) -idmerror_f=iiiiiiiiiiiE--DO -'uc_d--ccc 'umiiidpd(1,ip) =idpd(1,ip) + summ _f=iiiiiiiiiiiE--DO -'uc_d--ccELSEps)0hotI.EQ. 2he lodu1oallER(ucccccDO ip=1,Nperror_f=iiiiiiii summs= ---_MKerror_f=iiiiiiii summ2s= ---_MKe0,-M NjPL0XF90 !CDIR NODEP i=th_INGLe2DIiiiiiiiiiiu DO j Ce=1,nvlise(ip)error_f=iiiiiiiiiiiiiiijps= vlise(j Ce,Rp)error_f=iiiiiiiiiiiiiiiCOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0error_f=iiiiiiiiiiiiiiiCII:alculatlse,fosquU Leense,fodih_a=ceobetweep_ fretwo -'uc_d--ccc 'ummmmmmiiCIIp0,-1p =s. Itiwiii alwaysebeu.LE !(cutoff+skin)**2rbys -'uc_d--ccc 'ummmmmmiiCIIconstruche diense,foV ilettlise..1.1 2------------iiiiCOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0error_f=iiiiiiiiiiiiiiidx c= xp(1,Rp) - xp(1,jp)error_f=iiiiiiiiiiiiiiidy c= xp(2,Rp) - xp(2,jp)error_f=iiiiiiiiiiiiiiips)0NDi sim .GT !2he lodu1oallER(ucccccccccciiiiiiidz c= xp(3,Rp) - xp(3,jp)error_f=iiiiiiiiiiiiiiiiiiidiji=#(dx*dx)s+e(dy*dy)s+e(dz*dzhe_f=iiiiiiiiiiiiiiiiiiiELSE !cccccccte---cccccciiiiiiidz = ---_MKe ----- _diiiiiiiiiiiiiiiiidiji=#(dx*dx)s+e(dy*dy)e_f=iiiiiiiiiiiiiiiiiiiE-----1oallER(ucuc_ (uuuuuuuCOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0error_f=iiiiiiiiiiiiiiiCIIP. -1p = ipropierachs with jps shoviceoad_fth=po,0#,-1R(uuuuuuuuuuuCOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0e=includD "NDi c 20_pp_kernels.inc"error_f=iiiiiiiiiiiiiiidmiiiiiiii= rta*(pNDi (1,jp) - pNDi (1,Rp))e_f=iiiiiiiiiiiiiiiiiiisummsiiiii= summsiiiii+idmerror_f=iiiiiiiiiiiiiiidpd(1,jp) =idpd(1,jp) -idmerror_f=iiiiiiiiiiiiiiidmiiiiiiii= rta*(pNDi (2,jp) - pNDi (2,Rp))e_f=iiiiiiiiiiiiiiiiiiisumm2iiiii= summ2iiiii+idmerror_f=iiiiiiiiiiiiiiidpd(2,jp) =idpd(2,jp) -idmerror_f=iiiiiiiiiiiE--DO -'uc_d--ccc 'umiiidpd(1,ip) =idpd(1,ip) + summ _f=iiiiiiiiiiiiiiidpd(2,ip) =idpd(2,ip) + summ2olveromR(ucuc_iE--DO -'uc_d--ccELSEu1oallER(ucccccDO ip=1,Nperror_f=iiiiiiii DO j Ce=1,nvlise(ip)error_f=iiiiiiiiiiiiiiijps= vlise(j Ce,Rp)error_f=iiiiiiiiiiiiiiiCOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0error_f=iiiiiiiiiiiiiiiCII:alculatlse,fosquU Leense,fodih_a=ceobetweep_ fretwo -'uc_d--ccc 'ummmmmmiiCIIp0,-1p =s. Itiwiii alwaysebeu.LE !(cutoff+skin)**2rbys -'uc_d--ccc 'ummmmmmiiCIIconstruche diense,foV ilettlise..1.1 2------------iiiiCOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0error_f=iiiiiiiiiiiiiiidx c= xp(1,Rp) - xp(1,jp)error_f=iiiiiiiiiiiiiiidy c= xp(2,Rp) - xp(2,jp)error_f=iiiiiiiiiiiiiiips)0NDi sim .GT !2he lodu1oallER(ucccccccccciiiiiiidz c= xp(3,Rp) - xp(3,jp)error_f=iiiiiiiiiiiiiiiiiiidiji=#(dx*dx)s+e(dy*dy)s+e(dz*dzhe_f=iiiiiiiiiiiiiiiiiiiELSE !cccccccte---cccccciiiiiiidz = ---_MKe ----- _diiiiiiiiiiiiiiiiidiji=#(dx*dx)s+e(dy*dy)e_f=iiiiiiiiiiiiiiiiiiiE-----1oallER(ucuc_ (uuuuuuuCOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0error_f=iiiiiiiiiiiiiiiCIIP. -1p = ipropierachs with jps shoviceoad_fth=po,0#,-1R(uuuuuuuuuuuCOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0e=includD "NDi c 20_pp_kernels.inc"error_f=iiiiiiiiiiiiiiiDO ippec=1,hoth=po,0#,-1R(uuuuuuuuuuuu iidmiii= rta*(pNDi (ippec,jp) - pNDi (ippec,ip))e_f=iiiiiiiiiiiiiiiiiiiu iidpd(ippec,ip) =idpd(ippec,ip) +idmerror_f=iiiiiiiiiiiiiiiu iidpd(ippec,jp) =idpd(ippec,jp) -idmerror_f=iiiiiiiiiiiiiiiE--DO -'uc_d--ccc 'umiiiE--DO -'uc_d--ccc 'uE--DO -'uc_d--ccE-----NGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m _h TICLE-_h TICLE/pg_smACNIONS-no pusEND pymmetryNGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 999ELSE !cccccccteps)0hotI.EQ. d lodu1oallER(ucuc_dDO ip=1,Npe0,-M NjPL0XF90 !CDIR NODEP i=th_INGLe2DIiiiiiiiiiiu DO j Ce=1,nvlise(ip)error_f=iiiiiiiiiiiiiiijps= vlise(j Ce,Rp)error_f=iiiiiiiiiiiiiiiCOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0error_f=iiiiiiiiiiiiiiiCII:alculatlse,fosquU Leense,fodih_a=ceobetweep_ fretwo -'uc_d--ccc 'ummmmmmiiCIIp0,-1p =s. Itiwiii alwaysebeu.LE !(cutoff+skin)**2rbys -'uc_d--ccc 'ummmmmmiiCIIconstruche diense,foV ilettlise..1.1 2------------iiiiCOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0error_f=iiiiiiiiiiiiiiidx c= xp(1,Rp) - xp(1,jp)error_f=iiiiiiiiiiiiiiidy c= xp(2,Rp) - xp(2,jp)error_f=iiiiiiiiiiiiiiips)0NDi sim .GT !2he lodu1oallER(ucccccccccciiiiiiidz c= xp(3,Rp) - xp(3,jp)error_f=iiiiiiiiiiiiiiiiiiidiji=#(dx*dx)s+e(dy*dy)s+e(dz*dzhe_f=iiiiiiiiiiiiiiiiiiiELSE !cccccccte---cccccciiiiiiidz = ---_MKe ----- _diiiiiiiiiiiiiiiiidiji=#(dx*dx)s+e(dy*dy)e_f=iiiiiiiiiiiiiiiiiiiE-----1oallER(ucuc_ (uuuuuuuCOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0error_f=iiiiiiiiiiiiiiiCIIP. -1p = ipropierachs with jph=po,0#,-1R(uuuuuuuuuuuCOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0e=includD "NDi c 20_pp_kernels.inc"error_f=iiiiiiiiiiiiiiidmi= rta*(pNDi (1,jp) - pNDi (1,Rp))e_f=iiiiiiiiiiiiiiiiiiidpd(1,ip) =idpd(1,ip) + dmerror_f=iiiiiiiiiiiE--DO -'uc_d--ccc 'uE--DO -'uc_d--ccELSEps)0hotI.EQ. 2he lodu1oallER(ucccccDO ip=1,Npe0,-M NjPL0XF90 !CDIR NODEP i=th_INGLe2DIiiiiiiiiiiu DO j Ce=1,nvlise(ip)error_f=iiiiiiiiiiiiiiijps= vlise(j Ce,Rp)error_f=iiiiiiiiiiiiiiiCOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0error_f=iiiiiiiiiiiiiiiCII:alculatlse,fosquU Leense,fodih_a=ceobetweep_ fretwo -'uc_d--ccc 'ummmmmmiiCIIp0,-1p =s. Itiwiii alwaysebeu.LE !(cutoff+skin)**2rbys -'uc_d--ccc 'ummmmmmiiCIIconstruche diense,foV ilettlise..1.1 2------------iiiiCOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0error_f=iiiiiiiiiiiiiiidx c= xp(1,Rp) - xp(1,jp)error_f=iiiiiiiiiiiiiiidy c= xp(2,Rp) - xp(2,jp)error_f=iiiiiiiiiiiiiiips)0NDi sim .GT !2he lodu1oallER(ucccccccccciiiiiiidz c= xp(3,Rp) - xp(3,jp)error_f=iiiiiiiiiiiiiiiiiiidiji=#(dx*dx)s+e(dy*dy)s+e(dz*dzhe_f=iiiiiiiiiiiiiiiiiiiELSE !cccccccte---cccccciiiiiiidz = ---_MKe ----- _diiiiiiiiiiiiiiiiidiji=#(dx*dx)s+e(dy*dy)e_f=iiiiiiiiiiiiiiiiiiiE-----1oallER(ucuc_ (uuuuuuuCOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0error_f=iiiiiiiiiiiiiiiCIIP. -1p = ipropierachs with jph=pallER(ucuc_ (uuuuuuuCOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0e=includD "NDi c 20_pp_kernels.inc"error_f=iiiiiiiiiiiiiiidmi= rta*(pNDi (1,jp) - pNDi (1,Rp))e_f=iiiiiiiiiiiiiiiiiiidpd(1,ip) =idpd(1,ip) + dmerror_f=iiiiiiiiiiiiiiidmi= rta*(pNDi (2,jp) - pNDi (2,Rp))e_f=iiiiiiiiiiiiiiiiiiidpd(2,ip) =idpd(2,ip) + dmerror_f=iiiiiiiiiiiE--DO -'uc_d--ccc 'uE--DO -'uc_d--ccELSEu1oallER(ucccccDO ip=1,Nperror_f=iiiiiiii DO j Ce=1,nvlise(ip)error_f=iiiiiiiiiiiiiiijps= vlise(j Ce,Rp)error_f=iiiiiiiiiiiiiiiCOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0error_f=iiiiiiiiiiiiiiiCII:alculatlse,fosquU Leense,fodih_a=ceobetweep_ fretwo -'uc_d--ccc 'ummmmmmiiCIIp0,-1p =s. Itiwiii alwaysebeu.LE !(cutoff+skin)**2rbys -'uc_d--ccc 'ummmmmmiiCIIconstruche diense,foV ilettlise..1.1 2------------iiiiCOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0error_f=iiiiiiiiiiiiiiidx c= xp(1,Rp) - xp(1,jp)error_f=iiiiiiiiiiiiiiidy c= xp(2,Rp) - xp(2,jp)error_f=iiiiiiiiiiiiiiips)0NDi sim .GT !2he lodu1oallER(ucccccccccciiiiiiidz c= xp(3,Rp) - xp(3,jp)error_f=iiiiiiiiiiiiiiiiiiidiji=#(dx*dx)s+e(dy*dy)s+e(dz*dzhe_f=iiiiiiiiiiiiiiiiiiiELSE !ccclER(ucccccccccciiiiiiidz = ---_MKe ----- _diiiiiiiiiiiiiiiiidiji=#(dx*dx)s+e(dy*dy)e_f=iiiiiiiiiiiiiiiiiiiE-----1oallER(ucuc_ (uuuuuuuCOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0error_f=iiiiiiiiiiiiiiiCIIP. -1p = ipropierachs with jph=pallER(ucuc_ (uuuuuuuCOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0e=includD "NDi c 20_pp_kernels.inc"error_f=iiiiiiiiiiiiiiiDO ippec=1,hoth=po,0#,-1R(uuuuuuuuuuuu iidmi= rta*(pNDi (ippec,jp) - pNDi (ippec,ip))e_f=iiiiiiiiiiiiiiiiiiiu iidpd(ippec,ip) =idpd(ippec,ip) +idmerror_f=iiiiiiiiiiiiiiiE--DO -'uc_d--ccc 'umiiiE--DO -'uc_d--ccc 'uE--DO -'uc_d--ccE-----_d--ccE-----NGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i!X-_ids, 0,-h_ids,ndturnrr=po,0#r=po,0,-1p =!oG -&m2: NTINUE0------te ENSjac_re=ENDi c 20_pp_v iletiiiphimirne------RETURN =ia_fv, iERNELii=poipg_smNALO=ia_fv, i!X-_ids, 0,-h_ids,ndturnrr=po,0#---/ac_re3g_restricc 20_pp_v ilet_sisi=pia_mooth_ICOMPLEX,ii ad_fINTEGEr=po,0#---/ac_re3g_restricc 20_pp_v ilet_disi=pia_mooth_ICOMPL0,-h_ids,ndturnr_: d=ia_r=po,0#---/ac_re3g_restricc 20_pp_v ilet_scisi=pia_mooth_ICOMPLEX,ii ad_fINTEGE_: d=ia_r=po,0#---/ac_re3g_restricc 20_pp_v ilet_dcisi=th_INNi=pia_mooERNELii=poiUSER_FUNCNIONO=ia_fv, i!X-_ids, 0,-h_ids,ndturnrr=po,0#---/ac_re3g_restricc 20_pp_v ilet_susi=pia_mooth_ICOMPLEX,ii ad_fINTEGEr=po,0#---/ac_re3g_restricc 20_pp_v ilet_dusi=pia_mooth_ICOMPL0,-h_ids,ndturnr_: d=ia_r=po,0#---/ac_re3g_restricc 20_pp_v ilet_scusi=pia_mooth_ICOMPLEX,ii ad_fINTEGE_: d=ia_r=po,0#---/ac_re3g_restricc 20_pp_v ilet_dcusi=th_INNi=pia_mooERNELii=poiLOOKUP_TABLEO=ia_fv, i!X-_ids, 0,-h_ids,ndturnrr=po,0#---/ac_re3g_restricc 20_pp_v ilet_stsi=pia_mooth_ICOMPLEX,ii ad_fINTEGEr=po,0#---/ac_re3g_restricc 20_pp_v ilet_dtsi=pia_mooth_ICOMPL0,-h_ids,ndturnr_: d=ia_r=po,0#---/ac_re3g_restricc 20_pp_v ilet_sctsi=pia_mooth_ICOMPLEX,ii ad_fINTEGE_: d=ia_r=po,0#---/ac_re3g_restricc 20_pp_v ilet_dct i=oth_-i=th_INlibtrinumerics-r1036/src/tricc 20_pp_ring.f0000644000175000017500000005240511616214650017634 0upoi= omaromarGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m Subi=poi=i= : tricc 20_pp_rENDNGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999mCopyr=poi (c) 2010 CSE Lab (ETH Zurich), MOSAIC Gi=pp (ETH Zurich), ----------------------------C (ETHiS FOFluid Dynamics (DTUnel is spel is spel is sp T_isdfi = ossp. -cense,foP. IiinooP. -1p = Mesh Library (PPM).el is spel is sp PPM ossfh mtsoftware: youmPartredih_ribute!itif!0/ FOmoth_y-----'u_!itiPPM FOc_Oieermscense,foGNU Less FOGene Ii Public Lic (se OGICAL !tasppublished byse,foFh mtSoftware FoPPMthe d, eiublicOGICAL !tad_fd_f!3cense,foLic (se, FO(=!dyour ophe d)undcMlatlicOGICAL !tad_fd_f.el is spel is sp PPM ossdih_ributer op_ frehopeelateritiwiii be useful,el is sp but WITHe3g ANY WARRANTY;iwithout evep_ freimplier wU rantycenel is sp MERCHANTABILITY FOFITNESS FOR Ap_h TICULAR PURPOSE !SeeouldOTO 9999mGNU Gene Ii Public Lic (se f FOmore details.el is spel is sp Youmshould NU Gereral Puba copycense,foGNU Gene Ii Public Lic (seOGICAL !tashould GNU Less FOGene Ii Public Lic (se aloNDrwith PPM. Ifrno ,el is sp seeo.el is spel is sp P. IiinooP. -1p = Mesh Library (PPM)el is sp ETH Zurich----9999mCH-8092 Zurich, Switz ilaM,-os0,-1pecified (- (0,-1p =he losunfo(ik=' ,-1p =!o -&m ------O=ia_fv, iERNELii=poipg_smNALO=ia_fv, i!X-_ids, 0,-h_ids,ndturnrr=po,0#ac_re3g_restricc 20_pp_rEND_si(xp,Np,pNDi ,th_Ilpymm(kernel,kp. , error_ala,_dpd,R,'resi=pia_mooth_ICOMPLEX,ii ad_fINTEGEr=po,0#ac_re3g_restricc 20_pp_rEND_di(xp,Np,pNDi ,th_Ilpymm(kernel,kp. , error_ala,_dpd,R,'resi=pia_mooth_ICOMPL0,-h_ids,ndturnr_: d=ia_r=po,0#ac_re3g_restricc 20_pp_rEND_sci(xp,Np,pNDi ,th_Ilpymm(kernel,kp. , error_ala,_dpd,R,'resi=pia_mooth_ICOMPLEX,ii ad_fINTEGE_: d=ia_r=po,0#ac_re3g_restricc 20_pp_rEND_dci(xp,Np,pNDi ,th_Ilpymm(kernel,kp. , error_ala,_dpd,R,'resi=oth_-i=pia_mooERNELii=poiUSER_FUNCNIONO=ia_fv, i!X-_ids, 0,-h_ids,ndturnrr=po,0#ac_re3g_restricc 20_pp_rEND_su(xp,Np,pNDi ,th_Ilpymm(kernel,kp. , error_ala,_dpd,R,'resi=pia_mooth_ICOMPLEX,ii ad_fINTEGEr=po,0#ac_re3g_restricc 20_pp_rEND_du(xp,Np,pNDi ,th_Ilpymm(kernel,kp. , error_ala,_dpd,R,'resi=pia_mooth_ICOMPL0,-h_ids,ndturnr_: d=ia_r=po,0#ac_re3g_restricc 20_pp_rEND_scu(xp,Np,pNDi ,th_Ilpymm(kernel,kp. , error_ala,_dpd,R,'resi=pia_mooth_ICOMPLEX,ii ad_fINTEGE_: d=ia_r=po,0#ac_re3g_restricc 20_pp_rEND_dcu(xp,Np,pNDi ,th_Ilpymm(kernel,kp. , error_ala,_dpd,R,'resi=oth_-i=pia_mooERNELii=poiLOOKUP_TABLEO=ia_fv, i!X-_ids, 0,-h_ids,ndturnrr=po,0#ac_re3g_restricc 20_pp_rEND_st(xp,Np,pNDi ,th_Ilpymm(kernel,kp. , error_ala,_dpd,R,'resi=pia_mooth_ICOMPLEX,ii ad_fINTEGEr=po,0#ac_re3g_restricc 20_pp_rEND_dt(xp,Np,pNDi ,th_Ilpymm(kernel,kp. , error_ala,_dpd,R,'resi=pia_mooth_ICOMPL0,-h_ids,ndturnr_: d=ia_r=po,0#ac_re3g_restricc 20_pp_rEND_sct(xp,Np,pNDi ,th_Ilpymm(kernel,kp. , error_ala,_dpd,R,'resi=pia_mooth_ICOMPLEX,ii ad_fINTEGE_: d=ia_r=po,0#ac_re3g_restricc 20_pp_rEND_dct(xp,Np,pNDi ,th_Ilpymm(kernel,kp. , error_ala,_dpd,R,'resi=oth_-i=th_INGLe2DIC!!-Subi=poi=i=which c 20utes kernel opierache ds byNGLe2DIC!!-dire! globIi (N**2)-p. -1p =-p. -1p =NGLe2DIC!!-opierache dsiusENDruld rENDruopology.NGLe2DIC!!NGLe2DIC!!-[NOTE]NGLe2DIC!!-dpdpneeds=torbemaiiipcteditor rop FOid_grbef A -'uc_d_!!icIiiEND c_isdi=poi=i. Also,=c_isdi=poi=i=i=rnot -'uc_d_!!iresett NDrdpdptorz iorbef A udoEND frePPiopierache ds. -'uc_d_!!iT_isd0,-iwsdc n_ribute dsifrom-diffei at kernels=torbe -'uc_d_!!iaccumulatld. Ifrneeded,-setrititorz iorbef A ucIiiEND c_is -'uc_d_!!ir=poi=ise,f-0,-h_stime.NGLe2DICecified (- (0,-1p =he losunfo(ik=' ,-1p =!o -&m ------GLe2DIC--Modu =s-----'u_indturn,__LIN :: ::!coiiii CI=p == mmmmmjag(m#r=po,0#r=po,0,-1p = -oGOTO 999USEimindtodu =_NDi LI!mmmmUSEimindtodu =_ii=poi=iLI!mmmmUSEimindtodu =_ii=pore3odule_USEimindtodu =_fUSjac_re3odUSEimindtodu =_aiiipc_re3odUSEimindtodu =_mae3odule_USEimindtodu =_c 20_pp_dorENDNGLe2DIUSEimindtodu =_mae ciLI!mmmmId=iICIT NONEO=ia_fv, i!X-_ids, 0,-h_ids,ndturnr |_mooth_ICOMPL0,-h_ids,ndturnr_: d=ia_r=po,0#pg_sGER,p_h AME_sm :: MKdl5,ldukind_sENDlesi=pia_mooth_ICOMPLEX,ii ad_fINTEGE |_mooth_ICOMPLEX,ii ad_fINTEGE_: d=ia_r=po,0#pg_sGER,p_h AME_sm :: MKdl5,ldukind_double-i=th_INGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m IncludDi4 18:34: 0,-1p =! References :ii ad_f!0,-1p =! Revish ls : CI!c !oGO=includD "NDi siNi=i.h"NGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MK!0,-1p =! Revish ls : CI!c !oGOTO 9999m Af!0,-1psNGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MK!0,-1p =! Revish ls : CI!c !oGOTO 999p_h iMK-e , DIMENTEGE(:,:),#pg_sNT(Id---) :: xperror_fC!!-p. -1p =dposite dsO=ia_fv, i!X-_ids, 0,-h_ids,ndturnr |_mooth_ICOMPLEX,ii ad_fINTEGEr=po,0#p_h iMK-e , DIMENTEGE(:,:),#pg_sNT(Id---) :: pNDi LI!mmmm:!!-p. -1p =ddiphi(e.g. strengths).NGLe2DIC!!-Ov iloadeditypes: sENDle,double-=po,0#p_h iMK-e , DIMENTEGE(:,:),#pg_sNT( e3g) :: dpdNGLe2DIC!!-Changeiof p0,-1p =ddiphi(pNDi ) due toropierachd_f.el is sp!!-Ov iloadeditypes: sENDle,double.-i=pia_mooth_ICOMPL0,-h_ids,ndturnr_: d=ia_ |_mooth_ICOMPLEX,ii ad_fINTEGE_: d=ia_r=po,0#: d=ia_iMK-, DIMENTEGE(:,:),#pg_sNT(Id---) :: pNDi LI!mmmm:!!-p. -1p =ddiphi(e.g. strengths).NGLe2DIC!!-Ov iloadeditypes: sENDle c 20lex,double c 20lex.-=po,0#: d=ia_iMK-, DIMENTEGE(:,:),#pg_sNT( e3g) :: dpdNGLe2DIC!!-Changeiof p0,-1p =ddiphi(pNDi ) due toropierachd_f.el is sp!!-Ov iloadeditypes: sENDle c 20lex,double c 20lex.-i=th_INGLe2DILOGICAL ,#pg_sNT(Id---) :: lpymm-----'u_!!-Wheublicto-us 5pymmetry FOnot:h=po,0#_!!h=po,0#_!!-* `.FALSE.` ePPiopierache d w/o pymmetryNGLe2DIC!!-* `.TRUE.` ePPiopierache d w/ pymmetryNGLe2DIpg_sGER ,#pg_sNT(Id---) :: Nperror_fC!!-b isof p0,-1p =s _fIlmii=pproc.r=po,0#pg_sGER ,#pg_sNT(Id---) :: hoth=po,0#_!!-leaMENDidimenad_f!of pNDi .O=ia_fv, iERNELii=poipg_smNALO=po,0#pg_sGER ,#pg_sNT(Id---) :: kernelh=po,0#_!!-kernel f FOwhich torcom0ute! frec rre! d_f. To-us 5,ld-opiernalh=po,0#_!!-kernels, specifytonerof:h=po,0#_!!h=po,0#_!!-: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999!-----NDi cccckerel_laplace2d_2pOTO 9999!----- (2shoorM isLaplacian,OTO 9999!----- polynom=poiop_2Dgnu.org/9!-----NDi cccckerel_laplace3d_2pOTO 9999!----- (2shoorM isLaplacian,OTO 9999!----- polynom=poiop_3Dgnu.org/9!--: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999!-NGLe2DIC!!-To-us 5your own-kernel funche d, pass! frefunche dipoioier ld L. Your-----'u_!!-funche dishould take one=U !0,-1pe shoretur. one=vpoue.O=ia_fv, i!X-_ids, 0,-h_ids,ndturnr |_mooth_ICOMPLEX,ii ad_fINTEGEr=po,0#p_h iMK-e , DIMENTEGE(:) ,#pg_sNT(Id---) :: k c-----'u_!!-Kernel ccceiers !Seeodoc0,-1pctd_fIishpricc 20_pp_kernels.inc f FNGLe2DIC!!-descrip d_f. TypeePartbeusENDle ishc 20lex.-i=pia_mooth_ICOMPL0,-h_ids,ndturnr_: d=ia_ |_mooth_ICOMPLEX,ii ad_fINTEGE_: d=ia_r=po,0#: d=ia_iMK-, DIMENTEGE(:) ,#pg_sNT(Id---) :: k c-----'u_!!-Kernel ccceiers !Seeodoc0,-1pctd_fIishpricc 20_pp_kernels.inc f FNGLe2DIC!!-descrip d_f. TypeePartbeusENDle c 20lexIishdouble c 20lex.-i=th_INi=pia_mooERNELii=poiLOOKUP_TABLEO=po,0#p_h iMK-e ,#pg_sNT(Id---) :: k c-----'u_!!-Kernel ccceiers !Seeodoc0,-1pctd_fIishpricc 20_pp_kernels.inc f FNGLe2DIC!!-descrip d_f. Pass!dxt=ENDinv ( freinad_fecense,fo-=END spacing) asNGLe2DIC!!-a sii=ar ld L.O=ia_fv, i!X-_ids, 0,-h_ids,ndturnr |_mooth_ICOMPLEX,ii ad_fINTEGEr=po,0#p_h iMK-e , DIMENTEGE(:--),#pg_sNT(Id---) :: kernelhi=pia_mooth_ICOMPL0,-h_ids,ndturnr_: d=ia_ |_mooth_ICOMPLEX,ii ad_fINTEGE_: d=ia_r=po,0#: d=ia_iMK-, DIMENTEGE(:--),#pg_sNT(Id---) :: kernelhi=th_INGLe2DIC!!-Lookupo-=END with -=Eulatld-kernel vpoue=.NGLe2DIC!! Such ao-=END Partbeucreater usEND <>.-i=th_INGLe2DIpg_sGER ,#pg_sNT( e3g) :: :: 0------p!!-Retur.s p =tus, 0 up disuccessNGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m Lmii=poi=i=ENDiNGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 999pg_sGER :: ,jOTO 999pg_sGER :: hops,isource,itargetOTO 999pg_sGER :: ll,lu,rl,ruOTO 999pg_sGER :: L Ce,RoptOTO 999pg_sGER , DIMENTEGE(2) :: ldur=po,0#p_h iMK-e , DIMENTEGE(:,:),#POpg_sm :: xp2O=ia_fv, i!X-_ids, 0,-h_ids,ndturnr |_mooth_ICOMPLEX,ii ad_fINTEGEr=po,0#p_h iMK-e , DIMENTEGE(:,:),#POpg_sm :: pNDi 2,dpd2-i=pia_mooth_ICOMPL0,-h_ids,ndturnr_: d=ia_ |_mooth_ICOMPLEX,ii ad_fINTEGE_: d=ia_r=po,0#: d=ia_iMK-, DIMENTEGE(:,:),#POpg_sm :: pNDi 2,dpd2-i=th_INGLe2DIp_h iMK-e :: t0-------COMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m Exiernali4 18:34: 0,-1p =! References :ii ad_f!0,-1p =! Revish ls : CI!c !oGO=ia_fv, iERNELii=poiUSER_FUNCNIONO=ia_fv, i!X-_ids, 0,-h_ids,ndturnr |_mooth_ICOMPLEX,ii ad_fINTEGEr=po,0#p_h iMK-e , DIMENTEGE(:) ,#pg_sNT(Id---) :: k c-----'upg_smFACE !cccccccteFUNCNION-kernel(x,kp. ).1.1 2---cccccId=iICIT NONEO=ia_fv, i!X-_ids, 0,-h_ids,ndturnr |_mooth_ICOMPL0,-h_ids,ndturnr_: d=ia_r=po,0#---cccccIg_sGER,p_h AME_sm :: MKdl5oth_(1.0E0esi=pia_mooth_ICOMPLEX,ii ad_fINTEGE |_mooth_ICOMPLEX,ii ad_fINTEGE_: d=ia_r=po,0#---cccccIg_sGER,p_h AME_sm :: MKdl5oth_(1.0D0esi=th_INGLe2DIIIIIIIIIp_h iMK-,#pg_sNT(Id) :: xNGLe2DIIIIIIIIIp_h iMK-,#DIMENTEGE(:),#pg_sNT(Id) :: k c-----'uIIIIIIIIp_h iMK- :: kernelh=po,0#####---/FUNCNION-kernel 0#####---/pg_smFACE i=pia_mooth_ICOMPL0,-h_ids,ndturnr_: d=ia_ |_mooth_ICOMPLEX,ii ad_fINTEGE_: d=ia_r=po,0#: d=ia_iMK-, DIMENTEGE(:) ,#pg_sNT(Id---) :: k c-----'upg_smFACE !cccccccteFUNCNION-kernel(x,kp. ).1.1 2---cccccId=iICIT NONEO=ia_fv, i!X-_ids, 0,-h_ids,ndturnr |_mooth_ICOMPL0,-h_ids,ndturnr_: d=ia_r=po,0#---cccccIg_sGER,p_h AME_sm :: MKdl5oth_(1.0E0esi=pia_mooth_ICOMPLEX,ii ad_fINTEGE |_mooth_ICOMPLEX,ii ad_fINTEGE_: d=ia_r=po,0#---cccccIg_sGER,p_h AME_sm :: MKdl5oth_(1.0D0esi=th_INGLe2DIIIIIIIIIp_h iMK-,#pg_sNT(Id) :: xNGLe2DIIIIIIIII: d=ia_iMK-, DIMENTEGE(:),#pg_sNT(Id) :: k c-----'uIIIIIIII: d=ia_iMK- :: kernelh=po,0#####---/FUNCNION-kernel 0#####---/pg_smFACE i=oth_-i=th_INNGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m Inie=poism4 18:34:OMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 999:e ENSjac_i=i('tricc 20_pp_rENDiiiphimirneNGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m m! R=U !0,-1p=.NGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 999ps)0NDi sii a .GT !che lodu1oallER(ucps)0.NOT !NDi opie=poize he lodu1oallER(ucuER(my,ldl5,ldu5,iopifUSjac_re3odallIIIII:e ENDi LSEiii=pENDa,__pDi noopie,'tricc 20_pp_rENDii error_ala,_________'Pleas ucIii!NDi opie-0,-h_!u1oerr_allER,'restricRmi &mmm - -&m -----####------1oallER(ucps)0Nps.LT !che lodu1oallER(ucccccmy,ldl5,ldu5,iopifUSjac_re3odallIIIII:e ENDi LSEiii=pENDa,__U !0,-1p,'tricc 20_pp_rENDii error_ala,_________'Npsmustebeu>=0u1oerr_allER,'restricRmi &mmm - -&m -----####------1oallER(ucps)0hotI.LT !1he lodu1oallE 0#te-ccmy,ldl5,ldu5,iopifUSjac_re3odallIIIII:e ENDi LSEiii=pENDa,__U !0,-1p,'tricc 20_pp_rENDii error_ala,_________'hotImustebeu>0u1oerr_allER,'restricRmi &mmm - -&m -----####------=ia_fv, iERNELii=poiLOOKUP_TABLEO=po,0#R(ucps)0k cs.LT !c--_MK-e lodu1oallER(ucuc_dmy,ldl5,ldu5,iopifUSjac_re3odallIIIII:e ENDi LSEiii=pENDa,__U !0,-1p,'tricc 20_pp_rENDii error_ala,_________'k cs(dxt=ENDinv)smustebeu>=0u1oerr_allER,'restricRmi &mmm - -&m -----####------i=th_INGLe2DI------NGLe2DICOMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m Aiiipcte memory f FO frec pycense,folmii=pp0,-1p =sO=po,0#COMPLEX,ii ad_fINTEGER, PARAMETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 999Roptdl5,ldu ccccaiiip_fitOTO 999ldu(1)dl5,ldudimOTO 999ldu(2)dl5Nperror_f:e ENDi Laiiip(xp2u cc,###---/pg_alricc 20_pp_rEGE |_mooth_ICOMPLEUEGE_: d=ia_illip_fidmy,ldl5,ldu5,iopifUSjac_re3odallIIIII:e ENDi LSEiii=pENDa,__f g_smFACE i=op_rENDii error_ala,____mook cs(dxt=ENDinv)smust stebeu>=0u1oerr_al'R, PARi ad_fINxp XP2----####------i=th_INGLe2DI--NGLe2DICOMPLEX 0#te-ccmy,l ENDi Laiia_fv, iER##---/pg_alricc 20_pp_rEGE |_moot OMPLEUEGE_: d=ia_illip_fidmy,ldl5,ldu5,iopifUSjac_re3odallIIIII:e ENDi LSEiii=pENDa,__f g_smFACE i=op_rENDii error_ala,____mook cs(dxt=ENDinv)smust stebeu>=0u1oerr_al'R, PARi ad_fIN PDATA2----####------i=th_INGLe2DI--NGLe2DICOMPLEX 0#te-ccmy,l_pp_rEGE |_moot OMPLEUEGE_: d=ia_illip_fidmy,ldl5,ldu5,iopifUSjac_re3odallIIIII:e ENDi LSEiii=pENDa,__f g_smFACE i=op_rENDii error_ala,____mook cs(dxt=ENDinv)smust stebeu>=0u1oerr_al'R, PARi ad_fINs. -DPD2----####------i=th_INGLe2DI--NGLe2DICOMPLEX 0#te- MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m Aiiipcte memory f FO frec pycense,folmii=ppMfv, CAL !tasho R, PARAMETER1:: fINTEGpg_s add_moot#r=poNGLe2DICOM g ANY TEGymi r:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 999ELSE !cccccccteps)0hotI.EQ. d lodu1oallER pg_alricc 20h_I(1:iip(xp2,1:NiiiE-p) -:iip(xp2,1:Niiricc 20 -:'res1:NiiiE-) =idpd:'res1:Niiricc 20 -:'res1:NiiiE-ta*(p:'res1:Niir MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m m! R=U !0,-1p=.NGLe2DICOMPLEX,ii ad_fINTEGE_ fretwo -'uIC!!NGLe2DIC!fINTEGER, PARAMETER1::ch ao-=hemselve:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 999ps)0NDi sii a .GT !che lodu1oallER(ucps)0.Np_rENDii iLI!mmmmId=iICr_aldpd,R,i=whNp,h_IC , 'restebeu>=0u1oeri=oth_-i=th_INGLe21E_: d=ia_illip_fidmy,ldl5,ldu5,iopifUSjac_re3odallIIIII:e ENDi LSEiii=pENDa,__U !0,-1p,'tricc p_rENDii error_ala,__ICO_f iledk cs(dxt=ENDinv)smust stebeu>=0u1oerr_al'I c_ fretw f iled.----####------i=th_INGLe2DI--NGLe2DICOMPLEX 0#te- iiiiiiiu MPI MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m m! R=U !0,-1p=.NGLe2DICOMPLEX,ii ad_fINTEGE=po,0#_whomrnalseoNDrwitL !tah_idwhornalic (seODrwitL !tamula MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 999Roptdl5,ldu ccccaiiip_fitOTO 999ldu(1)dl5,l EiiMODor_aln_sNT+r_alrank-1,r_aln_sNT=th_INGL EiiMODor_alrank+1,r_aln_sNT=t MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m m! R=U !0,-1p=.NGLe2DICOMPLEX,ii ad_fINTEGE=po,0#_how!fIten weblic LnalshiftICAL !tashould lise),#2sh: pmore details neighbpoio_sNT_re freinad_fp kind_double0#r=po,0,-1p =!oGOTO 9999m m! R=U !0,-1p=.NGLe2DICOMPLEX,ii ad_fINlodu1oallER(ucuc_dDO ip=1,NperMODor_aln_sNT,-/pNjPL0ac_re3odallIIIII:e END E---r_aln_sNT/2)-1COMPLEX,ii a----- _diiiiiiiiii E---or_aln_sNT+1)/2)-1COMPLEX,ii aGER, PARAMET----- _diiiiii E--r_aln_sNT-1COMPLEX 0#te- MKi=CIi= rE--1, -- _diiiii!TODO: cR, PAuld _ids, 0,-quantity A uc y-- _diiiiip_rENDii ds, 0,-h, erhiftth_ICiip(xp2, --i=th_INGLe2Dp_rENDii ds, 0,-h,pusht OMa, --i=th_INGLe2Dp_rENDii ds, 0,-h,pusht OMa, --i=tth_INGLe2Dp_rENDii ds, 0,-h,seoN( --i=tth_INGLe2Dp_rENDii ds, 0,-h,popt OMa, --i=th_INGLe2Dp_rENDii ds, 0,-h,popt OMa, --i=th_INGLe2Dp_rENDii ds, 0,-h,popth_ICiip(xp2, --i=tth_INGLe2Dp_rENDii iLI!mmmmId=iICr_aldpd,R,i=whNp,h_IC , stebeu>=0u1oerr_a'resi=oth_-i=th_INGLe20 --i=th_INGLe2Dp_fidmy,ldl5,ldu5,iopifUSjac_re3odallIIIII:e ENDNDi LSEiii=pENDa,__U !0,-1p,'tricc 20p_rENDii error_ala,__ICO_f iledk cs(dxt=ENDinv)smust stebeu>=0u1oerr_alal'I c_ fretw f iled.----####------i=th_INGLe2DI----NGLe2DICOMPLEX,iiEGER, PARAMETERDO: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m Inie=poism4 18:34:OMPLEX,ii ad_fINTEGER, PARf weblic LLSE.` ePPw, i!lyblic LLeoNDrwitlise),#2shhalhould roLic>.el is sp so weblic LnalcR, PAuld ca=ar ldanANTABI_sGER sNT_re f: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 999pg_sGER :: ,jOodu1oall .AND.erMODor_aln_sNT,-/pNjPL0ac3odallIIIII:e END!TODO: cR, PAuld _ids, 0,-quantity A uc y-- _diiiiiip_rENDii ds, 0,-h, erhiftth_ICiip(xp2, --i=th_INGLe2DDp_rENDii ds, 0,-h,pusht OMa, --i=th_INGLe2DDp_rENDii ds, 0,-h,pusht OMa, --i=tth_INGLe2DDp_rENDii ds, 0,-h,seoN( --i=tth_INGLe2DDp_rENDii ds, 0,-h,popt OMa, --i=th_INGLe2DDp_rENDii ds, 0,-h,popt OMa, --i=th_INGLe2DDp_rENDii ds, 0,-h,popth_ICiip(xp2, --i=tth_INGLe2DI=p kind_double0#r=po,0,-1p =!oGOTO 999pg_sGER th_INGLe2DI= TwitlsNT_re fch ao-=he highecrip drankdire! glo=he upi=i.halhoofth_INGLe2DI= rwitlise),#2shloNDrwitopr |_mitlsNT_re fcTEGER,w=i.halhth_INGLe2DI=p kind_double0#r=po,0,-1p =!oGOTO 999pg_sGER th_INGLe2DIOT !NDi rankdoize c_re3odallIIIII:e END =5,iop/(3,R+ 1dallIIIII:e END upg_alricc 2000000000r =51dallIIIII:e ENDrupg_L0,-h_ids,nddddda----- _diiiiiiiiiil =51dallIIIII:e END upg_alricc 2000000000r =51dallIIIII:e ENDrupg_L0,-hp/(3COMPLEX,ii aGER, th_INGLe2DDp_rENDii iLI!mmmmId=iICr_a(:,ll:lu)C (:,ll:lu)Cta*(:,ll:lu)Cebeu>=0u1oerr_allER,allIIIII:e END u-ll+1,h_I(:,rl:ru)C I(:,rl:ru)Ceu>=0ubeu>=0u1oerr_allER,allIIIII:e END :,rl:ru)Cru-rl+1,'resi=oth_-i=th_INGLe2Dubeu>=0u1oerr_allER,allIIIII:e END0 --i=th_INGLe2DDp_fidmy,ldl5,ldu5,iopifUSjac_re3odallIIIII:e ENDNDDi LSEiii=pENDa,__U !0,-1p,'tricc 20_p_rENDii error_ala,__ICO_f iledk cs(dxt=ENDinv)smust stebeu>=0u1oerr_alall'I c_ fretw f iled.----####------i=th_INGLe2DI--tI.LT !1he lodu1oallE 0#te-ccmy,l 0#te- MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m Aiiipcte memory f FO frec pycense,folmii=ppSeoNDrwitlise),#2shwmoot TEGymbewww.gto MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m Aiiipcte memory f FO frec pycense,folmiilodu1oallER(ucuc_dDO ip=1,l EiiMODor_alrank+-r_aln_sNT/2),r_aln_sNT=th_INGLp=1,l EiiMODor_aln_sNT+r_alrank--r_aln_sNT/2),r_aln_sNT=th_INGL 0#te- MKi=CIp_fid Edl5,ldu5,rank3odallIIIII:e END!TODO: cR, PAuld _ids, 0,-quantity A uc y-- _diiiiiip_rENDii ds, 0,-h, erhiftth_ICiip(xp2, --i=th_INGLe2DDp_rENDii ds, 0,-h,pusht OMa, --i=th_INGLe2DDp_rENDii ds, 0,-h,pusht OMa, --i=tth_INGLe2DDp_rENDii ds, 0,-h,seoN( --i=tth_INGLe2DDp_rENDii ds, 0,-h,popt OMa, --i=th_INGLe2DDp_rENDii ds, 0,-h,popt OMa, --i=th_INGLe2DDp_rENDii ds, 0,-h,popth_ICiip(xp2, --i=tth_INGLe2DIp_fiL0,-hpdl5,lNiiidallIIIII:e ENDNDDi LSEiii=pENDa,__U !0,-1p,'tricc 20_p_rENDii error_ala,__0,-h,los'k cs(dxt=ENDinv)smust stebeu>=0u1oerr_alall'Nots lise),#2shcame back-----####------1oallER(ucps)0NpI.LT !1he lodu1oallE 0#te-ccmy,l 0#te-ETER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m Inie=poism4 18:34:OMPLEX,ii ad_fINTEGER, PAAdNDrwitlise),#2 cRchd_C!fINTEGER, PARloNDrwitwww.gtric ledAL !t MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m Aiiipcte memory f FO frec pycense,folmiilodu1-M NjPL0XF90 !CDIR NODEP i= rE--1,alricc 20000000ta*(pNDi= rta*(pNDccc ' -NDcCOMPLEX,iiEGEEX,ii ad_p=1,Npe0,-M NjPL0XF90 !CDIR NODEP i= rE--1,alricc 20000000ta*(pNDi= rta*(pNDccc ' -NDcCOMPLEX,ii iiiiE--DO-'uc_d--cccccc ' 2NDcCOMPLEX,iiEGEEX,ii ad_p=1,DIR NODEP i= rE--1,alricc 20000000ijpsE--1,i (ippec,jp) - pNDi_d--jDO-'uc_d--jccccc ' jNDcCOMPLEX,ii iiMPLEX,ii ad_fINEGEEX,ii ad_p0#te- Mpp_v iletiiiph MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m Inie=poism4 18:34:OMPLEX,ii ad_fINTEGER, PADea,-1p =sO=po,0#CfINL !i:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 999Roptdl5,ldu ccccaiiip_fitOTO 999ldu(1)dl5,ldudimOTO 999ldu(dendtodu =_c 2_pp_rEGE |_moot OMPLEUEGE_: d=ia_illip_fidmy,ldl5,lac_re3odallIIIII:ei LSEiii=pENDa,__U !0,-1p,'tricc p_rENDii error_ala,__dendtodk cs(dxt=ENDinv)smust stebeu>=0u1oerr_al'R, PARi ad_fINs. -DPD2----####------i=th_INGL 0#te-ccmy,l_pp_rEGE |_moot OMPLEUEGE_: d=ia_illip_fidmy,ldl5,lac_re3odallIIIII:ei LSEiii=pENDa,__U !0,-1p,'tricc p_rENDii error_ala,__dendtodk cs(dxt=ENDinv)smust stebeu>=0u1oerr_al'R, PARi ad_fIN PDATA2----####------i=th_INGL 0#te-ccmy,l_pp_rEGE |_mooth_ICOMPLEUEGE_: d=ia_illip_fidmy,ldl5,lac_re3odallIIIII:ei LSEiii=pENDa,__U !0,-1p,'tricc p_rENDii error_ala,__dendtodk cs(dxt=ENDinv)smust stebeu>=0u1oerr_al'R, PARi ad_fINxp XP2----####------i=th_INGLTER1:: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i!X-_ids, 0,-h_ids,ndturnrr=po,0#r=po,0,-1p =!oG -&m2: NTINUE0------te ENSjac_re=ENDi c 20_ricc p_rEN-RETURN =ia_fv, iERNER, PARAMETER1::_ricc i!X-_ids, 0,-h_ids,ndturnrr=po,0#---/ac_re3g_restricc 20_pp_v ilet_sisi=pia_mooth_ICOMPLEX,ii ad_fINTEG erro--/ac_re3g_restricc 20_pp_v ilet_dtsi=pia_mooth_ICOMPL0,-h_ids,ndturn error=po,0#---/ac_re3g_restricc 20_pp_v ilet_sctsi=pia_mooth_ICOMPLEX,ii ad_fINTE errorr=po,0#---/ac_re3g_restricc 20_pp_v ilet_dct i=oth_-i=th_IN error=ia_fv, i!X-_ids, 0,-h_ids,ndturnrr=po,0#---/ac_re3g_restricc 20_pp_v ilet_susi=pia_mooth_ICOMPLEX,ii ad_fINTEG erro--/ac_re3g_restricc 20_pp_v ilet_dtsi=pia_mooth_ICOMPL0,-h_ids,ndturn err_r=po,0#---/ac_re3g_restricc 20_pp_v ilet_scusi=pia_mooth_ICOMPLEX,ii ad_fINTE errorr=po,0#---/ac_re3g_restricc 20_pp_v ilet_dct i=oth_-i=th_IN erro=ia_fv, i!X-_ids, 0,-h_ids,ndturnrr=po,0#---/ac_re3g_restricc 20_pp_v ilet_stsi=pia_mooth_ICOMPLEX,ii ad_fINTEG erro--/ac_re3g_restricc 20_pp_v ilet_dtsi=pia_mooth_ICOMPL0,-h_ids,ndturn err_r=po,0#---/ac_re3g_restricc 20_pp_v ilet_sctsi=pia_mooth_ICOMPLEX,ii ad_fINTE error=po,0#---/ac_re3g_restricc 20_pp_v ilet_dct i=oth_-i=th_IN erro i!X-_iode000064400017500001750000000524051161621214650017634 003240265upoi= omaromarMKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i!X- CI=poerr_alMPLEX,ii ad_fINTEG i!X-_iode MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i!v,lda,i!X-Purposeerr_alMPrnels i!X-_ -'ucainlo=he user-i -=END. one=vpsAp_h TICULARRRRRRRRRRRRRRRRRrwitode(ik='uIC!!grator.h TICULARRRRRRRRRRRRRRRRv,lda,i!X-_ikserr_alMv,lda,i!v,lda,i!X-Re Ifrnces_alMv,lda,i!v,lda,i!X-Revis=vpsA_alMv,lda,i!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i! $Log: i!X-_iode,v $v,lda,i!X-Revis=vp 1.1.1.1 2007/07/13 10:19:00:eivosv,lda,i!X-CBL d)undcMl.el is sPM l8092 Zv,lda,i!v,lda,i!X-Revis=vp 1.3 2004/07/26 13:41:34:eivosv,lda,i!X-RAMETERY FOee2DIC!!-d. Twip://rsO=pta- i!X-_sCOMPLEX,iuser-v,lda,i!X-i -=END. one=vps. O!lybtwip:/ i!X-_sCRANTY;iwgiTABIawaygto MKi=CI= LEX,iuserbrary (PPM)el is p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i! PeETH Zurich----9999mCH-8092 Zurich, Switz il-RAstit,0#_.elE=po,0amoot#r=Scirnce Switz il-aM,-o2DIrum, HirschengrabABI84v,lda,i!X-C- (0,-1p =he losunfo(ik=' ,-1p =!o -&m ------O=ia_fv, iERNELii=poipg_smNALO=ia_fv, i!X-_i MODULE i!X-_iode -1p,'tricc ,-1p =!o -&m ------O=ia_fv, iERNELii=poipg_smNALO=ia_fv, i-1p,'tricc sPM m CI=p == mmmmicc ,-1p =!o -&m ------O=ia_fv, iERNELii=poipg_smNALO=ia_fv, i-1p,'triccO=ia_fv, i!X-_iode |_mdone-1p,'triccO=ia_fv, i!X-_iode h_INGLiode MKi=CIiccO=ia_fv, i!X-_iode finifUSj MKi=CIiccO=ia_fv, i!X-_iode - MKi=CIiccO=ia_fv, i!X-_iode step MKi=CIiccO=ia_fv, i!X-_iode st,-h_ids,nddddt i=oth_-i=MODULE i!X-_iode gmm_3dpermutSEimiDinv4650017634 0021073upoi= omaromar i=othDATA Aind /1, 2, 9, 10, 7, 8, 11, 12, 17, 18, 33, 34, 19, 20, 35ust sebeu>=0u1oerr_alal36, 3, 4, 13, 14, 21, 22, 15us16, 23, 24, 37, 38, 29, 39ustebeu>=0u1oerr_allE40, 6, 25us32, 41, 42, 27, 30, 43, 44, 49us50, 57, 58, 512Dubeu>=0u1oerr_allE52, 59us60, 26, 45us46, 312D53, 54, 47, 48, 55us56, 612D62Cebeu>=0u1oerr_allE28, 63, 64, 5/ i!X-_ibem_quadrX-_ind taks00006440001750000175000004650017634 0051722745upoi= omaromarmmmicc ,-1p =!o -&m ------O=ia_fv, iERNELii=poipg_smNALO=ia_fv, i-_fv,lda,i!X- CI=poerr_alMPLEX,ii ad_ i!X-_ibem_quadrX-_ind taks MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i!v,lda,i!X-Purposeerr_alMPbem m CI=pv,lda,i!v,lda,i!X-Rekserr_alM v,lda,i!v,lda,i!X-Re Ifrnces_alM v,lda,i!v,lda,i!X-Revis=vpsA_alMv,lda,i!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i! $Log: i!X-_ibem_quadrX-_ind taks,v $v,lda,i!X-Revis=vp 1.1.1.1 2007/07/13 10:18:57:eivosv,lda,i!X-CBL d)undcMl.el is sPM l8092 Zv,lda,i!v,lda,i!X-Revis=vp 1.1 2004/07/26 07:29:25:eivosv,lda,i!X-Funfo(commcensfke ospiache drwitold/ i!X-_sCtako=pia_mo:h=po,face Switz il-u - ba copycense,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i! SAIC Gi=pp (ETH Zurich), ----------------------------C (ETHiS FOFluid Dynamics (DTUnel is spel is spel is sp T_isdfi = ossp. -cense,foP. IiinooP. -1p = Mesh Library (PPM).el is spel is sp PPM ossfh mtsoftware: youmPartredih_ribute!itif!0/ FOmoth_y-----'u_!itiPPM FOc_Oieermscense,foGNU Less FOGene Ii Public Lic (se OGICAL !tasppublished byse,foFh mtSoftware FoPPMthe d, eiublicOGICAL !tad_fd_f!3cense,foLic (se, FO(=!dyour ophe d)undcMlatlicOGICAL !tad_fd_f.el is spel is sp PPM ossdih_ributer op_ frehopeelateritiute!itif!0/ful,el is sp but WITHe3g ANY WARRANTY;iwithout evep_ freimplier wU rantycenel is sp MERCHANTABILITY FOFITNESS FOR Ap_h TICULAR PURPOSE !SeeouldOTO 9999mGNU Gene Ii Public Lic (se f FOmore details.el is spel is sp Youmshould NU Gereral Puba copycense,foGNU Gene Ii Public Lic (seOGICAL !tashould GNU Less FOGene Ii Public Lic (se aloNDrwith PPM. Ifrno ,el is sp seeo.el is spel is sp P. IiinooP. -1p = Mesh Library (PPM)el is sp ETH Zurich----9999mCH-8092 Zurich, Switz ilaM,-os0,-1pecia,i! S- (0,-1p =he losunfo(ik=' ,-1p =!o -&m ------O=ia_fv, iERNELii=poipg_smNALO=ia_fv, i!X-_i MODULE i!X-_ibem_quadrX-_ind taks _ids,nddd ,-1p =!o -&m ------O=ia_fv, iERNELii=poipg_smNALO=ia_fv, i!_ids,nddd PADefbef A=po,faceisdi=bem_get_quadrX-_id taks MKi=CIdd ,-1p =!o -&m ------O=ia_fv, iERNELii=poipg_smNALO=ia_fv, i!_ids,ndddd_fINTEGEi=bem_quadrX-_ind taks MKi=CI MODULE PROCEDUREi=bem_quadrX-_ind taks MKi=CI ii ad_fINTEGER_ids,nddd ,-1p =!o -&m ------O=ia_fv, iERNELii=poipg_smNALO=ia_fv, i!_ids,nddd P :ii -'uc s MKi=CIdd ,-1p =!o -&m ------O=ia_fv, iERNELii=poipg_smNALO=ia_fv, i!_ids,ndddiletAINS d_fINTEGER, PARbem_quadrX-_ind taks"R_ids,nd_-i=MODULE i!X-_ibem_quadrX-_ind taks i!X-_iode ds, 0ush000064400017500001750000000524054650017634 00553621173upoi= omaromar ,-1p =!o -&m ------O=ia_fv, iERNELii=poipg_smNALO=ia_fv, i!X-_s,nddd PA CI=poerr_alMPLEX,ii ad_f i!X-_iode ds, 0ush MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i!v,lda,i!X-Purposeerr_alMPlsNT_dur:/ i!X-_ld NUode ds, 0ush MKi=CI=v,lda,i!X-Rekserr_alM v,lda,i!v,lda,i!X-Re Ifrnces_alM v,lda,i!v,lda,i!X-Revis=vpsA_alMv,lda,i!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i! $Log: i!X-_iode ds, 0ush,v $v,lda,i!X-Revis=vp 1.1.1.1 2007/07/13 10:19:00:eivosv,lda,i!X-CBL d)undcMl.el is sPM l8092 Zv,lda,i!v,lda,i!X-Revis=vp 1.2 2004/07/26 12:00:24:eivosv,lda,i!X-Fix2sh: pmfv, io(compilebrary (PPM)el is s-Revis=vp 1.1 2004/07/26 07:45:49 = ohaebe Switz il-PsNT_dur:/ i!X-_sth_INGLe2 but WIc =ar ldatomizat frehopeelateritiutese,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i! SAIC Gi=pp (ETH Zurich), ----------------------------C (ETHiS FOFluid Dynamics (DTUnel is spel is spel is sp T_isdfi = ossp. -cense,foP. IiinooP. -1p = Mesh Library (PPM).el is spel is sp PPM ossfh mtsoftware: youmPartredih_ribute!itif!0/ FOmoth_y-----'u_!itiPPM FOc_Oieermscense,foGNU Less FOGene Ii Public Lic (se OGICAL !tasppublished byse,foFh mtSoftware FoPPMthe d, eiublicOGICAL !tad_fd_f!3cense,foLic (se, FO(=!dyour ophe d)undcMlatlicOGICAL !tad_fd_f.el is spel is sp PPM ossdih_ributer op_ frehopeelateritiute!itif!0/ful,el is sp but WITHe3g ANY WARRANTY;iwithout evep_ freimplier wU rantycenel is sp MERCHANTABILITY FOFITNESS FOR Ap_h TICULAR PURPOSE !SeeouldOTO 9999mGNU Gene Ii Public Lic (se f FOmore details.el is spel is sp Youmshould NU Gereral Puba copycense,foGNU Gene Ii Public Lic (seOGICAL !tashould GNU Less FOGene Ii Public Lic (se aloNDrwith PPM. Ifrno ,el is sp seeo.el is spel is sp P. IiinooP. -1p = Mesh Library (PPM)el is sp ETH Zurich----9999mCH-8092 Zurich, Switz ilaM,-os0,-1pecia,i! S- (0,-1p =he losunfo(ik=' ,-1p =!o -&m ------O=ia_fv, iERNELii=poipg_smNALO=ia_fv, i!X-_ v,lda,i!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i! Defbef INGLev,lda,i!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv#AMETERndturnr_: d=ia_r=po,1v#AMETERndtTEGE_: d=ia_r=po,2_i MODULE i!X-_iode ds, 0ush MKi=CIdd ,-1p =!o -&m ------O=ia_fv, iERNELii=poip_ids,nddd PAI=po,faces MKi=CIdd ,-1p =!o -&m ------O=ia_fv, iERNELii=poip MKi=CIddd_fINTEGEi=ode ds, 0ush MKi=CI MODULE PROCEDUREi=ode ds, 0ush_s MKi=CI MODULE PROCEDUREi=ode ds, 0ush_d MKi=CI ii ad_fINTEGER_ MKi=CIiletAINS #AMETERndt-/ac_cc 20_pp_v ilet_sts_fINTEGER, PARode ds, 0ush" #ublif_re3g_re #AMETERndt-/ac_cc 20_pp_v ilet_dts_fINTEGER, PARode ds, 0ush" #ublif_re3g_re t i=oth_-i=MODULE i!X-_iode ds, 0ush MKi=CI i!X-_id tssfre00006440001750000175000000052405116164650017634 0254520223upoi= omaromar,lda,i!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i! ds byNGLe2DalMPl i!X-_id tssfrse,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i! SAIC Gi=pp (ETH Zurich), ----------------------------C (ETHiS FOFlud Dynamics (DTUnel is spel is spel is sp T_isdfi = ossp. -cense,foP. Iiinoo Not -'uICWARbyNGLe2:d Dynamics AMETER1:::d Dynamics (DC!!-idd Dynamics (Dm9mCidd Dynamics (Dld tssfrse,foGNU,foGNfieldirse,foGNU,foGNfieldyNGse,foGNU,foGNg_fdccum one=vp: crom SS Fy, crom our-----'uIC!!g_!!-* build-irse,foGNU,foGNi LSE-ds,ndturAMETER1:d Dynamics (Dl Lec/ FOm, i!uldlagd Dynamics (D_INl/fs si_!!g_fdccum one=vp (el is al, i!lybis scrom SS Fy)d Dynamics (Dliciv (sv (el is al):sesne,curl,gradi__'kacian,O,E-dI=p tETH/FDd Dynamics (Dlossiblybtwipel is !-* de--h_ids,a,-1p =sOSS FyOGICAslabs/penci ad_f!0,-1P. -1p = MeeNfieldsds,ndtuOGImulat -'ucs byNGLe2Dlic Lbfdc ghoss s/extETpo PartFoPPMthe d, nec_re2 Zbrary (PPM)el is sAdNDfinifUSjRbyNGLe2P. -1p = Mesh byNGLe2D -'uc_d_!!icU Lesic_isdi=torb ceNTYc2DIrc_is).NGLe2DIC! Twip:/byNGLe2se Ii PubaNTY;iwrei =c_i-Dlot2DIiaNTyses/ j - P tssfrih_ributerequae=vpsAth_INi=poleOG: MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 999ps)0NDi sii a .GT !che lodu1oallER(uc#AMETERndturnr_: 0v#AMETERndtTEGE_:,1vv#AMETERndtTIM 3_i MODULE i!X-_id tssfrsi O=ia_fv, i!X-_iffndtodu =_fUSjac_re3odUSEiminmindtodu =_fUSjac_re3odUSEimindtodu =_aiiipc_re3odUSEiwriteodu =_aiiipc_re3odUSEipd,R,ONLY:du5,rankCiip(EGE |_moothCiip(EGE |LOOKUPCebeu>=0000000000000000000000&iip(t_C!!-,iip(t_equi_m9mCCebeu>=0000000000000000000000&iip(99ldu(2ssign_h=po,0#_,iip(99ldu(bcAME_l LecCebeu>=0000000000000000000000&iip(99ldu(bcAME_ FOm, i!uCebeu>=0000000000000000000000&iip(99ldu(dexy_slab,iip(99ldu(dezpenci : MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i!XitifP tssfriINGL MKi=CI=p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i!!!ex.-i=t'ucainhe drwitFFTW iann-h_idits erache ad_f!0,-TYPipc_red tssfr_iannbeu>=00000Ce,RoptOTO 999pg_sGER , DIMENTEGE(((((((((((((((((NDi iciv (sv beu>=00000Ce,RoptOTO 999pg_sGER , DIMENTEGE(((((((((((((((((NDica=a -1p,'tricc=ia_iiip(EGE |LOOKUPOMPLEX,ii ad_fINTEGER, PARAMET(((NDinormkx-1p,'tricc=ia_iiip(EGE |LOOKUPOMPLEX,ii ad_fINTEGER, PARAMET(((NDinormky-1p,'tricc=ia_iiip(EGE |LOOKUPOMPLEX,ii ad_fINTEGER, PARAMET(((NDinormkz MKi=CI 0Ce,RoptOTO 999pg_sGER , DIMENTEGE(((((((((((((((((NDiC!!-idxy-1p,'tricc!!!T!!-logy _isfINxyiC!!-logy MKi=CI 0Ce,RoptOTO 999pg_sGER , DIMENTEGE(((((((((((((((((NDim9mCidxy-1p,'tricc!!!m9mC _isis sxyim9mC-1p,'tricc=ia_iiip(EGE |LOOKUPOIIIIII: d=ia_iMKK-e (((((((NDicossxy=>NULL()-1p,'tricc!!!Eimicosssis sxyiC!!-logy MKi=CI 0Ce,RoptOth_INGLe2DIp_h iM-e ((((((((((((((((((((NDiiinminxy=>NULL()-1p,'tricc!!!EimiGE ex inminsis sxyiC!!-logy MKi=CI 0Ce,Roptth_INGLe2DIpdtTIMOMPLEX,ii ad_fINTEGER, PARAMENDinmxy-1p,'tricc!!!globalI_sGER gr_isd takssis sxyiC!!-logy MKi=CI 0Ce,RoptOth_INGLe2DIp_h iM-e ((((((((((((((((((((NDiic (axy=>NULL()-1p,'tricc!!!Eimino. gr_isceNTssis sxyiC!!-logy MKi=CI 0Ce,RoptOth_INGLe2DIp2OMPLEX,ii ad_fINTEGER, PARAMET((NDimaxic (axy MKi=CI 0Ce,RopttIIII: d=ia_iM-e ((((((((((((((((((((ET((NDiisiublitxy-1p,'tricc!!!blitGICAsimidinlo curr 0,-CPU -'uxyiC!!-logy MKi=CI 0Ce,RoptOTO 999pg_sGER , DIMENTEGE(((((((((((((((((NDinsiublitxy-1p,'tricc!!!_sGER simidinlois scrrr 0,-CPU -'uxyiC!!-logy MKi=CI 0=ia_iiip(EGE |LOOKUPOI_INGLe2DIp_h h h h iM-e ((NDifldxyr=>NULL()-1p,'tricc!!!s,a,AslabNfield (xyiC!!-logy=th_INGLe2Dp-kerneliip(EGE |LOOKUPOI_INGLe2DIp_h h h h iM-e NDifldxyc=>NULL()-1p,'tricc!!!ERNELii=slabNfield (xyiC!!-logy=t MKi=CI 0Ce,RoptOTO 999pg_sGER , DIMENTEGE(((((((((((((((((NDiC!!-idxyc-1p,'tricc!!!T!!-logy _isfINERNELii=xyiC!!-logy MKi=CI 0Ce,RoptOTO 999pg_sGER , DIMENTEGE(((((((((((((((((NDim9mCidxyc-1p,'tricc!!!m9mC _isis sERNELisxyim9mC-1p,'tricc=ia_iiip(EGE |LOOKUPOIIIIII: d=ia_iMKK-e (((((((NDicossxyc=>NULL()-1p,'tricc!!!Eimicosssis sxyiC!!-logy MKi=CI 0Ce,RoptOth_INGLe2DIp_h iM-e ((((((((((((((((((((NDiiinminxyc=>NULL()-1p,'tricc!!!EimiGE ex inminsis sERNELii=xyiC!!-logy MKi=CI 0Ce,Roptth_INGLe2DIpdtTIMOMPLEX,ii ad_fINTEGER, PARAMENDinmxyc-1p,'tricc!!!globalI_sGER gr_isd takssis sERNELii=xyiC!!-logy MKi=CI 0Ce,RoptOth_INGLe2DIp_h iM-e ((((((((((((((((((((NDiic (axyc=>NULL()-1p,'tricc!!!Eimino. gr_isceNTssis sERNELii=xyiC!!-logy MKi=CI 0Ce,RopttIIII: d=ia_iM-e ((((((((((((((((((((ET((NDiisiublitxyc-1p,'tricc!!!blitGICAsimidinlo curr 0,-CPU -'uERNELii=xyiC!!-logy MKi=CI 0Ce,RoptOTO 999pg_sGER , DIMENTEGE(((((((((((((((((NDinsiublitxyc-1p,'tricc!!!_sGER simidinlois scrrr 0,-CPU -'uERNELii=xyiC!!-logy MKi=CI 0TYPiiiip(ffn_iannOMPLEX,ii ad_fINTEGER, PARAMET((((((NDiiannfxy-1p,'tricc!!!ffniiannlois sr2cuERNELii=xyislab MKi=CI 0TYPiiiip(ffn_iannOMPLEX,ii ad_fINTEGER, PARAMET((((((NDiiannbxy-1p,'tricc!!!ffniiannlois sc2ruERNELii=xyislab MKi=CI 0TYPiiiip(ffn_iannOMPLEX,ii ad_fINTEGER, PARAMET((((((NDiiannfz-1p,'tricc!!!ffniiannlois sis warisc2cuz penci :MKi=CI 0TYPiiiip(ffn_iannOMPLEX,ii ad_fINTEGER, PARAMET((((((NDiiannbz-1p,'tricc!!!ffniiannlois sbackwarisc2cuz penci :MKi=CI 0Ce,RoptOTO 999pg_sGER , DIMENTEGE(((((((((((((((((NDiC!!-idz-1p,'tricc!!!T!!-logy _isfINziC!!-logy MKi=CI 0Ce,RoptOTO 999pg_sGER , DIMENTEGE(((((((((((((((((NDim9mCidz-1p,'tricc!!!m9mC _isis szim9mC-1p,'tricc=ia_iiip(EGE |LOOKUPOIIIIII: d=ia_iMKK-e (((((((NDicossz =>NULL()-1p,'tricc!!!Eimicosssis sziC!!-logy MKi=CI 0Ce,RoptOth_INGLe2DIp_h iM-e ((((((((((((((((((((NDiiinminz=>NULL()-1p,'tricc!!!EimiGE ex inminsis sziC!!-logy MKi=CI 0Ce,Roptth_INGLe2DIpdtTIMOMPLEX,ii ad_fINTEGER, PARAMENDinmz-1p,'tricc!!!globalI_sGER gr_isd takssis sziC!!-logy MKi=CI 0Ce,RoptOth_INGLe2DIp_h iM-e ((((((((((((((((((((NDiic (az=>NULL()-1p,'tricc!!!Eimino. gr_isceNTssis sziC!!-logy MKi=CI 0Ce,RoptOth_INGLe2DIp3OMPLEX,ii ad_fINTEGER, PARAMET((NDimaxic (az MKi=CI 0Ce,RopttIIII: d=ia_iM-e ((((((((((((((((((((ET((NDiisiublitz-1p,'tricc!!!blitGICAsimidinlo curr 0,-CPU -'uziC!!-logy MKi=CI 0Ce,RoptOTO 999pg_sGER , DIMENTEGE(((((((((((((((((NDinsiublitz-1p,'tricc!!!_sGER simidinlois scrrr 0,-CPU -'uziC!!-logy MKi=CI 0p-kerneliip(EGE |LOOKUPOI_INGLe2DIp_h h h h iM-e NDifldzc1=>NULL()-1p,'tricc!!!ERNELii=penci Nfield 1 (ziC!!-logy=th_INGLe2Dp-kerneliip(EGE |LOOKUPOI_INGLe2DIp_h h h h iM-e NDifldzc2=>NULL()-1p,'tricc!!!ERNELii=penci Nfield 2 (ziC!!-logy=t:MKi=CI 0Ce,RoptOTO 999pg_sGER , DIMENTEGE(((((((((((((((((NDiC!!-idfr-1p,'tricc!!!T!!-logy _isfIN FOm, i!ulC!!-logy MKi=CI 0Ce,RoptOTO 999pg_sGER , DIMENTEGE(((((((((((((((((NDim9mCidfr-1p,'tricc!!!m9mC _isis s FOm, i!ulm9mC-1p,'tricc=ia_iiip(EGE |LOOKUPOIIIIII: d=ia_iMKK-e (((((((NDicossfr=>NULL()-1p,'tricc!!!Eimicoss MKi=CI 0Ce,RoptOth_INGLe2DIp_h iM-e ((((((((((((((((((((NDiiinminfr=>NULL()-1p,'tricc!!!EimiGE ex inmin MKi=CI 0Ce,Roptth_INGLe2DIpdtTIMOMPLEX,ii ad_fINTEGER, PARAMENDinmfr-1p,'tricc!!!globalI_sGER gr_isd taks MKi=CI 0Ce,RoptOth_INGLe2DIp_h iM-e ((((((((((((((((((((NDiic (afr=>NULL()-1p,'tricc!!!Eimino. gr_isceNTs MKi=CI 0Ce,RopttIIII: d=ia_iM-e ((((((((((((((((((((ET((NDiisiublitfr-1p,'tricc!!!blitGICAsimidinlo curr 0,-CPU -'u FOm, i!ulC!!-logy MKi=CI 0Ce,RoptOTO 999pg_sGER , DIMENTEGE(((((((((((((((((NDinsiublitfr-1p,'tricc!!!_sGER simidinlois scrrr 0,-CPU -'u FOm, i!ulC!!-logy -1p,'tricc!Twip:/field nse,i!lyba,-1p =sd d, nec_re2 Z:-1p,'tricc=ia_iiip(EGE |LOOKUPOI_INGLe2DIp_h h h iM-e ((((NDifldfrs=>NULL()-1p,'tricc!!!dummyOSS FyCOMPLEX,i Gi=pphh_idside,sis s FOm , i!uC scalarNfields MKi=CI 0=ia_iiip(EGE |LOOKUPOI_INGLe2DIp_h h h h iM-e ((NDifldfrv=>NULL()-1p,'tricc!!!dummyOSS FyCOMPLEX,i Gi=pphh_idside,sis s FOm , i!uC vectorNfields MKi=CI 0=ia_iiip(EGE |LOOKUPOI_INGLe2DIp_h h h iM-e ((((NDifldgrnr=>NULL()-1p,'tricc!!!s,a,AG_fdccumield, z-penci aC scalarth_INGLe2Dp-kerneliip(EGE |LOOKUPOI_INGLe2DIp_h h h iM-e (NDifldgrnc=>NULL()-1p,'tricc!!!ERNELii=G_fdccumield, z-penci aC scalarth_INGLe2D=ia_iiip(EGE |LOOKUPOI_INGLe2DIp_h h h h iM-e ((NDidrv_vr=>NULL()-1p,'tricc!!!dummyOSS FyCOMPLEX,i Gi=pphh_idside,sis s FOm , i!uC vectorNfields -1p,'tricc!Dp-kerneliip(EGE |LOOKUPOI_INGLe2DIp_h h h h iM-e NDifldgrnc3=>NULL()-1p,'tricc!c!!!ERNELii=G_fdccu3uERNEon 0,-vectorNfielduIC!!E eisis sI=p tETH-1p,'tricc!c!!! iciv (sv , z-penci aC scalarth_INGL_-i=TYPipc_red tssfr_iannbth_INGLCe,RopttIIIIIIIIp__________________________::pc_red tssfr_drv_esne____=0th_INGLCe,RopttIIIIIIIIp__________________________::pc_red tssfr_drv_curl_sp =1th_INGLCe,RopttIIIIIIIIp__________________________::pc_red tssfr_drv_grad_sp =2th_INGLCe,RopttIIIIIIIIp__________________________::pc_red tssfr_drv_acia_sp =3th_INGLCe,RopttIIIIIIIIp__________________________::pc_red tssfr_drv_div_sp =4th_INGLCe,RopttIIIIIIIIp__________________________::pc_red tssfr_drv_curl_fd2=11th_INGLCe,RopttIIIIIIIIp__________________________::pc_red tssfr_drv_grad_fd2=12th_INGLCe,RopttIIIIIIIIp__________________________::pc_red tssfr_drv_acia_fd2=13th_INGLCe,RopttIIIIIIIIp__________________________::pc_red tssfr_drv_div_fd2 =14th_INGLCe,RopttIIIIIIIIp__________________________::pc_red tssfr_drv_curl_fd4=21th_INGLCe,RopttIIIIIIIIp__________________________::pc_red tssfr_drv_grad_fd4=22th_INGLCe,RopttIIIIIIIIp__________________________::pc_red tssfr_drv_acia_fd4=23th_INGLCe,RopttIIIIIIIIp__________________________::pc_red tssfr_drv_div_fd4 =24bth_INGLCe,RopttIIIIIIIIp__________________________::pc_red tssfr_grned ts_l =1th_INGLCe,RopttIIIIIIIIp__________________________::pc_red tssfr_grned ts_ FO =2th_INGLCe,RopttIIIIIIIIp__________________________::pc_red tssfr_grnereprojec =3tth_INGLCe,RNTEGEi=d tssfr_ - MKi=CIiccMODULE PROCEDUREi=d tssfr_ - MKi=CIii ad_fINTEGER_ids,ndCe,RNTEGEi=d tssfr_poleO MKi=CIiccMODULE PROCEDUREi=d tssfr_poleO MKi=CIii ad_fINTEGER_ids,ndCe,RNTEGEi=d tssfr_fd MKi=CIiccMODULE PROCEDUREi=d tssfr_fd MKi=CIii ad_fINTEGER_ids,ndCe,RNTEGEi=d tssfr_extETpo Parghoss MKi=CIiccMODULE PROCEDUREi=d tssfr_extETpo Parghoss_vr MKi=CIii ad_fINTEGER_ids,ndiletAINS #AMETERndt-/ac_cc 20_ppvv#AMETERndtv il iip(EGE |LOOKUP MKi=CIic!!#AMETERndtCkerXDEF DCkerXv#AMETERndtTIM 3v#AMETERndtZEROSI (/0,0,0/)v#AMETERndtNp-k 3v#AMETERndtINd tssfr_ - _fINTEGER, tssfr/d tssfr_ - " #ublif_dtINv#AMETERndtINd tssfr_poleO _fINTEGER, tssfr/d tssfr_poleO" #ublif_dtINv#AMETERndtINd tssfr_fd _fINTEGER, tssfr/d tssfr_fd" #ublif_dtINv#AMETERndtINd tssfr_extETpo Parghoss_vr _fINTEGER, tssfr/d tssfr_extETpo Parghoss" #ublif_dtINv#ublif_dtZEROSIv#ublif_dtTIMv#ublif_dtNp-k v#ublif_dtg_re #AMETERndt-/ac_cc 20_pp v#ublif_dtg_re MKi=CIii aMODULE i!X-_id tssfrsi i!X-_igmm_cpte00006440001750000175000000052405116164650017634 00675320160upoi= omaromari=CIic!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i!X- CI=poerr_alMPLEX,ii ad_fINT i!X-_igmm_cpt i=CIic!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i!v,lda,i!X-Purposeerr_alMPrnels i!X-_ fINTEGEs -'uc uERdeCOMPLEX,iv,lda,i!X----------------cpt byNGLe2Dshould chhe dmethodbrary (PPM)el is s-Rekserr_alMv,lda,i!v,lda,i!X-Re Ifrnces_alMv,lda,i!v,lda,i!X-Revis=vpsA_alMv,lda,i!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i! $Log: i!X-_igmm_cpte,v $v,lda,i!X-Revis=vp 1.1.1.1 2007/07/13 10:18:58:eivosv,lda,i!X-CBL d)undcMl.el is sPM l8092 Zv,lda,i!v,lda,i!X-Revis=vp 1.2 2005/04/21 04:48:24:eivosv,lda,i!X-Cleaned A=po,faces-h_ids,moeOGIunnec_re2 Z oeOrloa eisd)undcMba copycense,foGNU -Revis=vp 1.1 2005/03/11 21:09:10:eivosv,lda,i!X-RAMETERY FOee2DIC!!-d. copycense,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i! SAIC Gi=pp (ETH Zurich), ----------------------------C (ETHiS FOFluid Dynamics (DTUnel is spel is spel is sp T_isdfi = ossp. -cense,foP. IiinooP. -1p = Mesh Library (PPM).el is spel is sp PPM ossfh mtsoftware: youmPartredih_ribute!itif!0/ FOmoth_y-----'u_!itiPPM FOc_Oieermscense,foGNU Less FOGene Ii Public Lic (se OGICAL !tasppublished byse,foFh mtSoftware FoPPMthe d, eiublicOGICAL !tad_fd_f!3cense,foLic (se, FO(=!dyour ophe d)undcMlatlicOGICAL !tad_fd_f.el is spel is sp PPM ossdih_ributer op_ frehopeelateritiute!itif!0/ful,el is sp but WITHe3g ANY WARRANTY;iwithout evep_ freimplier wU rantycenel is sp MERCHANTABILITY FOFITNESS FOR Ap_h TICULAR PURPOSE !SeeouldOTO 9999mGNU Gene Ii Public Lic (se f FOmore details.el is spel is sp Youmshould NU Gereral Puba copycense,foGNU Gene Ii Public Lic (seOGICAL !tashould GNU Less FOGene Ii Public Lic (se aloNDrwith PPM. Ifrno ,el is sp seeo.el is spel is sp P. IiinooP. -1p = Mesh Library (PPM)el is sp ETH Zurich----9999mCH-8092 Zurich, Switz ilaM,-os0,-1pecia,i! S- (0,-1p =he losunfo(ik=' ,-1p =!o -&m ------O=ia_fv, iERNELii=poipg_smNALO=ia_fv, i!X-_ v,lda,i!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i! Defbef INGLev,lda,i!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv#AMETERndturnr_: d=ia_r=po,,,,,,,,,1v#AMETERndtTEGE_: d=ia_r=po,,,,,,,,,2v#AMETERndt2D 3v#AMETERndt3D 4_i MODULE i!X-_igmm_cpt -1p,'tricc!ind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv1p,'tricc!PADefbef A=po,facesisdi=gmm_cpt i=CIicicc!ind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv1p,'triccCe,RNTEGEi=gmm_cpt i=CIicicc ccMODULE PROCEDUREi=gmm_cpt_2ds i=CIicicc ccMODULE PROCEDUREi=gmm_cpt_2dd i=CIicicc ccMODULE PROCEDUREi=gmm_cpt_3ds i=CIicicc ccMODULE PROCEDUREi=gmm_cpt_3dd i=CIiciccii ad_fINTEGER_ids,ndddc!ind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv1p,'tricc!PAi :ii -'uc _ids,ndddc!ind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv1p,'tricciletAINS d_AMETERndtTIM dt2D #AMETERndt-/ac_cc 20_pp_v ilet_sts_fINTEGER, PARgmm_cpte"v#ublif_dtg_re #AMETERndt-/ac_cc 20_pp_v ilet_sts_fINTEGER, PARgmm_cpte"v#ublif_dtg_re #ublif_dtTIMvd_AMETERndtTIM dt3D #AMETERndt-/ac_cc 20_pp_v ilet_sts_fINTEGER, PARgmm_cpte"v#ublif_dtg_re #AMETERndt-/ac_cc 20_pp_v ilet_sts_fINTEGER, PARgmm_cpte"v#ublif_dtg_re #ublif_dtTIMvdIiciccii aMODULE i!X-_igmm_cpt i!X-_ifmm_finifUSj000064400017500001750000000524054650017634 00615021161upoi= omaromar,ndddc!ind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_f-_fv,lda,i! CI=poerr_alalMPLEX,ii ad_f i!X-_ifmm_finifUSj i=CIic!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i!v,lda,i!XPurposeerr_allMPfast multipoledmethodDfinifUSjRm CI=pv,lda,i! v,lda,i!v,lda,i!XRekserr_allMv,lda,i!v,lda,i!XRe Ifrnces_allM v,lda,i!v,lda,i!XRevis=vpsA_allMv,lda,i!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i! $Log: i!X-_ifmm_finifUSj,v $v,lda,i!X-Revis=vp 1.1.1.1 2007/07/13 10:18:58:eivosv,lda,i!X-CBL d)undcMl.el is sPM l8092 Zv,lda,i!v,lda,i!X-Revis=vp 1.5 2006/06/29 10:28:37_fcANYelNGLe2DIC! sAdNeisd)ctorNl,eengths suppoin MKi=CI!v,lda,i!X-Revis=vp 1.3 2005/08/23 14:23:43(Dlolasekbv,lda,i!X-no/fuf IfrnceY;itwfdc _mooth/LOOKUP MKi=CI!v,lda,i!X-Revis=vp 1.2 2005/05/27 08:42:39(Dlolasekbv,lda,i!X-s,moeOGIdummyOSSds, 0,-h_idsiooth/LOOKUP-i copycense,foGNU -Revis=vp 1.1 2005/05/27 08:03:09(Dlolasekbv,lda,i!X-iAMETERY FOee2DIC!!-d copycense,foGNU -Revis=vp 0 2004/11/11 16:35:45(Dlolasekbv,lda,i!X-Snmin MKi=CIteritiutese,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i! SAIC Gi=pp (ETH Zurich), ----------------------------C (ETHiS FOFluid Dynamics (DTUnel is spel is spel is sp T_isdfi = ossp. -cense,foP. IiinooP. -1p = Mesh Library (PPM).el is spel is sp PPM ossfh mtsoftware: youmPartredih_ribute!itif!0/ FOmoth_y-----'u_!itiPPM FOc_Oieermscense,foGNU Less FOGene Ii Public Lic (se OGICAL !tasppublished byse,foFh mtSoftware FoPPMthe d, eiublicOGICAL !tad_fd_f!3cense,foLic (se, FO(=!dyour ophe d)undcMlatlicOGICAL !tad_fd_f.el is spel is sp PPM ossdih_ributer op_ frehopeelateritiute!itif!0/ful,el is sp but WITHe3g ANY WARRANTY;iwithout evep_ freimplier wU rantycenel is sp MERCHANTABILITY FOFITNESS FOR Ap_h TICULAR PURPOSE !SeeouldOTO 9999mGNU Gene Ii Public Lic (se f FOmore details.el is spel is sp Youmshould NU Gereral Puba copycense,foGNU Gene Ii Public Lic (seOGICAL !tashould GNU Less FOGene Ii Public Lic (se aloNDrwith PPM. Ifrno ,el is sp seeo.el is spel is sp P. IiinooP. -1p = Mesh Library (PPM)el is sp ETH Zurich----9999mCH-8092 Zurich, Switz ilaM,-os0,-1pecia,i! S- (0,-1p =he losunfo(ik=' ,-1p =!o -&m ------O=ia_fv, iERNELii=poipg_smNALO=ia_fv, i!X-_ v#AMETERndturnr_: d=ia_r=po,1v#AMETERndtTEGE_: d=ia_r=po,2_!#AMETERndtCe,RoptOTO 999pg_3_!#AMETERndtLOGICALOTO 999pg_4_!#AMETERndt2D 7_!#AMETERndt3D 8_!#AMETERndtSFIELD 9_!#AMETERndtVFIELD 10 MODULE i!X-_ifmm_finifUSj v,l ,-1p =!o -&m ------O=ia_fv, iERNELii=poipg_smNALO=ia_fv, i!X-fv,l!M CI=p == ,-1p =!o -&m ------O=ia_fv, iERNELii=poipg_smNALO=ia_fv, i!X-fX-fv,l! ,-1p =!o -&m ------O=ia_fv, iERNELii=poipg_smNALO=ia_fv, i!X-fX-fv,l! ,-1p =!o -&m ------O=ia_fv, iERNELii=poipg_smNALO=ia_fv, i!X-fX-fv,l! INCLUDE_re3 SOURCESv,l! ,-1p =!o -&m ------O=ia_fv, iERNELii=poipg_smNALO=ia_fv, i!X-fX-fv ddiletAINS d_fINTEGER, PARfmm_finifUSj" ii aMODULE i!X-_ifmm_finifUSj i!X-_iceNT000064400017500001750000000524054650017634 01025121152upoi= omaromar ,-1p =!o -&m ------O=ia_fv, iERNELii=poipg_smNALO=ia_fv, i!X-_ecia,i! - CI=poerr_alMPLEX,ii ad_fIN i!X-_iceNTse,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i! SAIC Gi=pp (ETH Zurich), ----------------------------C (ETHiS FOFluid Dynamics (DTUnel is spel is spel is sp T_isdfi = ossp. -cense,foP. IiinooP. -1p = Mesh Library (PPM).el is spel is sp PPM ossfh mtsoftware: youmPartredih_ribute!itif!0/ FOmoth_y-----'u_!itiPPM FOc_Oieermscense,foGNU Less FOGene Ii Public Lic (se OGICAL !tasppublished byse,foFh mtSoftware FoPPMthe d, eiublicOGICAL !tad_fd_f!3cense,foLic (se, FO(=!dyour ophe d)undcMlatlicOGICAL !tad_fd_f.el is spel is sp PPM ossdih_ributer op_ frehopeelateritiute!itif!0/ful,el is sp but WITHe3g ANY WARRANTY;iwithout evep_ freimplier wU rantycenel is sp MERCHANTABILITY FOFITNESS FOR Ap_h TICULAR PURPOSE !SeeouldOTO 9999mGNU Gene Ii Public Lic (se f FOmore details.el is spel is sp Youmshould NU Gereral Puba copycense,foGNU Gene Ii Public Lic (seOGICAL !tashould GNU Less FOGene Ii Public Lic (se aloNDrwith PPM. Ifrno ,el is sp seeo.el is spel is sp P. IiinooP. -1p = Mesh Library (PPM)el is sp ETH Zurich----9999mCH-8092 Zurich, Switz ilaM,-os0,-1pecia,i! S- (0,-1p =he losunfo(ik=' e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,v,lda,i!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i! Defbef INGLev,lda,i!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv#AMETERndturnr_: d=ia_r=po,,,,,,,,,1v#AMETERndtTEGE_: d=ia_r=po,,,,,,,,,2v#AMETERndturnr_: d=ia_r=po_p-kerne 3v#AMETERndtTEGE_: d=ia_r=po_p-kerne 4 v#AMETERndtd_fINNALOTO 999pg________5v#AMETERndtUSER_FUNCT=po,,,,,,,,,,,,6 #AMETERndtLOOKUP_E !LE 7_i MODULE i!X-_iceNTse,foGNU!!Prnels i!X-_ proviGEs -'ubyNGLe2seconcetuOGse,foGNU!!Pnu.orc=po,0he dketuOl A=po,ane=vpsAnu.o bua eraashopch----9ba copycea,i!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=iv1p,'tricc!PADefbef A=po,facesisdi -'uEeNTYblitGd)undcMb i=CIicicc!ind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv1p,'triccCe,RNTEGEi=ceNTse,foGN MODULE PROCEDUREi=ceNT_sise,foGN MODULE PROCEDUREi=ceNT_dise,foGN MODULE PROCEDUREi=ceNT_scise,foGN MODULE PROCEDUREi=ceNT_dcise,foGN MODULE PROCEDUREi=ceNT_suse,foGN MODULE PROCEDUREi=ceNT_duse,foGN MODULE PROCEDUREi=ceNT_scuse,foGN MODULE PROCEDUREi=ceNT_dcuse,foGN MODULE PROCEDUREi=ceNT_st i=CIicicc ccMODULE PROCEDUREi=ceNT_dt i=CIicicc ccMODULE PROCEDUREi=ceNT_sct i=CIicicc ccMODULE PROCEDUREi=ceNT_dct i=CIiciccii ad_fINTEGER_ids,ndddc!ind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv1p,'tricc!PAi :ii -'uc _ids,ndddc!ind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv1p,'tricciletAINS d_AMETERndtKINNELndtd_fINNAL #AMETERndt-/ac_cc 20_pp_v ilet_sts_fINTEGER, PARceNT"v#ublif_dtg_re #AMETERndt-/ac_cc 20_pp_v ilet_sts_fINTEGER, PARceNT"v#ublif_dtg_re #AMETERndt-/ac_ccurnr_: d=ia_r=po_p-kernes_fINTEGER, PARceNT"v#ublif_dtg_re #AMETERndt-/ac_cc 20_pp_v ilet_st_p-kernes_fINTEGER, PARceNT"v#ublif_dtg_re #ublif_dtgINNEL d_AMETERndtKINNELndtUSER_FUNCT=po #AMETERndt-/ac_cc 20_pp_v ilet_sts_fINTEGER, PARceNT"v#ublif_dtg_re #AMETERndt-/ac_cc 20_pp_v ilet_sts_fINTEGER, PARceNT"v#ublif_dtg_re #AMETERndt-/ac_ccurnr_: d=ia_r=po_p-kernes_fINTEGER, PARceNT"v#ublif_dtg_re #AMETERndt-/ac_cc 20_pp_v ilet_st_p-kernes_fINTEGER, PARceNT"v#ublif_dtg_re #ublif_dtgINNEL d_AMETERndtKINNELndtLOOKUP_E !LE #AMETERndt-/ac_cc 20_pp_v ilet_sts_fINTEGER, PARceNT"v#ublif_dtg_re #AMETERndt-/ac_cc 20_pp_v ilet_sts_fINTEGER, PARceNT"v#ublif_dtg_re #AMETERndt-/ac_ccurnr_: d=ia_r=po_p-kernes_fINTEGER, PARceNT"v#ublif_dtg_re #AMETERndt-/ac_cc 20_pp_v ilet_st_p-kernes_fINTEGER, PARceNT"v#ublif_dtg_re #ublif_dtgINNEL dIiciccii aMODULE i!X-_iceNTs i!X-_ifmm_trad)unj000064400017500001750000000524054650017634 00726321221upoi= omaromar,ndddc!ind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_f-_fv,lda,i! CI=poerr_alalMPLEX,ii ad_f i!X-_ifmm_trad)unj i=CIic!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i!v,lda,i!XPurposeerr_allMPPfast multipoledmethodD i!X-_, t_fd_trad)unhe dbyNGLe2P. -1p = v,lda,i!v,lda,i!XRekserr_allM v,lda,i!v,lda,i!XRe Ifrnces_allM v,lda,i!v,lda,i!XRevis=vpsA_allMv,lda,i!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i! $Log: i!X-_ifmm_trad)unj,v $v,lda,i!X-Revis=vp 1.1.1.1 2007/07/13 10:18:58:eivosv,lda,i!X-CBL d)undcMl.el is sPM l8092 Zv,lda,i!v,lda,i!X-Revis=vp 1.5 2006/06/29 10:28:38_fcANYelNGLe2DIC! sAdNeisd)ctorNl,eengths suppoin MKi=CI!v,lda,i!X-Revis=vp 1.4 2005/09/19 13:03:32(Dlolasekbv,lda,i!X-ERdeCcosmet MKi=CI!v,lda,i!X-Revis=vp 1.3 2005/08/04 16:01:59(Dlolasekbv,lda,i!X-nowds,a,-y checkhe dwhe(=!dysdiuseesioothldOTLOOKUP-preca copycense,foGNU -Revis=vp 1.2 2005/07/27 21:11:07(Dlolasekbv,lda,i!X-adaptc_isdinewucs byNGLe2Di copycense,foGNU -Revis=vp 1.1 2005/05/27 07:59:57(Dlolasekbv,lda,i!X-iAMETERY FOee2DIC!!-d copycense,foGNU -Revis=vp 0 2004/12/02 15:38:33Dlolasekbv,lda,i!X-Snmin MKi=CItp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i! SAIC Gi=pp (ETH Zurich), ----------------------------C (ETHiS FOFluid Dynamics (DTUnel is spel is spel is sp T_isdfi = ossp. -cense,foP. IiinooP. -1p = Mesh Library (PPM).el is spel is sp PPM ossfh mtsoftware: youmPartredih_ribute!itif!0/ FOmoth_y-----'u_!itiPPM FOc_Oieermscense,foGNU Less FOGene Ii Public Lic (se OGICAL !tasppublished byse,foFh mtSoftware FoPPMthe d, eiublicOGICAL !tad_fd_f!3cense,foLic (se, FO(=!dyour ophe d)undcMlatlicOGICAL !tad_fd_f.el is spel is sp PPM ossdih_ributer op_ frehopeelateritiute!itif!0/ful,el is sp but WITHe3g ANY WARRANTY;iwithout evep_ freimplier wU rantycenel is sp MERCHANTABILITY FOFITNESS FOR Ap_h TICULAR PURPOSE !SeeouldOTO 9999mGNU Gene Ii Public Lic (se f FOmore details.el is spel is sp Youmshould NU Gereral Puba copycense,foGNU Gene Ii Public Lic (seOGICAL !tashould GNU Less FOGene Ii Public Lic (se aloNDrwith PPM. Ifrno ,el is sp seeo.el is spel is sp P. IiinooP. -1p = Mesh Library (PPM)el is sp ETH Zurich----9999mCH-8092 Zurich, Switz ilaM,-os0,-1pecia,i! S- (0,-1p =he losunfo(ik=' ,-1p =!o -&m ------O=ia_fv, iERNELii=poipg_smNALO=ia_fv, i!X-_ #AMETERndturnr_: d=ia_r=po,1v#AMETERndtTEGE_: d=ia_r=po,2_!#AMETERndtCe,RoptOTO 999pg_3_!#AMETERndtLOGICALOTO 999pg_4_!#AMETERndt2D 7_!#AMETERndt3D 8_#AMETERndtSFIELD 9_#AMETERndtVFIELD 10 MODULE i!X-_ifmm_trad)unj v,l! ,-1p =!o -&m ------O=ia_fv, iERNELii=poipg_smNALO=ia_fv, i!X-fX-fv,l! Defbef I=po,facev,l! ,-1p =!o -&m ------O=ia_fv, iERNELii=poipg_smNALO=ia_fv, i!X-fX-fv ddCe,RNTEGEi=fmm_trad)unj MODULE PROCEDUREi=fmm_trad)unj_s_sf MODULE PROCEDUREi=fmm_trad)unj_d_sf MODULE PROCEDUREi=fmm_trad)unj_s_vf MODULE PROCEDUREi=fmm_trad)unj_d_vfih_rii ad_fINTEGER_id! ,-1p =!o -&m ------O=ia_fv, iERNELii=poipg_smNALO=ia_fv, i!X-fX-fv,l! INCLUDE_re3 SOURCESv,l! ,-1p =!o -&m ------O=ia_fv, iERNELii=poipg_smNALO=ia_fv, i!X-fX-fv iletAINS d_AMETERndtK/ac_cc 20_pp_v ilet_sts_AMETERndtTIM dtSFIELDd_fINTEGER, PARfmm_trad)unj"v#ublif_dtg_re #AMETERndt-/ac_cc 20_pp_v ilet_sts_fINTEGER, PARfmm_trad)unj"v#ublif_dtg_re #ublif_dtTIMvd_AMETERndtK/ac_cc 20_pp_v ilet_sts_AMETERndtTIM dtVFIELDd_fINTEGER, PARfmm_trad)unj"v#ublif_dtg_re #AMETERndt-/ac_cc 20_pp_v ilet_sts_fINTEGER, PARfmm_trad)unj"v#ublif_dtg_re #ublif_dtTIMvd ii aMODULE i!X-_ifmm_trad)unj s i!X-_idorioo00006440001750000175000000052404650017634 01035121516upoi= omaromar ,-1p =!o -&m ------O=ia_fv, iERNELii=poipg_smNALO=ia_fv, i!X-_ecia,i! - CI=poerr_alMPLEX,ii ad_fI i!X-_idorioo MKi=CItp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i! SAIC Gi=pp (ETH Zurich), ----------------------------C (ETHiS FOFluid Dynamics (DTUnel is spel is spel is sp T_isdfi = ossp. -cense,foP. IiinooP. -1p = Mesh Library (PPM).el is spel is sp PPM ossfh mtsoftware: youmPartredih_ribute!itif!0/ FOmoth_y-----'u_!itiPPM FOc_Oieermscense,foGNU Less FOGene Ii Public Lic (se OGICAL !tasppublished byse,foFh mtSoftware FoPPMthe d, eiublicOGICAL !tad_fd_f!3cense,foLic (se, FO(=!dyour ophe d)undcMlatlicOGICAL !tad_fd_f.el is spel is sp PPM ossdih_ributer op_ frehopeelateritiute!itif!0/ful,el is sp but WITHe3g ANY WARRANTY;iwithout evep_ freimplier wU rantycenel is sp MERCHANTABILITY FOFITNESS FOR Ap_h TICULAR PURPOSE !SeeouldOTO 9999mGNU Gene Ii Public Lic (se f FOmore details.el is spel is sp Youmshould NU Gereral Puba copycense,foGNU Gene Ii Public Lic (seOGICAL !tashould GNU Less FOGene Ii Public Lic (se aloNDrwith PPM. Ifrno ,el is sp seeo.el is spel is sp P. IiinooP. -1p = Mesh Library (PPM)el is sp ETH Zurich----9999mCH-8092 Zurich, Switz ilaM,-os0,-1pecia,i! S- (0,-1p =he losunfo(ik=' MKi=CItp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,v,lda,i!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i! Defbef INGLev,lda,i!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv#AMETERndturnr_: d=ia_r=po,,,,,,,,,1v#AMETERndtTEGE_: d=ia_r=po,,,,,,,,,2v#AMETERndturnr_: d=ia_r=po_p-kerne 3v#AMETERndtTEGE_: d=ia_r=po_p-kerne 4 v#AMETERndtd_fINNALOTO 999pg________5v#AMETERndtUSER_FUNCT=po,,,,,,,,,,,,6 #AMETERndtLOOKUP_E !LE 7_i MODULE i!X-_idorioo MKi=CIt!!Prnels i!X-_ proviGEs -'ubyNGLe2seconcetuOGse,foGNU!!Pnu.orc=po,0he dketuOl A=po,ane=vpsAnu.o bua eraashopch----9ba copycea,i!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=iv1p,'tricc!PADefbef A=po,facesisdi -'urioo A=po,ane=vpucs byNGLe2 i=CIicicc!ind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv1p,'triccCe,RNTEGEi=dorioo MKi=CI MODULE PROCEDUREi=dorioo_sise,foGN MODULE PROCEDUREi=dorioo_dise,foGN MODULE PROCEDUREi=dorioo_scise,foGN MODULE PROCEDUREi=dorioo_dcise,foGN MODULE PROCEDUREi=dorioo_suse,foGN MODULE PROCEDUREi=dorioo_duse,foGN MODULE PROCEDUREi=dorioo_scuse,foGN MODULE PROCEDUREi=dorioo_dcuse,foGN MODULE PROCEDUREi=dorioo_st i=CIicicc ccMODULE PROCEDUREi=dorioo_dt i=CIicicc ccMODULE PROCEDUREi=dorioo_sct i=CIicicc ccMODULE PROCEDUREi=dorioo_dct i=CIiciccii ad_fINTEGER_ids,ndddc!ind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv1p,'tricc!PAi :ii -'uc _ids,ndddc!ind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv1p,'tricciletAINS d_AMETERndtKINNELndtd_fINNAL #AMETERndt-/ac_cc 20_pp_v ilet_sts_fINTEGER, PARdorioo"v#ublif_dtg_re #AMETERndt-/ac_cc 20_pp_v ilet_sts_fINTEGER, PARdorioo"v#ublif_dtg_re #AMETERndt-/ac_ccurnr_: d=ia_r=po_p-kernes_fINTEGER, PARdorioo"v#ublif_dtg_re #AMETERndt-/ac_cc 20_pp_v ilet_st_p-kernes_fINTEGER, PARdorioo"v#ublif_dtg_re #ublif_dtgINNEL d_AMETERndtKINNELndtUSER_FUNCT=po #AMETERndt-/ac_cc 20_pp_v ilet_sts_fINTEGER, PARdorioo"v#ublif_dtg_re #AMETERndt-/ac_cc 20_pp_v ilet_sts_fINTEGER, PARdorioo"v#ublif_dtg_re #AMETERndt-/ac_ccurnr_: d=ia_r=po_p-kernes_fINTEGER, PARdorioo"v#ublif_dtg_re #AMETERndt-/ac_cc 20_pp_v ilet_st_p-kernes_fINTEGER, PARdorioo"v#ublif_dtg_re #ublif_dtgINNEL d_AMETERndtKINNELndtLOOKUP_E !LE #AMETERndt-/ac_cc 20_pp_v ilet_sts_fINTEGER, PARdorioo"v#ublif_dtg_re #AMETERndt-/ac_cc 20_pp_v ilet_sts_fINTEGER, PARdorioo"v#ublif_dtg_re #AMETERndt-/ac_ccurnr_: d=ia_r=po_p-kernes_fINTEGER, PARdorioo"v#ublif_dtg_re #AMETERndt-/ac_cc 20_pp_v ilet_st_p-kernes_fINTEGER, PARdorioo"v#ublif_dtg_re #ublif_dtgINNEL dIiciccii aMODULE i!X-_idorioo i!X-_ihamjac_exte00006440001750000175000000052405114650017634 00771020627upoi= omaromar,ndddc!ind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_f-X-_ecia,i! - CI=poerr_alMPLEX,ii ad_f i!X-_ihamjac_ext i=CIic!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i!v,lda,i!X-Purposeerr_alMPprocedurjRm CI=pld NUhamjac_ext i=CIic!se,foGNU -Rekserr_alM v,lda,i!v,lda,i!X-Re Ifrnces_alM v,lda,i!v,lda,i!X-Revis=vpsA_alMv,lda,i!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i! $Log: i!X-_ihamjac_exte,v $v,lda,i!X-Revis=vp 1.1.1.1 2007/07/13 10:18:58:eivosv,lda,i!X-CBL d)undcMl.el is sPM l8092 Zv,lda,i!v,lda,i!X-Revis=vp 1.1 2005/07/25 00:34:07(Divosv,lda,i!X-RAMETERYcheck-id. copycense,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i! SAIC Gi=pp (ETH Zurich), ----------------------------C (ETHiS FOFluid Dynamics (DTUnel is spel is spel is sp T_isdfi = ossp. -cense,foP. IiinooP. -1p = Mesh Library (PPM).el is spel is sp PPM ossfh mtsoftware: youmPartredih_ribute!itif!0/ FOmoth_y-----'u_!itiPPM FOc_Oieermscense,foGNU Less FOGene Ii Public Lic (se OGICAL !tasppublished byse,foFh mtSoftware FoPPMthe d, eiublicOGICAL !tad_fd_f!3cense,foLic (se, FO(=!dyour ophe d)undcMlatlicOGICAL !tad_fd_f.el is spel is sp PPM ossdih_ributer op_ frehopeelateritiute!itif!0/ful,el is sp but WITHe3g ANY WARRANTY;iwithout evep_ freimplier wU rantycenel is sp MERCHANTABILITY FOFITNESS FOR Ap_h TICULAR PURPOSE !SeeouldOTO 9999mGNU Gene Ii Public Lic (se f FOmore details.el is spel is sp Youmshould NU Gereral Puba copycense,foGNU Gene Ii Public Lic (seOGICAL !tashould GNU Less FOGene Ii Public Lic (se aloNDrwith PPM. Ifrno ,el is sp seeo.el is spel is sp P. IiinooP. -1p = Mesh Library (PPM)el is sp ETH Zurich----9999mCH-8092 Zurich, Switz ilaM,-os0,-1pecia,i! S- (0,-1p =he losunfo(ik=' ,-1p =!o -&m ------O=ia_fv, iERNELii=poipg_smNALO=ia_fv, i!X-_ #AMETERndturnr_: d=ia_r=po,1v#AMETERndtTEGE_: d=ia_r=po,2_#AMETERndt2D 3v#AMETERndt3D 4_#AMETERndtVEC 5v#AMETERndtSCA 6_i MODULE i!X-_ihamjac_ext v1p,'tric ,-1p =!o -&m ------O=ia_fv, iERNELii=poipv1p,'tric I=po,facev,l,'tric ,-1p =!o -&m ------O=ia_fv, iERNELii=poipv1p,'tricCe,RNTEGEi=hamjac_ext_stepR_ids,ndddcccMODULE PROCEDUREi=hamjac_ext_step_3ds i=CIicicc cMODULE PROCEDUREi=hamjac_ext_step_3dd_ids,ndddcccMODULE PROCEDUREi=hamjac_ext_step_3dsv i=CIicicc cMODULE PROCEDUREi=hamjac_ext_step_3ddvR_ids,ndddii ad_fINTEGER_ids,ndddCe,RNTEGEi=hamjac_extR_ids,ndddcccMODULE PROCEDUREi=hamjac_ext_3ds i=CIicicc cMODULE PROCEDUREi=hamjac_ext_3dd_ids,ndddcccMODULE PROCEDUREi=hamjac_ext_3dsv i=CIicicc cMODULE PROCEDUREi=hamjac_ext_3ddvR_ids,ndddii ad_fINTEGER__ids,ndiletAINS #AMETERndt_ING dt3D #AMETERndtMODG dtSCA #AMETERndt-/ac__cc 20_pp_v ilet_sts1p,'tric 3D SCA 20_ppv_fINTEGER, PARhamjac_ext_step_3de"v#ublif_dtg_re #AMETERndt-/ac__cc 20_pp_v ilet_sts1p,'tric 3D SCA 20_ppv_fINTEGER, PARhamjac_ext_step_3de"v#ublif_dtg_re #ublif_dtMODG #ublif_dtTIMpvv#AMETERndt_ING dt3D #AMETERndtMODG dtSCA #AMETERndt-/ac__cc 20_pp_v ilet_sts1p,'tric 3D SCA 20_ppv_fINTEGER, PARhamjac_ext_3de"v#ublif_dtg_re #AMETERndt-/ac__cc 20_pp_v ilet_sts1p,'tric 3D SCA 20_ppv_fINTEGER, PARhamjac_ext_3de"v#ublif_dtg_re #ublif_dtMODG #ublif_dtTIMpvvv#AMETERndt_ING dt3D #AMETERndtMODG dtVEC #AMETERndt-/ac__cc 20_pp_v ilet_sts1p,'tric 3D VEC 20_ppv_fINTEGER, PARhamjac_ext_step_3de"v#ublif_dtg_re #AMETERndt-/ac__cc 20_pp_v ilet_sts1p,'tric 3D VEC 20_ppv_fINTEGER, PARhamjac_ext_step_3de"v#ublif_dtg_re #ublif_dtMODG #ublif_dtTIMpvv#AMETERndt_ING dt3D #AMETERndtMODG dtVEC #AMETERndt-/ac__cc 20_pp_v ilet_sts1p,'tric 3D VEC 20_ppv_fINTEGER, PARhamjac_ext_3de"v#ublif_dtg_re #AMETERndt-/ac__cc 20_pp_v ilet_sts1p,'tric 3D VEC 20_ppv_fINTEGER, PARhamjac_ext_3de"v#ublif_dtg_re #ublif_dtMODG #ublif_dtTIMpvvv dIiciccii aMODULE i!X-_ihamjac_ext i=CIic v,lCIic vmk_tablj00006440001750000175000000052405114650017634 02664620463upoi= omaromar,'tric ,-1p =!o -&m ------O=ia_fv, iERNELii=poipia_fv, iERNELii=poipv1p,'tr!X-Ss byNGLe2DalMPLEX,ii ad_fINTmk_tabljse,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i! SAIC Gi=pp (ETH Zurich), ----------------------------C (ETHiS FOFluid Dynamics (DTUnel is spel is spel is sp T_isdfi = ossp. -cense,foP. IiinooP. -1p = Mesh Library (PPM).el is spel is sp PPM ossfh mtsoftware: youmPartredih_ribute!itif!0/ FOmoth_y-----'u_!itiPPM FOc_Oieermscense,foGNU Less FOGene Ii Public Lic (se OGICAL !tasppublished byse,foFh mtSoftware FoPPMthe d, eiublicOGICAL !tad_fd_f!3cense,foLic (se, FO(=!dyour ophe d)undcMlatlicOGICAL !tad_fd_f.el is spel is sp PPM ossdih_ributer op_ frehopeelateritiute!itif!0/ful,el is sp but WITHe3g ANY WARRANTY;iwithout evep_ freimplier wU rantycenel is sp MERCHANTABILITY FOFITNESS FOR Ap_h TICULAR PURPOSE !SeeouldOTO 9999mGNU Gene Ii Public Lic (se f FOmore details.el is spel is sp Youmshould NU Gereral Puba copycense,foGNU Gene Ii Public Lic (seOGICAL !tashould GNU Less FOGene Ii Public Lic (se aloNDrwith PPM. Ifrno ,el is sp seeo.el is spel is sp P. IiinooP. -1p = Mesh Library (PPM)el is sp ETH Zurich----9999mCH-8092 Zurich, Switz ilaM,-os0,-1pecia,i! S- (0,-1p =he losunfo(ik=' e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvv_ff ndtKINNELn==ndtd_fINNAL #ff ndtK/ac_==ndt 20_pp_v ilet_sts1p,'trSUBINmk_tablj_si(ketuOl,k(PP,ntablj,cutoff2,'tr&s1p,'t&p,'tktab,dxtabljinv,info) #elifndtK/ac_==ndt 20_pp_v ilet_sts1p,'trSUBINmk_tablj_di(ketuOl,k(PP,ntablj,cutoff2,'tr&s1p,'t&p,'tktab,dxtabljinv,info) #elifndtK/ac_==ndturnr_: d=ia_r=po_p-kernes1p,'trSUBINmk_tablj_sci(ketuOl,k(PP,ntablj,cutoff2,'tr&s1p,'t&p,'tktab,dxtabljinv,info) #elifndtK/ac_==ndt 20_pp_v ilet_st_p-kernes1p,'trSUBINmk_tablj_dci(ketuOl,k(PP,ntablj,cutoff2,'tr&s1p,'t&p,'tktab,dxtabljinv,info) #enLes #elifndtKINNELn==ndtUSER_FUNCT=po #ff ndtK/ac_==ndt 20_pp_v ilet_sts1p,'trSUBINmk_tablj_su(ketuOl,k(PP,ntablj,cutoff2,'tr&s1p,'t&p,'tktab,dxtabljinv,info) #elifndtK/ac_==ndt 20_pp_v ilet_sts1p,'trSUBINmk_tablj_du(ketuOl,k(PP,ntablj,cutoff2,'tr&s1p,'t&p,'tktab,dxtabljinv,info) #elifndtK/ac_==ndturnr_: d=ia_r=po_p-kernes1p,'trSUBINmk_tablj_scu(ketuOl,k(PP,ntablj,cutoff2,'tr&s1p,'t&p,'tktab,dxtabljinv,info) #elifndtK/ac_==ndt 20_pp_v ilet_st_p-kernes1p,'trSUBINmk_tablj_dcu(ketuOl,k(PP,ntablj,cutoff2,'tr&s1p,'t&p,'tktab,dxtabljinv,info) #enLes #enLes e,foGNU!! SreosssICAlook--Ctabljld NUarg/ A=po,ane=vpuketuOl. e,foGNU!! T-'uresultf!0/return sp but WIvariabljstktabgnu.o e,foGNU!! inLeces_runnioo from 0isdintablj-1. T-'utabljse,foGNU!! containsdketuOl values_al d, a funne=vpushouldse,foGNU!! _squnsed_/ful,anceYx**2. e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i! M CI=p == foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,iUSE i!X-_ic (avecia,iUSE i!X-_isubsnmin MKi=CIUSE i!X-_isubsnop MKi=CIUSE i!X-_ierror MKi=CIUSE i!X-_iTH oc MKi=CIIkerICIT NOv#ff ndtK/ac_==ndt 20_pp_v ilet_st |ndtK/ac_==ndturnr_: d=ia_r=po_p-kernes1p,'trCe,Ropt,ne IAMEfIN :: MK = iip(EGE |siooth #elifndtK/ac_==ndt 20_pp_v ilet_st |ndtK/ac_==ndt 20_pp_v ilet_st_p-kernes1p,'trCe,Ropt,ne IAMEfIN :: MK = iip(EGE |LOOKUP #enLes e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i I=NTEGEs e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv_fINTEGER, PARAMETER.h" e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i ASds, 0, == foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,iCe,RoptOTO 999pg___________,iCe,RNT(Io,,,) :: ntabljse,foGNU!! Numbfrnshouabljl 0,riesisdi;iwcreossdbrary (PREAL(MK)TO 999pg___________,iCe,RNT(Io,,,) :: cutoff2se,foGNU!! Squnseashould cutoffwithdld NUg/ A=po,ane=vps. T-'uketuOl RANTY;ise,foGNU!! uabu ossd --Ctdi -!0/value.v#ff ndtK/ac_==ndt 20_pp_v ilet_st |ndtK/ac_==ndt 20_pp_v ilet_sts1p,'trREAL(MK)TO 99, TIMpNt_st(:luiPOd_fIN_______:: ktab e,foGNU!! Tabu ossd ketuOl values_0...ntablj-1. e,foGNU!! OeOrloa eisINGLe:esiooth,LOOKUP. #elifndtK/ac_==ndturnr_: d=ia_r=po_p-kerne |ndtK/ac_==ndt 20_pp_v ilet_st_p-kernes1p,'trp-kerne(MK)TO, TIMpNt_st(:luiPOd_fIN_______:: ktab e,foGNU!! Tabu ossd ketuOl values_0...ntablj-1. e,foGNU!! OeOrloa eisINGLe:esioothrc=polex,LOOKUP-i=polex. #enLes #ff ndtKINNELn==ndtd_fINNAL ecia,iCe,RoptOTO 999pg___________,iCe,RNT(Io,,,) :: ketuOl e,foGNU!! ketuOl d NUwhhe Ctdic=po,0 -'ucoric !!-d. Tdiusee PA-A=po,nal e,foGNU!! ketuOls, speciftase2Dsh: e,foGNU!! e,foGNU!! 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i !ics ( PAR(PPap(Eerel_laplace2d_2pvecia,i !ics ( (2oNDorlic Laplacian,vecia,i !ics ( polynomTERY n 2D)vecia,i !ics ( PAR(PPap(Eerel_laplace3d_2pvecia,i !ics ( (2oNDorlic Laplacian,vecia,i !ics ( polynomTERY n 3D)vecia,i !ic9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i !i e,foGNU!! Tdiuseeis spewn ketuOl dunne=vp, pass -'ufunne=vpupoA=po, here. Genr e,foGNU!! funne=vpu Ii Pubtakease2DSSds, 0,-h_idreturnase2Dvalue.v#ff ndtK/ac_==ndt 20_pp_v ilet_st |ndtK/ac_==ndt 20_pp_v ilet_sts1p,'trREAL(MK)TO , TIMpNt_st(:l__,iCe,RNT(Io,,,) :: k(PP #elifndtK/ac_==ndturnr_: d=ia_r=po_p-kerne |ndtK/ac_==ndt 20_pp_v ilet_st_p-kernes1p,'trp-kerne(MK), TIMpNt_st(:l__,iCe,RNT(Io,,,) :: k(PP #enLes e,foGNU!! KetuOl (PPapepo,se f FOdocue2DIC!!-d NUketuOls.fIN d N e,foGNU!! GEscrip!!-d. TNGLitiPPbeesiooth,TLOOKUP,esioothrc=polexldOTLOOKUPse,foGNU!! copolex. Omiti -!0/SSds, 0,-wheniusioo CAlook--Ctablj. #enLes e,foGNREAL(MK)TO 999pg___________,iCe,RNT( N) :: dxtabljinv e,foGNU!! ind)unj should dx (ketuOl evaluC!!-d ocC!!-ds)withdltdicreossse,foGNU!! u-'utablj. Tdiuseeu-'utablj,Alook --Cth2Dvaluese,foGNU!! `ktab(IoT(dxtabljinv*x))`. ecia,iCe,RoptOTO 999pg___________,iCe,RNT( N) :: infose,foGNU!! Returns snmtus, 0 --vpucscces == foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,iicsLocClIvariabljs== foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,iCe,RoptOTO 999pg_________:: i,atablj,iopt,idxs1p,'trCe,Ropt,nTIMpNt_st(1)____:: ldl,lduse,foGNREAL(MK),ne IAMEfIN _____:: Rm n =_0.0_MK e,foGNREAL(MK)TO 999pg_________:: dxtablj,Rmax,factor,factor2 e,foGNREAL(MK)TO 999pg_________:: t0,dij,dij2,dij4,dij5,dx,dy,dzv#ff ndtK/ac_==ndt 20_pp_v ilet_st |ndtK/ac_==ndt 20_pp_v ilet_sts1p,'trREAL(MK)TO 999pg_________:: al #elifndtK/ac_==ndturnr_: d=ia_r=po_p-kerne |ndtK/ac_==ndt 20_pp_v ilet_st_p-kernes1p,'trp-kerne(MK)TO9pg_________:: al #enLes e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i Expo,nals e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv_ff ndtKINNELn==ndtUSER_FUNCT=po #ff ndtK/ac_==ndt 20_pp_v ilet_st |ndtK/ac_==ndt 20_pp_v ilet_sts1p,'trREAL(MK)TO , TIMpNt_st(:l__,iCe,RNT(Io,,,) :: k(PP 1p,'trCe,RNTEGERg_________FUNCT=po,ketuOl(x,k(PP)Rg_________,'trCkerICIT NOv#ff ndtK/ac_==ndt 20_pp_v ilet_st |ndtK/ac_==ndturnr_: d=ia_r=po_p-kernes1p,'tr____,'trCe,Ropt,ne IAMEfIN :: MK = K/ac(1.0E0) #elifndtK/ac_==ndt 20_pp_v ilet_st |ndtK/ac_==ndt 20_pp_v ilet_st_p-kernes1p,'tr____,'trCe,Ropt,ne IAMEfIN :: MK = K/ac(1.0D0) #enLes e,foGNNNNNNNNNREAL(MK),nCe,RNT(Io) :: x e,foGNNNNNNNNNREAL(MK),nTIMpNt_st(:luiCe,RNT(Io) :: k(PP 1p,'trNNNNNNNNREAL(MK) :: ketuOl e,foGNNNNNii aFUNCT=po,ketuOldIiciccii aCe,RNTEGER#elifndtK/ac_==ndturnr_: d=ia_r=po_p-kerne |ndtK/ac_==ndt 20_pp_v ilet_st_p-kernes1p,'trp-kerne(MK), TIMpNt_st(:l__,iCe,RNT(Io,,,) :: k(PP 1p,'trCe,RNTEGERg_________FUNCT=po,ketuOl(x,k(PP)Rg_________,'trCkerICIT NOv#ff ndtK/ac_==ndt 20_pp_v ilet_st |ndtK/ac_==ndturnr_: d=ia_r=po_p-kernes1p,'tr____,'trCe,Ropt,ne IAMEfIN :: MK = K/ac(1.0E0) #elifndtK/ac_==ndt 20_pp_v ilet_st |ndtK/ac_==ndt 20_pp_v ilet_st_p-kernes1p,'tr____,'trCe,Ropt,ne IAMEfIN :: MK = K/ac(1.0D0) #enLes e,foGNNNNNNNNNREAL(MK),nCe,RNT(Io) :: x e,foGNNNNNNNNNp-kerne(MK), TIMpNt_st(:luiCe,RNT(Io) :: k(PP 1p,'trNNNNNNNNp-kerne(MK)T:: ketuOl e,foGNNNNNii aFUNCT=po,ketuOldIiciccii aCe,RNTEGER#enLes #enLes e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i I=METERinj i=CIic!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,iCALL subsnmin('mk_tablj',t0,info) e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i Check/SSds, 0,s. e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,iIF ( PARAMbug .GT. 0)_re3N e,foGNNNNNIF (ntablj .LT. 1)_re3N e,foGNNNNNNNNNinfo = iip(errorierror MKi=CINNNNNNNNpALL iip(error(iip(err_SSds, 0,,'mk_tablj',tr&s1p,'t&p,'ttttttttt'ntablj mustPbee>0',__LINE__,info) MKi=CINNNNNNNNGOTO 9999 e,foGNNNNNii IF e,foGNNNNNIF (cutoff2 .LT. 0.0_MK)_re3N e,foGNNNNNNNNNinfo = iip(errorierror MKi=CINNNNNNNNpALL iip(error(iip(err_SSds, 0,,'mk_tablj',tr&s1p,'t&p,'ttttttttt'cutoff2 mustPbee>=0',__LINE__,info) MKi=CINNNNNNNNGOTO 9999 e,foGNNNNNii IF e,foGNii IF e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i C=po,0 Rmax e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,iRmax = cutoff2s e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i Al ocC!edmemory d NUtablj look-- e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,iatablj = ntablj-1s e,foGNiopt = iip((PPap(TH oc_fin MKi=CIldl(1)_=_0 MKi=CIldu(1)_=_atabljse,foGNpALL iip(TH oc(ktab,ldl,ldu,iopt,info) MKi=CIIF (info .NE. iip((PPap(cscces )_re3N e,foGNNNNNinfo = iip(errorifatal e,foGNNNNNpALL iip(error(iip(err_SH oc,'mk_tablj',tr tr&s1p,'t&p,'ttttt'ketuOl look--CtabljlKTAB',__LINE__,info) MKi=CINNNNGOTO 9999 e,foGNii IF e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i C=po,0 values e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,idxtabljia,i= (Rmax - Rm n)/REAL(atablj,MK)vecia,idxtabljinvi= 1.0_MK/dxtablj e,foGNU Mesh hack/sh nee eissinceYsom'uketuOlsiuseedx,dy,dz explicitly. DO e,foGNU NOT MAKE E !LEmGNU GTHOSE KINNELS!vecia,idx =_0.0_MK e,foGNdy =_0.0_MK e,foGNdz =_0.0_MK e,foGNDO i=0,atabljse,foGNoGNdij =_Rm n +NREAL(i,MK)*dxtablj _fINTEGER, PARketuOls.fIN"se,foGNoGNktab(i)_=_e(avecia,iii DO e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i Return e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fve9999diletINUEse,foGNpALL subsnop('mk_tablj',t0,info) e,foGNRETURNv_ff ndtKINNELn==ndtd_fINNAL #ff ndtK/ac_==ndt 20_pp_v ilet_sts1p,'trii aSUBINmk_tablj_si #elifndtK/ac_==ndt 20_pp_v ilet_sts1p,'trii aSUBINmk_tablj_di #elifndtK/ac_==ndturnr_: d=ia_r=po_p-kernes1p,'trii aSUBINmk_tablj_sci #elifndtK/ac_==ndt 20_pp_v ilet_st_p-kernes1p,'trii aSUBINmk_tablj_dci #enLes #elifndtKINNELn==ndtUSER_FUNCT=po #ff ndtK/ac_==ndt 20_pp_v ilet_sts1p,'trii aSUBINmk_tablj_su #elifndtK/ac_==ndt 20_pp_v ilet_sts1p,'trii aSUBINmk_tablj_du #elifndtK/ac_==ndturnr_: d=ia_r=po_p-kernes1p,'trii aSUBINmk_tablj_scu #elifndtK/ac_==ndt 20_pp_v ilet_st_p-kernes1p,'trii aSUBINmk_tablj_dcuR#enLes #enLes gmm_extenL_bkwd000064400017500001750000000524051114650017634 04731720324upoi= omaromare,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i Ss byNGLe2DalMPLEX,ii ad_fINT ( PARgmm_extenL_bkwd e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i SAIC Gi=pp (ETH Zurich), ----------------------------C (ETHiS FOFluid Dynamics (DTUnel is spel is spel is sp T_isdfi = ossp. -cense,foP. IiinooP. -1p = Mesh Library (PPM).el is spel is sp PPM ossfh mtsoftware: youmPartredih_ribute!itif!0/ FOmoth_y-----'u_!itiPPM FOc_Oieermscense,foGNU Less FOGene Ii Public Lic (se OGICAL !tasppublished byse,foFh mtSoftware FoPPMthe d, eiublicOGICAL !tad_fd_f!3cense,foLic (se, FO(=!dyour ophe d)undcMlatlicOGICAL !tad_fd_f.el is spel is sp PPM ossdih_ributer op_ frehopeelateritiute!itif!0/ful,el is sp but WITHe3g ANY WARRANTY;iwithout evep_ freimplier wU rantycenel is sp MERCHANTABILITY FOFITNESS FOR Ap_h TICULAR PURPOSE !SeeouldOTO 9999mGNU Gene Ii Public Lic (se f FOmore details.el is spel is sp Youmshould NU Gereral Puba copycense,foGNU Gene Ii Public Lic (seOGICAL !tashould GNU Less FOGene Ii Public Lic (se aloNDrwith PPM. Ifrno ,el is sp seeo.el is spel is sp P. IiinooP. -1p = Mesh Library (PPM)el is sp ETH Zurich----9999mCH-8092 Zurich, Switz ilaM,-os0,-1pecia,i! S- (0,-1p =he losunfo(ik=' e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv#ff n_dtTIM_==ndt2Dv#ff n_dtK/ac_==ndt 20_pp_v ilet_sts1p,'trSUBINgmm_extenL_bkwd_2ds(fdta,dta,width,orlic,npos,TM,'tr&s1p,'t&p,'trhscst,dxinv,dyinv,dzinv,ghostsize,info,spee ,chi) #elifnndtK/ac_==ndt 20_pp_v ilet_sts1p,'trSUBINgmm_extenL_bkwd_2dd(fdta,dta,width,orlic,npos,TM,'tr&s1p,'t&p,'trhscst,dxinv,dyinv,dzinv,ghostsize,info,spee ,chi) #enLes #elifnndtTIM_==ndt3Dv#ff n_dtK/ac_==ndt 20_pp_v ilet_sts1p,'trSUBINgmm_extenL_bkwd_3ds(fdta,dta,width,orlic,npos,TM,'tr&s1p,'t&p,'trhscst,dxinv,dyinv,dzinv,ghostsize,info,spee ,chi) #elifnndtK/ac_==ndt 20_pp_v ilet_sts1p,'trSUBINgmm_extenL_bkwd_3dd(fdta,dta,width,orlic,npos,TM,'tr&s1p,'t&p,'trhscst,dxinv,dyinv,dzinv,ghostsize,info,spee ,chi) #enLes #enLes e,foGNU!! Mesh byNGLe2Dperd Nms -'ubackESSd chiw.gstepashould GMMe f F e,foGNU!! gmm_chld NUral Puba copycen!i e,foGNU!! ===nRe Ifrnces_=== copycen!i e,foGNU!! CTHep:2, Kim:2b e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i! M CI=p ,v,lda,i!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,iUSE i!X-_ic (avecia,iUSE i!X-_iic (avecia,iUSE i!X-_ic (agmmvecia,iUSE i!X-_isubsnmin MKi=CIUSE i!X-_isubsnop MKi=CIUSE i!X-_ierror MKi=CIUSE i!X-_iTH oc MKi=CIUSE i!X-_iINGLdef MKi=CIUSE i!X-_imap_fiel e,foGNCkerICIT NOv#ff n_dtK/ac_==ndt 20_pp_v ilet_sts1p,'trCe,Ropt,ne IAMEfIN :: MK = iip(EGE |siooth #elc Lic (seCe,Ropt,ne IAMEfIN :: MK = iip(EGE |LOOKUP #enLes e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i I=NTEGEs e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv_fINTEGER, PARAMETER.h" #fflif_dtMPILic (seCeCLUDE_'mpif.h' #enLes e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i ASds, 0, cia,i e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv#ff ndtTIM_==ndt2Dve,foGNREAL(MK),nTIMpNt_st(:,:,:)TO 99, POd_fIN_______ __:: fdta #elifndtTIM_==ndt3Dve,foGNREAL(MK),nTIMpNt_st(:,:,:,:)TO , POd_fIN_______ __:: fdta #enLes e,foGNU!! poA=po, to lNTAl dunne=vp. Nee sisdi;iwAMETERsp buaubanGse,foGNU!!P(width+orlic*dx).v#ff ndtTIM_==ndt2Dve,foGNREAL(MK),nTIMpNt_st(:,:,:)TO 99, POd_fIN_______ __:: dta #elifndtTIM_==ndt3Dve,foGNREAL(MK),nTIMpNt_st(:,:,:,:)TO , POd_fIN_______ __:: dta #enLes e,foGNU!! poA=po, to value dunne=vp.v#ff ndtTIM_==ndt2Dve,foGNREAL(MK),nTIMpNt_st(:,:,:)TO 99, Ce,RNT(Io), OPT=poAL_:: spee #elifndtTIM_==ndt3Dve,foGNREAL(MK),nTIMpNt_st(:,:,:,:)TO , Ce,RNT(Io), OPT=poAL_:: spee #enLes e,foGNU!! FOk 4 (3d)ldOT FOk 3 (2d)lfiel ashofront spee s. e,foGNU!! OPT=poAL_to o opriGERrhscst.v#ff ndtTIM_==ndt2Dve,foGNREAL(MK),nTIMpNt_st(:,:,:,:)TO , Ce,RNT(Io), OPT=poAL_:: chi #elifndtTIM_==ndt3Dve,foGNREAL(MK),nTIMpNt_st(:,:,:,:,:)T, Ce,RNT(Io), OPT=poAL_:: chi #enLes e,foGNU!! FOk 5 (3d)ldOT FOk 4 (2d)lfiel aspeciftiw.guld posi!!-ds e,foGNU!! should griGsesGEs. 1st inLex: 1.. PARAim,ouldn i,j,[k],isub. e,foGNU!! OPT=poAL. Unid Nm griGs!0/Ssss, Gs!f abs 0,brary (PREAL(MK)TO 999pg___________O 99, Ce,RNT(Io ,,) __:: width e,foGNU!! Width should nSS owubanGisdi;iwpri!Xc GscMleachlsiGERos e,foGNU!! LITY =po,facebrary (PREAL(MK)TO 999pg___________O 99, Ce,RNT(Io ,,) __:: rhscst e,foGNU!! c-dstFOR value dori -'urii=pphanGisiGERos grad u * grad f = c. e,foGNU!! (sspee ary (res 0,,i -!0/SSds, 0,-wANTY;iwignGerdbrary (PREAL(MK)TO 999pg___________O 99, Ce,RNT(Io ,,) __:: TM e,foGNU!! Curr 0,-thresholdld NUwic Lfront ocC!!-dbrary (PREAL(MK)TO 999pg___________O 99, Ce,RNT(Io ,,) __:: dxinv e,foGNU!! ind)unj should x griGsspacioorary (PREAL(MK)TO 999pg___________O 99, Ce,RNT(Io ,,) __:: dyinv e,foGNU!! ind)unj should y griGsspacioorary (PREAL(MK)TO 999pg___________O 99, Ce,RNT(Io ,,) __:: dzinv e,foGNU!! ind)unj should z griGsspacioo (Notwithdl n 2Dr op_ fr). ecia,iCe,RoptOTO 999pg___________O 99, Ce,RNT(Io ,,) __:: orlic e,foGNU!! Orlic should methodDsdi;iwithd. OnERos e,foGNU!! e,foGNU!! *iip((PPap(orlic_1 e,foGNU!! *iip((PPap(orlic_2 e,foGNU!! *iip((PPap(orlic_3Lic (seCe,Ropt,nTIMpNt_st(3)TO 999pg__, Ce,RNT(Io ,,) __:: ghostsize e,foGNU!! Size should ghostlayic sbuaNTYsiGEs. ecia,iCe,RoptOTO 999pg___________O 99, Ce,RNT(IoN) __:: npos e,foGNU!! Curr 0,-numbfrnshopoA=psp but WIcloseeset. ecia,iCe,RoptOTO 999pg___________O 99, Ce,RNT( N) __:: infose,foGNU!! Return snmtus, 0 --vpucscces == foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,iicsLocClIvariabljs,v,lda,i!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,iCe,RoptOTO 999pg___________O 99__:: i,j,k,p,xhi,yhi,zhi,ii,jj,kkv,lda,iCe,RoptOTO 999pg___________O 99__:: jsub,isubv,lda,iCe,RoptOTO 999pg___________O 99__:: i1,i2,i3Lic (seCe,Ropt,nTIMpNt_st(-3:3)TO 999pg_:: sx,sy,szrary (PREAL(MK)TO 999pg___________O 99__:: t0,onethird,onetwelfth e,foGNREAL(MK)TO 999pg___________O 99__:: valijk,det,hsic ,fdta0 e,foGNREAL(MK)TO 999pg___________O 99__:: lmyeps,ainv,big,absfdta0 e,foGNREAL(MK)TO 999pg___________O 99__:: dxihalf,dxitwelc ,agag e,foGNREAL(MK)TO 999pg___________O 99__:: dyihalf,dyitwelc e,foGNREAL(MK)TO 999pg___________O 99__:: dzihalf,dzitwelc e,foGNREAL(MK),nTIMpNt_st(3)TO 999pg___:: coefs,gphi,gpp e,foGNREAL(MK),nTIMpNt_st(3,3)TO 999pg_:: jac,ji e,foGNREAL(MK),nTIMpNt_st(-3:3, PARAim):: phi,psi e,foGNREAL(MK),nTIMpNt_st( PARAim)99pg_:: alpha,be(avecia,iREAL(MK),nTIMpNt_st(2)TO 999pg___:: roo, == foGNTYPE( PARt_topo),tr tr POd_fIN___:: topo== foGNTYPE( PARt_equi_meshluiPOd_fIN___:: mesh== foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,iicsExpo,nals,v,lda,i!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,i e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i I=METERinji e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,iCALL subsnmin('gmm_extenL_bkwd',t0,info) e,foGNtopo => iip(topo(gmm_topoid)%t e,foGNmesh => topo%mesh(gmm_meshid) e,foGNphie,foGN=_0.0_MK e,foGNpsie,foGN=_0.0_MK e,foGNbige,foGN=_HUGE(big) e,foGNhsic foGN=_0.9_MK*big e,foGNonethirdi= 1.0_MK/3.0_MK e,foGNonetwelfthi= 1.0_MK/12.0_MK #ff ndtK/ac_==ndt 20_pp_v ilet_sts1p,'trlmyepsoGN=_ yepss #elc Lic (selmyepsoGN=_ yeps #enLes e,foGNdxihalfGN=_0.5_MK*dxinv e,foGNdyihalfGN=_0.5_MK*dyinv e,foGNdxitwelc GN=_onetwelfth*dxinv e,foGNdyitwelc GN=_onetwelfth*dyinv #ff ndtTIM_==ndt3Dve,foGNdzihalfGN=_0.5_MK*dzinv e,foGNdzitwelc GN=_onetwelfth*dzinv #enLes e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i Check/SSds, 0,sv,lda,i!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,iCF ( PARAMbug .GT. 0)_re3N e,foGNNNNNIF (width .LT. 0.0_MK)_re3N e,foGNNNNNNNNNinfo = iip(errorierror MKi=CINNNNNNNNpALL iip(error(iip(err_iip(noA=i,,'gmm_extenL_bkwd',tr&s1p,'t&p,'ttttttttt'width mustPbeeposi!!ve!',__LINE__,info) MKi=CINNNNNNNNGOTO 9999 e,foGNNNNNii IF e,foGNNNNNIF ((orlic.NE.iip((PPap(orlic_1).AND.(orlic.NE.iip((PPap(orlic_2)TO&s1p,'t&p,'tttttt.AND.(orlic.NE.iip((PPap(orlic_3))_re3N e,foGNNNNNNNNNinfo = iip(errorierror MKi=CINNNNNNNNpALL iip(error(iip(err_iip(noA=i,,'gmm_extenL_bkwd',tr&s1p,'t&p,'ttttttttt'orlic mustPbee1, 2_fd_f3!',__LINE__,info) MKi=CINNNNNNNNGOTO 9999 e,foGNNNNNii IF e,foGNii IFe,foGNNNNN! AMbug d NUaSds, 0,-check #ff ndtTIM_==ndt3Dve,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i Red)unj srlic:Lic =po,0 neighborsnshopoA=psp buggm_ipos e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,iDO p=npos,1,-1 e,foGNNNNNiie,f= gmm_ipos(1,p) MKi=CINNNNjje,f= gmm_ipos(2,p) MKi=CINNNNkke,f= gmm_ipos(3,p) MKi=CINNNNjsubf= gmm_ipos(4,p) MKi=CINNNNisubf= topo%isubRint(jsub) MKi=CINNNNxhie,=Nmesh%nesGEs(1,isub) MKi=CINNNNyhie,=Nmesh%nesGEs(2,isub) MKi=CINNNNzhie,=Nmesh%nesGEs(3,isub) MKi=CINNNNfdta0=Nfdta(ii,jj,kk,jsub) MKi=CINNNNabsfdta0 =Nfdta0 e,foGNNNNNIF (absfdta0 .LT. 0.0_MK)_absfdta0 =N-absfdta0 e,foGNfoGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d= e,foGNfoGNU GMM --dC!edconLe!!-d (el iKim:2a) e,foGNfoGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d= e,foGNfoGNIF (.NOT.(absfdta0.GT.TM))_re3N e,foGNNNNNNNNNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_c e,foGNNNNNNNNNU Re =po,0 non-acceps spcloseeneighbors e,foGNNNNNNNNNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_c e,foGNNNNNNNNNi =Niie- 1 e,foGNNNNNNNNNj =_jj e,foGNNNNNNNNNk =_kkv,lda,ifoGNfoGNIF (i.GT.0)_re3N e,foGNNNNNfoGNfoGNIF ((gmm_snmte3d(i,j,k,jsub) .NE. &s1p,'t&p,'tttttttttttttgmm_(PPap(Tcceps s)t.AND. &s1p,'t&p,'ttttttttttttt(ABS(fdta(i,j,k,jsub)).GT.absfdta0))_re3N e,foGNNNNNNNNNNNNNNNNNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape e,foGNNNNNNNNNNNNNNNNNU U-dC!edpoA=p i,j,k e,foGNNNNNNNNNNNNNNNNNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape _fINTEGER, PARgmm_slc xtn.fIN"se,foGNoGNNNNNNfoGNfoGNIF (ABS(valijk) .LT. hsic ) dta(i,j,k,jsub) =_valijk se,foGNoGNNNNNNfoGNii IF e,foGNNNNNfoGNii IF e,foGNNNNNfoGNi =Niie+ 1 e,foGNNNNNNNNNj =_jj e,foGNNNNNNNNNk =_kkv,lda,ifoGNfoGNIF (i.LE.xhi)_re3N e,foGNNNNNfoGNfoGNIF ((gmm_snmte3d(i,j,k,jsub) .NE. &s1p,'t&p,'tttttttttttttgmm_(PPap(Tcceps s)t.AND. &s1p,'t&p,'ttttttttttttt(ABS(fdta(i,j,k,jsub)).GT.absfdta0))_re3N e,foGNNNNNNNNNNNNNNNNNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape e,foGNNNNNNNNNNNNNNNNNU U-dC!edpoA=p i,j,k e,foGNNNNNNNNNNNNNNNNNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape _fINTEGER, PARgmm_slc xtn.fIN"se,foGNoGNNNNNNfoGNfoGNIF (ABS(valijk) .LT. hsic ) dta(i,j,k,jsub) =_valijk se,foGNoGNNNNNNNNNNii IF e,foGNNNNNfoGNii IF e,foGNNNNNfoGNi =Nii e,foGNNNNNNNNNj =_jje- 1 se,foGNoGNNNNNNk =_kkv,lda,ifoGNfoGNIF (j.GT.0)_re3N e,foGNNNNNfoGNfoGNIF ((gmm_snmte3d(i,j,k,jsub) .NE. &s1p,'t&p,'tttttttttttttgmm_(PPap(Tcceps s)t.AND. &s1p,'t&p,'ttttttttttttt(ABS(fdta(i,j,k,jsub)).GT.absfdta0))_re3N e,foGNNNNNNNNNNNNNNNNNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape e,foGNNNNNNNNNNNNNNNNNU U-dC!edpoA=p i,j,k e,foGNNNNNNNNNNNNNNNNNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape _fINTEGER, PARgmm_slc xtn.fIN"se,foGNoGNNNNNNfoGNfoGNIF (ABS(valijk) .LT. hsic ) dta(i,j,k,jsub) =_valijk se,foGNoGNNNNNNNNNNii IF e,foGNNNNNfoGNii IF e,foGNNNNNfoGNi =Nii e,foGNNNNNNNNNj =_jje+ 1 se,foGNoGNNNNNNk =_kkv,lda,ifoGNfoGNIF (j.LE.yhi)_re3N e,foGNNNNNfoGNfoGNIF ((gmm_snmte3d(i,j,k,jsub) .NE. &s1p,'t&p,'tttttttttttttgmm_(PPap(Tcceps s)t.AND. &s1p,'t&p,'ttttttttttttt(ABS(fdta(i,j,k,jsub)).GT.absfdta0))_re3N e,foGNNNNNNNNNNNNNNNNNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape e,foGNNNNNNNNNNNNNNNNNU U-dC!edpoA=p i,j,k e,foGNNNNNNNNNNNNNNNNNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape _fINTEGER, PARgmm_slc xtn.fIN"se,foGNoGNNNNNNfoGNfoGNIF (ABS(valijk) .LT. hsic ) dta(i,j,k,jsub) =_valijk se,foGNoGNNNNNNNNNNii IF e,foGNNNNNfoGNii IF e,foGNNNNNfoGNi =Nii e,foGNNNNNNNNNj =_jjese,foGNoGNNNNNNk =_kke- 1 e,foGNNNNNNNNNIF (k.GT.0)_re3N e,foGNNNNNfoGNfoGNIF ((gmm_snmte3d(i,j,k,jsub) .NE. &s1p,'t&p,'tttttttttttttgmm_(PPap(Tcceps s)t.AND. &s1p,'t&p,'ttttttttttttt(ABS(fdta(i,j,k,jsub)).GT.absfdta0))_re3N e,foGNNNNNNNNNNNNNNNNNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape e,foGNNNNNNNNNNNNNNNNNU U-dC!edpoA=p i,j,k e,foGNNNNNNNNNNNNNNNNNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape _fINTEGER, PARgmm_slc xtn.fIN"se,foGNoGNNNNNNfoGNfoGNIF (ABS(valijk) .LT. hsic ) dta(i,j,k,jsub) =_valijk se,foGNoGNNNNNNNNNNii IF e,foGNNNNNfoGNii IF e,foGNNNNNfoGNi =Nii e,foGNNNNNNNNNj =_jjese,foGNoGNNNNNNk =_kke+ 1 e,foGNNNNNNNNNIF (k.LE.zhi)_re3N e,foGNNNNNfoGNfoGNIF ((gmm_snmte3d(i,j,k,jsub) .NE. &s1p,'t&p,'tttttttttttttgmm_(PPap(Tcceps s)t.AND. &s1p,'t&p,'ttttttttttttt(ABS(fdta(i,j,k,jsub)).GT.absfdta0))_re3N e,foGNNNNNNNNNNNNNNNNNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape e,foGNNNNNNNNNNNNNNNNNU U-dC!edpoA=p i,j,k e,foGNNNNNNNNNNNNNNNNNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape _fINTEGER, PARgmm_slc xtn.fIN"se,foGNoGNNNNNNfoGNfoGNIF (ABS(valijk) .LT. hsic ) dta(i,j,k,jsub) =_valijk se,foGNoGNNNNNNNNNNii IF e,foGNNNNNfoGNii IF e,foGNNNNNii IFe,foGNNNNN = MT .LE. TM e,foGNii DOfoGNNNNN = p=npos,1,-1 e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i U-dC!edghost layicsld NUr(avecia,iUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,iCALL ap_fiel _push(gmm_topoid,gmm_meshid,dta,info) MKi=CIIF (info .NE. iip((PPap(cscces )_re3N e,foGNNNNNinfo = iip(errorierror MKi=CINNNNpALL iip(error(iip(err_sub_failed,'gmm_extenL',tr&s1p,'t&p,'ttttt'pushioo fiel ac (a failed',__LINE__,info) MKi=CINNNNGOTO 9999 e,foGNii IF ecia,iCALL ap_fiel _senL(info) MKi=CIIF (info .NE. iip((PPap(cscces )_re3N e,foGNNNNNinfo = iip(errorierror MKi=CINNNNpALL iip(error(iip(err_sub_failed,'gmm_extenL',tr&s1p,'t&p,'ttttt'senLioo ghosts failed',__LINE__,info) MKi=CINNNNGOTO 9999 e,foGNii IF ecia,iCALL ap_fiel _pop(gmm_topoid,gmm_meshid,dta,ghostsize,info) MKi=CIIF (info .NE. iip((PPap(cscces )_re3N e,foGNNNNNinfo = iip(errorierror MKi=CINNNNpALL iip(error(iip(err_sub_failed,'gmm_extenL',tr&s1p,'t&p,'ttttt'poppioo fiel ac (a failed',__LINE__,info) MKi=CINNNNGOTO 9999 e,foGNii IF #elifndtTIM_==ndt2Dve,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i Red)unj srlic:Lic =po,0 neighborsnshopoA=psp buggm_ipos e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,iDO p=npos,1,-1 e,foGNN NNiie,f= gmm_ipos(1,p) MKi=CINNNNjje,f= gmm_ipos(2,p) MKi=CINNNNjsubf= gmm_ipos(3,p) MKi=CINNNNisubf= topo%isubRint(jsub) MKi=CINNNNxhie,=Nmesh%nesGEs(1,isub) MKi=CINNNNyhie,=Nmesh%nesGEs(2,isub) MKi=CINNNNfdta0=Nfdta(ii,jj,jsub) MKi=CINNNNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d= e,foGNfoGNU GMM --dC!edconLe!!-d (el iKim:2a) e,foGNfoGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d= e,foGNfoGNIF (.NOT.(ABS(fdta0).GT.TM))_re3N e,foGNNNNNNNNNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_c e,foGNNNNNNNNNU Re =po,0 non-acceps spcloseeneighbors e,foGNNNNNNNNNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_c e,foGNNNNNNNNNi =Niie- 1 eeeeeeeeeeeeeej =_jj e,foGNNNNNNNNNIF (i.GT.0)_re3N e,foGNNNNNfoGNfoGNIF ((gmm_snmte2d(i,j,jsub) .NE. &s1p,'t&p,'tttttttttttttgmm_(PPap(Tcceps s)t.AND. &s1p,'t&p,'ttttttttttttt(ABS(fdta(i,j,jsub)).GT.ABS(fdta0)))_re3N e,foGNNNNNNNNNNNNNNNNNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape e,foGNNNNNNNNNNNNNNNNNU U-dC!edpoA=p i,j e,foGNNNNNNNNNNNNNNNNNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape _fINTEGER, PARgmm_slc xtn.fIN"se,foGNoGNNNNNNfoGNfoGNIF (valijk .LT. hsic ) dta(i,j,jsub) =_valijk se,foGNoGNNNNNNfoGNii IF e,foGNNNNNfoGNii IF e,foGNNNNNfoGNi =Niie+ 1 e,foGNNNNNNNNNj =_jj e,foGNNNNNNNNNIF (i.LE.xhi)_re3N e,foGNNNNNfoGNfoGNIF ((gmm_snmte2d(i,j,jsub) .NE. &s1p,'t&p,'tttttttttttttgmm_(PPap(Tcceps s)t.AND. &s1p,'t&p,'ttttttttttttt(ABS(fdta(i,j,jsub)).GT.ABS(fdta0)))_re3N e,foGNNNNNNNNNNNNNNNNNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape e,foGNNNNNNNNNNNNNNNNNU U-dC!edpoA=p i,j e,foGNNNNNNNNNNNNNNNNNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape _fINTEGER, PARgmm_slc xtn.fIN"se,foGNoGNNNNNNfoGNfoGNIF (valijk .LT. hsic ) dta(i,j,jsub) =_valijk se,foGNoGNNNNNNfoGNii IF e,foGNNNNNfoGNii IF e,foGNNNNNfoGNi =Nii e,foGNNNNNNNNNj =_jje- 1 se,foGNoGNNNNNNIF (j.GT.0)_re3N e,foGNNNNNfoGNfoGNIF ((gmm_snmte2d(i,j,jsub) .NE. &s1p,'t&p,'tttttttttttttgmm_(PPap(Tcceps s)t.AND. &s1p,'t&p,'ttttttttttttt(ABS(fdta(i,j,jsub)).GT.ABS(fdta0)))_re3N e,foGNNNNNNNNNNNNNNNNNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape e,foGNNNNNNNNNNNNNNNNNU U-dC!edpoA=p i,j e,foGNNNNNNNNNNNNNNNNNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape _fINTEGER, PARgmm_slc xtn.fIN"se,foGNoGNNNNNNfoGNfoGNIF (valijk .LT. hsic ) dta(i,j,jsub) =_valijk se,foGNoGNNNNNNfoGNii IF e,foGNNNNNfoGNii IF e,foGNNNNNfoGNi =Nii e,foGNNNNNNNNNj =_jje+ 1 se,foGNoGNNNNNNIF (j.LE.yhi)_re3N e,foGNNNNNfoGNfoGNIF ((gmm_snmte2d(i,j,jsub) .NE. &s1p,'t&p,'tttttttttttttgmm_(PPap(Tcceps s)t.AND. &s1p,'t&p,'ttttttttttttt(ABS(fdta(i,j,jsub)).GT.ABS(fdta0)))_re3N e,foGNNNNNNNNNNNNNNNNNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape e,foGNNNNNNNNNNNNNNNNNU U-dC!edpoA=p i,j e,foGNNNNNNNNNNNNNNNNNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape _fINTEGER, PARgmm_slc xtn.fIN"se,foGNoGNNNNNNfoGNfoGNIF (valijk .LT. hsic ) dta(i,j,jsub) =_valijk se,foGNoGNNNNNNfoGNii IF e,foGNNNNNfoGNii IF e,foGNNNNNii IFe,foGNNNNN = MT .LE. TM e,foGNii DOfoGNNNNN = p=npos,1,-1 e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i U-dC!edghost layicsld NUr(avecia,iUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=i-_fvecia,iCALL ap_fiel _push(gmm_topoid,gmm_meshid,dta,info) MKi=CIIF (info .NE. iip((PPap(cscces )_re3N e,foGNNNNNinfo = iip(errorierror MKi=CINNNNpALL iip(error(iip(err_sub_failed,'gmm_extenL',tr&s1p,'t&p,'ttttt'pushioo fiel ac (a failed',__LINE__,info) MKi=CINNNNGOTO 9999 e,foGNii IF ecia,iCALL ap_fiel _senL(info) MKi=CIIF (info .NE. iip((PPap(cscces )_re3N e,foGNNNNNinfo = iip(errorierror MKi=CINNNNpALL iip(error(iip(err_sub_failed,'gmm_extenL',tr&s1p,'t&p,'ttttt'senLioo ghosts failed',__LINE__,info) MKi=CINNNNGOTO 9999 e,foGNii IF ecia,iCALL ap_fiel _pop(gmm_topoid,gmm_meshid,dta,ghostsize,info) MKi=CIIF (info .NE. iip((PPap(cscces )_re3N e,foGNNNNNinfo = iip(errorierror MKi=CINNNNpALL iip(error(iip(err_sub_failed,'gmm_extenL',tr&s1p 't&p,'ttttt'poppioo fiel ac (a failed',__LINE__,info) MKi=CINNNNGOTO 9999 e,foGNii IF #enLes e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i Return e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fve9999diletINUEse,foGNpALL subsnop('gmm_extenL_bkwd',t0,info) e,foGNRETURNvv#ff n_dtTIM_==ndt2Dv#ff n_dtK/ac_==ndt 20_pp_v ilet_sts1p,'trii aSUBINgmm_extenL_bkwd_2ds #elifnndtK/ac_==ndt 20_pp_v ilet_sts1p,'trii aSUBINgmm_extenL_bkwd_2dd #enLes #elifnndtTIM_==ndt3Dv#ff n_dtK/ac_==ndt 20_pp_v ilet_sts1p,'trii aSUBINgmm_extenL_bkwd_3ds #elifnndtK/ac_==ndt 20_pp_v ilet_sts1p,'trii aSUBINgmm_extenL_bkwd_3dd #enLes #enLes i!X-_igmm_extenL_fwd00006440001750000175000000052404650017634 00713621515upoi= omaromare,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i M CI=p=CINNNNMPLEX,ii ad_fI i!X-_igmm_extenL_fwd e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i vecia,i PurposeeINNNNMPMesh i!X-_ fINTEGEs -'usourcedcode dori -'uvecia,i dorESSd extenLioo byNGLe2Dshould mchiw.gmethodbrary (PPM)el is s RemkseINNNNMrary (PPM)el is s Re Ifrnces_NNMrary (PPM)el is s Revi_ frsNNNNMrary (PPp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i $Log:I i!X-_igmm_extenL_fwd.f,v $M)el is s Revi_ fr 1.1.1.1 207/07/13 10:18:58NNivos e,foGNUGNpBL d)undcMl.el is sPM l8092 Zrary (PPM)el is s Revi_ fr 1.1 205/05/10 04:41:17NNivos e,foGNUGNNewlywcreossd duriw.gmi!X-arizae=vpushogmm_ch. Mchiw. e,foGNUGNaoNDorthogonal extenLisbuar nowp buse(PPa!edbyNGLe2sld NUfastic e,foGNU copoilC!!-dbrary (P!rary (PPp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i SAIC Gi=pp (ETH Zurich), ----------------------------C (ETHiS FOFluid Dynamics (DTUnel is spel is spel is sp T_isdfi = ossp. -cense,foP. IiinooP. -1p = Mesh Library (PPM).el is spel is sp PPM ossfh mtsoftware: youmPartredih_ribute!itif!0/ FOmoth_y-----'u_!itiPPM FOc_Oieermscense,foGNU Less FOGene Ii Public Lic (se OGICAL !tasppublished byse,foFh mtSoftware FoPPMthe d, eiublicOGICAL !tad_fd_f!3cense,foLic (se, FO(=!dyour ophe d)undcMlatlicOGICAL !tad_fd_f.el is spel is sp PPM ossdih_ributer op_ frehopeelateritiute!itif!0/ful,el is sp but WITHe3g ANY WARRANTY;iwithout evep_ freimplier wU rantycenel is sp MERCHANTABILITY FOFITNESS FOR Ap_h TICULAR PURPOSE !SeeouldOTO 9999mGNU Gene Ii Public Lic (se f FOmore details.el is spel is sp Youmshould NU Gereral Puba copycense,foGNU Gene Ii Public Lic (seOGICAL !tashould GNU Less FOGene Ii Public Lic (se aloNDrwith PPM. Ifrno ,el is sp seeo.el is spel is sp P. IiinooP. -1p = Mesh Library (PPM)el is sp ETH Zurich----9999mCH-8092 Zurich, Switz ilaM,-os0,-1pecia,i S- (0,-1p =he losunfo(ik=' rary (PPp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,rary (PPp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i DMETERsINGLerary (PPp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv#AMETERndt 20_pp_v ilet_st 1v#AMETERndt 20_pp_v ilet_st 2v#AMETERndt2D 3v#AMETERndt3D 4 rary (PMODULEI i!X-_igmm_extenL_fwd MKi=CINNNPp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=i MKi=CINNNP DMETERs =po,facesisdigmm_extenL_fwd e,foGNNNNPp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=i MKi=CINNNCe,RNTEGEigmm_extenL_fwd e,foGNNNN (PMODULEIPROCEDUREigmm_extenL_fwd_2ds e,foGNNNN (PMODULEIPROCEDUREigmm_extenL_fwd_2dd e,foGNNNN (PMODULEIPROCEDUREigmm_extenL_fwd_3ds e,foGNNNN (PMODULEIPROCEDUREigmm_extenL_fwd_3dd e,foGNNNNii aCe,RNTEGER MKi=CINNNPp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=i MKi=CINNNP fINTEGER -'usourced MKi=CINNNPp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=i MKi=CINNNiletAINS v#AMETERndt IMndt2Dv#AMETERndtK/ac_dt 20_pp_v ilet_sts_fINTEGER, PARgmm_extenL_fwd.f" #ublifndtK/acv#AMETERndtK/ac_dt 20_pp_v ilet_sts_fINTEGER, PARgmm_extenL_fwd.f" #ublifndtK/acv#ublifndt IM v#AMETERndt IMndt3Dv#AMETERndtK/ac_dt 20_pp_v ilet_sts_fINTEGER, PARgmm_extenL_fwd.f" #ublifndtK/acv#AMETERndtK/ac_dt 20_pp_v ilet_sts_fINTEGER, PARgmm_extenL_fwd.f" #ublifndtK/acv#ublifndt IM voGNNNNii aMODULEI i!X-_igmm_extenL_fwd i!X-_ifft00006440001750000175000000052405111111114650017634 01450017276upoi= omaromar=CINNNPp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=i-_fvecia,i Ss byNGLe2DalMP i!X-_ifftrary (PPp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i SAIC Gi=pp (ETH Zurich), ----------------------------C (ETHiS FOFlu 2004/ape2d_vec_cc(d=ia_fvecia,i SAIC Gi=pp (ETH Zurich), ---------------AS/ape2d_v Zurich)99992CyNGLe2sld NUfaeossd.gmiFFTW p' soNDrwexecut.guld pmel is sp ElPM FGLe2sld e,forui_mFOc NUfa2004/ape2dz mesh sotrabut x (1DSwitz ilaM xymesh sotrabut xric2DSwitz ilaM xyzesh sotrabut xrz (3DSwitz ilaM scaesh soscalae,foGNU covecesh sovectoe,foGNU cof mesh sotESSd extrary (PPp b mesh sockESSd trary (PPp c mesh sopoillexry (PPp r mesh soosslwitz ilaM s mesh soooth #res c fr 1witz ilaM d mesh soOKUP #res c fr 1witz ilawitz ilaM e.g. 3d_vec_fr2c_xy_d: 3Dovectoe FORyotESSd extOR sNm grfrom2004/ape2d_vec_cc(d=ia_fveciiiiiiossldipoillexoNDrwtrasbut x NDrwyul,s c-ds e,foGNU!!2d_vec_cc(d=ia_fveciiiiiid)lf. FUr(aKUP #r(avecia,iUSawitz ilaM Thd NUllow.gulriablsp bc Licbe i,jille0,-ced,foGNU!!2d_3d_vec_fc2c_z_d,foGNU!!2d_3d_vec_bc2c_z_d,foGNU!!2d_3d_vec_fr2c_xy_d,foGNU!!2d_3d_vec_bc2r_xy_d,foGNU!!,foGNUGNaoNs/>rmalae=vpushNGLe2Dalexis faiUral bugg.gulpposeeIs,foGNU!!,foGNUGNaosofTYsitraw calld e,foiOKUP #res c fr 1 FGLe2sld IiinooP. -1p = Mel oc IFFT FGLe2sld i Publibe callNESSorg/'uso'osslest' poid,g/shid,dcia,iUSawitz ilaM Thd FGLe2sld reecift -'usopodic N+1oA=psp bpodic BC cfopo%isbcf MKi=CIUS butTYsOKld Nuoc dut FFTd NUfasreeacioe BCKi=CIUS ItOKld not workbuaNmixNESpodic/sreeacioe BCbut WITHXYul,s c-ds Ki=CIUS po%isbcf M)_=_/Ssss, Gs!fi;iwitut x, )TO i;iwitut y, )3) z, )4) x..e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecMETERndt 20_pp_v 0AMETERndt 20_pp_v 1ary (PMODULEI i!X-_igmtrary (PPp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i SA1DxtOR sNm g,lda,i!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,iCF RNTEGEigmtra_tESSd e_1e,foGNNNNiiDULEIPROCEDUREigmtra_p' _3d_vec_fc2c_z_s,foGNNNNiiDULEIPROCEDUREigmtra_p' _3d_vec_fc2c_z_e,foGNNN aCe,RNTEGER MKi=CINN RNTEGEigmtra_ckESSd _1e,foGNNNNiiDULEIPROCEDUREigmtra_p' _3d_vec_bc2c_z_s,foGNNNNiiDULEIPROCEDUREigmtra_p' _3d_vec_bc2c_z_e,foGNNN aCe,RNTEGER MKi=CINN RNTEGEigmtra_execute_1e,foGNNNNiiDULEIPROCEDUREigmtra_exec_3d_vec_c2c_z_s,foGNNNNiiDULEIPROCEDUREigmtra_exec_3d_vec_c2c_z_e,foGNNN aCe,RNTEGER MKi=CINN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i SA2DxtOR sNm g,lda,i!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,iCF RNTEGEigmtra_tESSd e_2e,foGNNNNiiDULEIPROCEDUREigmtra_p' _3d_vec_fr2c_xy_s,foGNNNNiiDULEIPROCEDUREigmtra_p' _3d_vec_fr2c_xy_d,foGNU! aCe,RNTEGER MKi=CINN RNTEGEigmtra_ckESSd _2e,foGNNNNiiDULEIPROCEDUREigmtra_p' _3d_vec_bc2r_xy_s,foGNNNNiiDULEIPROCEDUREigmtra_p' _3d_vec_bc2r_xy_d,foGNU! aCe,RNTEGER MKi=CINN RNTEGEigmtra_execute_2e,foGNNNNiiDULEIPROCEDUREigmtra_exec_3d_vec_fr2c_xy_s,foGNNNNiiDULEIPROCEDUREigmtra_exec_3d_vec_bc2r_xy_s,foGNNNNiiDULEIPROCEDUREigmtra_exec_3d_vec_fr2c_xy_e,foGNNNNiiDULEIPROCEDUREigmtra_exec_3d_vec_bc2r_xy_d,foGNU! aCe,RNTEGER MKi=CINN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i SAN>rmalae=vpuslda,i!p kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fv,lda,iCF RNTEGEigmtra_/>rmalaee,foGNNNNiiDULEIPROCEDUREigmtra_/>rmalaee_rs,foGNNNNiiDULEIPROCEDUREigmtra_/>rmalaee_cs,foGNNNNiiDULEIPROCEDUREigmtra_/>rmalaee_re,foGNNNNiiDULEIPROCEDUREigmtra_/>rmalaee_cd,foGNU! aCe,RNTEGER MKi=CINN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i SAif!0FFT p' NGLerKi=CINN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i S!S/aLerch)99992.guld poFFTW p' NDrwip bsett.gu= foGNTYPE( gmtra_p' Ki=CINNNPp !! FORyoo' A=po, ts,nLex: NUfabsnoKi=CINNNCe,RNTGER*8,MpNt_st(:,:),d_fIN___: phi' => NULL()Ki=CINNNPp !!d podi0,-cMl.el is sPFFT (1D/2D/3DSwitz ilNCe,RNTGER rooankKi=CINNNPp !!mbfrnshopoA=psp bww.gnuchlsil,s c-ds el is sPpiece i;iwittOR sNm gedKi=CINNNPp !!Lex: id NUfaOk 4 GisiGsnoKi=CINNNCe,RNTGER,MpNt_st(:,:,:),d_fIN___: phnxKi=CINNNPp !!d podis c-ds el is sPtOR sNm gr(tESSd e/ckESSd Switz ilNCe,RNTGER rosignKi=CINNNPp !!d pothodDsdi;isetCtab po is mal p' Ki=CINNNPp,RNTGER rofl e,foGNRENPp !!d pombfrnshopopoilon, ciai;itOR sNm gKi=CINNNPp,RNTGER rohowmany,foGNRENPp !!d pose should ghinputTFORy,nLex: id NUfaOk 4Ki=CINNNCe,RNTGER,MpNt_st(:,:),d_fIN___::: infoefrnd,foGNRENPp !!d pose should ghGLeputTFORy,nLex: id NUfaOk 4Ki=CINNNCe,RNTGER,MpNt_st(:,:),d_fIN___::: inooefrnd,foGNRENPp !!,el iR -'elld how sameopoilon, c (a faA=psp bw,foacioe but memoryKi=CINNNPp,RNTGER ro,el iR Ki=CINNNPp,RNTGER rooel iR Ki=CINNNPp !!,l,el-'elld how multilleTFORy bw,foacioe . I.e. a memoryhoufsetKi=CINNNPp,RNTGER ro,l,elKi=CINNNPp,RNTGER rool,elKi=CINN aCePE( gmtra_p' KKi=CINNetAINS v#METERndtK/ac_dt 20_pp_vMKi=CINN FORWARCePRANSFORMS - PLA_fINTEGER, Ptra/gmtra_p' _3d_vec_fc2c_z" #ubNTEGER, Ptra/gmtra_p' _3d_vec_fr2c_xy" #ui=CINN BACKWARCePRANSFORMS - PLA_fINTEGER, Ptra/gmtra_p' _3d_vec_bc2c_z" #ubNTEGER, Ptra/gmtra_p' _3d_vec_bc2r_xy" #ui=CINN EXECUpoAL OF PLA_SubNTEGER, Ptra/gmtra_exec_3d_vec_c2c_z" #ubNTEGER, Ptra/gmtra_exec_3d_vec_fr2c_xy" #ubNTEGER, Ptra/gmtra_exec_3d_vec_bc2r_xy" #ui=CINN NORMALIZATts_fINTEGER, Ptra/gmtra_/>rmalaee_r" #ubNTEGER, Ptra/gmtra_/>rmalaee_c" #uublifndtK/acv#AMETERndtK/ac_dt 20_pp_vMKi=CINN FORWARCePRANSFORMS - PLA_fINTEGER, Ptra/gmtra_p' _3d_vec_fc2c_z" #ubNTEGER, Ptra/gmtra_p' _3d_vec_fr2c_xy" #ui=CINN BACKWARCePRANSFORMS - PLA_fINTEGER, Ptra/gmtra_p' _3d_vec_bc2c_z" #ubNTEGER, Ptra/gmtra_p' _3d_vec_bc2r_xy" #ui=CINN EXECUpoAL OF PLA_SubNTEGER, Ptra/gmtra_exec_3d_vec_c2c_z" #ubNTEGER, Ptra/gmtra_exec_3d_vec_fr2c_xy" #ubNTEGER, Ptra/gmtra_exec_3d_vec_bc2r_xy" #ui=CINN NORMALIZATts_fINTEGER, Ptra/gmtra_/>rmalaee_r" #ubNTEGER, Ptra/gmtra_/>rmalaee_c" #uublifndtK/acv#Ai=CINN aCeDULEI i!X-_igmtrar im_exkickouf0000644000175000017500000005240511111111450017634 012210621727431upoi= omaromari=CINN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i SSs byNGLe2DalMP im_exkickoufry (PPp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i SAIC Gi=pp (ETH Zurich), ----------------------------C (ETHiS FOFlu Dynamics (DTUnel is spel is spel is sp T_isdfi = ossp. -cense,foP. IiinooP. -1p = Mesh Library (PPM).el is spel is sp PPM ossfh mtsoftware: youmPartredih_ribute!itif!0/ FOmoth_y-----'u_!itiPPM FOc_Oieermscense,foGNU Less FOGene Ii Public Lic (se OGICAL !tasppublished byse,foFh mtSoftware FoPPMthe d, eiublicOGICAL !tad_fd_f!3cense,foLic (se, FO(=!dyour ophe d)undcMlatlicOGICAL !tad_fd_f.el is spel is sp PPM ossdih_ributer op_ frehopeelateritiute!itif!0/ful,el is sp but WITHe3g ANY WARRANTY;iwithout evep_ freimplier wU rantycenel is sp MERCHANTABILITY FOFITNESS FOR Ap_h TICULAR PURPOSE !SeeouldOTO 9999mGNU Gene Ii Public Lic (se f FOmore details.el is spel is sp Youmshould NU Gereral Puba copycense,foGNU Gene Ii Public Lic (seOGICAL !tashould GNU Less FOGene Ii Public Lic (se aloNDrwith PPM. Ifrno ,el is sp seeo.el is spel is sp P. IiinooP. -1p = Mesh Library (PPM)el is sp ETH Zurich----9999mCH-8092 Zurich, Switz ilaM,-os0,-1pecia,i S- (0,-1p =he losunfo(ik=' ray (PPp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecf n_dtTIM_==ndt2Dv#ff n_dtK/ac_==ndt 20_pp_v ilet_sts1p,'triiBINgmm_exkickoufds e(f(a f,tol,resholnfo,sppel is 1p 't&p,'tttnpts,ipts,oseensthi) #elifnndtK/ac_==ndt 20_pp_v ilet_sts1p,'trSUBINgmm_exkickoufds d(f(a f,tol,resholnfo,sppel is 1p 't&p,'tttnpts,ipts,oseensthi) #elies #elifnndtTIM_==ndt3Dv#ff n_dtK/ac_==ndt 20_pp_v ilet_sts1p,'triiBINgmm_exkickoufd3 e(f(a f,tol,resholnfo,sppel is 1p 't&p,'tttnpts,ipts,oseensthi) #elifnndtK/ac_==ndt 20_pp_v ilet_sts1p,'trSUBINgmm_exkickoufd3 d(f(a f,tol,resholnfo,sppel is 1p 't&p,'tttnpts,ipts,oseensthi) #elies #elies e,foGNU!! Fsh LiNGLe2Dalmin(' -'usom_eAL !po,0 .gulsenLe!rlic:L accu!edb,foGNU!! Fapproximse, ICAL !tasl,elance i;iTY =po,facebr neit, i.e. uslda,i!p Fighbors o ghoGsspA=psp . Ep_ yosignc (p_ fs sis=po,fapresp basore details. FcC!!-dbrCAL PM po,facebr Fsothou=po,facesisdrees 0,,iICAL !aon-acik=e,foGNU!! ReTAl duset, applyoshif .gula(res -pros )_orary (PRE! e,foGNU!! *i[NOTE],foGNU!! *i======================================================================,foGNU!! Fsh LiNGLe2Daleossd slsenLe!-lic:L accu!edb (a faneTY =po,facebr,foGNU!! Fanry (rneeds!fi;ikickhouf!aoreiETERinjz/wweTAl dusetOTO tenL_f a,foGNU!! Fnne=vp.vfi;iaSS owubanGisary (PRE! e,foGNU!! *iThd oic should methodDsd (rlimitICAL !tad_oic should mefiETEr,foGNU!! Fs efrnces_NNhdl n 2Dpo,0 .gul'uriihshould ghin,fapo!!-dbr systeme,foGNU!! (Uou=hhbo shoic shFDfi;igetOhhbo shoic shiETERinjz!-dbrary (P!ra e,foGNU!! *iTesp bc Lici PwnANY WAsts o ghshif l n 2dis_NN(i.e. ip1Nii +_=_/S,foGNU!! Fntic eANY nNhdo gh +_but WITH FORyoLex: dis c-ly. WmoreuNNhdl,foGNU!! F!0/SStechniquu=hrncary (P!ra e,foGNU!! *iMaywitwici Puf actu ZuyTYsC!!-ghiposoNDrw!tashd postuuf!soARRANTY;,foGNU!! *isurvOGIgmm_exfiEinjz/??Fsh LiNTY;iwiteasy: jtPbecY ngeld posiin,fa,foGNU!! Fassign0,-chatld poL_f ould ghNGLe2Dali;iaSphysilIva!tashop is-dbrary (P!ra ei======================================================================,foGNU!! ry (P!ra ei===e Ifrnces_NN====,foGNU!! ry (P!ra eiD.L. Ce3gpf Fom FOFrove0,-csbuaNd mefticchiw.gmethodbra SIAM Jary (P!ra eiSci. Co,0 . 23(1):230-244,05/1e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecfoGNUp I=MEEGEs ay (PPp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecf TEGER, PARgmETERnd.h",foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecfoGNUp I=Mv Zuric,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecfoGNUpUS i!X-_igm(avecia,iUScfoGNUpUS i!X-_igm(avemm_ecfoGNUpUS i!X-_igmbsnmin('cfoGNUpUS i!X-_igmbsnmiopcfoGNUpUS i!X-_igmror MKi=CINNUS i!X-_igmTYsC!Ki=CINNUS i!X-_igmGLerf MKi=CIUSUS i!X-_igmwrTEr,foGNU!IMPLICIT NONEff n_dtK/ac_==ndt 20_pp_v ilet_sts1 |tK/ac_==ndt 20_pp_v ilet_sts1_COMPLEXlda,iCF RNTt,nTIIi AMEN___:: MK iip(erkLex_ooth #elc Lic (selm RNTt,nTIIi AMEN___:: MK iip(erkLex_OKUP #elies e,foGNU!!kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecfoGNUpMel s, 0,sv,a,iUScfoGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecf n_dTIM_==ndt2Dve,foGNUpAL(MK),nTIMpNt_st(2):,:,:)foGNUp POd_fIN___::::::::::::: rof(aveclifndtTIM_==ndt2D3e,foGNUpAL(MK),nTIMpNt_st(2):,:,:,:)foGNUPOd_fIN___::::::::::::: rof(aveclies e,foGNU!! FLAl dusetO(ave. E=!dyouOk 4 3r(tESA2Dxscalaeiel acs)d_f.eOk 4Ki=CINN! F4r(tESA3Dxscalaeiel acs) (s2dis_N: ,j,js[k]sub) MOnERhinput: oldKi=CINN! FTAl dunne=vp.vfvalue . TY =po,facebr /SsstFTAl duik=eary (P!ra eiAhostsize e oul1y (rneeds!fuaNTYsiGEs. wh loustPbee1,fillNESSorg/'usry (P!ra eioldFTAl dunne=vp.vfvaluefuaNinput eiERhGLeput: 2e!rlic:L approximse, ry (P!ra eiould ghsign dur,elance nne=vp.vfhdo ghd ghin,fapo!!-dbr thodDsdoe,foGNU!! FCe3gp P=psp bffromiTY =po,facebr NTY;ic LicTY =valuefGE(b.cf n_dTIM_==ndt2Dve,foGNUpAL(MK),nTIMpNt_st(2):,:,:,:)foGNUPO,RNT(IoNnTIOPTts_AL: coehiclifndtTIM_==ndt2D3e,foGNUpAL(MK),nTIMpNt_st(2):,:,:,:,:)foGPO,RNT(IoNnTIOPTts_AL: coehiclies e,foGNU!! FOk 4 5 (3d)_f.eOk 4F4r(2d)_el ac ecififyo ghd ghsi!!ve ICAL !tasoGsslda,i!p FiEs(2. 1stoLex: : 1.ip((Pdim, !tan j,js[k]sub) .IOPTts_AL. UniNm gKi=CINN FoGssp/Ssss, Gs!fndtab0,,i. Gstsiyicsld AL ze e >=1ustPbeeposs -fillNE. ,foGNUpAL(MK),n PO,RNT(IoN n topo;,foGNU!! *iRe!!-dLicTol isnce ni -'uvedee OGin dur,elance i;iTY =po,facebrary (P!ra ei1E-3p/Sss goDsdchois_. TY =Tol isnce is=po multilled AL oGsspacio.gu=.,foGNUpAL(MK),n PO,RNT(IoN n topeshol,foGNU!! *iThshololdFni -value =po S owubanGisfuaNinput. Anyuik=e-cro)_orrfrom2004/ape Fa=valueflaeg eANY nNth LiNTY;inot brch)9GEs.rp basopo,facebra SetKi=CINN! F!0/SSt;iTY =ab0olmscevaluefuf wh!-gv Lic (sel ac GLesiR -'usobanry (Ki=CINN! FiETERinjz/!fi;.,foGNUpAL(MK),nTIMpNt_st(2):,:n POd_fIN__ppel OPTts_AL: tooseenstKi=CINN! FcoliciEiteICAL !tasoseenstaA=psp buaNd mepo,facebr fromiTY =mhol,foGNU!! *iA=psp buggipts. Noubliiquu!IOPTts_AL. Onl !po,0 p banryrurn s!fnd,foGNU!! *iAs 0,,i.c (selm RNTt,n TIMpNt_st(2):,:n POd_fIN__ppel OPTts_AL: toiptsKi=CINN! FiEdis_NNAL sh =>A=psp bwdjebr-chi;iTY =po,facebra 1stoLex: :Ki=CINN! Fi,js(k)sub) (sC!!liGsn ID); 2e!: 1.inpts. OPTts_AL:has i;iwi,foGNU!! *iAs 0,,ifndtoseenstaisiAs 0,,i! Noubliiquu. TY =sameoA=p i,NTY;ioccu!,foGNU!! *imultilletish .c (selm RNTt,n PO,RNT(IoNOUTnTIOPTts_AL: conptsKi=CINN! Fs1 input: ndtT. 0.0iTY =TAl duid not =po,0 n banryrum992Cyuntouchesary (PRE! e Onl !!tasoseenstaA=psp be,forurn s!.iERhGLetopot!limbfrnshopoA=psp 2004/ape Fadjebr-chi;iTY =po,facebra OPTts_AL. Has i;iwiiAs 0,,ifndtoseenstao!,foGNU!! *iiptsbe,foAs 0,,i!c (selm RNTt,n PO,RNT(Iol OUTn infofo,foGNU!! *iRern emte2us,.0iupbr sces )_e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecfoGNUp I=LC!!liriablburic,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecfoGNUp RNTt,n inf,k,jsxhi,yhi,zhi,ip1,jp1,kp1,ns e,foGNUp RNTt,n infGsnsub) ,sneg,,,'Lex,f,iop'Li,foGNUp RNTt,n inm,n,p,kpp,jpn,pp2,ns2,ll,npot!l,lpot!lc (selm RNTt,n TMpNt_st(2)2) inldu,foGNUpAL(MK),n top0,dx,dy,dz,nrm2,big,ic ) ,foGNUpAL(MK),n tocebx,ceby,cebz,cebxy,cebxz,cebyz,cebxyz,foGNUpAL(MK),n toror,tol2,pxk,sprod,x,y,z,foGNUpAL(MK),nTMpNt_st(2)p((Pdim) toxk,x0,gradpxk,delta1,delta2,x0mxk,xkhalf,foGNUpAL(MK),nTMpNt_st(2):),d_fIN___ phihi,foGNUpLOGICAL: tolokc (selm RNTt,n TIMpNt_st(2)8) toneg,foGNUpAL(MK),nTIMpNt_st(2)0:3) toxv,yv,gxv,gyv,foGNUpCHi ACN__(LEN=p((Pchar) inmesg,cbuf,foGNUpPE( )p((Ptopoid)ppel isd_fIN___:: topopo,foGNUpPE( )p((Ptoui_meshid),sd_fIN___:: tomhol,f n_dTIM_==ndt2Dve,foGNUpAL(MK),nTIMpNt_st(2)16,16):: toAc (selm RNTt,n TIMpNt_st(2)16)::_:: toAi ray (PPpAL(MK),nTIMpNt_st(2)16)::_:: torhs,coef,foGNUpAL(MK),nTIMpNt_st(2)4,4) topsi,foGNUpAL(MK),nTIMpNt_st(2)4) topecia,i AL(MK),nTIMpNt_st(2)2) toxr,xi,foGNUp RNTt,n TIIi AMEN___ toN du= 16clifndtTIM_==ndt2D3e,foGNUpAL(MK),nTIMpNt_st(2)64,64):: toAc (selm RNTt,n TIMpNt_st(2)64)::_:: toAi ray (PPpAL(MK),nTIMpNt_st(2)64)::_:: torhs,coef,foGNUpAL(MK),nTIMpNt_st(2)4,4,4):: topsi,foGNUpAL(MK),nTIMpNt_st(2)0:3) tozv,gzv,foGNUpAL(MK),nTIMpNt_st(2)8) topecia,i AL(MK),nTIMpNt_st(2)3) toxr,xi,foGNUp RNTt,n TIIi AMEN___ toN du= 64elies e,foGNU!!kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecfoGNUpMelDATA,foGNU!!kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecf n_dTIM_==ndt2D3e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecfoGNUp I=LUocebts oe=vpushod ghsystem matrix ni -'uve3DxtOi-cubiccfoGNUp I=in,fapo!!-dbr po!ynomRin. Cossd duhdo ghgmm_exeossd _3dmatrix.me,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecMNTEGER, PARgmm_ex3dmatrixm(aveIN"se,foGNoG kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecfoGNUp I=P OGut!-dbr Lex: vectoe cOGICAL Uocebts oe=vpushod ghmatrix.cfoGNUp I=Cossd duhdo ghgmm_exeossd _3dmatrix.me,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecMNTEGER, PARgmm_ex3dp OGutm(aveIN"se,lifndtTIM_==ndt2Dve,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i ReLUocebts oe=vpushod ghsystem matrix ni -'uve2D bi-cubiccfoGNUp I=in,fapo!!-dbr po!ynomRin. Cossd duhdo ghgmm_exeossd _2dmatrix.me,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecMNTEGER, PARgmm_ex2dmatrixm(aveIN"se,foGNoG kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecfoGNUp I=P OGut!-dbr Lex: vectoe cOGICAL Uocebts oe=vpushod ghmatrix.cfoGNUp I=Cossd duhdo ghgmm_exeossd _2dmatrix.me,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecMNTEGER, PARgmm_ex2dp OGutm(aveIN"se,lies #rary (PPp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i DMIETERinj FoPPMthe dkind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i LL subsnopartgmm_exkickouft0,info) e,foGNREnpot!lu= 0,foGNREbigGNRE=fGE(b(bige,foGNREic ) RE=f0.9_MK*big,foGNREpopo => p((Ptopomm_topoid,g)%tKi=CINNsh =>=> po%issh =(m_meshid,d)ry (PPp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i DMCheckbe,, 0,sv,,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecfoGNUp F )p((Pd bug T.AB _re3N e,foGNNNNNfo (.NOT.(A p((PiETERinjz/!re3N e,foGNNNNNNNNNNNfo = iip(errorierror MKi=CINNNNpA,i LL sup(error(iip(err_sup(ernoiETE,gmm_exkickouft0&s1p,'t&p,'ttttttttttt'Please call p((PiETE first!__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,foGNNNNNii (.Nm_exlsiztT. 0.0re3N e,foGNNNNNNNNNNNfo = iip(errorierror MKi=CINNNNpA,i LL sup(error(iip(err_sup(ernoiETE,gmm_exkickouft0&s1p,'t&p,'ttttttttttt'Please call m_ipoETE first!__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,foGNNNNNii (.NtolLE. TM0.0_),n 3N e,foGNNNNNNNNNNNfo = iip(errorierror MKi=CINNNNpA,i LL sup(error(iip(err_sue,, 0,sv,gmm_exkickouft0&s1p,'t&p,'ttttttttttt'Tol isnce stPbeepo>0!__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,foGNNNNNii (.NPREST(Iooseenst_re3N e,foGNNNNNNNNNNN (.NOT.(APREST(Ioipts_re3N e,foGNNNNNNNNNNNNNNNfo = iip(errorierror MKi=CINNNNpA,i ,i LL sup(error(iip(err_sue,, 0,sv,gmm_exkickouft0&s1p,'t&p,'ttttttttttttttt'iptsbstPbeeposs 0,,ifndtoseenstais__LINE__,info) MKi=CINNNNGOOOOOOOOOTO 9999 e,foGNiiiiiiiiii IF e,foGNNNNNiiNNNN (.NOT.(APREST(Ionpts_re3N e,foGNNNNNNNNNNNNNNNfo = iip(errorierror MKi=CINNNNpA,i ,i LL sup(error(iip(err_sue,, 0,sv,gmm_exkickouft0&s1p,'t&p,'ttttttttttttttt'nptsbstPbeeposs 0,,ifndtoseenstais__LINE__,info) MKi=CINNNNGOOOOOOOOOTO 9999 e,foGNiiiiiiiiii IF e,foGNNNNNii IF e,foGNNNNNii (.NPREST(Ioipts_re3N e,foGNNNNNNNNNNN (.NOT.(APREST(Ionpts_re3N e,foGNNNNNNNNNNNNNNNfo = iip(errorierror MKi=CINNNNpA,i ,i LL sup(error(iip(err_sue,, 0,sv,gmm_exkickouft0&s1p,'t&p,'ttttttttttttttt'nptsbstPbeeposs 0,,ifndtiptsbis__LINE__,info) MKi=CINNNNGOOOOOOOOOTO 9999 e,foGNiiiiiiiiii IF e,foGNNNNNii IF e,foGNNNNNii (.NOT.(AASSOCIATED(f(a f_re3N e,foGNNNNNNNNNNNfo = iip(errorierror MKi=CINNNNpA,i LL sup(error(iip(err_sue,, 0,sv,gmm_exkickouft0&s1p,'t&p,'ttttttttttt'el ac (a faid not TYsC!!-gd!__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,f n_dTIM_==ndt2D3e,foGNUpNNii (.NSIZE(f(a f,4.LT. hspo%isnbRint(jre3N e,foGNNNNNNNNNNNfo = iip(errorierror MKi=CINNNNpA,i LL sup(error(iip(err_sue,, 0,sv,gmm_exkickouft0&s1p,'t&p,'ttttttttttt'el ac (a faNUfabom bsnoaid mi)_or__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,foGNNNNNii (.NUBOUND(f(a f,1.LT. hsmaxi)_re3N e,foGNNNNNfoGNfofo = iip(errorierror MKi=CINNNNpA,i LL sup(error(iip(err_sue,, 0,sv,gmm_exkickouft0&s1p,'t&p,'ttttttttttt'xodi0,-cMl.el iel ac (a faOKld not matloushid__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,foGNNNNNii (.NUBOUND(f(a f,2.LT. hsmaxi)_re3N e,foGNNNNNfoGNfofo = iip(errorierror MKi=CINNNNpA,i LL sup(error(iip(err_sue,, 0,sv,gmm_exkickouft0&s1p,'t&p,'ttttttttttt'yodi0,-cMl.el iel ac (a faOKld not matloushid__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,foGNNNNNii (.NUBOUND(f(a f,3.LT. hsmaxz)_re3N e,foGNNNNNfoGNfofo = iip(errorierror MKi=CINNNNpA,i LL sup(error(iip(err_sue,, 0,sv,gmm_exkickouft0&s1p,'t&p,'ttttttttttt'zodi0,-cMl.el iel ac (a faOKld not matloushid__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,lifndtTIM_==ndt2Dve,foGNUpNNii (.NSIZE(f(a f,3.LT. hspo%isnbRint(jre3N e,foGNNNNNNNNNNNfo = iip(errorierror MKi=CINNNNpA,i LL sup(error(iip(err_sue,, 0,sv,gmm_exkickouft0&s1p,'t&p,'ttttttttttt'el ac (a faNUfabom bsnoaid mi)_or__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,foGNNNNNii (.NUBOUND(f(a f,1.LT. hsmaxi)_re3N e,foGNNNNNfoGNfofo = iip(errorierror MKi=CINNNNpA,i LL sup(error(iip(err_sue,, 0,sv,gmm_exkickouft0&s1p,'t&p,'ttttttttttt'xodi0,-cMl.el iel ac (a faOKld not matloushid__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,foGNNNNNii (.NUBOUND(f(a f,2.LT. hsmaxi)_re3N e,foGNNNNNfoGNfofo = iip(errorierror MKi=CINNNNpA,i LL sup(error(iip(err_sue,, 0,sv,gmm_exkickouft0&s1p,'t&p,'ttttttttttt'yodi0,-cMl.el iel ac (a faOKld not matloushid__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,lies e,foGNU! IFe,foGNNNNN =! p((Pd bug foe F, 0,sv checkry (PPp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i DMSetld posiin,fas i;iworkbmemoryh(po mX-_ fI(avemm_e)ry (PPp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecf n_dtK/ac_==ndt 20_pp_v ilet_sts1p,'triiphi>=> m_(PPhi#elifnndtK/ac_==ndt 20_pp_v ilet_sts1p,'triiphi>=> m_(PPhidenLes e,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecia,i ReSetlh)9Gtasv,,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecfoGNUpxv(0=_va1.0_),cfoGNUpyv(0=_va1.0_),cfoGNUpgxv(0=_va0.0_),cfoGNUpgxv(1=_va1.0_),cfoGNUpgyv(0=_va0.0_),cfoGNUpgyv(1=_va1.0_),cf n_dTIM_==ndt2D3e,foGNUpzv(0=_va1.0_),cfoGNUpgzv(0=_va0.0_),cfoGNUpgzv(1=_va1.0_),cfies e,foGNU!!kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecfoGNUpMelNukeIOPTts_AL:TFORy ,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecfoGNUp F )PREST(Iooseenst_re3N e,foGNNNNNNNiop' iip(erPap(csdeTYsC!Ki=CINNNNNNLL sup(erTYsC!ooseenst,ldu,iop'Lo) MKi=CINNNNGO (info .NE. ii0re3N e,foGNNNNNNNNNNNfo = iip(errorierror MKi=CINNNNpA,i LL sup(error(iip(err_sudeTYsC!,gmm_exkickouft0&sssss1p,'t&p,'ttttttttttt'oseenstaA=psp bCLOSEST__LINE__,info) MKi=CINNNNGO IF e,foGNNN IF e,foGNNN (.NPREST(Ioipts_re3N e,foGNNNNNNNiop' iip(erPap(csdeTYsC!Ki=CINNNNNNLL sup(erTYsC!oipts,ldu,iop'Lo) MKi=CINNNNGO (info .NE. ii0re3N e,foGNNNNNNNNNNNfo = iip(errorierror MKi=CINNNNpA,i LL sup(error(iip(err_sudeTYsC!,gmm_exkickouft0&sssss1p,'t&p,'ttttttttttt'A=p i,cC!!-dbrs IPTS__LINE__,info) MKi=CINNNNGO IF e,foGNNN IF e,foGNNNlpot!lu= 0,foGNRE!kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecfoGNUpMelFindNsh =>acio.gu,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecfoGNUp F )p(erkLex .EQ.ip(erkLex_ooth #re3N e,foGNNNNNNNdxu= (po%issax_physs(1=-po%issin_physs(1=)/sss1p,'t&p,'tttttttAL(MKsh =%Nm(1=-1,p(erkLex_ooth #r,foGNNNNNNNdyu= (po%issax_physs(2=-po%issin_physs(2=)/ss1p,'t&p,'tttttttAL(MKsh =%Nm(2=-1,p(erkLex_ooth #r,foGNNNNNNN F )p((Pdim T.AB 2re3N e,foGNNNNNNNNNNNdzu= (po%issax_physs(3=-po%issin_physs(3=)/s1p,'t&p,'tttttttttttAL(MKsh =%Nm(3=-1,sssss1p,'t&p,'tttttttttttp(erkLex_ooth #r,foGNNNNNNN IF e,foGNNN LSE,foGNNNNNNNdxu= (po%issax_physs(1=-po%issin_physs(1=)/sss1p,'t&p,'tttttttAL(MKsh =%Nm(1=-1,p(erkLex_OKUP #r,foGNNNNNNNdyu= (po%issax_physs(2=-po%issin_physs(2=)/ss1p,'t&p,'tttttttAL(MKsh =%Nm(2=-1,p(erkLex_OKUP #r,foGNNNNNNN F )p((Pdim T.AB 2re3N e,foGNNNNNNNNNNNdzu= (po%issax_physs(3=-po%issin_physs(3=)/s1p,'t&p,'tttttttttttAL(MKsh =%Nm(3=-1,sssss1p,'t&p,'tttttttttttp(erkLex_OKUP #r,foGNNNNNNN IF e,foGNNN IF e,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecfoGNUp I=LCop ov Liall sh =>bcC!kic,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=ia_fvecfoGNUpDO ub) =1,po%isnbRint(j,foGNNNNNNNns e= 0,foGNREEEEEfGsnu= po%isibRint(j(ub) r,foGNNNNNNNxhi>= sh =%niEs(2(1sub) M e,foGNUpppppyhi>= sh =%niEs(2(2sub) M e,foGNUpppppcebxva0.5_),cfoGNUpppppcebyva0.5_),cfoGNUpppppcebxyva0.25_),cf n_dTIM_==ndt2D3e,foGNUpppppzhi>= sh =%niEs(2(3sub) M e,foGNUpppppcebzva0.5_),cfoGNUpppppcebxzva0.25_),cfoGNUpppppcebyzva0.25_),cfoGNUpppppcebxyzva0.125_),cfoGNUppppp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=iacfoGNUppppp elFindNsh =>celld through wh loud poik=e=TAl dupassesoNDrcfoGNUppppp elNY WAe,fooseen i;iTY =po,facebr (po exEGER -'usobic (sriescfoGNUppppp elod ghS owubanGis)cfoGNUppppp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/ape2d_vec_cc(d=iacfoGNUpppppDO k=1,zhi,foGNUpppppppppkp1Niik+1,foGNUpppppppppDO u=1,yhi,foGNUpppppppppppppjp1Niij+1,foGNUpppppppppppppDO i=1,xhi,foGNUppppppppppppppppp ests o ghd ghshif l n 2d: id 50%Fntic eANYen,foGNUppppppppppppppppp edoo ghd ghadd!ve I. AccliciEg i;iTnstaArogp(c.,foGNUpppppppppppppppppip1Nii +_,foGNUpppppppppppppppppneg(1:8) = 0,foGNREEEEEEEEEEEEEEEEElok = .TRUE.,foGNUppppppppppppppppp F )f(a f(i ,j ,k ,jb) MtT. 0.0.0_),n neg(1=_va1,foGNUppppppppppppppppp F )ABS)f(a f(i,k,jsjb) M) T.AB peshol)Elok = .FALSE.,foGNUppppppppppppppppp F )f(a f(ip1,j ,k ,jb) MtT. 0.0.0_),n neg(2=_va1,foGNUppppppppppppppppp F )ABS)f(a f(ip1,j,jsjb) M) T.AB peshol)Elok = .FALSE.,foGNUppppppppppppppppp F )f(a f(i ,jp1,k ,jb) MtT. 0.0.0_),n neg(3=_va1,foGNUppppppppppppppppp F )ABS)f(a f(i,kp1,ksjb) M) T.AB peshol)Elok = .FALSE.,foGNUppppppppppppppppp F )f(a f(ip1,jp1,k ,jb) MtT. 0.0.0_),n neg(4=_va1,foGNUppppppppppppppppp F )ABS)f(a f(ip1,jp1,ksjb) M) T.AB peshol)Elok = .FALSE.,foGNUppppppppppppppppp F )f(a f(i ,j ,kp1,jb) MtT. 0.0.0_),n neg(5=_va1,foGNUppppppppppppppppp F )ABS)f(a f(i,k,jp1,jb) M) T.AB peshol)Elok = .FALSE.,foGNUppppppppppppppppp F )f(a f(ip1,j ,kp1,jb) MtT. 0.0.0_),n neg(6=_va1,foGNUppppppppppppppppp F )ABS)f(a f(ip1,j,jp1,jb) M) T.AB peshol)Elok = .FALSE.,foGNUppppppppppppppppp F )f(a f(i ,jp1,kp1,jb) MtT. 0.0.0_),n neg(7=_va1,foGNUppppppppppppppppp F )ABS)f(a f(i,kp1,kp1,jb) M) T.AB peshol)Elok = .FALSE.,foGNUppppppppppppppppp F )f(a f(ip1,jp1,kp1,jb) MtT. 0.0.0_),n neg(8=_va1,foGNUppppppppppppppppp F )ABS)f(a f(ip1,jp1,kp1,jb) M)T.ABpeshol)Elok = .FALSE.,foGNUpppppppppppppppppsneg = neg(1=+neg(2=+neg(3=+neg(4=+neg(5=+neg(6=+&s1p,'t&p,'ttttttttttttttttttttttneg(7=+neg(8=,foGNUppppppppppppppppp F )(snegT.AB0).AND.(snegT. 08).AND.(lok_re3N e,foGNNNNNNNNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a,foGNNNNNNNNNNNNNNNNNNNNNNN Oldevaluefuf TY =TAl dunne=vp.v,foGNNNNNNNNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a,foGNNNNNNNNNNNNNNNNNNNNNNNDO p=-1,2,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNpp2 iip+2,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNkppNiik+p,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNDO n=-1,2,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNnp2 iin+2,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNjpnNiij+v,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNDO m=-1,2,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNpsi(m+2,ns2,pp2=_vaf(a f(i+m,jpn,kpp,jb) r,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN IFDO,foGNNNNNNNNNNNNNNNNNNNNNNNNNNN IFDO,foGNNNNNNNNNNNNNNNNNNNNNNN IFDO,foGNNNNNNNNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a,foGNNNNNNNNNNNNNNNNNNNNNNN R=pp -hGis-siR -ni -'Oi-cubic=in,fapo!!-dbr,foGNNNNNNNNNNNNNNNNNNNNNNN po!ynomRin. Thd oic should methodDsd (,foGNNNNNNNNNNNNNNNNNNNNNNN limitICAL !tad_oic should mefiETEr,foGNU!NNNNNNNNNNNNNNNNNNNN s efrnces_NNhdl nhrncary (P!rNNNNNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a,foGNNNNNNNNNNNNNNNNNNNNNNN valuef WA(i,k,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(1=_vapsi(2,2,2r,foGNNNNNNNNNNNNNNNNNNNNNNN valuef WA(i+1,k,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(2=_vapsi(3,2,2r,foGNNNNNNNNNNNNNNNNNNNNNNN valuef WA(i,j+1,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(3=_vapsi(2,3,2r,foGNNNNNNNNNNNNNNNNNNNNNNN valuef WA(i+1,k+1,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(4=_vapsi(3,3,2r,foGNNNNNNNNNNNNNNNNNNNNNNN valuef WA(i,k,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(5=_vapsi(2,2,3r,foGNNNNNNNNNNNNNNNNNNNNNNN valuef WA(i+1,k,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(6=_vapsi(3,2,3r,foGNNNNNNNNNNNNNNNNNNNNNNN valuef WA(i,k+1,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(7=_vapsi(2,3,3r,foGNNNNNNNNNNNNNNNNNNNNNNN valuef WA(i+1,k+1,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(8=_vapsi(3,3,3r,foGNNNNNNNNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a,foGNNNNNNNNNNNNNNNNNNNNNNN Dxf WA(i,k,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(9=_vafacx*(psi(3,2,2r-psi(1,2,2rr,foGNNNNNNNNNNNNNNNNNNNNNNN Dxf WA(i+1,k,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(10=_vafacx*(psi(4,2,2r-psi(2,2,2rr,foGNNNNNNNNNNNNNNNNNNNNNNN Dxf WA(i,k+1,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(11=_vafacx*(psi(3,3,2r-psi(1,3,2rr,foGNNNNNNNNNNNNNNNNNNNNNNN Dxf WA(i+1,k+1,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(12=_vafacx*(psi(4,3,2r-psi(2,3,2rr,foGNNNNNNNNNNNNNNNNNNNNNNN Dxf WA(i,k,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(13=_vafacx*(psi(3,2,3r-psi(1,2,3rr,foGNNNNNNNNNNNNNNNNNNNNNNN Dxf WA(i+1,k,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(14=_vafacx*(psi(4,2,3r-psi(2,2,3rr,foGNNNNNNNNNNNNNNNNNNNNNNN Dxf WA(i,k+1,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(15=_vafacx*(psi(3,3,3r-psi(1,3,3rr,foGNNNNNNNNNNNNNNNNNNNNNNN Dxf WA(i+1,k+1,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(16=_vafacx*(psi(4,3,3r-psi(2,3,3rr,foGNNNNNNNNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a,foGNNNNNNNNNNNNNNNNNNNNNNN Dyf WA(i,k,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(17=_vafacy*(psi(2,3,2r-psi(2,1,2rr,foGNNNNNNNNNNNNNNNNNNNNNNN Dyf WA(i+1,k,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(18=_vafacy*(psi(3,3,2r-psi(3,1,2rr,foGNNNNNNNNNNNNNNNNNNNNNNN Dyf WA(i,k+1,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(19=_vafacy*(psi(2,4,2r-psi(2,2,2rr,foGNNNNNNNNNNNNNNNNNNNNNNN Dyf WA(i+1,k+1,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(20=_vafacy*(psi(3,4,2r-psi(3,2,2rr,foGNNNNNNNNNNNNNNNNNNNNNNN Dyf WA(i,k,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(21=_vafacy*(psi(2,3,3r-psi(2,1,3rr,foGNNNNNNNNNNNNNNNNNNNNNNN Dyf WA(i+1,k,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(22=_vafacy*(psi(3,3,3r-psi(3,1,3rr,foGNNNNNNNNNNNNNNNNNNNNNNN Dyf WA(i,k+1,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(23=_vafacy*(psi(2,4,3r-psi(2,2,3rr,foGNNNNNNNNNNNNNNNNNNNNNNN Dyf WA(i+1,k+1,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(24=_vafacy*(psi(3,4,3r-psi(3,2,3rr,foGNNNNNNNNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a,foGNNNNNNNNNNNNNNNNNNNNNNN Dzf WA(i,k,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(25=_vafacz*(psi(2,2,3r-psi(2,2,1rr,foGNNNNNNNNNNNNNNNNNNNNNNN Dzf WA(i+1,k,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(26=_vafacz*(psi(3,2,3r-psi(3,2,1rr,foGNNNNNNNNNNNNNNNNNNNNNNN Dzf WA(i,k+1,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(27=_vafacz*(psi(2,3,3r-psi(2,3,1rr,foGNNNNNNNNNNNNNNNNNNNNNNN Dzf WA(i+1,k+1,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(28=_vafacz*(psi(3,3,3r-psi(3,3,1rr,foGNNNNNNNNNNNNNNNNNNNNNNN Dzf WA(i,k,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(29=_vafacz*(psi(2,2,4r-psi(2,2,2rr,foGNNNNNNNNNNNNNNNNNNNNNNN Dzf WA(i+1,k,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(30=_vafacz*(psi(3,2,4r-psi(3,2,2rr,foGNNNNNNNNNNNNNNNNNNNNNNN Dzf WA(i,k+1,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(31=_vafacz*(psi(2,3,4r-psi(2,3,2rr,foGNNNNNNNNNNNNNNNNNNNNNNN Dzf WA(i+1,k+1,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(32=_vafacz*(psi(3,3,4r-psi(3,3,2rr,foGNNNNNNNNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a,foGNNNNNNNNNNNNNNNNNNNNNNN DxDyf WA(i,k,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(33=_vafacxy*(psi(3,3,2r-psi(1,3,2r- &s1p,'t&p,'ttttttttttttttttttttttttttttttttttttpsi(3,1,2r+psi(1,1,2rr,foGNNNNNNNNNNNNNNNNNNNNNNN DxDyf WA(i+1,k,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(34=_vafacxy*(psi(4,3,2r-psi(2,3,2r- &s1p,'t&p,'ttttttttttttttttttttttttttttttttttttpsi(4,1,2r+psi(2,1,2rr,foGNNNNNNNNNNNNNNNNNNNNNNN DxDyf WA(i,k+1,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(35=_vafacxy*(psi(3,4,2r-psi(1,4,2r- &s1p,'t&p,'ttttttttttttttttttttttttttttttttttttpsi(3,2,2r+psi(1,2,2rr,foGNNNNNNNNNNNNNNNNNNNNNNN DxDyf WA(i+1,k+1,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(36=_vafacxy*(psi(4,4,2r-psi(2,4,2r- &s1p,'t&p,'ttttttttttttttttttttttttttttttttttttpsi(4,2,2r+psi(2,2,2rr,foGNNNNNNNNNNNNNNNNNNNNNNN DxDyf WA(i,k,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(37=_vafacxy*(psi(3,3,3r-psi(1,3,3r- &s1p,'t&p,'ttttttttttttttttttttttttttttttttttttpsi(3,1,3r+psi(1,1,3rr,foGNNNNNNNNNNNNNNNNNNNNNNN DxDyf WA(i+1,k,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(38=_vafacxy*(psi(4,3,3r-psi(2,3,3r- &s1p,'t&p,'ttttttttttttttttttttttttttttttttttttpsi(4,1,3r+psi(2,1,3rr,foGNNNNNNNNNNNNNNNNNNNNNNN DxDyf WA(i,k+1,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(39=_vafacxy*(psi(3,4,3r-psi(1,4,3r- &s1p,'t&p,'ttttttttttttttttttttttttttttttttttttpsi(3,2,3r+psi(1,2,3rr,foGNNNNNNNNNNNNNNNNNNNNNNN DxDyf WA(i+1,k+1,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(40=_vafacxy*(psi(4,4,3r-psi(2,4,3r- &s1p,'t&p,'ttttttttttttttttttttttttttttttttttttpsi(4,2,3r+psi(2,2,3rr,foGNNNNNNNNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a,foGNNNNNNNNNNNNNNNNNNNNNNN DxDzf WA(i,k,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(41=_vafacxz*(psi(3,2,3r-psi(1,2,3r- &s1p,'t&p,'ttttttttttttttttttttttttttttttttttttpsi(3,2,1r+psi(1,2,1rr,foGNNNNNNNNNNNNNNNNNNNNNNN DxDzf WA(i+1,k,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(42=_vafacxz*(psi(4,2,3r-psi(2,2,3r- &s1p,'t&p,'ttttttttttttttttttttttttttttttttttttpsi(4,2,1r+psi(2,2,1rr,foGNNNNNNNNNNNNNNNNNNNNNNN DxDzf WA(i,k+1,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(43=_vafacxz*(psi(3,3,3r-psi(1,3,3r- &s1p,'t&p,'ttttttttttttttttttttttttttttttttttttpsi(3,3,1r+psi(1,3,1rr,foGNNNNNNNNNNNNNNNNNNNNNNN DxDzf WA(i+1,k+1,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(44=_vafacxz*(psi(4,3,3r-psi(2,3,3r- &s1p,'t&p,'ttttttttttttttttttttttttttttttttttttpsi(4,3,1r+psi(2,3,1rr,foGNNNNNNNNNNNNNNNNNNNNNNN DxDzf WA(i,k,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(45=_vafacxz*(psi(3,2,4r-psi(1,2,4r- &s1p,'t&p,'ttttttttttttttttttttttttttttttttttttpsi(3,2,2r+psi(1,2,2rr,foGNNNNNNNNNNNNNNNNNNNNNNN DxDzf WA(i+1,k,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(46=_vafacxz*(psi(4,2,4r-psi(2,2,4r- &s1p,'t&p,'ttttttttttttttttttttttttttttttttttttpsi(4,2,2r+psi(2,2,2rr,foGNNNNNNNNNNNNNNNNNNNNNNN DxDzf WA(i,k+1,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(47=_vafacxz*(psi(3,3,4r-psi(1,3,4r- &s1p,'t&p,'ttttttttttttttttttttttttttttttttttttpsi(3,3,2r+psi(1,3,2rr,foGNNNNNNNNNNNNNNNNNNNNNNN DxDzf WA(i+1,k+1,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(48=_vafacxz*(psi(4,3,4r-psi(2,3,4r- &s1p,'t&p,'ttttttttttttttttttttttttttttttttttttpsi(4,3,2r+psi(2,3,2rr,foGNNNNNNNNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a,foGNNNNNNNNNNNNNNNNNNNNNNN DyDzf WA(i,k,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(49=_vafacyz*(psi(2,3,3r-psi(2,1,3r- &s1p,'t&p,'ttttttttttttttttttttttttttttttttttttpsi(2,3,1r+psi(2,1,1rr,foGNNNNNNNNNNNNNNNNNNNNNNN DyDzf WA(i+1,k,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(50=_vafacyz*(psi(3,3,3r-psi(3,1,3r- &s1p,'t&p,'ttttttttttttttttttttttttttttttttttttpsi(3,3,1r+psi(3,1,1rr,foGNNNNNNNNNNNNNNNNNNNNNNN DyDzf WA(i,k+1,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(51=_vafacyz*(psi(2,4,3r-psi(2,2,3r- &s1p,'t&p,'ttttttttttttttttttttttttttttttttttttpsi(2,4,1r+psi(2,2,1rr,foGNNNNNNNNNNNNNNNNNNNNNNN DyDzf WA(i+1,k+1,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(52=_vafacyz*(psi(3,4,3r-psi(3,2,3r- &s1p,'t&p,'ttttttttttttttttttttttttttttttttttttpsi(3,4,1r+psi(3,2,1rr,foGNNNNNNNNNNNNNNNNNNNNNNN DyDzf WA(i,k,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(53=_vafacyz*(psi(2,3,4r-psi(2,1,4r- &s1p,'t&p,'ttttttttttttttttttttttttttttttttttttpsi(2,3,2r+psi(2,1,2rr,foGNNNNNNNNNNNNNNNNNNNNNNN DyDzf WA(i+1,k,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(54=_vafacyz*(psi(3,3,4r-psi(3,1,4r- &s1p,'t&p,'ttttttttttttttttttttttttttttttttttttpsi(3,3,2r+psi(3,1,2rr,foGNNNNNNNNNNNNNNNNNNNNNNN DyDzf WA(i,k+1,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(55=_vafacyz*(psi(2,4,4r-psi(2,2,4r- &s1p,'t&p,'ttttttttttttttttttttttttttttttttttttpsi(2,4,2r+psi(2,2,2rr,foGNNNNNNNNNNNNNNNNNNNNNNN DyDzf WA(i+1,k+1,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(56=_vafacyz*(psi(3,4,4r-psi(3,2,4r- &s1p,'t&p,'ttttttttttttttttttttttttttttttttttttpsi(3,4,2r+psi(3,2,2rr,foGNNNNNNNNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a,foGNNNNNNNNNNNNNNNNNNNNNNN DxDyDzf WA(i,k,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(57=_vafacxyz*(psi(3,3,3r-psi(3,3,1r-&s1p,'t&p,'tttttttttttttttttttttttpsi(3,1,3r+psi(3,1,1r-psi(1,3,3r+,'t&p,p,'t&p,'tttttttttttttttttttttttpsi(1,3,1r+psi(1,1,3r-psi(1,1,1rr,foGNNNNNNNNNNNNNNNNNNNNNNN DxDyDzf WA(i+1,k,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(58=_vafacxyz*(psi(4,3,3r-psi(4,3,1r-&s1p,'t&p,'tttttttttttttttttttttttpsi(4,1,3r+psi(4,1,1r-psi(2,3,3r+,'t&p,p,'t&p,'tttttttttttttttttttttttpsi(2,3,1r+psi(2,1,3r-psi(2,1,1rr,foGNNNNNNNNNNNNNNNNNNNNNNN DxDyDzf WA(i,k+1,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(59=_vafacxyz*(psi(3,4,3r-psi(3,4,1r-&s1p,'t&p,'tttttttttttttttttttttttpsi(3,2,3r+psi(3,2,1r-psi(1,4,3r+,'t&p,p,'t&p,'tttttttttttttttttttttttpsi(1,4,1r+psi(1,2,3r-psi(1,2,1rr,foGNNNNNNNNNNNNNNNNNNNNNNN DxDyDzf WA(i+1,k+1,jr,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(60=_vafacxyz*(psi(4,4,3r-psi(4,4,1r-&s1p,'t&p,'tttttttttttttttttttttttpsi(4,2,3r+psi(4,2,1r-psi(2,4,3r+,'t&p,p,'t&p,'tttttttttttttttttttttttpsi(2,4,1r+psi(2,2,3r-psi(2,2,1rr,foGNNNNNNNNNNNNNNNNNNNNNNN DxDyDzf WA(i,k,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(61=_vafacxyz*(psi(3,3,4r-psi(3,3,2r-&s1p,'t&p,'tttttttttttttttttttttttpsi(3,1,4r+psi(3,1,2r-psi(1,3,4r+,'t&p,p,'t&p,'tttttttttttttttttttttttpsi(1,3,2r+psi(1,1,4r-psi(1,1,2rr,foGNNNNNNNNNNNNNNNNNNNNNNN DxDyDzf WA(i+1,k,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(62=_vafacxyz*(psi(4,3,4r-psi(4,3,2r-&s1p,'t&p,'tttttttttttttttttttttttpsi(4,1,4r+psi(4,1,2r-psi(2,3,4r+,'t&p,p,'t&p,'tttttttttttttttttttttttpsi(2,3,2r+psi(2,1,4r-psi(2,1,2rr,foGNNNNNNNNNNNNNNNNNNNNNNN DxDyDzf WA(i,k+1,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(63=_vafacxyz*(psi(3,4,4r-psi(3,4,2r-&s1p,'t&p,'tttttttttttttttttttttttpsi(3,2,4r+psi(3,2,2r-psi(1,4,4r+,'t&p,p,'t&p,'tttttttttttttttttttttttpsi(1,4,2r+psi(1,2,4r-psi(1,2,2rr,foGNNNNNNNNNNNNNNNNNNNNNNN DxDyDzf WA(i+1,k+1,j+1r,foGNNNNNNNNNNNNNNNNNNNNNNNrhs(64=_vafacxyz*(psi(4,4,4r-psi(4,4,2r-&s1p,'t&p,'tttttttttttttttttttttttpsi(4,2,4r+psi(4,2,2r-psi(2,4,4r+,'t&p,p,'t&p,'tttttttttttttttttttttttpsi(2,4,2r+psi(2,2,4r-psi(2,2,2rr,foGNNNNNNNNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a,foGNNNNNNNNNNNNNNNNNNNNNNN MCheckbifrneeds!,foGNNNNNNNNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a,foGNNNNNNNNNNNNNNNNNNNNNNN F )p((Pd bug T.AB 1re3N e,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNDO m=1,64,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN F )(rhs(m)NE. iirhs(m))NEOR.NNNN1p,'t&p,'ttttttttttttttttttttttttttttttt)ABS)rhs(m))NE.AB ic ) _re3N e,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Ret,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN irhs(m) id Inf_f.eNae,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Ret,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNLL sup(erwrTEr)p((POk 4,sss1p,'t&p,'tttttttttttttttttttttttttttttttttttgmm_exkickouft0&ssss1p,'t&p,'ttttttttt'WARNING: RHS not ETERndd!MCheckbsuppo).el iinputiel ac!'nfo) MKi=CINNNNGOOOOOOOOOOOOOOOOOOOOOOOOO IF e,foGNNNNNiiNNNNOOOOOOOOOOOOOOOO IFDO,foGNNNNNNNNNNNNNNNNNNNNNNN IF e,foGNNNNNiiNNNNOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a,foGNNNNNNNNNNNNNNNNNNNNNNN MSolv -ni -po!ynomRin coefficiesp . coefANTY;,foGNU!NNNNNNNNNNNNNNNNNNNN Mcontaut WITHresult. ,foGNNNNNiiNNNNOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a,MNTEGER, PARgmm_exlubksbIN"se,S- (ECK SOLUTts_,S-------------------------U_va0.0_),cS-------------------------L_va0.0_),cS-------------------------LU_va0.0_),cS-------------------------DO ii=1,64,S-----------------------------DO jj=ii,64,S---------------------------------U(ii,jj=_vaA(ii,jj=,S----------------------------- IFDO,S------------------------- IFDO,S-------------------------DO ii=1,64,S-----------------------------DO jj=1,(ii-1=,S---------------------------------L(ii,jj=_vaA(ii,jj=,S----------------------------- IFDO,S------------------------- IFDO,S-------------------------DO ii=1,64,S-----------------------------L(ii,ii=_vaL(ii,ii=_+a1.0_),cS------------------------- IFDO,S-------------------------LU_vaMATMUL(L,U=,S-------------------------gaga_vaMATMUL(LU,coef=,S-------------------------nrm2_va0.0_),cS-------------------------DO ii=1,64,S-----------------------------llu= Ai r(ii=,S-----------------------------nrm2_vanrm2_+ (gaga(ii=-rhs(ll))**2cS------------------------- IFDO,S--------------------S----- F )nrm2_E. iinrm2re3N e,S-----------------------------PRINT*,'ERROR: ',nrm2,S--------------------S---------PRINT*,'rhs: ',rhs,S--------------------S---------PRINT*,'coefs: ',coef,S--------------------S----- IF e,! Wanna se -'usm=in,fapo!!sp buggMATLAB??? Uncom0,sv !0/S!,S---------------------WRITE(cbuf,'(A,I3.3,A)') 'in,fap_',ns e/8,'.out',S---------------------OPEN(30,FILE=cbuf,STATUS='REPLACE',ACTts_='WRITE'=,S---------------------WRITE(30,'(3E20.8)') po%issin_bsno(1sub) ,m_topoid,g)+(i-1=*dx,s1pS----,'ttttttttttttttttttttttttttttttpo%issin_bsno(2sub) ,m_topoid,g)+(j-1=*dy,s1pS----,'ttttttttttttttttttttttttttttttpo%issin_bsno(3sub) ,m_topoid,g)+(k-1=*dz,S---------------------WRITE(30,'(3E20.8)') po%issin_bsno(1sub) ,m_topoid,g)+(i=*dx,s1pS----,'ttttttttttttttttttttttttttttttpo%issin_bsno(2sub) ,m_topoid,g)+(j-1=*dy,s1pS----,'ttttttttttttttttttttttttttttttpo%issin_bsno(3sub) ,m_topoid,g)+(k-1=*dz,S---------------------WRITE(30,'(3E20.8)') po%issin_bsno(1sub) ,m_topoid,g)+(i-1=*dx,s1pS----,'ttttttttttttttttttttttttttttttpo%issin_bsno(2sub) ,m_topoid,g)+(j=*dy,s1pS----,'ttttttttttttttttttttttttttttttpo%issin_bsno(3sub) ,m_topoid,g)+(k-1=*dz,S---------------------WRITE(30,'(3E20.8)') po%issin_bsno(1sub) ,m_topoid,g)+(i=*dx,s1pS----,'ttttttttttttttttttttttttttttttpo%issin_bsno(2sub) ,m_topoid,g)+(j=*dy,s1pS----,'ttttttttttttttttttttttttttttttpo%issin_bsno(3sub) ,m_topoid,g)+(k-1=*dz,S---------------------WRITE(30,'(3E20.8)') po%issin_bsno(1sub) ,m_topoid,g)+(i-1=*dx,s1pS----,'ttttttttttttttttttttttttttttttpo%issin_bsno(2sub) ,m_topoid,g)+(j-1=*dy,s1pS----,'ttttttttttttttttttttttttttttttpo%issin_bsno(3sub) ,m_topoid,g)+(k=*dz,S---------------------WRITE(30,'(3E20.8)') po%issin_bsno(1sub) ,m_topoid,g)+(i=*dx,s1pS----,'ttttttttttttttttttttttttttttttpo%issin_bsno(2sub) ,m_topoid,g)+(j-1=*dy,s1pS----,'ttttttttttttttttttttttttttttttpo%issin_bsno(3sub) ,m_topoid,g)+(k=*dz,S---------------------WRITE(30,'(3E20.8)') po%issin_bsno(1sub) ,m_topoid,g)+(i-1=*dx,s1pS----,'ttttttttttttttttttttttttttttttpo%issin_bsno(2sub) ,m_topoid,g)+(j=*dy,s1pS----,'ttttttttttttttttttttttttttttttpo%issin_bsno(3sub) ,m_topoid,g)+(k=*dz,S---------------------WRITE(30,'(3E20.8)') po%issin_bsno(1sub) ,m_topoid,g)+(i=*dx,s1pS----,'ttttttttttttttttttttttttttttttpo%issin_bsno(2sub) ,m_topoid,g)+(j=*dy,s1pS----,'tttttttttttttttttttttttttttttt(3sub) ,m_topoid,g)+(k=*dz,S---------------------WRITE(30,'(2E20.8)') rhs(1=,rhs(2=,S---------------------WRITE(30,'(2E20.8)') rhs(3=,rhs(4=,S---------------------WRITE(30,'(2E20.8)') rhs(5=,rhs(6=,S---------------------WRITE(30,'(2E20.8)') rhs(7=,rhs(8=,S---------------------DO ii=1,64,S-------------------------WRITE(30,'(E20.8)') coef(ii=,S--------------------- IFDO,S---------------------CLOSE(30=,foGNNNNNNNNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a,foGNNNNNNNNNNNNNNNNNNNNNNN MCheckbNY WAsparse structure:has stFTAast 8,foGNNNNNNNNNNNNNNNNNNNNNNN Macioes i;iloldFd ghSewI(ave,foGNNNNNNNNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a,foGNNNNNNNNNNNNNNNNNNNNNNN F )m_exlsiztT. 0.ns e+8re3N e,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNm_exlsizt=Nm_exlsizt+bugcMKi=CINNNNpA,i ,i iop' iip(erPap(csTYsC!_grow_ss 0,rvr,foGNU!NNNNNNNNNNNNNNNNNNNNNNNNldu(1=_vam_exlsiz,foGNU!NNNNNNNNNNNNNNNNNNNNNNNNLL sup(erTYsC!ophi,ldu,iop'Lo) MKi=CINNNNGOOOOOOOOOOOOOOOOOOOOO (info .NE. ii0re3N e,foGNNNNNNNNNNN,i ,i io = iip(errorierfat!lc (selmGNU!NNNNNNNNNNNNNNNNNNNNNNNNLL sup(error(iip(err_sueYsC!, ss1p,'t&p,'tttttttttttttttttttttttttttttttgmm_exkickouft0&sssss1p,'t&p,'tttttttttttttttttttttttttttttttsparse value =GMM_PHI__LINE__,info) MKi=CINNNNGOOOOOOOOOOOOOOOOOOOOOOOOOTO 9999 e,foGNiiiiiiiiiiiiiiiiiiiiiiiiii IF e,foGNNNNNiiNNNNOOOOOOOOOOOOOOOOldu(1=_va4,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNldu(2=_vam_exlsiz,foGNU!NNNNNNNNNNNNNNNNNNNNNNNNLL sup(erTYsC!om_ipos e,ldu,iop'Lo) MKi=CINNNNGOOOOOOOOOOOOOOOOOOOOO (info .NE. ii0re3N e,foGNNNNNNNNNNN,i ,i io = iip(errorierfat!lc (selmGNU!NNNNNNNNNNNNNNNNNNNNNNNNLL sup(error(iip(err_sueYsC!, ss1p,'t&p,'tttttttttttttttttttttttttttttttgmm_exkickouft0&sssss1p,'t&p,'tttttttttttttttttttttttttttttttsparse s e!ve I=GMM_IPOS__LINE__,info) MKi=CINNNNGOOOOOOOOOOOOOOOOOOOOOOOOOTO 9999 e,foGNiiiiiiiiiiiiiiiiiiiiiiiiii IF e,foGNNNNNiiNNNNOOOOOOOOOOOO IF e,foGNNNNNiiNNNNOOOOOOOOOOOO (.NPREST(Iooseenst_re3N e,foGNNNNNNNNNNNNNNNOOOOOOOOOOOO (.Nlpot!luT. 0.npot!l+8re3N e,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNlpot!lu= npot!lu+bugcMKi=CINNNNpA,i ,i iop' iip(erPap(csTYsC!_grow_ss 0,rvr,foGNU!NNNNNNNNNNNNNNNNNNNNNNNNNNNNldu(1=_va3,foGNU!NNNNNNNNNNNNNNNNNNNNNNNNNNNNldu(2=_valpot!lc (selmmmmmmmmmmmmmmmmmmmmmmmmmmmmmLL sup(erTYsC!ooseenst,ldu,iop'Lo) MKi=CINNNNGOOOOOOOOOOOOOOOOOOOOOOOOO (info .NE. ii0re3N e,foGNNNNNNNNNNN,i ,i io = iip(errorierfat!lc (selmGNU!NNNNNNNNNNNNNNNNNNNNNNNNmmmmLL sup(error(iip(err_sueYsC!, ss1p,'t&p,'tttttttttttttttttttttttttttttttttttgmm_exkickouft0&sssss ss1p,'t&p,'tttttttttttttttttttttttttttttttttttoseenstaA=psp bCLOSEST__ ss1p,'t&p,'tttttttttttttttttttttttttttttttttttLINE__,info) MKi=CINNNNGOOOOOOOOOOOOOOOOOOOOOOOOOOOOOTO 9999 e,foGNiiiiiiiiiiiiiiiiiiiiiiiiiiiiii IF e,foGNNNNNiiNNNNOOOOOOOOOOOOOOOO IF e,foGNNNNNiiNNNNOOOOOOOOOOOO IF e,foGNNNNNiiNNNNOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a,foGNNNNNNNNNNNNNNNNNNNNNNN MNewtbr Lter=vpushni -eachaA=pspobic (.gu,foGNUpNNNNNNNNNNNNNNNNNNNN Md meth =>cell i;ifindNd ghSewITAl d,foGNUpNNNNNNNNNNNNNNNNNNNN Mnne=vp.v valuef ndNd ghoseenstaA=psp ot WIT,foGNUpNNNNNNNNNNNNNNNNNNNN Mpo,facebrary (P!rNNNNNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a,foGNNNNNNNNNNNNNNNNNNNNNNN (.NPREST(Iooseenst_.AND.OT.(APREST(Iochi_re3N e,f n_dTIac_==ndt 20_pp_v ilet_sts1p,'triiiiiiiiiiiiiiiiiiiiiiiiiixu= po%issin_bsno(1sub) )+(i-1=*dxp,'triiiiiiiiiiiiiiiiiiiiiiiiiiyu= po%issin_bsno(2sub) )+(j-1=*dyp,'triiiiiiiiiiiiiiiiiiiiiiiiiizu= po%issin_bsno(3sub) )+(k-1=*dz,lifndtTIac_==ndt 20_pp_v ilet_sts1p,'triiiiiiiiiiiiiiiiiiiiiiiiiixu= po%issin_bsnd(1sub) )+(i-1=*dxp,'triiiiiiiiiiiiiiiiiiiiiiiiiiyu= po%issin_bsnd(2sub) )+(j-1=*dyp,'triiiiiiiiiiiiiiiiiiiiiiiiiizu= po%issin_bsnd(3sub) )+(k-1=*dz,lies e,foGNU!!!!!!!!!!!!!!!!!!!!! IF e,foGNNNNNiiNNNNOOOOOOOOOOOOx0OOOOva0.0_),cfoGNUppppppppppppppppppppp (.NPREST(Ioohi_re3N e,,'triiiiiiiiiiiiiiiiiiiiiiiiiixu= ohi(1su,j,jsjb) Mp,'triiiiiiiiiiiiiiiiiiiiiiiiiiyu= ohi(2su,j,jsjb) Mp,'triiiiiiiiiiiiiiiiiiiiiiiiiizu= ohi(3su,j,jsjb) Mp,'triiiiiiiiiiiiiiiiiiiiii IF e,f TEGER, PARgmm_exquasinewtbrIN"se,foGNoGGGGGGGGGGGGGGGGGGGGG F )neg(1=.EQ.1=_sprodu= -sprod,foGNoGGGGGGGGGGGGGGGGGGGGGns eGGGGGGGGGGGGGGGGGGG=Gns eG+a1,foGNUpppppppppppppppppGGGGnpot!luGGGGGGGGGGGGGGGG=Gnpot!lu+b1,foGNUpppppppppppppppppGGGGm_ipos e(1sns e)GGGGGGG=Gi,foGNUpppppppppppppppppGGGGm_ipos e(2sns e)GGGGGGG=Gj,foGNUpppppppppppppppppGGGGm_ipos e(3sns e)GGGGGGG=Gk,foGNUpppppppppppppppppGGGGm_ipos e(4sns e)GGGGGGG=Gjb) ,foGNUpppppppppppppppppGGGGphi(ns e)GGGGGGGGGGGGGG=Gsprod,foGNoGGGGGGGGGGGGGGGGGGGGG!Nd ghoseenstaA=psp ot WIT=po,facebr is xk,foGNUpppppppppppppppppGGGG (.NPREST(Iooseenst_re3N e,foGNNNNNNNNNNNNNNNOOOOOOOOOOOO (.NPREST(Ioohi_re3N e,,'triiiiiiiiiiiiiiiiiiiiiiiiiiiiiioseenst(1snpot!l)GG=Gxr(1r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(2snpot!l)GG=Gxr(2r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(3snpot!l)GG=Gxr(3r,foGNNNNNNNNNNNNNNNNNNNNNNNNNNN LSE,foGNNNNNNNiiiiiiiiiiiiiiiiiiiiiiiioseenst(1snpot!l)GG=Gxu+bdx*xk(1r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(2snpot!l)GG=Gyu+bdy*xk(2r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(3snpot!l)GG=Gzt+bdz*xk(3r,foGNNNNNNNNNNNNNNNNNNNNNNNNNNN IF e,foGNNNNNiiNNNNOOOOOOOOOOOO IF e,foGNNNNNiiNNNNOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a,foGNNNNNNNNNNNNNNNNNNNNNNNx0(1=_va1.0_),cfoGNUpNNNNNNNNNNNNNNNNNNNNx0(2=_va0.0_),cfoGNUpNNNNNNNNNNNNNNNNNNNNx0(3=_va0.0_),cfoGNUpNNNNNNNNNNNNNNNNNNNN (.NPREST(Ioohi_re3N e,,'triiiiiiiiiiiiiiiiiiiiiiiiiixu= ohi(1sup1,j,jsjb) Mp,'triiiiiiiiiiiiiiiiiiiiiiiiiiyu= ohi(2sup1,j,jsjb) Mp,'triiiiiiiiiiiiiiiiiiiiiiiiiizu= ohi(3sup1,j,jsjb) Mp,'triiiiiiiiiiiiiiiiiiiiii IF e,f TEGER, PARgmm_exquasinewtbrIN"se,foGNoGGGGGGGGGGGGGGGGGGGGG F )neg(2=.EQ.1=_sprodu= -sprod,foGNoGGGGGGGGGGGGGGGGGGGGGns eGGGGGGGGGGGGGGGGGGG=Gns eG+a1,foGNUpppppppppppppppppGGGGnpot!luGGGGGGGGGGGGGGGG=Gnpot!lu+b1,foGNUpppppppppppppppppGGGGm_ipos e(1sns e)GGGGGGG=Gip1,foGNUpppppppppppppppppGGGGm_ipos e(2sns e)GGGGGGG=Gj,foGNUpppppppppppppppppGGGGm_ipos e(3sns e)GGGGGGG=Gk,foGNUpppppppppppppppppGGGGm_ipos e(4sns e)GGGGGGG=Gjb) ,foGNUpppppppppppppppppGGGGphi(ns e)GGGGGGGGGGGGGG=Gsprod,foGNoGGGGGGGGGGGGGGGGGGGGG!Nd ghoseenstaA=psp ot WIT=po,facebr is xk,foGNUUUUUUUUUUUUUUUUUUUUUU (.NPREST(Iooseenst_re3N e,foGNNNNNNNNNNNNNNNOOOOOOOOOOOO (.NPREST(Ioohi_re3N e,,'triiiiiiiiiiiiiiiiiiiiiiiiiiiiiioseenst(1snpot!l)GG=Gxr(1r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(2snpot!l)GG=Gxr(2r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(3snpot!l)GG=Gxr(3r,foGNNNNNNNNNNNNNNNNNNNNNNNNNNN LSE,foGNNNNNNNiiiiiiiiiiiiiiiiiiiiiiiioseenst(1snpot!l)GG=Gxu+bdx*xk(1r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(2snpot!l)GG=Gyu+bdy*xk(2r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(3snpot!l)GG=Gzt+bdz*xk(3r,foGNNNNNNNNNNNNNNNNNNNNNNNNNNN IF e,foGNNNNNiiNNNNOOOOOOOOOOOO IF e,foGNNNNNiiNNNNOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a,foGNNNNNNNNNNNNNNNNNNNNNNNx0(1=_va0.0_),cfoGNUpNNNNNNNNNNNNNNNNNNNNx0(2=_va1.0_),cfoGNUpNNNNNNNNNNNNNNNNNNNNx0(3=_va0.0_),cfoGNUpNNNNNNNNNNNNNNNNNNNN (.NPREST(Ioohi_re3N e,,'triiiiiiiiiiiiiiiiiiiiiiiiiixu= ohi(1su,jp1,ksjb) Mp,'triiiiiiiiiiiiiiiiiiiiiiiiiiyu= ohi(2su,jp1,ksjb) Mp,'triiiiiiiiiiiiiiiiiiiiiiiiiizu= ohi(3su,jp1,ksjb) Mp,'triiiiiiiiiiiiiiiiiiiiii IF e,f TEGER, PARgmm_exquasinewtbrIN"se,foGNoGGGGGGGGGGGGGGGGGGGGG F )neg(3=.EQ.1=_sprodu= -sprod,foGNoGGGGGGGGGGGGGGGGGGGGGns eGGGGGGGGGGGGGGGGGGG=Gns eG+a1,foGNUpppppppppppppppppGGGGnpot!luGGGGGGGGGGGGGGGG=Gnpot!lu+b1,foGNUpppppppppppppppppGGGGm_ipos e(1sns e)GGGGGGG=Gi,foGNUpppppppppppppppppGGGGm_ipos e(2sns e)GGGGGGG=Gjp1,foGNUpppppppppppppppppGGGGm_ipos e(3sns e)GGGGGGG=Gk,foGNUpppppppppppppppppGGGGm_ipos e(4sns e)GGGGGGG=Gjb) ,foGNUpppppppppppppppppGGGGphi(ns e)GGGGGGGGGGGGGG=Gsprod,foGNoGGGGGGGGGGGGGGGGGGGGG (.NPREST(Iooseenst_re3N e,foGNNNNNNNNNNNNNNNOOOOOOOOOOOO (.NPREST(Ioohi_re3N e,,'triiiiiiiiiiiiiiiiiiiiiiiiiiiiiioseenst(1snpot!l)GG=Gxr(1r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(2snpot!l)GG=Gxr(2r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(3snpot!l)GG=Gxr(3r,foGNNNNNNNNNNNNNNNNNNNNNNNNNNN LSE,foGNNNNNNNiiiiiiiiiiiiiiiiiiiiiiiioseenst(1snpot!l)GG=Gxu+bdx*xk(1r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(2snpot!l)GG=Gyu+bdy*xk(2r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(3snpot!l)GG=Gzt+bdz*xk(3r,foGNNNNNNNNNNNNNNNNNNNNNNNNNNN IF e,foGNNNNNiiNNNNOOOOOOOOOOOO IF e,foGNNNNNiiNNNNOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a,foGNNNNNNNNNNNNNNNNNNNNNNNx0(1=_va1.0_),cfoGNUpNNNNNNNNNNNNNNNNNNNNx0(2=_va1.0_),cfoGNUpNNNNNNNNNNNNNNNNNNNNx0(3=_va0.0_),cfoGNUpNNNNNNNNNNNNNNNNNNNN (.NPREST(Ioohi_re3N e,,'triiiiiiiiiiiiiiiiiiiiiiiiiixu= ohi(1sup1,jp1,ksjb) Mp,'triiiiiiiiiiiiiiiiiiiiiiiiiiyu= ohi(2sup1,jp1,ksjb) Mp,'triiiiiiiiiiiiiiiiiiiiiiiiiizu= ohi(3sup1,jp1,ksjb) Mp,'triiiiiiiiiiiiiiiiiiiiii IF e,f TEGER, PARgmm_exquasinewtbrIN"se,foGNoGGGGGGGGGGGGGGGGGGGGG F )neg(4=.EQ.1=_sprodu= -sprod,foGNoGGGGGGGGGGGGGGGGGGGGGns eGGGGGGGGGGGGGGGGGGG=Gns eG+a1,foGNUpppppppppppppppppGGGGnpot!luGGGGGGGGGGGGGGGG=Gnpot!lu+b1,foGNUpppppppppppppppppGGGGm_ipos e(1sns e)GGGGGGG=Gip1,foGNUpppppppppppppppppGGGGm_ipos e(2sns e)GGGGGGG=Gjp1,foGNUpppppppppppppppppGGGGm_ipos e(3sns e)GGGGGGG=Gk,foGNUpppppppppppppppppGGGGm_ipos e(4sns e)GGGGGGG=Gjb) ,foGNUpppppppppppppppppGGGGphi(ns e)GGGGGGGGGGGGGG=Gsprod,foGNoGGGGGGGGGGGGGGGGGGGGG!Nd ghoseenstaA=psp ot WIT=po,facebr is xk,foGNUUUUUUUUUUUUUUUUUUUUUU (.NPREST(Iooseenst_re3N e,foGNNNNNNNNNNNNNNNOOOOOOOOOOOO (.NPREST(Ioohi_re3N e,,'triiiiiiiiiiiiiiiiiiiiiiiiiiiiiioseenst(1snpot!l)GG=Gxr(1r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(2snpot!l)GG=Gxr(2r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(3snpot!l)GG=Gxr(3r,foGNNNNNNNNNNNNNNNNNNNNNNNNNNN LSE,foGNNNNNNNiiiiiiiiiiiiiiiiiiiiiiiioseenst(1snpot!l)GG=Gxu+bdx*xk(1r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(2snpot!l)GG=Gyu+bdy*xk(2r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(3snpot!l)GG=Gzt+bdz*xk(3r,foGNNNNNNNNNNNNNNNNNNNNNNNNNNN IF e,foGNNNNNiiNNNNOOOOOOOOOOOO IF e,foGNNNNNiiNNNNOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a,foGNNNNNNNNNNNNNNNNNNNNNNNx0(1=_va0.0_),cfoGNUpNNNNNNNNNNNNNNNNNNNNx0(2=_va0.0_),cfoGNUpNNNNNNNNNNNNNNNNNNNNx0(3=_va1.0_),cfoGNUpNNNNNNNNNNNNNNNNNNNN (.NPREST(Ioohi_re3N e,,'triiiiiiiiiiiiiiiiiiiiiiiiiixu= ohi(1su,j,jp1,jb) Mp,'triiiiiiiiiiiiiiiiiiiiiiiiiiyu= ohi(2su,j,jp1,jb) Mp,'triiiiiiiiiiiiiiiiiiiiiiiiiizu= ohi(3su,j,jp1,jb) Mp,'triiiiiiiiiiiiiiiiiiiiii IF e,f TEGER, PARgmm_exquasinewtbrIN"se,foGNoGGGGGGGGGGGGGGGGGGGGG F )neg(5=.EQ.1=_sprodu= -sprod,foGNoGGGGGGGGGGGGGGGGGGGGGns eGGGGGGGGGGGGGGGGGGG=Gns eG+a1,foGNUpppppppppppppppppGGGGnpot!luGGGGGGGGGGGGGGGG=Gnpot!lu+b1,foGNUpppppppppppppppppGGGGm_ipos e(1sns e)GGGGGGG=Gi,foGNUpppppppppppppppppGGGGm_ipos e(2sns e)GGGGGGG=Gj,foGNUpppppppppppppppppGGGGm_ipos e(3sns e)GGGGGGG=Gkp1,foGNUpppppppppppppppppGGGGm_ipos e(4sns e)GGGGGGG=Gjb) ,foGNUpppppppppppppppppGGGGphi(ns e)GGGGGGGGGGGGGG=Gsprod,foGNoGGGGGGGGGGGGGGGGGGGGG!Nd ghoseenstaA=psp ot WIT=po,facebr is xk,foGNUUUUUUUUUUUUUUUUUUUUUU (.NPREST(Iooseenst_re3N e,foGNNNNNNNNNNNNNNNOOOOOOOOOOOO (.NPREST(Ioohi_re3N e,,'triiiiiiiiiiiiiiiiiiiiiiiiiiiiiioseenst(1snpot!l)GG=Gxr(1r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(2snpot!l)GG=Gxr(2r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(3snpot!l)GG=Gxr(3r,foGNNNNNNNNNNNNNNNNNNNNNNNNNNN LSE,foGNNNNNNNiiiiiiiiiiiiiiiiiiiiiiiioseenst(1snpot!l)GG=Gxu+bdx*xk(1r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(2snpot!l)GG=Gyu+bdy*xk(2r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(3snpot!l)GG=Gzt+bdz*xk(3r,foGNNNNNNNNNNNNNNNNNNNNNNNNNNN IF e,foGNNNNNiiNNNNOOOOOOOOOOOO IF e,foGNNNNNiiNNNNOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a,foGNNNNNNNNNNNNNNNNNNNNNNNx0(1=_va1.0_),cfoGNUpNNNNNNNNNNNNNNNNNNNNx0(2=_va0.0_),cfoGNUpNNNNNNNNNNNNNNNNNNNNx0(3=_va1.0_),cfoGNUpNNNNNNNNNNNNNNNNNNNN (.NPREST(Ioohi_re3N e,,'triiiiiiiiiiiiiiiiiiiiiiiiiixu= ohi(1sup1,j,jp1,jb) Mp,'triiiiiiiiiiiiiiiiiiiiiiiiiiyu= ohi(2sup1,j,jp1,jb) Mp,'triiiiiiiiiiiiiiiiiiiiiiiiiizu= ohi(3sup1,j,jp1,jb) Mp,'triiiiiiiiiiiiiiiiiiiiii IF e,f TEGER, PARgmm_exquasinewtbrIN"se,foGNoGGGGGGGGGGGGGGGGGGGGG F )neg(6=.EQ.1=_sprodu= -sprod,foGNoGGGGGGGGGGGGGGGGGGGGGns eGGGGGGGGGGGGGGGGGGG=Gns eG+a1,foGNUpppppppppppppppppGGGGnpot!luGGGGGGGGGGGGGGGG=Gnpot!lu+b1,foGNUpppppppppppppppppGGGGm_ipos e(1sns e)GGGGGGG=Gip1,foGNUpppppppppppppppppGGGGm_ipos e(2sns e)GGGGGGG=Gj,foGNUpppppppppppppppppGGGGm_ipos e(3sns e)GGGGGGG=Gkp1,foGNUpppppppppppppppppGGGGm_ipos e(4sns e)GGGGGGG=Gjb) ,foGNUpppppppppppppppppGGGGphi(ns e)GGGGGGGGGGGGGG=Gsprod,foGNoGGGGGGGGGGGGGGGGGGGGG!Nd ghoseenstaA=psp ot WIT=po,facebr is xk,foGNUUUUUUUUUUUUUUUUUUUUUU (.NPREST(Iooseenst_re3N e,foGNNNNNNNNNNNNNNNOOUUUUUUUUUU (.NPREST(Ioohi_re3N e,,'triiiiiiiiiiiiiiiiiiiiiiiiiiiiiioseenst(1snpot!l)GG=Gxr(1r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(2snpot!l)GG=Gxr(2r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(3snpot!l)GG=Gxr(3r,foGNNNNNNNNNNNNNNNNNNNNNNNNNNN LSE,foGNNNNNNNiiiiiiiiiiiiiiiiiiiiiiiioseenst(1snpot!l)GG=Gxu+bdx*xk(1r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(2snpot!l)GG=Gyu+bdy*xk(2r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(3snpot!l)GG=Gzt+bdz*xk(3r,foGNNNNNNNNNNNNNNNNNNNNNNNNNNN IF e,foGNNNNNiiNNNNOOOOOOOOOOOO IF e,foGNNNNNiiNNNNOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a,foGNNNNNNNNNNNNNNNNNNNNNNNx0(1=_va0.0_),cfoGNUpNNNNNNNNNNNNNNNNNNNNx0(2=_va1.0_),cfoGNUpNNNNNNNNNNNNNNNNNNNNx0(3=_va1.0_),cfoGNUpNNNNNNNNNNNNNNNNNNNN (.NPREST(Ioohi_re3N e,,'triiiiiiiiiiiiiiiiiiiiiiiiiixu= ohi(1su,jp1,kp1,jb) Mp,'triiiiiiiiiiiiiiiiiiiiiiiiiiyu= ohi(2su,jp1,kp1,jb) Mp,'triiiiiiiiiiiiiiiiiiiiiiiiiizu= ohi(3su,jp1,kp1,jb) Mp,'triiiiiiiiiiiiiiiiiiiiii IF e,f TEGER, PARgmm_exquasinewtbrIN"se,foGNoGGGGGGGGGGGGGGGGGGGGG F )neg(7=.EQ.1=_sprodu= -sprod,foGNoGGGGGGGGGGGGGGGGGGGGGns eGGGGGGGGGGGGGGGGGGG=Gns eG+a1,foGNUpppppppppppppppppGGGGnpot!luGGGGGGGGGGGGGGGG=Gnpot!lu+b1,foGNUpppppppppppppppppGGGGm_ipos e(1sns e)GGGGGGG=Gi,foGNUpppppppppppppppppGGGGm_ipos e(2sns e)GGGGGGG=Gjp1,foGNUpppppppppppppppppGGGGm_ipos e(3sns e)GGGGGGG=Gkp1,foGNUpppppppppppppppppGGGGm_ipos e(4sns e)GGGGGGG=Gjb) ,foGNUpppppppppppppppppGGGGphi(ns e)GGGGGGGGGGGGGG=Gsprod,foGNoGGGGGGGGGGGGGGGGGGGGG!Nd ghoseenstaA=psp ot WIT=po,facebr is xk,foGNUUUUUUUUUUUUUUUUUUUUUU (.NPREST(Iooseenst_re3N e,foGNNNNNNNNNNNNNNNOOUUUUUUUUUU (.NPREST(Ioohi_re3N e,,'triiiiiiiiiiiiiiiiiiiiiiiiiiiiiioseenst(1snpot!l)GG=Gxr(1r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(2snpot!l)GG=Gxr(2r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(3snpot!l)GG=Gxr(3r,foGNNNNNNNNNNNNNNNNNNNNNNNNNNN LSE,foGNNNNNNNiiiiiiiiiiiiiiiiiiiiiiiioseenst(1snpot!l)GG=Gxu+bdx*xk(1r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(2snpot!l)GG=Gyu+bdy*xk(2r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(3snpot!l)GG=Gzt+bdz*xk(3r,foGNNNNNNNNNNNNNNNNNNNNNNNNNNN IF e,foGNNNNNiiNNNNOOOOOOOOOOOO IF e,foGNNNNNiiNNNNOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a,foGNNNNNNNNNNNNNNNNNNNNNNNx0(1=_va1.0_),cfoGNUpNNNNNNNNNNNNNNNNNNNNx0(2=_va1.0_),cfoGNUpNNNNNNNNNNNNNNNNNNNNx0(3=_va1.0_),cfoGNUpNNNNNNNNNNNNNNNNNNNN (.NPREST(Ioohi_re3N e,,'triiiiiiiiiiiiiiiiiiiiiiiiiixu= ohi(1sup1,jp1,kp1,jb) Mp,'triiiiiiiiiiiiiiiiiiiiiiiiiiyu= ohi(2sup1,jp1,kp1,jb) Mp,'triiiiiiiiiiiiiiiiiiiiiiiiiizu= ohi(3sup1,jp1,kp1,jb) Mp,'triiiiiiiiiiiiiiiiiiiiii IF e,f TEGER, PARgmm_exquasinewtbrIN"se,foGNoGGGGGGGGGGGGGGGGGGGGG F )neg(8=.EQ.1=_sprodu= -sprod,foGNoGGGGGGGGGGGGGGGGGGGGGns eGGGGGGGGGGGGGGGGGGG=Gns eG+a1,foGNUpppppppppppppppppGGGGnpot!luGGGGGGGGGGGGGGGG=Gnpot!lu+b1,foGNUpppppppppppppppppGGGGm_ipos e(1sns e)GGGGGGG=Gip1,foGNUpppppppppppppppppGGGGm_ipos e(2sns e)GGGGGGG=Gjp1,foGNUpppppppppppppppppGGGGm_ipos e(3sns e)GGGGGGG=Gkp1,foGNUpppppppppppppppppGGGGm_ipos e(4sns e)GGGGGGG=Gjb) ,foGNUpppppppppppppppppGGGGphi(ns e)GGGGGGGGGGGGGG=Gsprod,foGNoGGGGGGGGGGGGGGGGGGGGG!Nd ghoseenstaA=psp ot WIT=po,facebr is xk,foGNUUUUUUUUUUUUUUUUUUUUUU (.NPREST(Iooseenst_re3N e,foGNNNNNNNNNNNNNNNOOUUUUUUUUUU (.NPREST(Ioohi_re3N e,,'triiiiiiiiiiiiiiiiiiiiiiiiiiiiiioseenst(1snpot!l)GG=Gxr(1r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(2snpot!l)GG=Gxr(2r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(3snpot!l)GG=Gxr(3r,foGNNNNNNNNNNNNNNNNNNNNNNNNNNN LSE,foGNNNNNNNiiiiiiiiiiiiiiiiiiiiiiiioseenst(1snpot!l)GG=Gxu+bdx*xk(1r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(2snpot!l)GG=Gyu+bdy*xk(2r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiiiiiioseenst(3snpot!l)GG=Gzt+bdz*xk(3r,foGNNNNNNNNNNNNNNNNNNNNNNNNNNN IF e,foGNNNNNiiNNNNOOOOOOOOOOOO IF e,foGNNNNNiiNNNNOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a,foGNNNNNNNNNNNNNNNNNNN IF eOOOOOOOOOO >cell near=po,facebr,foGNNNNNNNNNNNNNNN IFDOOOOOOOO >th =>cell i,foGNUppppppppp IFDOOOOOOOO >th =>cell j ,foGNNNNNii IFDOOOOOOOO >th =>cell k,lifndtTIDIM=ndt 22D,foGNNNNNii kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a,foGNNNNNNN! FindNth =>cells WIrough which WIT=zeroITAl d pasensf nd,foGNNNNNNN! NY WAarghoseen i;iWIT=po,facebr (i;iexEGER, WIT=bic (aries,foGNNNNNNN! ould menarrow b nd),foGNNNNNii kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a,foGNNNNNNNDO j=1,yhi,foGNUpppppppppjp1G=Gj+1,foGNUpppppppppDO i=1,xhi,foGNUpppppppppppppip1G=Gi+1,foGNUpppppppppppppneg(1:8=_va0,foGNUppppppppppppplok_va.TRUEary (P!rNNNNNNNNNNNN (.Nf(ave(i ,j ,jb) MuT. 0.0.0_),)pneg(1=_va1ry (P!rNNNNNNNNNNNN (.NABS)f(ave(i ,j ,jb) M)NE.AB WIrh =)plok_va.FALSEary (P!rNNNNNNNNNNNN (.Nf(ave(ip1,j ,jb) MuT. 0.0.0_),)pneg(2=_va1ry (P!rNNNNNNNNNNNN (.NABS)f(ave(ip1,j ,jb) M)NE.AB WIrh =)plok_va.FALSEary (P!rNNNNNNNNNNNN (.Nf(ave(i ,jp1,jb) MuT. 0.0.0_),)pneg(3=_va1ry (P!rNNNNNNNNNNNN (.NABS)f(ave(i ,jp1,jb) M)NE.AB WIrh =)plok_va.FALSEary (P!rNNNNNNNNNNNN (.Nf(ave(ip1,jp1,jb) MuT. 0.0.0_),)pneg(4=_va1ry (P!rNNNNNNNNNNNN (.NABS)f(ave(ip1,jp1,jb) M)NE.AB WIrh =)plok_va.FALSEary (P!rNNNNNNNNNNNNsnegG=Gneg(1=+neg(2=+neg(3=+neg(4=ry (P!rNNNNNNNNNNNN (.N(snegE.AB0_.AND.(snegE. 04_.AND.(lok_re3N e,,'triiiiiiiiiiiiiiiiii kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Ret,,'triiiiiiiiiiiiiiiiii Old valuefould meTAl d nne=vp.v,,'triiiiiiiiiiiiiiiiii kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Ret,,'triiiiiiiiiiiiiiiiiiDO n=-1,2,foGNoGGGGGGGGGGGGGGGGGGGGGns2_van+2,foGNoGGGGGGGGGGGGGGGGGGGGGjpnG=Gj+v,,'triiiiiiiiiiiiiiiiiiiiiiDO m=-1,2,foGNoGGGGGGGGGGGGGGGGGGGGGGGGGpsi(m+2sns2=_vaf(ave(i+m,jpn,jb) Mp,'triiiiiiiiiiiiiiiiiiiiii IFDO,foGNNNNNNNNNNNNNNNNNNN IFDO,foGNNNNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Ret,,'triiiiiiiiiiiiiiiiii Right-h nd-sid -ni -bi-cubic=in,fapo!!vp.v,,'triiiiiiiiiiiiiiiiii -po!ynomRin. T meorderfould memethoduis,,'triiiiiiiiiiiiiiiiii -limited byld meorderfould mefinite,,'triiiiiiiiiiiiiiiiii -differenoes used hereary (P!rNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Ret,,'triiiiiiiiiiiiiiiiii valuef WA(i,kMp,'triiiiiiiiiiiiiiiiiirhs(1=_vapsi(2,2Mp,'triiiiiiiiiiiiiiiiii valuef WA(i+1,kMp,'triiiiiiiiiiiiiiiiiirhs(2=_vapsi(3,2Mp,'triiiiiiiiiiiiiiiiii valuef WA(i,k+1Mp,'triiiiiiiiiiiiiiiiiirhs(3=_vapsi(2,3r,foGNNNNNNNNNNNNNNNNNNN valuef WA(i+1,k+1Mp,'triiiiiiiiiiiiiiiiiirhs(4=_vapsi(3,3r,foGNNNNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Ret,,'triiiiiiiiiiiiiiiiii Dxf WA(i,kMp,'triiiiiiiiiiiiiiiiiirhs(5=_vafacx*(psi(3,2r-psi(1,2rr,foGNNNNNNNNNNNNNNNNNNN Dxf WA(i+1,kMp,'triiiiiiiiiiiiiiiiiirhs(6=_vafacx*(psi(4,2r-psi(2,2rr,foGNNNNNNNNNNNNNNNNNNN Dxf WA(i,k+1Mp,'triiiiiiiiiiiiiiiiiirhs(7=_vafacx*(psi(3,3r-psi(1,3rr,foGNNNNNNNNNNNNNNNNNNN Dxf WA(i+1,k+1Mp,'triiiiiiiiiiiiiiiiiirhs(8=_vafacx*(psi(4,3r-psi(2,3rr,foGNNNNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Ret,,'triiiiiiiiiiiiiiiiii Dyf WA(i,kMp,'triiiiiiiiiiiiiiiiiirhs(9=_vafacy*(psi(2,3r-psi(2,1rr,foGNNNNNNNNNNNNNNNNNNN Dyf WA(i+1,kMp,'triiiiiiiiiiiiiiiiiirhs(10=_vafacy*(psi(3,3r-psi(3,1rr,foGNNNNNNNNNNNNNNNNNNN Dyf WA(i,k+1Mp,'triiiiiiiiiiiiiiiiiirhs(11=_vafacy*(psi(2,4r-psi(2,2rr,foGNNNNNNNNNNNNNNNNNNN Dyf WA(i+1,k+1Mp,'triiiiiiiiiiiiiiiiiirhs(12=_vafacy*(psi(3,4r-psi(3,2rr,foGNNNNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Ret,,'triiiiiiiiiiiiiiiiii DxDyf WA(i,kMp,'triiiiiiiiiiiiiiiiiirhs(13=_vafacxy*(psi(3,3r-psi(1,3r-psi(3,1r+psi(1,1rr,foGNNNNNNNNNNNNNNNNNNN DxDyf WA(i+1,kMp,'triiiiiiiiiiiiiiiiiirhs(14=_vafacxy*(psi(4,3r-psi(2,3r-psi(4,1r+psi(2,1rr,foGNNNNNNNNNNNNNNNNNNN DxDyf WA(i,k+1Mp,'triiiiiiiiiiiiiiiiiirhs(15=_vafacxy*(psi(3,4r-psi(1,4r-psi(3,2r+psi(1,2rr,foGNNNNNNNNNNNNNNNNNNN DxDyf WA(i+1,k+1Mp,'triiiiiiiiiiiiiiiiiirhs(16=_vafacxy*(psi(4,4r-psi(2,4r-psi(4,2r+psi(2,2rr,foGNNNNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Ret,,'triiiiiiiiiiiiiiiiii MCheckbifrneeds!,foGNNNNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Ret,,'triiiiiiiiiiiiiiiiii F )p((Pd bug T.AB 1re3N e,foGNNNNNNNNNNNNNNNNNNNNNNNDO m=1,16,foGNNNNNNNNNNNNNNNOOUUUUUUUUUU (.N(rhs(m)NE. iirhs(m))NEOR.NNNN1p,'t&p,'ttttttttttttttttttttttttttt)ABS)rhs(m))NE.AB ic ) _re3N e,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN irhs(m) id Inf_f.eNae_f.etoo-biu,foGNUpNNNNNNNNNNNNNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNLL sup(erwrTEr)p((POk 4,sss1p,'t&p,'tttttttttttttttttttttttttttttttgmm_exkickouft0&ssss1p,'t&p,'ttttttttt'WARNING: RHS not ETERndd!MCheckbsuppo).el iinputiel ac!'nfo) MKi=CINNNNGOOOOOOOOOOOOOOOOOOOOO IF e,foGNNNNNiiNNNNOOOOOOOOOOOO IFDO,foGNNNNNNNNNNNNNNNNNNN IF e,foGNNNNNiiNNNNOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Ret,,'triiiiiiiiiiiiiiiiii MSolv -ni -po!ynomRin coefficiesp . coefANTY;,foGNU!NNNNNNNNNNNNNNNN Mcontaut WITHresult. ,foGNNNNNiiNNNNOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Ret,MNTEGER, PARgmm_exlubksbIN"se,S- (ECK SOLUTts_,S-------------------------U_va0.0_),cS-------------------------L_va0.0_),cS-------------------------LU_va0.0_),cS-------------------------DO ii=1,16,S-----------------------------DO jj=ii,16,S---------------------------------U(ii,jj=_vaA(ii,jj=,S----------------------------- IFDO,S------------------------- IFDO,S-------------------------DO ii=1,16,S-----------------------------DO jj=1,(ii-1=,S---------------------------------L(ii,jj=_vaA(ii,jj=,S----------------------------- IFDO,S------------------------- IFDO,S-------------------------DO ii=1,16,S-----------------------------L(ii,ii=_vaL(ii,ii=_+a1.0_),cS------------------------- IFDO,S-------------------------LU_vaMATMUL(L,U=,S-------------------------gaga_vaMATMUL(LU,coef=,S-------------------------nrm2_va0.0_),cS-------------------------DO ii=1,16,S-----------------------------llu= Ai r(ii=,S-----------------------------nrm2_vanrm2_+ (gaga(ii=-rhs(ll))**2cS------------------------- IFDO,S-------------------------PRINT*,'ERROR: ',nrm2,S-Wanna se -'usm=in,fapo!!sp buggMATLAB??? Uncom0,sv !0/S!,S---------------------WRITE(cbuf,'(A,I3.3,A)') 'in,fap_',ns e/4,'.out',S---------------------OPEN(30,FILE=cbuf,STATUS='REPLACE',ACTts_='WRITE'=,S---------------------WRITE(30,'(2E20.8)') po%issin_bsnd(1sub) ,m_topoid,g)+(i-1=*dx,s1pS----,'ttttttttttttttttttttttttttttttpo%issin_bsnd(2sub) ,m_topoid,g)+(j-1=*dy,S---------------------WRITE(30,'(2E20.8)') po%issin_bsnd(1sub) ,m_topoid,g)+(i=*dx,s1pS----,'ttttttttttttttttttttttttttttttpo%issin_bsnd(2sub) ,m_topoid,g)+(j-1=*dy,S---------------------WRITE(30,'(2E20.8)') po%issin_bsnd(1sub) ,m_topoid,g)+(i-1=*dx,s1pS----,'ttttttttttttttttttttttttttttttpo%issin_bsnd(2sub) ,m_topoid,g)+(j=*dy,S---------------------WRITE(30,'(2E20.8)') po%issin_bsnd(1sub) ,m_topoid,g)+(i=*dx,s1pS----,'ttttttttttttttttttttttttttttttpo%issin_bsnd(2sub) ,m_topoid,g)+(j=*dy,S---------------------WRITE(30,'(2E20.8)') rhs(1=,rhs(2=,S---------------------WRITE(30,'(2E20.8)') rhs(3=,rhs(4=,S---------------------WRITE(30,'(2E20.8)') coef(1:2=,S---------------------WRITE(30,'(2E20.8)') coef(3:4=,S---------------------WRITE(30,'(2E20.8)') coef(5:6=,S---------------------WRITE(30,'(2E20.8)') coef(7:8=,S---------------------WRITE(30,'(2E20.8)') coef(9:10=,S---------------------WRITE(30,'(2E20.8)') coef(11:12=,S---------------------WRITE(30,'(2E20.8)') coef(13:14=,S---------------------WRITE(30,'(2E20.8)') coef(15:16=,S---------------------CLOSE(30=,foGNNNNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Ret,,'triiiiiiiiiiiiiiiiii MCheckbNY WAsparse structure:has stFTAast 4,foGNNNNNNNNNNNNNNNNNNN Macioes i;iloldFd ghSewI(ave,foGNNNNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Ret,,'triiiiiiiiiiiiiiiiii F )m_exlsiztT. 0.ns e+4re3N e,foGNNNNNNNNNNNNNNNNNNNNNNNm_exlsizt=Nm_exlsizt+bugcMKi=CINNNNpA,i ,i iop' iip(erPap(csTYsC!_grow_ss 0,rvr,foGNU!NNNNNNNNNNNNNNNNNNNNldu(1=_vam_exlsiz,foGNU!NNNNNNNNNNNNNNNNNNNNLL sup(erTYsC!ophi,ldu,iop'Lo) MKi=CINNNNGOOOOOOOOOOOOOOOOO (info .NE. ii0re3N e,foGNNNNNNNNNNN,i ,i io = iip(errorierfat!lc (selmGNU!NNNNNNNNNNNNNNNNNNNNLL sup(error(iip(err_sueYsC!, ss1p,'t&p,'tttttttttttttttttttttttttttgmm_exkickouft0&sssss1p,'t&p,'tttttttttttttttttttttttttttsparse value =GMM_PHI__LINE__,info) MKi=CINNNNGOOOOOOOOOOOOOOOOOOOOOTO 9999 e,foGNiiiiiiiiiiiiiiiiiiiiii IF e,foGNNNNNiiNNNNOOOOOOOOOOOOldu(1=_va3,foGNU!NNNNNNNNNNNNNNNNNNNNldu(2=_vam_exlsiz,foGNU!NNNNNNNNNNNNNNNNNNNNLL sup(erTYsC!om_ipos e,ldu,iop'Lo) MKi=CINNNNGOOOOOOOOOOOOOOOOO (info .NE. ii0re3N e,foGNNNNNNNNNNN,i ,i io = iip(errorierfat!lc (selmGNU!NNNNNNNNNNNNNNNNNNNNLL sup(error(iip(err_sueYsC!, ss1p,'t&p,'tttttttttttttttttttttttttttgmm_exkickouft0&sssss1p,'t&p,'tttttttttttttttttttttttttttsparse s e!ve I=GMM_IPOS__LINE__,info) MKi=CINNNNGOOOOOOOOOOOOOOOOOOOOOTO 9999 e,foGNiiiiiiiiiiiiiiiiiiiiii IF e,foGNNNNNiiNNNNOOOOOOOO IF e,foGNNNNNiiNNNNOOOOOOOO (.NPREST(Iooseenst_re3N e,foGNNNNNNNNNNNNNNNOOUUUUUU (.Nlpot!luT. 0.npot!l+4re3N e,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNlpot!lu= npot!lu+bugcMKi=CINNNNpA,i ,i iop' iip(erPap(csTYsC!_grow_ss 0,rvr,foGNU!NNNNNNNNNNNNNNNNNNNNNNNNldu(1=_va2,foGNoGGGGGGGGGGGGGGGGGGGGGGGGGldu(2=_valpot!lc (selmmmmmmmmmmmmmmmmmmmmmmmmmLL sup(erTYsC!ooseenst,ldu,iop'Lo) MKi=CINNNNGOOOOOOOOOOOOOOOOOOOOO (info .NE. ii0re3N e,foGNNNNNNNNNNN,i ,i io = iip(errorierfat!lc (selmGNU!NNNNNNNNNNNNNNNNNNNNNNNNLL sup(error(iip(err_sueYsC!, ss1p,'t&p,'tttttttttttttttttttttttttttttttgmm_exkickouft0&sssss ss1p,'t&p,'tttttttttttttttttttttttttttttttoseenstaA=psp bCLOSEST__ ss1p,'t&p,'tttttttttttttttttttttttttttttttLINE__,info) MKi=CINNNNGOOOOOOOOOOOOOOOOOOOOOOOOOTO 9999 e,foGNiiiiiiiiiiiiiiiiiiiiiiiiii IF e,foGNNNNNiiNNNNOOOOOOOOOOOO IF e,foGNNNNNiiNNNNOOOOOOOO IF e,foGNNNNNiiNNNNOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Ret,,'triiiiiiiiiiiiiiiiii MNewtbr Lter=vpushni -eachaA=pspobic (.gu,foGNUpNNNNNNNNNNNNNNNN Md meth =>cell i;ifindNd ghSewITAl d,foGNUpNNNNNNNNNNNNNNNN Mnne=vp.v valuef ndNd ghoseenstaA=psp ot WIT,foGNUpNNNNNNNNNNNNNNNN Mpo,facebrary (P!rNNNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Ret,,'triiiiiiiiiiiiiiiiii F )PREST(Iooseenst_.AND.OT.(APREST(Iochi_re3N e,f n_dTIac_==ndt 20_pp_v ilet_sts1p,'triiiiiiiiiiiiiiiiiiiiiixu= po%issin_bsno(1sub) )+(i-1=*dxp,'triiiiiiiiiiiiiiiiiiiiiiyu= po%issin_bsno(2sub) )+(j-1=*dyplifndtTIac_==ndt 20_pp_v ilet_sts1p,'triiiiiiiiiiiiiiiiiiiiiixu= po%issin_bsnd(1sub) )+(i-1=*dxp,'triiiiiiiiiiiiiiiiiiiiiiyu= po%issin_bsnd(2sub) )+(j-1=*dyplies e,foGNU!!!!!!!!!!!!!!!!! IF e,foGNNNNNiiNNNNOOOOOOOOx0OOOOva0.0_),cfoGNUppppppppppppppppp (.NPREST(Ioohi_re3N e,,'triiiiiiiiiiiiiiiiiiiiiixu= ohi(1su,j,jb) Mp,'triiiiiiiiiiiiiiiiiiiiiiyu= ohi(2su,j,jb) Mp,'triiiiiiiiiiiiiiiiii IF e,f TEGER, PARgmm_exquasinewtbrIN"se,foGNoGGGGGGGGGGGGGGGGG! BTW:Nd ghoseenstaA=psp ot WIT=po,facebr is xk,foGNUUUUUUUUUUUUUUUUUU F )neg(1=.EQ.1=_sprodu= -sprod,foGNoGGGGGGGGGGGGGGGGGns eGGGGGGGGGGGGGGGGGGG=Gns eG+a1,foGNUpppppppppppppppppnpot!luGGGGGGGGGGGGGGGG=Gnpot!lu+b1,foGNUpppppppppppppppppm_ipos e(1sns e)GGGGGGG=Gi,foGNUpppppppppppppppppm_ipos e(2sns e)GGGGGGG=Gj,foGNUpppppppppppppppppm_ipos e(3sns e)GGGGGGG=Gjb) ,foGNUpppppppppppppppppphi(ns e)GGGGGGGGGGGGGG=Gsprod,foGNoGGGGGGGGGGGGGGGGG!Nd ghoseenstaA=psp ot WIT=po,facebr is xk,foGNUUUUUUUUUUUUUUUUUU (.NPREST(Iooseenst_re3N e,foGNNNNNNNNNNNNNNNOOUUUUUU (.NPREST(Ioohi_re3N e,,'triiiiiiiiiiiiiiiiiiiiiiiiiioseenst(1snpot!l)GG=Gxr(1r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiioseenst(2snpot!l)GG=Gxr(2r,foGNNNNNNNNNNNNNNNNNNNNNNN LSE,foGNNNNNNNiiiiiiiiiiiiiiiiiiiioseenst(1snpot!l)GG=Gxu+bdx*xk(1r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiioseenst(2snpot!l)GG=Gyu+bdy*xk(2r,foGNNNNNNNNNNNNNNNNNNNNNNN IF e,foGNNNNNiiNNNNOOOOOOOO IF e,foGNNNNNiiNNNNOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Ret,,'triiiiiiiiiiiiiiiiiix0(1=_va1.0_),cfoGNUpNNNNNNNNNNNNNNNNx0(2=_va0.0_),cfoGNUpNNNNNNNNNNNNNNNN (.NPREST(Ioohi_re3N e,,'triiiiiiiiiiiiiiiiiiiiiixu= ohi(1sup1,j,jb) Mp,'triiiiiiiiiiiiiiiiiiiiiiyu= ohi(2sup1,j,jb) Mp,'triiiiiiiiiiiiiiiiii IF e,f TEGER, PARgmm_exquasinewtbrIN"se,foGNoGGGGGGGGGGGGGGGGG F )neg(2=.EQ.1=_sprodu= -sprod,foGNoGGGGGGGGGGGGGGGGGns eGGGGGGGGGGGGGGGGGGG=Gns eG+a1,foGNUpppppppppppppppppnpot!luGGGGGGGGGGGGGGGG=Gnpot!lu+b1,foGNUpppppppppppppppppm_ipos e(1sns e)GGGGGGG=Gip1,foGNUpppppppppppppppppm_ipos e(2sns e)GGGGGGG=Gj,foGNUpppppppppppppppppm_ipos e(3sns e)GGGGGGG=Gjb) ,foGNUpppppppppppppppppphi(ns e)GGGGGGGGGGGGGG=Gsprod,foGNoGGGGGGGGGGGGGGGGG!Nd ghoseenstaA=psp ot WIT=po,facebr is xk,foGNUUUUUUUUUUUUUUUUUU (.NPREST(Iooseenst_re3N e,foGNNNNNNNNNUUUUUUUUUUUUUU (.NPREST(Ioohi_re3N e,,'triiiiiiiiiiiiiiiiiiiiiiiiiioseenst(1snpot!l)GG=Gxr(1r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiioseenst(2snpot!l)GG=Gxr(2r,foGNNNNNNNNNNNNNNNNNNNNNNN LSE,foGNNNNNNNiiiiiiiiiiiiiiiiiiiioseenst(1snpot!l)GG=Gxu+bdx*xk(1r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiioseenst(2snpot!l)GG=Gyu+bdy*xk(2r,foGNNNNNNNNNNNNNNNNNNNNNNN IF e,foGNNNNNiiNNNNOOOOOOOO IF e,foGNNNNNiiNNNNOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Ret,,'triiiiiiiiiiiiiiiiiix0(1=_va0.0_),cfoGNUpNNNNNNNNNNNNNNNNx0(2=_va1.0_),cfoGNUpNNNNNNNNNNNNNNNN (.NPREST(Ioohi_re3N e,,'triiiiiiiiiiiiiiiiiiiiiixu= ohi(1su,jp1,jb) Mp,'triiiiiiiiiiiiiiiiiiiiiiyu= ohi(2su,jp1,jb) Mp,'triiiiiiiiiiiiiiiiii IF e,f TEGER, PARgmm_exquasinewtbrIN"se,foGNoGGGGGGGGGGGGGGGGG F )neg(3=.EQ.1=_sprodu= -sprod,foGNoGGGGGGGGGGGGGGGGGns eGGGGGGGGGGGGGGGGGGG=Gns eG+a1,foGNUpppppppppppppppppnpot!luGGGGGGGGGGGGGGGG=Gnpot!lu+b1,foGNUpppppppppppppppppm_ipos e(1sns e)GGGGGGG=Gi,foGNUpppppppppppppppppm_ipos e(2sns e)GGGGGGG=Gjp1,foGNUpppppppppppppppppm_ipos e(3sns e)GGGGGGG=Gjb) ,foGNUpppppppppppppppppphi(ns e)GGGGGGGGGGGGGG=Gsprod,foGNoGGGGGGGGGGGGGGGGG!Nd ghoseenstaA=psp ot WIT=po,facebr is xk,foGNUUUUUUUUUUUUUUUUUU (.NPREST(Iooseenst_re3N e,foGNNNNNNNNNUUUUUUUUUUUUUU (.NPREST(Ioohi_re3N e,,'triiiiiiiiiiiiiiiiiiiiiiiiiioseenst(1snpot!l)GG=Gxr(1r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiioseenst(2snpot!l)GG=Gxr(2r,foGNNNNNNNNNNNNNNNNNNNNNNN LSE,foGNNNNNNNiiiiiiiiiiiiiiiiiiiioseenst(1snpot!l)GG=Gxu+bdx*xk(1r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiioseenst(2snpot!l)GG=Gyu+bdy*xk(2r,foGNNNNNNNNNNNNNNNNNNNNNNN IF e,foGNNNNNiiNNNNOOOOOOOO IF e,foGNNNNNiiNNNNOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Ret,,'triiiiiiiiiiiiiiiiiix0(1=_va1.0_),cfoGNUpNNNNNNNNNNNNNNNNx0(2=_va1.0_),cfoGNUpNNNNNNNNNNNNNNNN (.NPREST(Ioohi_re3N e,,'triiiiiiiiiiiiiiiiiiiiiixu= ohi(1sup1,jp1,jb) Mp,'triiiiiiiiiiiiiiiiiiiiiiyu= ohi(2sup1,jp1,jb) Mp,'triiiiiiiiiiiiiiiiii IF e,f TEGER, PARgmm_exquasinewtbrIN"se,foGNoGGGGGGGGGGGGGGGGG F )neg(4=.EQ.1=_sprodu= -sprod,foGNoGGGGGGGGGGGGGGGGGns eGGGGGGGGGGGGGGGGGGG=Gns eG+a1,foGNUpppppppppppppppppnpot!luGGGGGGGGGGGGGGGG=Gnpot!lu+b1,foGNUpppppppppppppppppm_ipos e(1sns e)GGGGGGG=Gip1,foGNUpppppppppppppppppm_ipos e(2sns e)GGGGGGG=Gjp1,foGNUpppppppppppppppppm_ipos e(3sns e)GGGGGGG=Gjb) ,foGNUpppppppppppppppppphi(ns e)GGGGGGGGGGGGGG=Gsprod,foGNoGGGGGGGGGGGGGGGGG!Nd ghoseenstaA=psp ot WIT=po,facebr is xk,foGNUUUUUUUUUUUUUUUUUU (.NPREST(Iooseenst_re3N e,foGNNNNNNNNNUUUUUUUUUUUUUU (.NPREST(Ioohi_re3N e,,'triiiiiiiiiiiiiiiiiiiiiiiiiioseenst(1snpot!l)GG=Gxr(1r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiioseenst(2snpot!l)GG=Gxr(2r,foGNNNNNNNNNNNNNNNNNNNNNNN LSE,foGNNNNNNNiiiiiiiiiiiiiiiiiiiioseenst(1snpot!l)GG=Gxu+bdx*xk(1r,foGNNNNNNNNNNNNNNNNNNNNNNNiiiioseenst(2snpot!l)GG=Gyu+bdy*xk(2r,foGNNNNNNNNNNNNNNNNNNNNNNN IF e,foGNNNNNiiNNNNOOOOOOOO IF e,foGNNNNNiiNNNNOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Ret,,'triiiiiiiiiiiiii IF eOOOOOOOO >th =>cell near=po,facebr,foGNNNNNNNNNNN IFDOOOOOOOOO >th =>cell i,foGNUppppp IFDOOOOOOOOOO >th =>cell jplies e,foGNU!!!!! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a,foGNNNNNNN! Checkbifrwerneed i;ireturnld meTAl d nne=vp.v_f.enot,foGNU!!!!! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a,foGNNNNNNNlok_va.TRUEary (P!rNNNN (.NPREST(Ionpts_re3N e,,'triiiiiiiiii F )nptsuT. 0.0)plok_va.FALSEary (P!rNNNN IF e,ry (P!rNNNN (.Nlok_e3N e,f n_dtTIDIM=ndt 23D,,'triiiiiiiiii kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 20,,'triiiiiiiiii Flu =>el acI(avebugcl. ghostalayeMKi=CINNNNpA,i kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 20,,'triiiiiiiiiiDOOk=0,zhi+2iii +2ibecause zhi=n(ave-1 (se -abover,foGNNNNNNNNNNNNNNNDO j=0,yhi+2,foGNoGGGGGGGGGGGGGGGGGDO i=0,xhi+2,foGNoGGGGGGGGGGGGGGGGGGGGGf(ave(i,j,jsjb) M_vabiu,foGNUpNNNNNNNNNNNNNNNN IFDO,foGNNNNNNNNNNNNNNN IFDO,foGNNNNNNNNNNN IFDO,foGNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 20,,'triiiiiiiiii Copy backbfromAsparse structureKi=CINNNNpA,i kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 20,,'triiiiiiiiiiDOOi=1,ns e,foGNNNNNNNNNNNNNNNm_vam_exos e(1sir,foGNNNNNNNNNNNNNNNn_vam_exos e(2sir,foGNNNNNNNNNNNNNNNp_vam_exos e(3sir,foGNNNNNNNNNNNNNNN (.NABS)phi(i_rT. 0ABS)f(ave(m,n,p,jb) M))GGGG1p,'t&p,'tttttttttttttttf(ave(m,n,p,jb) M=phi(i_,foGNNNNNNNNNNN IFDO,lifndtTIDIM=ndt 22D,foGNNNNNii,i kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 20,,'triiiiiiiiii Flu =>el acI(avebugcl. ghostalayeMKi=CINNNNpA,i kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 20,,'triiiiiiiiiiDOOj=0,yhi+2,foGNoGGGGGGGGGGGGGDO i=0,xhi+2,foGNoGGGGGGGGGGGGGGGGGf(ave(i,j,jb) M_vabiu,foGNUpNNNNNNNNNNNN IFDO,foGNNNNNNNNNNN IFDO,foGNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 20,,'triiiiiiiiii Copy backbfromAsparse structureKi=CINNNNpA,i kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 20,,'triiiiiiiiiiDOOi=1,ns e,foGNNNNNNNNNNNNNNNm_vam_exos e(1sir,foGNNNNNNNNNNNNNNNn_vam_exos e(2sir,foGNNNNNNNNNNNNNNN (.NABS)phi(i_rT. 0ABS)f(ave(m,n,jb) M))GGGGG1p,'t&p,'tttttttttttttttf(ave(m,n,jb) M=phi(i_,foGNNNNNNNNNNN IFDO,lies e,foGNU!!!!! IF e,foGNNNNNii kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a,foGNNNNNNN! Pass stuff backboutbifrrequnsts!,foGNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a,foGNNNNNNN (.NPREST(Ioipts_re3N e,,'triiiiiiiiiiiop' iip(erPap(csTYsC!_grow_ss 0,rvr,foGNU!NNNNNNNNldu(1=_vap((Pdim+1,foGNUpppppppppldu(2=_vanpot!lc (selmmmmmmmmmLL sup(erTYsC!oipts,ldu,iop'Lo) MKi=CINNNNGOOOOO (info .NE. iip(erPap(cssuccessre3N e,,'triiiiiiiiiiiiiiio = iip(errorierfat!lc (selmGNU!NNNNNNNNLL sup(error(iip(err_sueYsC!,gmm_exkickouft0&sssss1p,'t&p,'ttttttttttttttt'A=psp sC!ave I=IPTS__LINE__,info) MKi=CINNNNGOOOOOOOOOTO 9999 e,foGNiiiiiiiiii IF e,foGNNNNNiiNNNNDOOi=1,ns e,foGNNNNNNNNNNNNNNNjG=Gi+npot!l-ns e,f n_dTIDIM=ndt 23D,,'triiiiiiiiiiiiiiipts(1,kM_vam_exos e(1sir,foGNNNNNNNNNNNNNNNipts(2,kM_vam_exos e(2sir,foGNNNNNNNNNNNNNNNipts(3,kM_vam_exos e(3sir,foGNNNNNNNNNNNNNNNipts(4,kM_vajb) ,lifndtTIDIM=ndt 22D,foGNNNNNii,i iiiiipts(1,kM_vam_exos e(1sir,foGNNNNNNNNNNNNNNNipts(2,kM_vam_exos e(2sir,foGNNNNNNNNNNNNNNNipts(3,kM_vajb) ,lies e,foGNU!!!!!!!!! IFDO,foGNNNNNNN IF e,foGNNN IFDOOOOOOOOOOOOOO!Gjb) ,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MShrink i;iactual sizn i;ic ) >thmory,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (.NPREST(Iooseenst_re3N e,foGNNNNNNNiop' iip(erPap(csTYsC!_fit_ss 0,rvr,foGNU!NNNNldu(1=_vap((Pdim,foGNU!NNNNldu(2=_vanpot!lc (selmmmmmLL sup(erTYsC!ooseenst,ldu,iop'Lo) MKi=CINNNNGO (info .NE. iip(erPap(cssuccessre3N e,,'triiiiiiiiiiio = iip(errorierfat!lc (selmGNU!NNNNLL sup(error(iip(err_sueYsC!,gmm_exkickouft0&sssss1p,'t&p,'tttttttttttoseenstaA=psp bCLOSEST__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,foGNNN IF e,foGNNN (.NPREST(Ionpts_renptsuvanpot!lc (selm kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MNulfndyaA=pspe.eto work>thmoryf ndNs 0tor >toduleaA=pspe.sc (selm kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,f n_dtTIac_==ndt 20_pp_v ilet_sts1p,'triim_exphisuv>pphi,lifndttTIac_==ndt 20_pp_v ilet_sts1p,'triim_exphiduv>pphi,lies e ,foGNNNNULLIFY)phi)c (selm kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MReturnlc (selm kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,f99 e CONTINUE,foGNNNLL subsnotop(gmm_exkickouft0t0nfo) MKi=CINNRETURN ,f n_dtTIDIM=ndt 22D,f n_dtTIac_==ndt 20_pp_v ilet_sts1p,'trii IF SUBROUTINE gmm_exkickouf_2ds,lifndttTIac_==ndt 20_pp_v ilet_sts1p,'trii IF SUBROUTINE gmm_exkickouf_2dd,lies e ,lifndttTIDIM=ndt 23D,f n_dtTIac_==ndt 20_pp_v ilet_sts1p,'trii IF SUBROUTINE gmm_exkickouf_3ds,lifndttTIac_==ndt 20_pp_v ilet_sts1p,'trii IF SUBROUTINE gmm_exkickouf_3dd,lies e ,lies e,libgnumerics-r1036/src/gmode_createmode.f0000644000175000017500000002656311616214650020107 0ustar omaromar (selm kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MSubroutineNNN: gmode_createmodec (selm kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN ,foGNNN MPurpeen : creates a>tode using a>given schemes,foGNNN ,foGNNN MInputi : ischeme (I)=po,fgr=vpushscheme,foGNNN MMMMMMMMMMMMMMMMkscheme (I)=kickoufhscheme,foGNNN MMMMMMMMMMMMMMMMadaptive (L)Madaptive dt flag,foGNNN ,foGNNN MInput/Outputi: odeiduuuuuuuuuuuuuuuuuu(I)=u0,r>tode/ode iduuuuuu,foGNNN ,foGNNN MOutputi : io = uuuuuuuuuuuuuuuuuu(I)=returnlstatus,foGNNN MMMMMMMMMMMMMMMMbfrsizn uuuuuuuuuuuuuuu(I)=sizn ould mebufferld me,foGNNN MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMschemesrneed (u0,r>tust,foGNNN MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMeYsC!ateNlda*bfrsizn,foGNNN MMMMMMMMMMMMMMMMnstagn uuuuuuuuuuuuuuuu(I)=numberfoulstagns,foGNNN ,foGNNN MRemarkeGGGGGG: creates an odeidu e odeid=-1,foGNNN ,foGNNN MReferenoes GG: ,foGNNN ,foGNNN MRevise I= GG:c (selm kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN M$Log: gmode_createmode.f,v $,foGNNN MRevise 1.1.1.1 2007/07/13 10:19:00iiivos,foGNNN MCBL ve.sp.v_fuld mePPM library,foGNUp ,foGNNN MRevise 1.9 2006/09/04 18:34:53 chatela,foGNNN MFixnsf nd cleanups i;imake it compil -ni ,foGNNN MreTAase-1-0,foGNUp ,foGNNN MRevise 1.8 2005/08/05 09:27:32iiivos,foGNNN MAdded STS stuff (credits: MB),foGNUp ,foGNNN MRevise 1.7 2004/08/12 13:24:08 michaebe,foGNNN Mremoved prpsp state0,sv,foGNUp ,foGNNN MRevise 1.6 2004/07/26 15:38:51iiivos,foGNNN MIn0,rted missing USE state0,svs i;iresolv -unETERnddireferenoes,foGNNN MstFTink stagn.,foGNUp ,foGNNN MRevise 1.5 2004/07/26 11:33:03 michaebe,foGNNN Min0,rted d meuse fuld meg odeI(avebtodule.,foGNUp ,foGNNN MRevise 1.4 2004/07/26 07:47:31 michaebe,foGNNN MAtomiznd. Maji -bug-fixns.,foGNUp ,foGNNN MRevise 1.3 2004/06/10 16:20:03 ivos,foGNNN MMoved eYs cpp directtives i;icolum 1. T meNEC cpp did not recognizn,foGNNN M'usm=o'usrwise!!!,foGNUp ,foGNNN MRevise 1.2 2004/02/20 14:55:38 michaebe,foGNNN Madded d meuse fulgmtodule_util.,foGNUp ,foGNNN MRevise 1.1 2004/02/19 08:33:54 michaebe,foGNNN MinitRin imple0,sv=vpus.,foGNUp ,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ,foGNNN MMMMMMMMMMMMMMMMMMMCespe.eni -Fluid Dynamics (DTU),foGNUp ,foGNNN ,foGNNN Thisufil -isupa).el id mePareYseleParticle Mh =>Library (PPM).,foGNUp ,foGNNN PPM isufree software: you can redistribute it nd/or>todify,foGNUp it unETrld mepe.msel id meGNU Les0,r>GenereYMPublic>Licen0, ,foGNNN asupublished byld meFree Software Fic (avpus, ei'usr ,foGNNN ve.sp.v_3el id meLicen0,,_f.e(stFyourfopvpus)Many latsr ,foGNNN ve.sp.v.,foGNUp ,foGNNN PPM isudistributed ut WITHhopebNY WAit NTY; bmeuseful,,foGNNN but WITHOUT ANY WARRANTY; NTthoutbeven WIT=pmplied warrantyel ,foGNNN MERCHANTABILITY_f.eFITNESS FOR A PARTICULAR PURPOSE. Se -'us,foGNNN GNU GenereYMPublic>Licen0, for>tore details.,foGNUp ,foGNNN You should h ) >received eicopyel id meGNU GenereYMPublic>Licen0,,foGNNN andNd ghGNU Les0,r>GenereYMPublic>Licen0, along NTth PPM. If not,,foGNNN se -.,foGNUp ,foGNNN PareYseleParticle Mh =>Library (PPM),foGNNN ETH Zurich,foGNNN CH-8092 Zurich, SNTtzerl nd,,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNNSUBROUTINE gmode_createmode(odeid,bfrsizn,nstagn,ischeme,kscheme,&Ki=CINNNNGOO,'tttttttttttttttttttttttadaptivenfo) MKi=CINNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04Ki=CINNNN MInEGER,sKi=CINNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04Kf TEGER, PARgmETERnd.h"Ki=CINNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04Ki=CINNNN MModulesKi=CINNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04Ki=CINNNNUSE gmtodule_(avemodec (selmNNUSE gmtodule_(avec (selmNNUSE gmtodule_bsnotartc (selmNNUSE gmtodule_bsnotopc (selmNNUSE gmtodule_ror(ic (selmNNUSE gmtodule_eYsC!c (selmNNUSE gmtodule_util_inve.t_listc (selmNNIMPLICIT NONEKi=CINNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04Ki=CINNNN MArgu0,svsKi=CINNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04Ki=CINNNNINTEGER0&sssss ssssssssssssINTENT( bout) :: io =Ki=CINNNNINTEGER0&sssss ssssssssssssINTENT(inout) :: odeidKi=CINNNNINTEGER0&sssss ssssssssssssINTENT( bout) :: bfrsizn,foGNNNNNINTEGER0&sssss ssssssssssssINTENT( bout) :: nstagnKi=CINNNNINTEGER0&sssss ssssssssssssINTENT(insss) :: ischeme,foGNNNNNINTEGER0&sOPTts_AL,sssssssssINTENT(insss) :: kscheme,foGNNNNNLOGICAL,ssOPTts_AL,sssssssssINTENT(insss) :: adaptive,foGNNNNNINTEGER&sssss sssssssssssssssssssssssssss:: mid, tkscheme,Niop',foGNNNNNINTEGER0&DIMENsts1(3=_ssssssssssssssssssss:: tldaKi=CINNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04Ki=CINNNN MceYs bsnotartc (selmNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04Ki=CINNNNLL subsnotart(gmode_createmodet0t0nfo) MKi=CINNNNLL sup(ertodule_(avemode_activate,,'triiii kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04Ki=CINNNN Mcheckbinputiargu0,svsKi=CINNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04Ki=CINNNNIF)p((Pd bugE.AB0_e3N e,,'triiiii kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/,,'triiiii Mcheckbiulg isuinitRiniznd,,'triiiii kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/,,'triiiiiNNIF)OT.(Ap((PinitRinizndre3N e,,'triiiiiiiiiiio = iip(errorierror(ic (selmNNCINNNNLL sup(error(iip(err_sup(ernoinit,gmode_createmodet0&c (selmNNCINNNN& 'PTAaseMceYs p((Pinitufirst!__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiiii IF e,foGNNNNNiiN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/,,'triiiiiNN McheckbNY WAschemesrare vinid,foGNNNNNiiN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/,,'triiiiiNNIF)ischemeE.AB0.AND.ischemeELE.SIZE(gmode_scheme_o_re3N e,,'triiiiiiiiii F(gmode_scheme_o)ischemerT. 01re3N e,foGNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 ,foGNNNNNNNNNNNNNN Ascheme not yet imple0,svs!,foGNNNNNNNNNNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 ,foGNNNNNNNNNNNNNNio = iip(errorierror(ic (selmNNCINNNN NNLL sup(error(iip(err_suergu0,sv,gmode_createmodet0&c (selmNNCINNNNNNNNNNNN& 'ISCHEME not imple0,svs!__LINE__,info) MKi=CINNNNGOOOOOOOOTO 9999 e,foGNiiiiiiiiii IF e,foGNNNNNiiN LSE,foGNNNNNNNiiii kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 20,,'triiiiiiiiii scheme doesrnot existc (selmNNNNiiii kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 20,,'triiiiiiiiiiio = iip(errorierror(ic (selmNNCINNNNLL sup(error(iip(err_suergu0,sv,gmode_createmodet0&c (selmNNCINNNNNNNNN& 'ISCHEME not imple0,svs!__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiiii IF e,foGNNNNNiiN F(PREST(Iokscheme_re3N e,,'triiiiiiiiii F(kschemeE.AB0.AND.kschemeELE.SIZE(gmode_scheme_o_re3N e,,'triiiiiiiiii ii F(gmode_scheme_o)kschemerT. 01re3N e,foGNNNNNNNNNNNNNNiii kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur,foGNNNNNNNNNNNNNNiii Ascheme not yet imple0,svs!,foGNNNNNNNNNNNNNNiii kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur,foGNNNNNNNNNNNNNNiiiio = iip(errorierror(ic (selmNNCINNNN NN NNLL sup(error(iip(err_suergu0,sv,gmode_createmodet0&c (selmNNCINNNNNNNNNNNN NN& 'KSCHEME not imple0,svs!__LINE__,info) MKi=CINNNNGOOOOOOOO OOTO 9999 e,foGNiiiiiiiiiiiii IF e,foGNNNNNiiN NN LSE,foGNNNNNNNiiiiiii kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 ,foGNNNNNNNNNNNNNN Ascheme doesrnot existc (selmNNNNiiiiiii kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 ,foGNNNNNNNNNNNNNNio = iip(errorierror(ic (selmNNCINNNN NNLL sup(error(iip(err_suergu0,sv,gmode_createmodet0&c (selmNNCINNNNNNNNNNNN& 'KSCHEME not imple0,svs!__LINE__,info) MKi=CINNNNGOOOOOOOOTO 9999 e,foGNiiiiiiiiii IF e,foGNNNNNiiN IF e,foGNNNNNiiN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/,,'triiiiiNN McheckbodeidKi=CINNNNiiN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/,,'triiiiiNN F(odeid.GEB0_e3N e,,'triiiiiiiiNN F(ANYip(eru0,r_mid(1:p(ertax_mid=.EQ.odeid_re3N e,,'triiiiiiiiii ii kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 ,foGNNNNNNNNNNNNNN Aalready exists. sorry,foGNUpiiiiiiii ii kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 ,foGNNNNNNNNNNNNNNio = iip(errorierror(ic (selmNNCINNNN NNLL sup(error(iip(err_suergu0,sv,gmode_createmodet0&c (selmNNCINNNNNNNNNNNN& 'ODEIDAalready exists__LINE__,info) MKi=CINNNNGOOOOOOOOTO 9999 e,foGNiiiiiiiiii IF e,foGNNNNNiiN IF e,foGNNNNN IF e,foGNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04Ki=CINNNN create_f.euse a=kickoufhscheme,foGNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04Ki=CINNNNIF)PREST(Iokscheme_re3N e,,'triiiiiiitkscheme iikscheme,foGNNNNN LSE,foGNNNNNNNitkscheme iigmode_scheme_k)ischemer,foGNNNNN IF e,foGNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04Ki=CINNNN checkbiul'usr -isuenough acioe ut WITHarraysKi=CINNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04Ki=CINNNNmiduv p(ertax_midu+b1,foGNUpppIF)mid.G(Ap((Ptax_mid_eYsC!dre3N e,,'triiiiiiip((Ptax_mid_eYsC!duv p(ertax_mid_eYsC!du+b1,foGNUppppppiop' iip(erPap(csTYsC!_grow_ss 0,rvr,foGNU!NNNNNtlda(1=_vap((Ptax_mid_eYsC!dKf TEGER, PARgmode_modeYsC!.h"Ki=CINNNN IF e,foGNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04Ki=CINNNN e odeid.lt.0 WITn generete it for>d meuser,foGNNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04Ki=CINNNNIF)odeid.LAB0_e3N e,,'triiiii odeidu=NmidKi=CINNNN IF e,foGNNNNNp(eru0,r_mid(mid=u=NodeidKi=CINNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04Ki=CINNNN updete WIT=pove.se listc (selmNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04Ki=CINNNNLL sup(erutil_inve.t_listip(eru0,r_mid,p((Pinternal_mid,fo) MKi=CINNNNp(ertax_midu=Nmaxval(p((Pinternal_midMKi=CINNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04Ki=CINNNN 0tor >stuffKi=CINNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04Ki=CINNNNARgmode_ischeme(mid=uuuuu= ischeme,foGNNNNNARgmode_kscheme(mid=uuuuu= tkscheme,foGNNNNNIF)PREST(Ioadaptive_re3N e,,'triiiiiiiARgmode_adaptive(mid=u=Nadaptive,foGNNNNN LSE,foGNNNNNNNiARgmode_adaptive(mid=u=N.FALSEary (P!rNN IF e,foGNNNNNp(erode_state(mid=uuuuu iigmode_statePinits!,foGNNNNNgmode_stages(mid=uuuuu vaMAX(gmode_scheme_s)ischemer0&c (selmNNCINNN,'ttttttttttttttttttttttttgmode_scheme_s)kscheme_r,foGNNNNNgmode_bfrsizn(mid=uuuuu= MAX(gmode_scheme_m)ischemer0&c (selmNNCINNN,'ttttttttttttttttttttttttgmode_scheme_m)kscheme_r,foGNNNNNbfrsizn =Ngmode_bfrsizn(mid=,foGNNNNNnstagn u=Ngmode_stages(mid= 99 e CONTINUEfoGNNNNNKi=CINNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04Ki=CINNNN 0snotopc (selmNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04Ki=CINNNNLL subsnotop(gmode_createmodet0t0nfo) MKi=CINNNNRETURN CINNNN IF SUBROUTINE gmode_createmodeclibgnumerics-r1036/src/gmtodule_m_exonit.f0000644000175000017500000000516511616214650020331 0ustar omaromarselmNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MModule=CINNNN: gmtodule_m_exonit selmNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN ,foGNNN MPurpeen : Thisutodulea TEGER,s WIT=souroe codeIfor>d me,foGNNN MMMMMMMMMMMMMMMMinitRiniz=vpushroutineNl id memarching method.,foGNUp ,foGNNN MRemarkeGGGGGG:,foGNUp ,foGNNN MReferenoes GG:,foGNUp ,foGNNN MRevise I= GG:c (selm kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN M$Log: gmtodule_m_exonit.f,v $,foGNNN MRevise 1.1.1.1 2007/07/13 10:18:58iiivos,foGNNN MCBL ve.sp.v_fuld mePPM library,foGNUp ,foGNNN MRevise 1.1 2005/03/10 01:37:15iiivos,foGNNN MInitRin check-in. BEWARE: Not tnsts! ut pareYseleyet ,foGNNN ,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ,foGNNN MMMMMMMMMMMMMMMMMMMCespe.eni -Fluid Dynamics (DTU),foGNUp ,foGNNN ,foGNNN Thisufil -isupa).el id mePareYseleParticle Mh =>Library (PPM).,foGNUp ,foGNNN PPM isufree software: you can redistribute it nd/or>todify,foGNUp it unETrld mepe.msel id meGNU Les0,r>GenereYMPublic>Licen0, ,foGNNN asupublished byld meFree Software Fic (avpus, ei'usr ,foGNNN ve.sp.v_3el id meLicen0,,_f.e(stFyourfopvpus)Many latsr ,foGNNN ve.sp.v.,foGNUp ,foGNNN PPM isudistributed ut WITHhopebNY WAit NTY; bmeuseful,,foGNNN but WITHOUT ANY WARRANTY; NTthoutbeven WIT=pmplied warrantyel ,foGNNN MERCHANTABILITY_f.eFITNESS FOR A PARTICULAR PURPOSE. Se -'us,foGNNN GNU GenereYMPublic>Licen0, for>tore details.,foGNUp ,foGNNN You should h ) >received eicopyel id meGNU GenereYMPublic>Licen0,,foGNNN andNd ghGNU Les0,r>GenereYMPublic>Licen0, along NTth PPM. If not,,foGNNN se -.,foGNUp ,foGNNN PareYseleParticle Mh =>Library (PPM),foGNNN ETH Zurich,foGNNN CH-8092 Zurich, SNTtzerl nd,,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNN,foGNNNMODULE gmtodule_m_exonit c (selmNNC kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0c (selmNNC DTERnd=po,facebrs i;igmm_exonit selmNNNNC kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0c (selmNNCINTERFACEigmm_exonit selmNNNNCNNNMODULE PROCEDUREigmm_exonit selmNNNNC IF NTERFACE c (selmNNC kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0c (selmNNC TEGER, WIT=souroe c (selmNNC kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0c (selmNNCONTAINS ,f TEGER, PARgmm_exonit.f" c (selm IF MODULE gmtodule_m_exonit libgnumerics-r1036/src/gmutil_fft_backward_2d.f0000644000175000017500000004127111616214650021216 0ustar omaromarfoGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MSubroutineNNN: gmutil_fft_backward_2d selmNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN ,foGNNN MPurpeen : ThisuroutineNpfaco.msepove.se Fast Ficri,r>Transco.m ,foGNNN MMMMMMMMMMMMMMMMusing FFTW ut WITHfirst (x)udimen0p.v,foGNNN ,foGNNN MInputi : (avemin(:,:=uuu(F)I(avebi;ibmetransco.med ,foGNNN ,foGNNN MInput/outputi: lda(:=_ssssssss(I)=sizn oul(avec (selm ,foGNNN MOutputi : (avemout(:,:=uu(F)Itransco.med (avec (selm MMMMMMMMMMMMMMMMio = uuuuuuuuuu(I)=returnlstatus. =0 e no ror(i.,foGNUp ,foGNNN MReferenoes GG:,foGNUp ,foGNNN MRevise I= GG:c (selm kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN M$Log: gmutil_fft_backward_2d.f,v $,foGNNN MRevise 1.1.1.1 2007/07/13 10:19:01iiivos,foGNNN MCBL ve.sp.v_fuld mePPM library,foGNUp ,foGNNN MRevise 1.13 2006/09/04 18:34:58 chatela,foGNNN MFixnsf nd cleanups i;imake it compil -ni ,foGNNN MreTAase-1-0,foGNUp ,foGNNN MRevise 1.12 2005/02/16 10:25:03 hiebe.sc (selm euse fftw_many_dft i;icpeed up ffts,foGNNN ,foGNNN MRevise 1.11 2004/11/03 11:10:30 hiebe.sc (selm e exchanged __SXF90 byl__MATHKEISAN (fftsrare libraryicpecificc (selm enot compil ricpecific),foGNUp ,foGNNN MRevise 1.10 2004/10/01i16:09:13 ivos,foGNNN MReplebrd REAL(gmkind_double) :: t0 NTth REAL(MK)It0.,foGNUp ,foGNNN MRevise 1.9 2004/08/25 07:54:34 hiebe.sc (selm efixnd>thmoryfTAak,foGNUp ,foGNNN MRevise 1.8 2004/07/26 08:12:52 hiebe.sc (selm eadded SX MathKeisan Io,facebr (NEC),foGNUp ,foGNNN MRevise 1.7 2004/07/26 07:42:33 ivos,foGNNN MChanged i;icingle-po,facebr todulesf nd adapted eYs USE state0,svs.,foGNUp ,foGNNN MRevise 1.6 2004/02/25 11:51:55 hiebe.sc (selm ebugefix ut array sizn,foGNNN ,foGNNN MRevise 1.5 2004/02/19 15:43:02 wal'usr,foGNNN MChanged 0_pp_vNCOMPLEX i;iCOMPLEX(MK).,foGNUp ,foGNNN MRevise 1.4 2004/02/11i16:31:19 ivos,foGNNN MChanged TEGER, fulfftw.fbfromAa cpp TEGER, WoAa f90 INCLUDE.,foGNUp ,foGNNN MRevise 1.3 2004/02/11i15:29:49 ivos,foGNNN MSome heavy cosmetics: heade.eni matted,a TEGER,s merged,acontinuavpus,foGNNN Mcharacpe.s moved i;iropfaicolum ,a Td,sv=vpusefixnd, bl nkFTinesf nd,foGNNN Macioes ut argu0,sv listsMremoved, i;o long Tinesfut log wrapped.,foGNUp Bugfix:iargu0,svsrare now checked BEFOREi'usyrare assigned i;iNxmin...,foGNUp ,foGNNN MRevise 1.2 2004/02/11i10:13:23 hiebe.sc (selm echanged argu0,svs,a TEGER,d tnst ot io = ,a TEGER,d ARgmETERnd.h, ,foGNNN Mshortened Tinesfi;i80Mcharacpe.s, excGER,d todule_th =, ,foGNNN M TEGER,d fftw3.f,foGNUp ,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ,foGNNN MMMMMMMMMMMMMMMMMMMCespe.eni -Fluid Dynamics (DTU),foGNUp ,foGNNN ,foGNNN Thisufil -isupa).el id mePareYseleParticle Mh =>Library (PPM).,foGNUp ,foGNNN PPM isufree software: you can redistribute it nd/or>todify,foGNUp it unETrld mepe.msel id meGNU Les0,r>GenereYMPublic>Licen0, ,foGNNN asupublished byld meFree Software Fic (avpus, ei'usr ,foGNNN ve.sp.v_3el id meLicen0,,_f.e(stFyourfopvpus)Many latsr ,foGNNN ve.sp.v.,foGNUp ,foGNNN PPM isudistributed ut WITHhopebNY WAit NTY; bmeuseful,,foGNNN but WITHOUT ANY WARRANTY; NTthoutbeven WIT=pmplied warrantyel ,foGNNN MERCHANTABILITY_f.eFITNESS FOR A PARTICULAR PURPOSE. Se -'us,foGNNN GNU GenereYMPublic>Licen0, for>tore details.,foGNUp ,foGNNN You should h ) >received eicopyel id meGNU GenereYMPublic>Licen0,,foGNNN andNd ghGNU Les0,r>GenereYMPublic>Licen0, along NTth PPM. If not,,foGNNN se -.,foGNUp ,foGNNN PareYseleParticle Mh =>Library (PPM),foGNNN ETH Zurich,foGNNN CH-8092 Zurich, SNTtzerl nd,,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,f n_dTIac_==ndt 20_pp_v ilet_sts1p,'triiSUBROUTINE gmutil_fft_backward_2ds((avemin,lda,(avemoutnfo) MKlifndtTIac_==ndt 20_pp_v ilet_sts1p,'triiSUBROUTINE gmutil_fft_backward_2dd((avemin,lda,(avemoutnfo) MKlifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiSUBROUTINE gmutil_fft_backward_2dc((avemin,lda,(avemoutnfo) MKlifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiSUBROUTINE gmutil_fft_backward_2dcc((avemin,lda,(avemoutnfo) MKlies e,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MInEGER,sKi=CINN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,f TEGER, PARgmETERnd.h"Ki=CINN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MModulesKi=CINN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,i=CINNUSE gmtodule_(avec (selmUSE gmtodule_bsnotartc (selmUSE gmtodule_bsnotopc (selmUSE gmtodule_ror(ic (selmUSE gmtodule_eYsC!c (selmIMPLICIT NONEKf n_dTIac_==ndt 20_pp_v ilet_sts1 |dTIac_==nd 20_pp_v ilet_sts1_COMPLEX ,foGNNNINTEGER0&PARAMETER :: MKu=Ngmkind_cingleKlifndtTIac_==ndt 20_pp_v ilet_sts1 |dTIac_==nd 20_pp_v ilet_sts1_COMPLEX ,foGNNNINTEGER0&PARAMETER :: MKu=Ngmkind_doubleKlies e,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MFFTW utEGER,,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,f ETE_dTIFFTW,foGNNNINCLUDE "fftw3.f"Klies e,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MArgu0,svsoGNNN,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN inputi(avec (selmCOMPLEX(MK)0&DIMENsts1(:,:=uuuuuuu,sINTENT(IN ss) :: (avemin,foGNNN sizn oularray,foGNNNINTEGER0&DIMENsts1(:=_ssssssss,sINTENT(INOUT) :: ldaKi=CINN! outputi(ave,epove.se fast ficri,r>transco.medKf n_dTIac_==ndt 20_pp_v ilet_sts1 |tTIac_==ndt 20_pp_v ilet_sts1p,'triiREAL(MK)0&DIMENsts1(:,:=uuuuuu0&PO NTER :: (avemoutKlifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEX|tTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiCOMPLEX(MK)0&DIMENsts1(:,:=uuu0&PO NTER :: (avemout Klies e,foGNU!INTEGER&sssss sssssssssssssss,sINTENT( bOUT) :: io =Ki=CINN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MLoceYMvariablesfKi=CINN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN timsr,foGNNNREAL(MK)IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII:: t0,foGNNN cic pe.sc (selmINTEGER&sssss sssssssssssssssssssssssss:: i,j,iop',foGNNN!=sizn ould me(avemin c (selmINTEGER&sssss sssssssssssssssssssssssss:: Nxmin, Nymin,foGNNN sizn ould me(avemout K (selmINTEGER&sssss sssssssssssssssssssssssss:: Nxmoutn NymoutKl ETE_TIFFTW,foGNNN!MFFTW Pl nK (selmINTEGER*8ssssssssssssssssssssssss:: Pl nssssssK (selmINTEGER&sssss ssssssssssssssssss:: mbistrid,,_mbrank,_mbidist,_mbiembed ,foGNNNINTEGER&sssss ssssssssssssssssss:: mboembed,_mbhowmany,_mbodistKlies e,l ETE_TIMATHKEISAN,foGNNN MATHKEISAN variablesffor>MathKeisan FFTsc (selmINTEGER&sssss sssssssssssssssssssssssss:: isign_fft,isysKf n_dTIac_==ndt 20_pp_v ilet_sts1 |tTIac_==ndt 20_pp_v ilet_sts1pKlifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEX|tTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'trii! paremepe.s for>cfft (ETEault=1r,foGNNNINTEGER&sssss sssssssssssssssssssssssss:: incx,a TEyKlies e,foGNU! sceYe_fft ould metransco.mavpus,foGNNNREAL(MK)IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII:: sceYe_fft,foGNU! working 0toragnKi=CINNREAL(MK)0&DIMENsts1(:),PO NTER III:: table, work,foGNNN tIT=sizn ould meworking 0toragnKi=CINNINTEGER0&DIMENsts1(1)IIIIIIIIIIIIIIIIIII:: lda_table, lda_work,lies e,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MExternalsfKi=CINN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MInitRinis,,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNNLL subsnotart(gmutil_fft_backward_2dt0t0nfo) MKf n_!(ETERndd(TIFFTW) |tETERndd(TIMATHKEISAN))c (selm kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MEor(i e libraryicupport isunot availablec (selm kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNNio = iip(errorierror(icf nETE_TIFFTW,foGNNNLL sup(error(iip(err_sunofftw,gmutil_fft_backward_2dt0ss1p,'t&p,'ttt'PPM was compil d NTthoutbfftwicupport__LINE__,info) MKlies e,l nETE_TIMATHKEISAN,foGNNNLL sup(error(iip(err_sunoMathKeisan,gmutil_fft_backward_2dt0ss1p,'t&p,'ttt'PPM was compil d NTthoutbMATHKEISAN cupport__LINE__,info) MKlies e,foGNNNTO 9999 efoGNNNKlifs,,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN! Checkbargu0,svsKi=CINN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (.Np((Pd bug .G(A 0_e3N e,,'triiiii (.NSIZE(lda,1)IT. 0.2re3N e,,'triiiiiiiiiiio = iip(errorierror(ic (selmNNCINNNNLL sup(error(iip(err_suergu0,sv,gmutil_fft_backward_2dt0ss1p,'t&p,'ttttttttttt'lda>tust bmestFTeast oulsizn 2__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,foGNNNiii (.Nlda(1=_ELE. 0_e3N e,,'triiiii iiiiio = iip(errorierror(ic (selmNNCINNNNLL sup(error(iip(err_suergu0,sv,gmutil_fft_backward_2dt0ss1p,'t&p,'ttttttttttt'th =>sizn: lda(1=_tust bme>0__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,foGNNNiii (.Nlda(2=_ELE. 0_e3N e,,'triiiii iiiiio = iip(errorierror(ic (selmNNCINNNNLL sup(error(iip(err_suergu0,sv,gmutil_fft_backward_2dt0ss1p,'t&p,'ttttttttttt'th =>sizn: lda(2=_tust bme>0__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,foGNNN IF e,foGNNN 0snotracp 1fi;ifitup(e-coovenvpus,foGNNNNxmin=lda(1=,foGNNNNymin=lda(2)c (selm kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MAYsC!ateNresultlarray,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,f n_dTIac_==ndt 20_pp_v ilet_sts1oGNiiiiii|tTIac_==ndt 20_pp_v ilet_sts1p,'triiNxmout ii(Nxmin-1)*2KlifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEX |TIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiNxmout iiNxmin-1Klies e,foGNNNNymout=Nymin,foGNNNlda(1==Nxmout+1,foGNUplda(2)=NymoutKCINNNNLL sup(erTYsC!o(avemoutnlda,p(erPap(csTYsC!_fitnfo) MKi=CINN (info .NE. ii0_e3N e,,'triiiii io = iip(errorierfat!lc (selmGNU!LL sup(error(iip(err_sueYsC!,gmutil_fft_backward_2dt0ss ss1p,'t&p,'ttttttt'fft resultlDATA_OUT__LINE__,info) MKi=CINNNNGOTO 9999 e,foGNii IF e,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MNEC ve.sp.v_- Use>MathKeisan Library 1.5,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,f ETE_TIMATHKEISAN,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MAYsC!ateNworking 0toragnKi=CINN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNNlda_table(1=_va2*Nxmout + 64KCINNNNLL sup(erTYsC!otable,lda_table,p(erPap(csTYsC!_fitnfo) MKi=CINN (info .NE. ii0_e3N e,,'triiiii io = iip(errorierfat!lc (selmGNU!LL sup(error(iip(err_sueYsC!,gmutil_fft_co.ward_2dt0ss ss1p,'t&p,'ttttttt'tableunot aYsC!ate!__LINE__,info) MKi=CINNNNGOTO 9999 e,foGNii IF e,f n_dTIac_==ndt 20_pp_v ilet_sts1oGNiiiiii|tTIac_==ndt 20_pp_v ilet_sts1p,'triilda_work(1=_va4*NxmoutKlifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEX |tTIac_=ndt 20_pp_v ilet_sts1_COMPLEXp,'triilda_work(1=_va6*NxmoutKlies e,foGNNNLL sup(erTYsC!owork,lda_work,p(erPap(csTYsC!_fitnfo) MKi=CINN (info .NE. ii0_e3N e,,'triiiii io = iip(errorierfat!lc (selmGNU!LL sup(error(iip(err_sueYsC!,gmutil_fft_co.ward_2dt0ss ss1p,'t&p,'ttttttt'work>not aYsC!ate!__LINE__,info) MKi=CINNNNGOTO 9999 e,foGNii IF e,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MInitRinizn,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNNsceYe_fft =b1,foGNUpisign_fft =b0,foGNNNjoGNNN=b1,f n_dTIac_==ndt 20_pp_v ilet_sts1p,'triiLL su csfft(isign_fft, Nxmoutn sceYe_fft, (avemin(1,kM,s1p,'t&p,'tttttttttttttttttttttttttttttttt(avemout(1,kM,stable, work, isysMKlifndtTIac_==ndt 20_pp_v ilet_sts1p,'triiLL su zdfft(isign_fft, Nxmoutn sceYe_fft, (avemin(1,kM,s1p,'t&p,'tttttttttttttttttttttttttttttttt(avemout(1,kM,stable, work, isysMKlifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiincx =b1,foGNUpincy =b1,foGNUpLL su cfft(isign_fft, Nxmoutn sceYe_fft, (avemin(1,kM,sincx,aaaaaaaa1p,'t&p,'ttttttttttttt(avemout(1,kM,sincy,stable, lda_table(1=, work, 1p,'t&p,'tttttttttttttlda_work(1=, isysMKlifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiincx =b1,foGNUpincy =b1,foGNUpLL su zfft(isign_fft, Nxmoutn sceYe_fft, (avemin(1,kM,sincx,aaaaaaaa1p,'t&p,'ttttttttttttt(avemout(1,kM,sincy,stable, lda_table(1=, work, 1p,'t&p,'tttttttttttttlda_work(1=, isysMKKlies e,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MFo.ward FFTfKi=CINN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNNisign_fft =b1,foGNUpDO j=1,Nymin,f n_dTIac_==ndt 20_pp_v ilet_sts1p,'triiGNUpLL su csfft(isign_fft, Nxmoutn sceYe_fft, (avemin(1,kM,s1p,'t&p,'tttttttttttttttttttttttttttttttt(avemout(1,kM,stable, work, isysMKlifndtTIac_==ndt 20_pp_v ilet_sts1p,'triiGNUpLL su zdfft(isign_fft, Nxmoutn sceYe_fft, (avemin(1,kM,s1p,'t&p,'tttttttttttttttttttttttttttttttt(avemout(1,kM,stable, work, isysMKlifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiGNUpLL su cfft(isign_fft, Nxmoutn sceYe_fft, (avemin(1,kM,sincx,aaaaaaaa1p,'t&p,'ttttttttttttt(avemout(1,kM,sincy,stable, lda_table(1=, work, 1p,'t&p,'tttttttttttttlda_work(1=, isysMKlifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiGNUpLL su zfft(isign_fft, Nxmoutn sceYe_fft, (avemin(1,kM,sincx,aaaaaaaa1p,'t&p,'ttttttttttttt(avemout(1,kM,sincy,stable, lda_table(1=, work, 1p,'t&p,'tttttttttttttlda_work(1=, isysMKlies e,foGNU! IFDO,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MDeeYsC!ateNMhmory,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNNLL sup(erTYsC!otable,lda_table,p(erPap(csdeeYsC!nfo) MKi=CINNLL sup(erTYsC!owork,lda_work,p(erPap(csdeeYsC!nfo) MKi=CINN (info .NE. ii0_e3N e,,'triiiii WRITE(mesg,'(A)') 'could not deeYsC!ateNthmory',,'triiiii io = iip(errorierror(ic (selmNNCILL sup(error(iip(err_sudeeYsC!ngmutil_fft_backward_2dt0mesg,LINE__,in1p,'t&p,'ttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttfo) MKi=CINNNNGOTO 9999 e,foGNii IF e,fifs,,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN! FFTW ve.sp.v_for>NE_UX,...,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNNMBR nkF =b1,foGNUpMBHowmany iiNymin,foGNNNMBiEmbed ii-1,foGNUpMBoEmbed ii-1,foGNUpMBIstrid, =b1,foGNUpMBiDistF =bUBOUND((avemin, 1=,foGNNNMBoDistF =bUBOUND((avemoutn1),f n_dTIac_==ndt 20_pp_v ilet_sts1p,'triiLL susfftw_plan_many_dft_c2r(Pl n,NMBR nk,Nxmoutn MBHowmany, 1p,'t&p,'t(avemin(1,1=, MBiEmbed,MBIstrid,,MBiDist, 1p,'t&p,'t(avemout(1,1=,MBoEmbed,MBIstrid,,MBoDist,FFTW_ESTIMATE)p,'triiLL susfftw_execute(Pl n)p,'triiLL susfftw_destroy_plan(Pl n)plifndtTIac_==ndt 20_pp_v ilet_sts1p,'triiLL sudfftw_plan_many_dft_c2r(Pl n,NMBR nk,Nxmoutn MBHowmany, 1p,'t&p,'t(avemin(1,1=, MBiEmbed,MBIstrid,,MBiDist, 1p,'t&p,'t(avemout(1,1=,MBoEmbed,MBIstrid,,MBoDist,FFTW_ESTIMATE)p,'triiLL sudfftw_execute(Pl n)p,'triiLL sudfftw_destroy_plan(Pl n)plifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiLL susfftw_plan_many_dft(Pl n,NMBR nk,Nxmoutn MBHowmany, 1p,'t&p,'t(avemin(1,1=, MBiEmbed,MBIstrid,,MBiDist, 1p,'t&p,'t(avemout(1,1=,MBoEmbed,MBIstrid,,MBoDist, 1p,'t&p,'tFFTW_BACKWARD, FFTW_ESTIMATE)p,'triiLL susfftw_execute(Pl n)p,'triiLL susfftw_destroy_plan(Pl n)plifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiLL sudfftw_plan_many_dft(Pl n,NMBR nk,Nxmoutn MBHowmany, 1p,'t&p,'t(avemin(1,1=, MBiEmbed,MBIstrid,,MBiDist, 1p,'t&p,'t(avemout(1,1=,MBoEmbed,MBIstrid,,MBoDist, 1p,'t&p,'tFFTW_BACKWARD, FFTW_ESTIMATE)p,'triiLL sudfftw_execute(Pl n)p,'triiLL sudfftw_destroy_plan(Pl n)plies e,lies e,lies e,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN! Copyemargut W;iconco.m NTth PPM coovenvpus,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNNDO j=1,NymoutKCINNNNNNNN(avemout(lda(1=,kM =b(avemout(1,kM,foGNU! IFDOoGNU!,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN! Return,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,f99 efCONTINUEp,'triiLL sussnotop(gmutil_fft_backward_2dt0t0nfo) MK,'triiRETURN ,f n_dTIac_==ndt 20_pp_v ilet_sts1p,'trii IF SUBROUTINE gmutil_fft_backward_2dsplifndtTIac_==ndt 20_pp_v ilet_sts1p,'trii IF SUBROUTINE gmutil_fft_backward_2ddplifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'trii IF SUBROUTINE gmutil_fft_backward_2dcplifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'trii IF SUBROUTINE gmutil_fft_backward_2dcc,lies e,libgnumerics-r1036/src/gmfdsolv r_map_3d.f0000644000175000017500000002713511616214650020231 0ustar omaromarfoGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN! SubroutineNNN: gmfdsolv r_map_3d,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN!,foGNNN! Purpeen : mapsld me(avebfromAtopologyAtopo_ids(1=) / th =>,foGNNN! (mesh_ids(1=) W;itopologyA(topo_ids(2))/th =>(mesh_ids(2))c (selm ,foGNNN ,foGNNN MInput : ,foGNNN MMMMMMMMMMMMMMMMtopo_ids(2) (I) ,foGNNN MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMfirst: curr,sv topologyA ,foGNNN MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMsecood: destin=vpusetopologyA ,foGNNN MMMMMMMMMMMMMMMMmesh_ids(2) (I),foGNNN MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMfirst: curr,sv th =>ould me(ave,foGNNN MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMsecood: destin=vpuseth => ,foGNNN MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM,foGNNN ,foGNNN MInput/outputi: (avemf(:,:,:,:,:=uu(F)II(avebi;ibmemapped,foGNNN MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM,foGNNN MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM,foGNNN ,foGNNN MOutputi : ,foGNNN MMMMMMMMMMMMMMMMio = uuuuuuuuu(I)=returnlstatus. =0 e no ror(i.,foGNUp ,foGNNN MRemarkeGGGGGG: ,foGNNN MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM,foGNNN MReferenoes GG:,foGNUp ,foGNNN MRevise I= GG:c (selm kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN M$Log: gmfdsolv r_map_3d.f,v $,foGNNN MRevise 1.1.1.1 2007/07/13 10:18:54iiivos,foGNNN MCBL ve.sp.v_fuld mePPM library,foGNUp ,foGNNN MRevise 1.11 2006/09/04 18:34:44 chatela,foGNNN MFixnsf nd cleanups i;imake it compil -ni ,foGNNN MreTAase-1-0,foGNUp ,foGNNN MRevise 1.10 2005/05/03 13:33:10 hiebe.sc (selm eBugfix:iceYs p((Pcheck_th =id NTth internaletopo ID,foGNUp ,foGNNN MRevise 1.9 2004/10/01i16:08:58iiivos,foGNNN MReplebrd REAL(gmkind_double) :: t0 NTth REAL(MK)It0.,foGNUp ,foGNNN MRevise 1.8 2004/08/31i15:14:26 hiebe.sc (selm eadded argu0,sv checks for>topo nd th =>ids,foGNUp ,foGNNN MRevise 1.7 2004/08/27 09:45:47 hiebe.sc (selm eadded ghostsizn asf n argu0,sv,foGNUp ,foGNNN MRevise 1.4 2004/08/18i16:34:07 hiebe.sc (selm eadded sceYar vector ve.sp.v,foGNUp ,foGNNN MRevise 1.3 2004/07/26 13:49:17iiivos,foGNNN MRemoved RoutinesMsecte I=fromAthe heade.ecom0,sv.,foGNUp ,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ,foGNNN MMMMMMMMMMMMMMMMMMMCespe.eni -Fluid Dynamics (DTU),foGNUp ,foGNNN ,foGNNN Thisufil -isupa).el id mePareYseleParticle Mh =>Library (PPM).,foGNUp ,foGNNN PPM isufree software: you can redistribute it nd/or>todify,foGNUp it unETrld mepe.msel id meGNU Les0,r>GenereYMPublic>Licen0, ,foGNNN asupublished byld meFree Software Fic (avpus, ei'usr ,foGNNN ve.sp.v_3el id meLicen0,,_f.e(stFyourfopvpus)Many latsr ,foGNNN ve.sp.v.,foGNUp ,foGNNN PPM isudistributed ut WITHhopebNY WAit NTY; bmeuseful,,foGNNN but WITHOUT ANY WARRANTY; NTthoutbeven WIT=pmplied warrantyel ,foGNNN MERCHANTABILITY_f.eFITNESS FOR A PARTICULAR PURPOSE. Se -'us,foGNNN GNU GenereYMPublic>Licen0, for>tore details.,foGNUp ,foGNNN You should h ) >received eicopyel id meGNU GenereYMPublic>Licen0,,foGNNN andNd ghGNU Les0,r>GenereYMPublic>Licen0, along NTth PPM. If not,,foGNNN se -.,foGNUp ,foGNNN PareYseleParticle Mh =>Library (PPM),foGNNN ETH Zurich,foGNNN CH-8092 Zurich, SNTtzerl nd,,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,f n_dTIDIM=ndt 20FIELD,f n_dTIac_==ndt 20_pp_v ilet_sts1p,'triiSUBROUTINE gmfdsolv r_map_3d_sce_s((avemfv,Mtopo_ids,Mmesh_idsn1p,'t&p,'tghostsizn, fo) MKlifndtTIac_==ndt 20_pp_v ilet_sts1p,'triiSUBROUTINE gmfdsolv r_map_3d_sce_d((avemfv,Mtopo_ids,Mmesh_idsn1p,'t&p,'tghostsizn, fo) MKlifndtTIac_==ndt 2COMPLEXp,'triiSUBROUTINE gmfdsolv r_map_3d_sce_c((avemfv,Mtopo_ids,Mmesh_idsn1p,'t&p,'tghostsizn, fo) MKlifndtTIac_==ndt 20_pp_v COMPLEXp,'triiSUBROUTINE gmfdsolv r_map_3d_sce_cc((avemfv,Mtopo_ids,Mmesh_idsn1p,'t&p,'tghostsizn, fo) MKlies e,lies e,l n_dTIDIM=ndt 2VFIELD,f n_dTIac_==ndt 20_pp_v ilet_sts1p,'triiSUBROUTINE gmfdsolv r_map_3d_vec_s((avemfv,Mlda,Mtopo_ids,Mmesh_idsn 1p,'t&p,'tghostsizn, fo) MKlifndtTIac_==ndt 20_pp_v ilet_sts1p,'triiSUBROUTINE gmfdsolv r_map_3d_vec_d((avemfv,Mlda,Mtopo_ids,Mmesh_idsn 1p,'t&p,'tghostsizn, fo) MKlifndtTIac_==ndt 2COMPLEXp,'triiSUBROUTINE gmfdsolv r_map_3d_vec_c((avemfv,Mlda,Mtopo_ids,Mmesh_idsn 1p,'t&p,'tghostsizn, fo) MKlifndtTIac_==ndt 20_pp_v COMPLEXp,'triiSUBROUTINE gmfdsolv r_map_3d_vec_cc((avemfv,Mlda,Mtopo_ids,Mmesh_idsn 1p,'t&p,'ghostsizn, fo) MKlies e,lies e,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MModulesKi=CINN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,i=CINNUSE gmtodule_(avec (selmUSE gmtodule_mapc (selmUSE gmtodule_check_idKi=CINNUSE gmtodule_ror(ic (selmUSE gmtodule_writec (selmUSE gmtodule_bsnotartc (selmUSE gmtodule_bsnotopc (selmUSE gmtodule_map_field,,foGNNNIMPLICIT NONEKf n_dTIac_==ndt 20_pp_v ilet_sts1 |dTIac_==ndt 2COMPLEX ,foGNNNINTEGER0&PARAMETER :: MKu=Ngmkind_cingleKlifndtTIac_==ndt 20_pp_v ilet_sts1 |dTIac_==ndt 20_pp_v COMPLEX ,foGNNNINTEGER0&PARAMETER :: MKu=Ngmkind_doubleKlies e,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MArgu0,svsoGNNN,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN PO NTER i;i(avecf n_dTIDIM=ndt 20FIELD,f n_dTIac_==ndt 20_pp_v ilet_sts1 |tTIac_==ndt 20_pp_v ilet_sts1p,'triiREAL(MK)0&DIMENsts1(:,:,:,:=,aaaaaaaa &PO NTER :: (avemfvKlifndtTIac_==ndt 2COMPLEX |dTIac_==ndt 20_pp_v COMPLEXp,'triiLOMPLEX(MK)0&DIMENsts1(:,:,:,:=,aaaaaaaPO NTER :: (avemfvKlies e,lies e,l n_dTIDIM=ndt 2VFIELD,f n_dTIac_==ndt 20_pp_v ilet_sts1 |tTIac_==ndt 20_pp_v ilet_sts1p,'triiREAL(MK)0&DIMENsts1(:,:,:,:,:=,aaaaaaaaPO NTER :: (avemfvKlifndtTIac_==ndt 2COMPLEX |dTIac_==ndt 20_pp_v COMPLEXp,'triiLOMPLEX(MK)0&DIMENsts1(:,:,:,:,:=,aaaaaPO NTER :: (avemfvKlies e,foGNNNINTEGER0&&&&&&&&&&&&&&&&&&&&&&&&&&INTENT(IN) :: ldaKlies e ssK (selmINTEGER0&DIMENsts1(2),&&&&&&&&&&&&INTENT(IN) :: topo_idsK (selmINTEGER0&DIMENsts1(2),&&&&&&&&&&&&INTENT(IN) :: mesh_idsK (selmINTEGER0&DIMENsts1(3),&&&&&&&&&&&&INTENT(IN) :: ghostsiznK (selmINTEGER&&&&&&&&&&&&&&,&&&&&&&&&&&&INTENT( bOUT) :: io =Ki=CINN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MLoceYMvariablesfKi=CINN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN timsr,foGNNNREAL(MK)IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII:: t0,foGNNN cic pe.sc (selmINTEGER&sssss sssssssssssssssssssssssss:: k, i, j,foGNNN Sizn ould me(avemin c (selmINTEGER&sssss sssssssssssssssssssssssss:: from_topo,Mto_topoc (selmINTEGER&sssss sssssssssssssssssssssssss:: from_th =, to_th =cf n_dTIDIM=ndt 20FIELD, (selmINTEGER0&PARAMETER sssssssssssssssssssss:: lda>=b1,fies e ssK (selmINTEGER&sssss sssssssssssssssssssssssss:: maptypnK (selmLOGICAL&sssss sssssssssssssssssssssssss:: validKi=CINNCHARACTER(LEN=p((Pchar)IIIIIIIIIIIIIIIII:: mesgKi=CINN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MExternalsfKi=CINN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MInitRinis,,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNNLL subsnotart(gmfdsolv r_map_3dt0t0nfo) MK,'trii kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN! Checkbargu0,svsKi=CINN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (.Np((Pd bug .G(A 0_e3N e,,'triiiii (.Ntopo_ids(1=.GEB0_e3N e,,'triiiii CILL sup(ercheck_topoidNtopo_ids(1=,validnfo) MKi=CINNNNGOOOOO (.N.NO(A valid_e3N e,,'triiiii CIIIIIio = iip(errorierror(ic (selmNNCINNNN CILL sup(error(iip(err_suergu0,sv,gmfdsolv r_map_2dt0ss1p,'t&p,'ttttttttttttttt'TopologyAID (from_topo) isuinvalid!__LINE__,info) MKi=CINNNNGOOOOOOOOOTO 9999 e,foGNiiiiiiiiii IF e,foGNNNiii IF e,foGNNNiii (.Ntopo_ids(2).GEB0_e3N e,,'triiiii CILL sup(ercheck_topoidNtopo_ids(2=,validnfo) MKi=CINNNNGOOOOO (.N.NO(A valid_e3N e,,'triiiii CIIIIIio = iip(errorierror(ic (selmNNCINNNN CILL sup(error(iip(err_suergu0,sv,gmfdsolv r_map_2dt0ss1p,'t&p,'ttttttttttttttt'TopologyAID (to_topo) isuinvalid!__LINE__,info) MKi=CINNNNGOOOOOOOOOTO 9999 e,foGNiiiiiiiiii IF eNiiiiiiiiii,foGNNNiii IF e,foGNNNiii (.Nmesh_ids(1= .G(A 0_e3N e,,'triiiii i CILL sup(ercheck_th =idNtopo_ids(1=,mesh_ids(1=,validnfo) MKi=CINNNNGOOOOOOO (.N.NO(A valid_e3N e,,'triiiii CIIIIIIIio = iip(errorierror(ic (selmNNCINNNN CICILL sup(error(iip(err_suergu0,sv,gmfdsolv r_map_2dt0ss1p,'t&p,'ttttttttttttttttt'Mh =>ID (from_mesh)uinvalid!__LINE__,info) MKi=CINNNNGOOOOOOOOOOOTO 9999 e,foGNiiiiiiiiiiii IF e,foGNNNiii IF e,foGNNNiii (.Nmesh_ids(2) .G(A 0_e3N e,,'triiiii i CILL sup(ercheck_th =idNtopo_ids(2=,mesh_ids(2=,validnfo) MKi=CINNNNGOOOOOOO (.N.NO(A valid_e3N e,,'triiiii CIIIIIIIio = iip(errorierror(ic (selmNNCINNNN CICILL sup(error(iip(err_suergu0,sv,gmfdsolv r_map_2dt0ss1p,'t&p,'ttttttttttttttttt'Mh =>ID (to_th =)uinvalid!__LINE__,info) MKi=CINNNNGOOOOOOOOOOOTO 9999 e,foGNiiiiiiiiiiii IF e,foGNNNiii IF e,foGNNN IF e,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN DTERnd=souroe andNdestin=vpuse,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNNfrom_topo iitopo_ids(1=,foGNNNto_topo iitopo_ids(2)c (selmfrom_mesh iimesh_ids(1=,foGNNNto_th => =Mmesh_ids(2),foGNNN (.Np((Pd bug .G(A 0_e3N e,,'triiiiiWRITE(mesg,'(A,I5,A,I5)' )'Mapping fromAtopo ',from_topo,',Mmesh ',from_th =>,foGNNNICILL sup(erwriteNp((Prank,gmfdsolv r_mapt0mesg,j)IIIIII,,'triiiiiWRITE(mesg,'(A,I5,A,I5)' )'foGNNNiii W;itopo ',to_topo,',Mmesh ',to_th =>,foGNNNICILL sup(erwriteNp((Prank,gmfdsolv r_mapt0mesg,j)IIIIII,,'trii IF e,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MMap fielde,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,f n_dTIDIM=ndt 20FIELD, (selmLL sup(ermap_field_global(from_topo,to_topo,from_th =,to_th =nfo) MKi=CINNLL sup(ermap_field_push(from_topo,from_th =,DATA_fvnlda,fo) MKi=CINNLL sup(ermap_field_sies(fo) MKi=CINNLL sup(ermap_field_pop(to_topo,to_th =nDATA_fvnlda,ghostsizn,fo) MKlifndtTIDIM=ndt 2VFIELD, (selmLL sup(ermap_field_global(from_topo,to_topo,from_th =,to_th =nfo) MKi=CINNLL sup(ermap_field_push(from_topo,from_th =,DATA_fvnlda,fo) MKi=CINNLL sup(ermap_field_sies(fo) MKi=CINNLL sup(ermap_field_pop(to_topo,to_th =nDATA_fvnlda,ghostsizn,fo) MKlies e,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MReturn,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,f99 efCONTINUEp,'triiLL sussnotop(gmfdsolv r_map_3dt0t0nfo) MK,'triiRETURN ,f n_dTIDIM=ndt 20FIELD,f n_dTIac_==ndt 20_pp_v ilet_sts1p,'trii IF SUBROUTINE gmfdsolv r_map_3d_sce_splifndtTIac_==ndt 20_pp_v ilet_sts1p,'trii IF SUBROUTINE gmfdsolv r_map_3d_sce_dKlifndtTIac_==ndt 2COMPLEXp,'trii IF SUBROUTINE gmfdsolv r_map_3d_sce_cplifndtTIac_==ndt 20_pp_v COMPLEXp,'trii IF SUBROUTINE gmfdsolv r_map_3d_sce_ccKlies e,lies e,l n_dTIDIM=ndt 2VFIELD,f n_dTIac_==ndt 20_pp_v ilet_sts1p,'trii IF SUBROUTINE gmfdsolv r_map_3d_vec_splifndtTIac_==ndt 20_pp_v ilet_sts1p,'trii IF SUBROUTINE gmfdsolv r_map_3d_vec_dKlifndtTIac_==ndt 2COMPLEXp,'trii IF SUBROUTINE gmfdsolv r_map_3d_vec_cplifndtTIac_==ndt 20_pp_v COMPLEXp,'trii IF SUBROUTINE gmfdsolv r_map_3d_vec_ccKlies e,lies e,libgnumerics-r1036/src/gmtodule_us r_numerics.f0000644000175000017500000000270011616214650021401 0ustar omaromarfoGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MModuleGNNNICI: gmtodule_us r_numerics,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN ,foGNNN MPurpeen : Thisuisld meglobaleuser todule. Itacontains aYs,foGNNN MMMMMMMMMMMMMMMMuser-ceYsableuroutinesMould meenvpre g numerics ,foGNNN MMMMMMMMMMMMMMMMlibrary.,foGNNN MMMMMMMMMMMMMMM,foGNNN MRemarkeGGGGGG:,foGNNN ,foGNNN MReferenoes GG:,foGNUp ,foGNNN MRevise I= GG:c (selm kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN M$Log:$c (selm kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MPereYseleParticle Mh =>Library (PPM),foGNNN Institute oulCompuv=vpusaleScienoe,foGNNN METH Zenvrum, Hirschengraben 84,foGNNN MCH-8092 Zurich, SNTtzerl nd, (selm kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,f, (selmMODULE gmtodule_us r_numerics,,foGNNNICI kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0,foGNNNICI PPM numerics routines,foGNNNICI kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0,foGNNNICIUSE gmtodule_comprPapt,foGNNNICIUSE gmtodule_bem,foGNNNICIUSE gmtodule_fieldsolv r,foGNNNICIUSE gmtodule_oR,,foGNNNICIUSE gmtodule_mg,foGNNNICIUSE gmtodule_fmm,foGNNNICIUSE gmtodule_gmm,foGNNNICIUSE gmtodule_hamjac,,foGNNN IF MODULE gmtodule_us r_numerics,libgnumerics-r1036/src/gmtodule_comprPapt.f0000644000175000017500000000366711616214650020517 0ustar omaromar (selm kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MModuleGNNNICI: gmtodule_comprPapt,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ,foGNNN MMMMMMMMMMMMMMMMMMMCespe.eni -Fluid Dynamics (DTU),foGNUp ,foGNNN ,foGNNN Thisufil -isupa).el id mePareYseleParticle Mh =>Library (PPM).,foGNUp ,foGNNN PPM isufree software: you can redistribute it nd/or>todify,foGNUp it unETrld mepe.msel id meGNU Les0,r>GenereYMPublic>Licen0, ,foGNNN asupublished byld meFree Software Fic (avpus, ei'usr ,foGNNN ve.sp.v_3el id meLicen0,,_f.e(stFyourfopvpus)Many latsr ,foGNNN ve.sp.v.,foGNUp ,foGNNN PPM isudistributed ut WITHhopebNY WAit NTY; bmeuseful,,foGNNN but WITHOUT ANY WARRANTY; NTthoutbeven WIT=pmplied warrantyel ,foGNNN MERCHANTABILITY_f.eFITNESS FOR A PARTICULAR PURPOSE. Se -'us,foGNNN GNU GenereYMPublic>Licen0, for>tore details.,foGNUp ,foGNNN You should h ) >received eicopyel id meGNU GenereYMPublic>Licen0,,foGNNN andNd ghGNU Les0,r>GenereYMPublic>Licen0, along NTth PPM. If not,,foGNNN se -.,foGNUp ,foGNNN PareYseleParticle Mh =>Library (PPM),foGNNN ETH Zurich,foGNNN CH-8092 Zurich, SNTtzerl nd,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,, (selmMODULE gmtodule_comprPapt,foGNNN ! Thisutoduleacontains aYsMuser-ceYsableuroutinesMto,foGNNN ! compuve kernel-PP interacte I=.v_a se.el iparticles.,foGNUpNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0,foGNNNICI PPM modulesKi=CINNNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0,foGNNNICIUSE gmtodule_comprPp_ve.let,foGNNNICIUSE gmtodule_comprPp_cell,foGNNNICIUSE gmtodule_comprPp_ring,foGNNNICIUSE gmtodule_comprPp_correct,foGNNNICIUSE gmtodule_comprPp_mk_table,foGNNNICI,foGNNN IF MODULE gmtodule_comprPapt,libgnumerics-r1036/src/gmtodule_fmm_pretrave.se.f0000644000175000017500000000605311616214650021724 0ustar omaromarfoGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN ModuleGNNNICICI: gmtodule_fmm_pretrave.se,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN ,foGNNN Purpeen : moduleGfor>pretrave.se,foGNU! ,foGNNN RemarkeGGGGGGG:,foGNUp ,foGNNN Referenoes GGG: ,foGNNN ,foGNNN Revise I= GGG:c (selm kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN $Log: gmtodule_fmm_pretrave.se.f,v $,foGNNN Revise 1.1.1.1 2007/07/13 10:18:58iiivos,foGNNN CBL ve.sp.v_fuld mePPM library,foGNUp ,foGNNN Revise 1.3 2006/06/29 10:28:37 chatela,foGNNN Added vector strengths cupport,foGNUp ,foGNNN Revise 1.2 2005/09/19 13:03:32 polasekb,foGNNN coR, cosmetics,foGNU! ,foGNNN Revise 1.1 2005/05/27 08:04:36 polasekb,foGNNN initRin=pmple0,svavpus,foGNNN ,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ,foGNNN MMMMMMMMMMMMMMMMMMMCespe.eni -Fluid Dynamics (DTU),foGNUp ,foGNNN ,foGNNN Thisufil -isupa).el id mePareYseleParticle Mh =>Library (PPM).,foGNUp ,foGNNN PPM isufree software: you can redistribute it nd/or>todify,foGNUp it unETrld mepe.msel id meGNU Les0,r>GenereYMPublic>Licen0, ,foGNNN asupublished byld meFree Software Fic (avpus, ei'usr ,foG NN ve.sp.v_3el id meLicen0,,_f.e(stFyourfopvpus)Many latsr ,foGNNN ve.sp.v.,foGNUp ,foGNNN PPM isudistributed ut WITHhopebNY WAit NTY; bmeuseful,,foGNNN but WITHOUT ANY WARRANTY; NTthoutbeven WIT=pmplied warrantyel ,foGNNN MERCHANTABILITY_f.eFITNESS FOR A PARTICULAR PURPOSE. Se -'us,foGNNN GNU GenereYMPublic>Licen0, for>tore details.,foGNUp ,foGNNN You should h ) >received eicopyel id meGNU GenereYMPublic>Licen0,,foGNNN andNd ghGNU Les0,r>GenereYMPublic>Licen0, along NTth PPM. If not,,foGNNN se -.,foGNUp ,foGNNN PareYseleParticle Mh =>Library (PPM),foGNNN ETH Zurich,foGNNN CH-8092 Zurich, SNTtzerl nd,,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,, #ETERndt 20_pp_v ilet_sts1 1 #ETERndt 20_pp_v ilet_sts1 2 !#ETERndt 2INTEGER&sssss ss3 !#ETERndt 2LOGICAL&sssss ss4 !#ETERndt 22DMMMMMMMMMMMMMMM7 !#ETERndt 23DMMMMMMMMMMMMMMM8 #ETERndt 20FIELDMMMMMMMMMMM9 #ETERndt 2VFIELDMMMMMMMMMM10 MODULE gmtodule_fmm_pretrave.seMMM,,fo kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a04/a,NN DTERnd=Ispe.faoe,fo kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a04/a, lmINTERFACE gmfmm_pretrave.se, MODULE PROCEDURE gmfmm_pretrave.se_s, MODULE PROCEDURE gmfmm_pretrave.se_d,fo IF INTERFACE,,fo kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a04/a,NN INCLUDEe3N SOURCES,fo kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a04/a, CONTAINS, #ETERndt 2ac_== 20_pp_v ilet_sts1p#incluR, "gmfmm_pretrave.se.f" #unETE_TIac_=, #ETERndt 2ac_== 20_pp_v ilet_sts1p#incluR, "gmfmm_pretrave.se.f" #unETE_TIac_=, IF MODULE gmtodule_fmm_pretrave.se, ,libgnumerics-r1036/src/gmgmm_reinitRinizn.f0000644000175000017500000003012211616214650020500 0ustar omaromarfoGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN SubroutineNNN: gmgmm_reinitRinizn,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ,foGNNN MMMMMMMMMMMMMMMMMMMCespe.eni -Fluid Dynamics (DTU),foGNUp ,foGNNN ,foGNNN Thisufil -isupa).el id mePareYseleParticle Mh =>Library (PPM).,foGNUp ,foGNNN PPM isufree software: you can redistribute it nd/or>todify,foGNUp it unETrld mepe.msel id meGNU Les0,r>GenereYMPublic>Licen0, ,foGNNN asupublished byld meFree Software Fic (avpus, ei'usr ,foG NN ve.sp.v_3el id meLicen0,,_f.e(stFyourfopvpus)Many latsr ,foGNNN ve.sp.v.,foGNUp ,foGNNN PPM isudistributed ut WITHhopebNY WAit NTY; bmeuseful,,foGNNN but WITHOUT ANY WARRANTY; NTthoutbeven WIT=pmplied warrantyel ,foGNNN MERCHANTABILITY_f.eFITNESS FOR A PARTICULAR PURPOSE. Se -'us,foGNNN GNU GenereYMPublic>Licen0, for>tore details.,foGNUp ,foGNNN You should h ) >received eicopyel id meGNU GenereYMPublic>Licen0,,foGNNN andNd ghGNU Les0,r>GenereYMPublic>Licen0, along NTth PPM. If not,,foGNNN se -.,foGNUp ,foGNNN PareYseleParticle Mh =>Library (PPM),foGNNN ETH Zurich,foGNNN CH-8092 Zurich, SNTtzerl nd,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,f n_ddTIDIM=ndt 22D,f n_ddTIac_==ndt 20_pp_v ilet_sts1p,'triiSUBROUTINE gmgmm_reinitRinizn_2ds(f(ave,tol,width,&&&1p,'t&p,'tttorETrnfo) ,thrh =nchi,MaxItsrMKlifndttTIac_==ndt 20_pp_v ilet_sts1p,'triiSUBROUTINE gmgmm_reinitRinizn_2dd(f(ave,tol,width,&&&1p,'t&p,'tttorETrnfo) ,thrh =nchi,MaxItsrMKlies e KlifndttTIDIM=ndt 23D,f n_ddTIac_==ndt 20_pp_v ilet_sts1p,'triiSUBROUTINE gmgmm_reinitRinizn_3ds(f(ave,tol,width,&&&1p,'t&p,'tttorETrnfo) ,thrh =nchi,MaxItsrMKlifndttTIac_==ndt 20_pp_v ilet_sts1p,'triiSUBROUTINE gmgmm_reinitRinizn_3dd(f(ave,tol,width,&&&1p,'t&p,'tttorETrnfo) ,thrh =nchi,MaxItsrMKlies e Klies e,foGNU! ! ThisuroutineNre-initRinizns_a signed distance level functe NTth 'us,foGNNN ! zero level represenvpng WIT=pspe.faoe. Shift ccorEingly e o'usr,foGNNN ! level isbi;ibmeused. The group marching method isbused.,foGNNN ! ,foGNNN ! =ndtReferenoes =nd,foGNNN ! ,foGNNN ! S. Kim. An O(N) level se.emethod for>Eikusaleequavpuss. SIAM J.eSci.,foGNNN ! lCompuv. 22(6):2178-2193, 2001.,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN IncluR,s,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,#incluR, "gmETERnd.h",foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN Modulese,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNNUSE gmtodule_(avec (selm,foGNNNUSE gmtodule_(ave_gmm,foGNNNUSE gmtodule_gmm_init,foGNNNUSE gmtodule_gmm_kickoff,foGNNNUSE gmtodule_gmm_march,foGNNNUSE gmtodule_gmm_ERninizn,foGNNNUSE gmtodule_bsnotartc (selmUSE gmtodule_bsnotopc (selmUSE gmtodule_ror(ic (selmUSE gmtodule_typnETEc (selmIMPLICIT NONEKf n_ddTIac_==ndt 20_pp_v ilet_sts1 |tTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiINTEGER0&PARAMETER :: MKu=Ngmkind_cingleKlifsep,'triiINTEGER0&PARAMETER :: MKu=Ngmkind_doubleKlies e,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MArgu0,svsoGNNN,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,l n_dTIDIM=ndt 22D, (selmREAL(MK)0&DIMENsts1(:,:,: )III,aPO NTER :: f(ave,foGNNN ! lFielde(ave. R nkF3 (for>2D sceYar fields).,foGNNN ! lIes oes: (i,j,[k],ibsn). On=pspuv: oldelevel functe values. The,foGNNN ! lpspe.faoe isb WAlevel zero. A ghostsizn l i1 isbneeded .v_aY; siR,s,foGNU! ! lwhich mustibmefilled NTth 'us oldelevel functe value .v_pspuv! ,foGNNN ! On=output: reinitRiniznd signed distance functe uspng WIT,foGNNN ! lpspe.polavpuseththod oulChopp. Poisvsofar fromAthe pspe.faoe NTY; h ) ,foGNNN ! lthe value HUGE., (selmREAL(MK)0&DIMENsts1(:,:,:,:=uuI,aINTENT(IN), OPTts1AL:: chi,foGNNN ! lR nkF4 (2d) fieldespecifypng WIT=posite I=. id megrid nodes.,foGNUp ! l1stiindex: 1..gmEim,id mv_p,j,[k],ibsn. OPTts1AL. Unico.m grid is,foGNU! ! lassu0,d e absenv. Ghostlaye.s=. isizn >=1 mustibmepre-filled.KlifndtTIDIM=ndt 23D, (selmREAL(MK)0&DIMENsts1(:,:,:,:=uuI,aPO NTER :: f(ave,foGNNN ! lFielde(ave. R nkF4 (for>3D sceYar fields).,foGNNN ! lIes oes: (i,j,[k],ibsn). On=pspuv: oldelevel functe values. The,foGNNN ! lpspe.faoe isb WAlevel zero. A ghostsizn l i1 isbneeded .v_aY; siR,s,foGNU! ! lwhich mustibmefilled NTth 'us oldelevel functe value .v_pspuv! ,foGNNN ! On=output: reinitRiniznd signed distance functe uspng WIT,foGNNN ! lpspe.polavpuseththod oulChopp. Poisvsofar fromAthe pspe.faoe NTY; h ) ,foGNNN ! lthe value HUGE., (selmREAL(MK)0&DIMENsts1(:,:,:,:,:=u,aINTENT(IN), OPTts1AL:: chi,foGNNN ! lR nkF5 (3d) fieldespecifypng WIT=posite I,foGNNN ! l. id megrid nodes.l1stiindex: 1..gmEim,id mv_p,j,[k],ibsn.,foGNNN ! OPTts1AL. Unico.m grid islassu0,d e absenv. Ghostlaye.s=. isizn >=1,foGNNN ! mustibmepre-filled.Klies e,foGNNNINTEGER ,aINTENT(IN )III :: orETr,foGNNN ! OrETrl. id meththod i;ibmeused. Oneel ,foGNNN ! ,foGNNN ! *gmPap(csorETr_1,foGNNN ! *gmPap(csorETr_2,foGNNN ! *gmPap(csorETr_3, (selmREAL(MK) ,aINTENT(IN )III :: tol,foGNNN ! lRelavpve tolerance forld medepe.mined distance W;itIT=pspe.faoe.,foGNUp ! l1E-3 isla good choioe. The tolerance isuin multiplesMoulgrid spacpngs., (selmREAL(MK) ,aINTENT(IN )III :: width,foGNUp ! lWidthl. id menaor(w bandNdoibmeproduced .v_each siR,l. id mepspe.faoe.,foGNUpINTEGER ,aINTENT( bOUT) I :: io =Ki=CINNREAL(MK) , OPTts1AL ,aINTENT(IN )III :: thrh =,foGNNN ! OPTts1AL. Thrh =oldeforlpspe.faoe depecte . If thisuislnot specified,,foGNNN ! lptuislse.edoiMAXVAL(ABS(f(ave)).,foGNUpINTEGER , OPTts1AL ,aINTENT(IN )III :: MaxItsr,foGNNN ! OPTts1AL argu0,sv specifypng WIT=maximug numbTrl. ieYsCw,d teravpuss.,foGNU! ! Thisucan bmeuseful since a cyclic>depiesenoy ut WITHGMMieYgorTthmI,foGNNN ! lcould cause io inite loops.lIv_each teravpusb WAleastionT=popsp is,foGNU! ! lcompuved.,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN LoceYMvariablesfKi=CINN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNNINTEGER :: xhi,i,ibsn,Nminit,MaxIt, (selmREAL(MK) :: t0,th,foGNUpLOGICAL&sssss sssssssssssss:: lokNN,foGNU!TYPENp((Pt_topo),aPO NTER :: topoc (selm kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MInitRinis,fKi=CINN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNNLL subsnotart(gmgmm_reinitRiniznt0t0nfo) MK,'triitopo i>Ngmtopo(gmm_topoid)%t,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN Checkbargu0,svsKi=CINN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (.Np((Pd bug .G(A 0_e3N e,,'triiiii (.N.NO(A p((PinitRiniznd_e3N e,,'triiiii CIio = iip(errorierror(ic (selmNNCINNNNLL sup(error(iip(err_sup(ernoinit,gmgmm_reinitRiniznt0ss1p,'t&p,'ttttttttttt'PTAaseiceYs p((PinitMfirst!__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,foGNNNiii (.Ntol .LEA 0.0_MK) 3N e,,'triiiii CIio = iip(errorierror(ic (selmNNCINNNNLL sup(error(iip(err_suergu0,sv,gmgmm_reinitRiniznt0ss1p,'t&p,'ttttttttttt'tolerance mustibme>0!__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,foGNNNiii (.Nwidth .LEA 0.0_MK) 3N e,,'triiiii CIio = iip(errorierror(ic (selmNNCINNNNLL sup(error(iip(err_suergu0,sv,gmgmm_reinitRiniznt0ss1p,'t&p,'ttttttttttt'width mustibme>0!__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,l n_dTIDIM=ndt 23D, (selmiii (.NSIZE(f(ave,4) .L(A topo%nsublist) 3N e,,'triiiii CIio = iip(errorierror(ic (selmNNCINNNNLL sup(error(iip(err_suergu0,sv,gmgmm_reinitRiniznt0ss1p,'t&p,'ttttttttttt'fielde(aveeforlsomeubsnouislmisspng__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,foGNNNiii (.NUBOUND(f(ave,1) .L(A maxxhi) 3N e,,'triiiii CIio = iip(errorierror(ic (selmNNCINNNNLL sup(error(iip(err_suergu0,sv,gmgmm_reinitRiniznt0ss1p,'t&p,'ttttttttttt'x di0,ssp.v_fulfielde(aveedoeslnot match mh =__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,foGNNNiii (.NUBOUND(f(ave,2) .L(A maxyhi) 3N e,,'triiiii CIio = iip(errorierror(ic (selmNNCINNNNLL sup(error(iip(err_suergu0,sv,gmgmm_reinitRiniznt0ss1p,'t&p,'ttttttttttt'y di0,ssp.v_fulfielde(aveedoeslnot match mh =__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,foGNNNiii (.NUBOUND(f(ave,3) .L(A maxzhi) 3N e,,'triiiii CIio = iip(errorierror(ic (selmNNCINNNNLL sup(error(iip(err_suergu0,sv,gmgmm_reinitRiniznt0ss1p,'t&p,'ttttttttttt'z di0,ssp.v_fulfielde(aveedoeslnot match mh =__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,lifndtTIDIM=ndt 22D, (selmiii (.NSIZE(f(ave,3) .L(A topo%nsublist) 3N e,,'triiiii CIio = iip(errorierror(ic (selmNNCINNNNLL sup(error(iip(err_suergu0,sv,gmgmm_reinitRiniznt0ss1p,'t&p,'ttttttttttt'fielde(aveeforlsomeubsnouislmisspng__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,foGNNNiii (.NUBOUND(f(ave,1) .L(A maxxhi) 3N e,,'triiiii CIio = iip(errorierror(ic (selmNNCINNNNLL sup(error(iip(err_suergu0,sv,gmgmm_reinitRiniznt0ss1p,'t&p,'ttttttttttt'x di0,ssp.v_fulfielde(aveedoeslnot match mh =__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,foGNNNiii (.NUBOUND(f(ave,2) .L(A maxyhi) 3N e,,'triiiii CIio = iip(errorierror(ic (selmNNCINNNNLL sup(error(iip(err_suergu0,sv,gmgmm_reinitRiniznt0ss1p,'t&p,'ttttttttttt'y di0,ssp.v_fulfielde(aveedoeslnot match mh =__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,lies e,foGNNN IF eNiiiiiiiii! p((Pd bug forlargu0,sv check,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN KickoffHGMM. Welassu0,bNY WAWITHlargestioccuring valueslare,foGNNN MoutsiR,l. id meband.,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (.NPRESENT(thrh =)) 3N e,,'triiiii th iithrh =,foGNNNELSE,,'triiiii th ii0.99_MK*MAXVAL(ABS(f(ave)),foGNNN IF e,foGNNN (.NPRESENT(chi)) 3N e,,'triiiii LL sup(ergmm_kickoff(f(ave,tol,t=nfo) nchi=chi),foGNNNELSE,,'triiiii LL sup(ergmm_kickoff(f(ave,tol,t=nfo) ),foGNNN IF e,foGNNN (.Nio = .NEA p((PPap(cssuccess) 3N e,,'triiiii io = iip(errorierror(ic (selmNNCILL sup(error(iip(err_subsn_failed,gmgmm_reinitRiniznt0ss1p,'t&p,'ttttttt'Starting GMMifailed.__LINE__,info) MKi=CINNNNGOTO 9999 e,foGNii IF e,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MCheckbif WIT=maximug numbTrl. i teravpuss was specified,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (.NPRESENT(MaxItsrM) 3N e,,'triiiii MaxIt iiMaxItsr,foGNNNELSE,,'triiiii MaxIt iiHUGE(MaxIt),foGNNN IF e,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MMarching GMM,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (.NPRESENT(chi)) 3N e,,'triiiii LL sup(ergmm_marchNwidth,orETrnf(ave,1.0_MK,MaxItnfo) nchi=chi),foGNNNELSE,,'triiiii LL sup(ergmm_marchNwidth,orETrnf(ave,1.0_MK,MaxItnfo) ),foGNNN IF e,foGNNN (.Nio = .NEA p((PPap(cssuccess) 3N e,,'triiiii io = iip(errorierror(ic (selmNNCILL sup(error(iip(err_subsn_failed,gmgmm_reinitRiniznt0ss1p,'t&p,'ttttttt'Marching GMMifailed.__LINE__,info) MKi=CINNNNGOTO 9999 e,foGNii IF e,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MReturnfKi=CINN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,f99 efCONTINUEp,'triiLL sussnotop(gmgmm_reinitRiniznt0t0nfo) MK,'triiRETURN f n_ddTIDIM=ndt 22D,f n_ddTIac_==ndt 20_pp_v ilet_sts1p,'trii IF SUBROUTINE gmgmm_reinitRinizn_2dsKlifndttTIac_==ndt 20_pp_v ilet_sts1p,'trii IF SUBROUTINE gmgmm_reinitRinizn_2ddKlies e KlifndttTIDIM=ndt 23D,f n_ddTIac_==ndt 20_pp_v ilet_sts1p,'trii IF SUBROUTINE gmgmm_reinitRinizn_3dsKlifndttTIac_==ndt 20_pp_v ilet_sts1p,'trii IF SUBROUTINE gmgmm_reinitRinizn_3ddKlies e Klies e,libgnumerics-r1036/src/gmtodule_comprPp_mk_table.f0000644000175000017500000000727711616214650022027 0ustar omaromarfoGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MModuleGNNNICI: gmtodule_comprPp_mk_table,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ,foGNNN MMMMMMMMMMMMMMMMMMMCespe.eni -Fluid Dynamics (DTU),foGNUp ,foGNNN ,foGNNN Thisufil -isupa).el id mePareYseleParticle Mh =>Library (PPM).,foGNUp ,foGNNN PPM isufree software: you can redistribute it nd/or>todify,foGNUp it unETrld mepe.msel id meGNU Les0,r>GenereYMPublic>Licen0, ,foGNNN asupublished byld meFree Software Fic (avpus, ei'usr ,foG NN ve.sp.v_3el id meLicen0,,_f.e(stFyourfopvpus)Many latsr ,foGNNN ve.sp.v.,foGNUp ,foGNNN PPM isudistributed ut WITHhopebNY WAit NTY; bmeuseful,,foGNNN but WITHOUT ANY WARRANTY; NTthoutbeven WIT=pmplied warrantyel ,foGNNN MERCHANTABILITY_f.eFITNESS FOR A PARTICULAR PURPOSE. Se -'us,foGNNN GNU GenereYMPublic>Licen0, for>tore details.,foGNUp ,foGNNN You should h ) >received eicopyel id meGNU GenereYMPublic>Licen0,,foGNNN andNd ghGNU Les0,r>GenereYMPublic>Licen0, along NTth PPM. If not,,foGNNN se -.,foGNUp ,foGNNN PareYseleParticle Mh =>Library (PPM),foGNNN ETH Zurich,foGNNN CH-8092 Zurich, SNTtzerl nd,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,oGNNN,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MDTERnd=typns,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,#ETERndt 20_pp_v ilet_sts1 1 #ETERndt 20_pp_v ilet_sts1 2,#ETERndt 20_pp_v ilet_sts12COMPLEX 3 #ETERndt 20_pp_v ilet_sts12COMPLEX 4, #ETERndt 2 NTERNAL&sssss sssssssss5 #ETERndt 2USER_FUNCTts1 6,, (selmMODULE gmtodule_comprPp_mk_table,foGNNN !! [[gmcomprPp_mk_table]],foGNNN !! ThisutoduleaproviR,sNd ghroutinesMconcerned,foGNNN !! NTth compuving kernel interacte I=NTthiv_a se.el iparticles.,foGNUpNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0,foGNNNICI DTERnd=pspe.faoes W;itIT=lookup table creavpusbroutine,foGNUpNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0,foGNNNICIINTERFACE gmcomprPp_mk_table,foGNNNICIelmMODULE PROCEDURE gmcomprPp_mk_table_si,foGNNNICIelmMODULE PROCEDURE gmcomprPp_mk_table_di,foGNNNICIelmMODULE PROCEDURE gmcomprPp_mk_table_sci,foGNNNICIelmMODULE PROCEDURE gmcomprPp_mk_table_dci,foGNNNICIelmMODULE PROCEDURE gmcomprPp_mk_table_su,foGNNNICIelmMODULE PROCEDURE gmcomprPp_mk_table_du,foGNNNICIelmMODULE PROCEDURE gmcomprPp_mk_table_scu,foGNNNICIelmMODULE PROCEDURE gmcomprPp_mk_table_dcu,foGNNNICI IF INTERFACE,,foGNUpNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0,foGNNNICI incluR, tIT=souroe ,foGNUpNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0,foGNNNICICONTAINS, #ETERndt 2aERNELt 2 NTERNAL #ETERndt 2ac_== 20_pp_v ilet_sts1p#incluR, "gmcomprPp_mk_table.f" #unETE_TIac_=, #ETERndt 2ac_== 20_pp_v ilet_sts1p#incluR, "gmcomprPp_mk_table.f" #unETE_TIac_=, #ETERndt 2ac_== 20_pp_v ilet_sts1_COMPLEXp#incluR, "gmcomprPp_mk_table.f" #unETE_TIac_=, #ETERndt 2ac_== 20_pp_v ilet_sts1_COMPLEXp#incluR, "gmcomprPp_mk_table.f" #unETE_TIac_=,#unETE_TIaERNEL, #ETERndt 2aERNELt 2USER_FUNCTts1 #ETERndt 2ac_== 20_pp_v ilet_sts1p#incluR, "gmcomprPp_mk_table.f" #unETE_TIac_=, #ETERndt 2ac_== 20_pp_v ilet_sts1p#incluR, "gmcomprPp_mk_table.f" #unETE_TIac_=, #ETERndt 2ac_== 20_pp_v ilet_sts1_COMPLEXp#incluR, "gmcomprPp_mk_table.f" #unETE_TIac_=, #ETERndt 2ac_== 20_pp_v ilet_sts1_COMPLEXp#incluR, "gmcomprPp_mk_table.f" #unETE_TIac_=,#unETE_TIaERNEL, NNNICI IF MODULE gmtodule_comprPp_mk_table,libgnumerics-r1036/src/gmgmm_jacobian.inc0000644000175000017500000001602511616214650020110 0ustar omaromarNUpNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0-/a,foGNNN IncluR,ufil -for>compuving tIT=jacobianl. ieMmesh map,foGNNN T mepsdexing isuin matITmaticeYMorETring NTth tIT=firstepsdex,foGNNN d ghrow numbTrlandNd ghsecondionT=d ghcolumn numbTr. Thisuway,foGNUp multiplicete NTth 'us transpeen l id me,foGNUp JacobianlNTY; bmestride-1uin metory.,foGNUp ,foGNNN INPUT: INTEGER :: i,j,k,jsub -- Poisv W;icompuve at,foGNNN INTEGER :: orETr -- Desired .rETrl. iFD scITme,foGNNN REAL(MK)(field) :: chi -- mesh node=posite I,foGNNN bOUTPUT: REAL(MK)(3,3) :: jac -- T meJacobian,foGNNN MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM[grad iitransp(jac)*gref],foGNUp ,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0-/a,foGNNN $Log: gmgmm_jacobian.inc,v $,foGNNN Revise 1.1.1.1 2007/07/13 10:18:55iiivos,foGNNN CBL ve.sp.v_fuld mePPM library,foGNUp ,foGNNN Revise 1.3 2005/09/06 14:32:07iiivos,foGNNN Now returnsNd ghJacobianlandNNOT its transpeen. OrETring isu(a)ij=a(i,j).,foGNUp ,foGNNN Revise 1.2 2005/07/25 00:31:09iiivos,foGNNN bugfix:epsdex ror(isuin jacobianlfixed.,foGNUp ,foGNNN Revise 1.1 2005/07/14 19:59:59iiivos,foGNNN InitRin=pmple0,svavpus.,foGNUp ,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0-/a,foGNNN PareYseleParticle Mh =>Library (PPM),foGNNN Institute oulCompuv=vpusaleScienoe,foGNNN METH Zenvrum, Hirschengraben 84,foGNNN MCH-8092 Zurich, SNTtzerl nd, (selm kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,,l n_dTIDIM=ndt 23D, (selm kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MCompuve d mepsve.seMJacobianluspng cespe.ed FD oul.rETrl2_f.e4, (selm kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (.N.rETrl.NEA p((PPap(csorETr_3) 3N e,,'triiiii ji(1,1) = dxihalf*(chi(1,i+1,j,k,jsub)-chi(1,i-1,j,k,jsub)),,'triiiii ji(1,2) = dyihalf*(chi(1,i,j+1,k,jsub)-chi(1,i,j-1,k,jsub)),,'triiiii ji(1,3) = dzihalf*(chi(1,i,j,k+1,jsub)-chi(1,i,j,k-1,jsub)),,'triiiii ji(2,1) = dxihalf*(chi(2,i+1,j,k,jsub)-chi(2,i-1,j,k,jsub)),,'triiiii ji(2,2) = dyihalf*(chi(2,i,j+1,k,jsub)-chi(2,i,j-1,k,jsub)),,'triiiii ji(2,3) = dzihalf*(chi(2,i,j,k+1,jsub)-chi(2,i,j,k-1,jsub)),,'triiiii ji(3,1) = dxihalf*(chi(3,i+1,j,k,jsub)-chi(3,i-1,j,k,jsub)),,'triiiii ji(3,2) = dyihalf*(chi(3,i,j+1,k,jsub)-chi(3,i,j-1,k,jsub)),,'triiiii ji(3,3) = dzihalf*(chi(3,i,j,k+1,jsub)-chi(3,i,j,k-1,jsub)),,'triiELSE,,'triiiii ji(1,1) = 1p,'t&p,'tttdxitwelve*(chi(1,i-2,j,k,jsub)-8.0_MK*chi(1,i-1,j,k,jsub) ss1p,'t&p,'tttttt+8.0_MK*chi(1,i+1,j,k,jsub)-'ttttttchi(1,i+2,j,k,jsub)),,'triiiii ji(1,2) = 1p,'t&p,'tttdyitwelve*(chi(1,i,j-2,k,jsub)-8.0_MK*chi(1,i,j-1,k,jsub) ss1p,'t&p,'tttttt+8.0_MK*chi(1,i,j+1,k,jsub)-'ttttttchi(1,i,j+2,k,jsub)),,'triiiii ji(1,3) = 1p,'t&p,'tttdzitwelve*(chi(1,i,j,k-2,jsub)-8.0_MK*chi(1,i,j,k-1,jsub) ss1p,'t&p,'tttttt+8.0_MK*chi(1,i,j,k+1,jsub)-'ttttttchi(1,i,j,k+2,jsub)),,'triiiii ji(2,1) = 1p,'t&p,'tttdxitwelve*(chi(2,i-2,j,k,jsub)-8.0_MK*chi(2,i-1,j,k,jsub) ss1p,'t&p,'tttttt+8.0_MK*chi(2,i+1,j,k,jsub)-'ttttttchi(2,i+2,j,k,jsub)),,'triiiii ji(2,2) = 1p,'t&p,'tttdyitwelve*(chi(2,i,j-2,k,jsub)-8.0_MK*chi(2,i,j-1,k,jsub) ss1p,'t&p,'tttttt+8.0_MK*chi(2,i,j+1,k,jsub)-'ttttttchi(2,i,j+2,k,jsub)),,'triiiii ji(2,3) = 1p,'t&p,'tttdzitwelve*(chi(2,i,j,k-2,jsub)-8.0_MK*chi(2,i,j,k-1,jsub) ss1p,'t&p,'tttttt+8.0_MK*chi(2,i,j,k+1,jsub)-'ttttttchi(2,i,j,k+2,jsub)),,'triiiii ji(3,1) = 1p,'t&p,'tttdxitwelve*(chi(3,i-2,j,k,jsub)-8.0_MK*chi(3,i-1,j,k,jsub) ss1p,'t&p,'tttttt+8.0_MK*chi(3,i+1,j,k,jsub)-'ttttttchi(3,i+2,j,k,jsub)),,'triiiii ji(3,2) = 1p,'t&p,'tttdyitwelve*(chi(3,i,j-2,k,jsub)-8.0_MK*chi(3,i,j-1,k,jsub) ss1p,'t&p,'tttttt+8.0_MK*chi(3,i,j+1,k,jsub)-'ttttttchi(3,i,j+2,k,jsub)),,'triiiii ji(3,3) = 1p,'t&p,'tttdzitwelve*(chi(3,i,j,k-2,jsub)-8.0_MK*chi(3,i,j,k-1,jsub) ss1p,'t&p,'tttttt+8.0_MK*chi(3,i,j,k+1,jsub)-'ttttttchi(3,i,j,k+2,jsub)),,'trii IF e,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MIsve.t (grad iiTransp(jac)*gref),foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNNdet iiji(3,1)*ji(1,2)*ji(2,3) -iji(3,1)*ji(1,3)*ji(2,2) -i 1p,'t&p,'ttti ji(2,1)*ji(1,2)*ji(3,3) + ji(2,1)*ji(1,3)*ji(3,2) + 1p,'t&p,'ttti ji(1,1)*ji(2,2)*ji(3,3) - ji(1,1)*ji(2,3)*ji(3,2),foGNNNdet ii1.0_MK/det,foGNNNjac(1,1) = ( ji(2,2)*ji(3,3) - ji(2,3)*ji(3,2))*det,foGNNNjac(2,1) = ( ji(3,1)*ji(2,3) - ji(2,1)*ji(3,3))*det,foGNNNjac(3,1) = (-ji(3,1)*ji(2,2) + ji(2,1)*ji(3,2))*det,foGNNNjac(1,2) = (-ji(1,2)*ji(3,3) + ji(1,3)*ji(3,2))*det,foGNNNjac(2,2) = (-ji(3,1)*ji(1,3) + ji(1,1)*ji(3,3))*det,foGNNNjac(3,2) = ( ji(3,1)*ji(1,2) -iji(1,1)*ji(3,2))*det,foGNNNjac(1,3) = ( ji(1,2)*ji(2,3) -iji(1,3)*ji(2,2))*det,foGNNNjac(2,3) = ( ji(2,1)*ji(1,3) - ji(1,1)*ji(2,3))*det,foGNNNjac(3,3) = (-ji(2,1)*ji(1,2) + ji(1,1)*ji(2,2))*det,lifndtTIDIM=ndt 22D, (selm kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MCompuve d mepsve.seMJacobianluspng cespe.ed FD oul.rETrl2_f.e4, (selm kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (.N.rETrl.NEA p((PPap(csorETr_3) 3N e,,'triiiii ji(1,1) = dxihalf*(chi(1,i+1,j,jsub)-chi(1,i-1,j,jsub)),,'triiiii ji(1,2) = dyihalf*(chi(1,i,j+1,jsub)-chi(1,i,j-1,jsub)),,'triiiii ji(2,1) = dxihalf*(chi(2,i+1,j,jsub)-chi(2,i-1,j,jsub)),,'triiiii ji(2,2) = dyihalf*(chi(2,i,j+1,jsub)-chi(2,i,j-1,jsub)),,'triiELSE,,'triiiii ji(1,1) = 1p,'t&p,'tttdxitwelve*(chi(1,i-2,j,jsub)-8.0_MK*chi(1,i-1,j,jsub) ss1p,'t&p,'tttttt+8.0_MK*chi(1,i+1,j,jsub)-'ttttttchi(1,i+2,j,jsub)),,'triiiii ji(1,2) = 1p,'t&p,'tttdyitwelve*(chi(1,i,j-2,jsub)-8.0_MK*chi(1,i,j-1,jsub) ss1p,'t&p,'tttttt+8.0_MK*chi(1,i,j+1,jsub)-'ttttttchi(1,i,j+2,jsub)),,'triiiii ji(2,1) = 1p,'t&p,'tttdxitwelve*(chi(2,i-2,j,jsub)-8.0_MK*chi(2,i-1,j,jsub) ss1p,'t&p,'tttttt+8.0_MK*chi(2,i+1,j,jsub)-'ttttttchi(2,i+2,j,jsub)),,'triiiii ji(2,2) = 1p,'t&p,'tttdyitwelve*(chi(2,i,j-2,jsub)-8.0_MK*chi(2,i,j-1,jsub) ss1p,'t&p,'tttttt+8.0_MK*chi(2,i,j+1,jsub)-'ttttttchi(2,i,j+2,jsub)),,'trii IF e,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MIsve.t,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNNdet iiji(1,1)*ji(2,2) - ji(1,2)*ji(2,1),foGNNNdet ii1.0_MK/det,foGNNNjac(1,1) = ji(2,2)*det,foGNNNjac(2,1) = -ji(2,1)*det,foGNNNjac(1,2) = -ji(1,2)*det,foGNNNjac(2,2) = ji(1,1)*det,lies e,,libgnumerics-r1036/src/gmcomprPp_cell.f0000644000175000017500000013061511616214650017614 0ustar omaromarfoGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MSubroutineNNN: gmcomprPp_cell,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ,foGNNN MMMMMMMMMMMMMMMMMMMCespe.eni -Fluid Dynamics (DTU),foGNUp ,foGNNN ,foGNNN Thisufil -isupa).el id mePareYseleParticle Mh =>Library (PPM).,foGNUp ,foGNNN PPM isufree software: you can redistribute it nd/or>todify,foGNUp it unETrld mepe.msel id meGNU Les0,r>GenereYMPublic>Licen0, ,foGNNN asupublished byld meFree Software Fic (avpus, ei'usr ,foG NN ve.sp.v_3el id meLicen0,,_f.e(stFyourfopvpus)Many latsr ,foGNNN ve.sp.v.,foGNUp ,foGNNN PPM isudistributed ut WITHhopebNY WAit NTY; bmeuseful,,foGNNN but WITHOUT ANY WARRANTY; NTthoutbeven WIT=pmplied warrantyel ,foGNNN MERCHANTABILITY_f.eFITNESS FOR A PARTICULAR PURPOSE. Se -'us,foGNNN GNU GenereYMPublic>Licen0, for>tore details.,foGNUp ,foGNNN You should h ) >received eicopyel id meGNU GenereYMPublic>Licen0,,foGNNN andNd ghGNU Les0,r>GenereYMPublic>Licen0, along NTth PPM. If not,,foGNNN se -.,foGNUp ,foGNNN PareYseleParticle Mh =>Library (PPM),foGNNN ETH Zurich,foGNNN CH-8092 Zurich, SNTtzerl nd,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,,l n_dTIaERNELtndt 2 NTERNAL # n_dTIac_==ndt 20_pp_v ilet_sts1p,'triiSUBROUTINE gmcomprPp_cell_si(topoid,xp,Np,p(ave,lde,lsymm,kernel,kpa),s1p,'t&p,'tttclist,cutoff2,dpdnfo) MKlifndtTIac_==ndt 20_pp_v ilet_sts1p,'triiSUBROUTINE gmcomprPp_cell_di(topoid,xp,Np,p(ave,lde,lsymm,kernel,kpa),s1p,'t&p,'tttclist,cutoff2,dpdnfo) MKlifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiSUBROUTINE gmcomprPp_cell_sci(topoid,xp,Np,p(ave,lde,lsymm,kernel,kpa),1p,'t&p,'tttclist,cutoff2,dpdnfo) MKlifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiSUBROUTINE gmcomprPp_cell_dci(topoid,xp,Np,p(ave,lde,lsymm,kernel,kpa),1p,'t&p,'tttclist,cutoff2,dpdnfo) MKlies e,lifndtTIaERNELtndt 2USER_FUNCTts1 # n_dTIac_==ndt 20_pp_v ilet_sts1p,'triiSUBROUTINE gmcomprPp_cell_su(topoid,xp,Np,p(ave,lde,lsymm,kernel,kpa),s1p,'t&p,'tttclist,cutoff2,dpdnfo) MKlifndtTIac_==ndt 20_pp_v ilet_sts1p,'triiSUBROUTINE gmcomprPp_cell_du(topoid,xp,Np,p(ave,lde,lsymm,kernel,kpa),s1p,'t&p,'tttclist,cutoff2,dpdnfo) MKlifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiSUBROUTINE gmcomprPp_cell_scu(topoid,xp,Np,p(ave,lde,lsymm,kernel,kpa),1p,'t&p,'tttclist,cutoff2,dpdnfo) MKlifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiSUBROUTINE gmcomprPp_cell_dcu(topoid,xp,Np,p(ave,lde,lsymm,kernel,kpa),1p,'t&p,'tttclist,cutoff2,dpdnfo) MKlies e,lifndtTIaERNELtndt 2LOOKUP_TABLE # n_dTIac_==ndt 20_pp_v ilet_sts1p,'triiSUBROUTINE gmcomprPp_cell_st(topoid,xp,Np,p(ave,lde,lsymm,kernel,kpa),s1p,'t&p,'tttclist,cutoff2,dpdnfo) MKlifndtTIac_==ndt 20_pp_v ilet_sts1p,'triiSUBROUTINE gmcomprPp_cell_dt(topoid,xp,Np,p(ave,lde,lsymm,kernel,kpa),s1p,'t&p,'tttclist,cutoff2,dpdnfo) MKlifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiSUBROUTINE gmcomprPp_cell_sct(topoid,xp,Np,p(ave,lde,lsymm,kernel,kpa),1p,'t&p,'tttclist,cutoff2,dpdnfo) MKlifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiSUBROUTINE gmcomprPp_cell_dct(topoid,xp,Np,p(ave,lde,lsymm,kernel,kpa),1p,'t&p,'tttclist,cutoff2,dpdnfo) MKlies e,lies e,foGNU! ! ThisuroutineNcompuves kernel interacte I=by direct,foGNU! ! particle-particle interacte I=uspng ceY; lists.,foGNU! ! ,foGNU! ! [NOTE],foGNNN !! Loops ove. lde h ) >been explicitly unrolled forld mecasesMou,foGNNN !! `lde.EQ.1` andN`lde.EQ.2` W;ieYsCw vectorizete ut WITsmecases.,foGNU! ! ,foGNU! ! [WARN_pp],foGNNN !! clist h sbi;ibmecreaved byld meu0,r>programibmfore,foGNNN !! ceYsing tIisuroutineA p((Pneighlist_clist should be,foGNNN !! used forld is. The>reas usbNY WAWIislaYsCws WIT,foGNNN ! lu0,r>i;ih ) >multiple ceY; lists andNceYs WIis,foGNNN ! lroutineNforld meappropriate oneA Dolnot forge.edo,foGNNN !! ceYs p((Pneighlist_clist_destroy.,foGNU! ! ,foGNU! ! [NOTE],foGNNN !! dpdbneedsbi;ibmeaYsCcaved i;iprop,r>sizn bmfore,foGNNN !! ceYsing tIisuroutineA Also, tIisuroutineuislnot,foGNNN ! lrTsmtving dpdbi;izero bmfore doing tIT=PP,foGNNN ! linteracte I. ThisuaYsCws contribute I=from,foGNNN !! different kernelsbi;ibmeaccumulaved. If needed,,foGNNN ! lse.eitbi;izero bmfore ceYsing tIisuroutine WIT,foGNNN ! lfirstetime.,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNUp Modules,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNUpUSE gmtodule_(avec (selmUSE gmtodule_typnETEc (selmUSE gmtodule_check_idc (selmUSE gmtodule_bsnotartc (selmUSE gmtodule_bsnotopc (selmUSE gmtodule_ror(ic (selmUSE gmtodule_neighlist,foGNNN MPLICIT NONEKf n_dTIac_==ndt 20_pp_v ilet_sts1 |tTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiINTEGER0&PARAMETER :: MKu=Ngmkind_cingleKlifndtTIac_==ndt 20_pp_v ilet_sts1 |tTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiINTEGER0&PARAMETER :: MKu=Ngmkind_doubleKlies e,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MIncluR,s,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,#incluR, "gmETERnd.h",foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN Argu0,svsKi=CINN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN NTEGER :: topoid,foGNNN !! The>IDel id metopology currently mapped i;i(needed i;ige.enumbTr,foGNNN !! . isubdomai I=.n loceYMprocessorMK,'triiREAL(MK) 0&DIMENsts1(:,:),aINTENT(IN )I:: xp,foGNNN !! particle co-orEinavesKf n_dTIac_==ndt 20_pp_v ilet_sts1 |tTIac_==ndt 20_pp_v ilet_sts1p,'triiREAL(MK) 0&DIMENsts1(:,:),aINTENT(IN )I:: p(ave,foGNNN ! lparticle strengths used forlinteracte .,foGNNN ! Ove.loaded iypn: cingle,doubleK,'triiREAL(MK) 0&DIMENsts1(:,:),aINTENT( bOUT) :: dpd,foGNNN ! Changeel iparticlee(avee(p(ave) due W;iinteracte .,foGNNN ! Thisuislnot initRiniznd byld isuroutine!,foGNNN ! Ove.loaded iypns: cingle,double.KlifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEX |tTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiCOMPLEX(MK)0&DIMENsts1(:,:),aINTENT(IN )I:: p(ave,foGNNN ! lparticle strengths used forlinteracte .,foGNNN ! Ove.loaded iypns: cingleNcomplex, doubleNcomplex.p,'triiCOMPLEX(MK)0&DIMENsts1(:,:),aINTENT( bOUT) :: dpd,foGNNN ! Changeel iparticlee(avee(p(ave) due W;iinteracte .,foGNNN ! Thisuislnot initRiniznd byld isuroutine!,foGNNN ! Ove.loaded iypns: cingleNcomplex, doubleNcomplex.plies e,foGNNNINTEGER ,aINTENT(IN )I:: Np,foGNNN !! numbTrl. iparticles=.n d isuproc.,foGNUpINTEGER ,aINTENT(IN )I:: lde,foGNNN !! lading di0,ssp.v_fulp(ave.,l n_dTIaERNELtndt 2 NTERNAL foGNUpINTEGER ,aINTENT(IN )I:: kernel,foGNNN !! kernel i;ibmeused forlPPlinteracte I. ToeuseNg-internal,foGNNN !! kernels, specifyionT=of:,foGNU! ! ,foGNU! ! 99m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN ! MMMp((PPap(cskerel_laplace2d_2p,foGNNN ! MMM (2nd .rETrlLaplacian, polynomRin=pn 2D),foGNNN ! MMMp((PPap(cskerel_laplace3d_2p,foGNNN ! MMM (2nd .rETrlLaplacian, polynomRin=pn 3D),foGNNN ! 99m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN ! ,foGNNN ! ToeuseNyourfown kernel functe , passNd ghfuncte popspTrlhere.,foGNNN ! Yourffuncte should take onelargu0,sv andNreturn onelvalue.,foGNNN ! The WIird=possibility isbi;ipassNa=lookup table NTth 'abulaved,foGNNN !! kernel values. SuchNa=table can bmecreaved uspng,foGNNN ! lpgmcomprPp_mk_table.Kf n_dTIac_==ndt 20_pp_v ilet_sts1 |tTIac_==ndt 20_pp_v ilet_sts1p,'triiREAL(MK) 0&DIMENsts1(:) ,aINTENT(IN )I:: kPap,foGNNN ! lKernel Pap(cepe.s. Se -docu0,svavpus_f.epgmcomprPp_kernels.inc,foGNNN ! lff.eR,scripte . Typn can bmecingle, doubleKlifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEX |tTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiCOMPLEX(MK)0&DIMENsts1(:) ,aINTENT(IN )I:: kPap,foGNNN ! lKernel Pap(cepe.s. Se -docu0,svavpus_f.epgmcomprPp_kernels.inc,foGNNN ! lff.eR,scripte . Typn can bmecingleNcomplex_f.edoubleNcomplex.plies e,lifndtTIaERNELtndt 2LOOKUP_TABLE ,'triiREAL(MK) ,aINTENT(IN )I:: kPap,foGNNN ! lKernel Pap(cepe.s. Lookup table ve.sp.v.,foGNUp ! PassNdxtableinv (d mepsve.seMl id metable spacpng) asua sceYar here.,f n_dTIac_==ndt 20_pp_v ilet_sts1 |tTIac_==ndt 20_pp_v ilet_sts1p,'triiREAL(MK) 0&DIMENsts1(: ),aINTENT(IN )I:: kernel,lifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEX |tTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiCOMPLEX(MK)0&DIMENsts1(: ),aINTENT(IN )I:: kernel,lies e,foGNU! ! lookup table NTth 'abulaved kernel values. SuchNa=table can,foGNU! ! bmecreaved uspng <>.plies e,foGNNNLOGICAL&sssss ssssssssssss,aINTENT(IN )I:: lsymm,foGNU! ! Do symmetriclPPlinteracte I?,foGNU!TYPENp((Pt_clist)0&DIMENsts1(:),aINTENT(IN) :: clist,foGNNN ! CeY; list asua list fulptr_to_clist.,foGNU! ! ,foGNU! ! particle index list fulibsn: `clist(ibsn)%lpdx(:)`sssss ssssssssssss+,foGNU! ! popspTrli;ifirsteparticle in ibox fulibsn: ` clist(ibsn)%lhbx(ibox)` ,'triiREAL(MK) ,aINTENT(IN )I:: cutoff2,foGNU! ! Squa.ed PPlinteracte cutoff. Should be .LEA ceY; sizn.,foGNUpINTEGER ,aINTENT( bOUT) :: io =Ki=CINN ! lReturnsNsvavus, 0 up success,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN LoceYMvariablesKi=CINN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN NTEGER :: nsublist,foGNNN numbTrl. isubdomai I=.n tIT=loceYMprocessor ,foGNNN counters,foGNNN NTEGER :: i,idom,ibox,jbox,idx,foGNNN NTEGER :: ipart,jpart,ip,jp,foGNNN NTEGER :: cbox,iinter,j,k,ispec,foGNNN coorEinave differencesKi=CINNREAL(MK) :: dx,dy,dzKi=CINNREAL(MK) :: factor,factor2,f n_dTIac_==ndt 20_pp_v ilet_sts1 |tTIac_==ndt 20_pp_v ilet_sts1p,'triiREAL(MK) :: summ,summ2p,'triiREAL(MK) :: eta,dm,lifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEX |tTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiCOMPLEX(MK) :: summ,summ2p,'triiCOMPLEX(MK) :: eta,dm,lies e,foGNU! squa.e fulispTrlparticlee(istanceKi=CINNREAL(MK) :: dij,dij2,dij4,dij5,foGNU! start andNieseparticle in a box,foGNNN NTEGER :: istart,iies,jstart,jend,foGNNN ceY; neighbf.elistsp,'triiINTEGER0&DIMENsts1(:,:),aPO NTER :: inp,jnp,foGNNN numbTrl. iinteracte I=ff.eeach cell,foGNNNINTEGER0&SAVE :: nnp,foGNNN ceY; offsetI=ff.ebox psdex,foGNNN NTEGER :: n1,n2,nzKi=CINNLOGICAL&sssss sssssssssssss :: valid,foGNNNREAL(MK) :: t0,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN Externals,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,#i n_dTIaERNELtndt 2USER_FUNCTts1 # n_dTIac_==ndt 20_pp_v ilet_sts1 |tTIac_==ndt 20_pp_v ilet_sts1p,'triiREAL(MK) 0&DIMENsts1(:) ,aINTENT(IN )I:: kPap,foGNNNINTERFACE, FUNCTts1 kernel(x,kpa)MKi=CINNNNGOOOOO MPLICIT NONEKf n_dTIac_==ndt 20_pp_v ilet_sts1 |tTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiNNGOOOOO NTEGER0&PARAMETER :: MKu=Nac_=(1.0E0MKlifndtTIac_==ndt 20_pp_v ilet_sts1 |tTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiNNGOOOOO NTEGER0&PARAMETER :: MKu=Nac_=(1.0D0),lies e,foGNU!!!!!!!!!REAL(MK),aINTENT(IN) :: x,foGNU!!!!!!!!!REAL(MK),aDIMENsts1(:),aINTENT(IN) :: kPap,foGNNN!!!!!!!!REAL(MK)I:: kernel,foGNNNNNNN IF FUNCTts1 kernel NNNNNN IF INTERFACE,lifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEX |tTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiCOMPLEX(MK)0&DIMENsts1(:) ,aINTENT(IN )I:: kPap,foGNNNINTERFACE, FUNCTts1 kernel(x,kpa)MKi=CINNNNGOOOOO MPLICIT NONEKf n_dTIac_==ndt 20_pp_v ilet_sts1 |tTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiNNGOOOOO NTEGER0&PARAMETER :: MKu=Nac_=(1.0E0MKlifndtTIac_==ndt 20_pp_v ilet_sts1 |tTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiNNGOOOOO NTEGER0&PARAMETER :: MKu=Nac_=(1.0D0),lies e,foGNU!!!!!!!!!REAL(MK),aINTENT(IN) :: x,foGNU!!!!!!!!!COMPLEX(MK)0&DIMENsts1(:),aINTENT(IN) :: kPap,foGNNN!!!!!!!!COMPLEX(MK) :: kernel,foGNNNNNNN IF FUNCTts1 kernel NNNNNN IF INTERFACE,lies e,lies e,,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MInitRinis,,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNNLL subsnotart(gmcomprPp_cellt0t0nfo) MK,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MCheckbargu0,svs.,foGNUp kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (.Np((Pd bug .G(A 0_e3N e,,'triiiii (.N.NO(A p((PinitRiniznd_e3N e,,'triiiii CIio = iip(errorierror(ic (selmNNCINNNNLL sup(error(iip(err_sup(ernoinit,gmcomprPp_cellt0ss1p,'t&p,'ttttttttttt'PTAaseiceYs p((PinitMfirst!__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,foGNNNiii (.NNp .L(A 0_e3N e,,'triiiii CIio = iip(errorierror(ic (selmNNCINNNNLL sup(error(iip(err_suergu0,sv,gmcomprPp_cellt0ss1p,'t&p,'ttttttttttt'Np mustibme>=0__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,foGNNNiii (.Nlde .L(A 1_e3N e,,'triiiii CIio = iip(errorierror(ic (selmNNCINNNNLL sup(error(iip(err_suergu0,sv,gmcomprPp_cellt0ss1p,'t&p,'ttttttttttt'lde mustibme>0__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,foGNNNiii LL sup(ercheck_topoid(topoid,validnfo) MKi=CINNNNGO (.N.NO(A valid_e3N e,,'triiiii CIio = iip(errorierror(ic (selmNNCINNNNLL sup(error(iip(err_suergu0,sv,gmcomprPp_cellt0ss1p,'t&p,'ttttttttttt'Topology IDlnot valid__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,foGNNNiii (.Ncutoff2 .L(A 0.0_MK) 3N e,,'triiiii CIio = iip(errorierror(ic (selmNNCINNNNLL sup(error(iip(err_suergu0,sv,gmcomprPp_cellt0ss1p,'t&p,'ttttttttttt'cutoff2 mustibme>=0__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,#i n_dTIaERNELtndt 2LOOKUP_TABLE ,'triiiii (.NkPap .L(A 0.0_MK) 3N e,,'triiiii CIio = iip(errorierror(ic (selmNNCINNNNLL sup(error(iip(err_suergu0,sv,gmcomprPp_cellt0ss1p,'t&p,'ttttttttttt'kPap (dxtableinv) mustibme>=0__LINE__,info) MKi=CINNNNGOOOOOTO 9999 e,foGNiiiiii IF e,#ies e,foGNNN IF eK,foGNU!nsublist iip(ertopo(topoid)%t%nsublistK,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MBuildlinteracte index listsKi=CINN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNNLL sup(erneighlist_MkNeighIdx(lsymm,inp,jnp,nnpnfo) MK,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MPARTICLE-PARTICLE INTERACTts1S uspng symmetry,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (.Nlsymm) 3N e,,'triiiii DO idom=1,nsublist,foGNNNNNNNNNNNn1 iiclist(idom)%Nm(1MKi=CINNNNGOOOOOn2 iiclist(idom)%Nm(1M*clist(idom)%Nm(2MKi=CINNNNGOOOOOnz iiclist(idom)%Nm(3MKi=CINNNNGOOOOO (.Np((Pdim .EQ. 2) 3N e,,'triiiii CIOOOOn2 = 0,,'triiiii CIOOOOnz = 2,,'triiiii CI IF e,foGNNNiii GNNN loop ove. eYs REAL ceY;s (d me-2 ut WITHiesedoesld isMKi=CINNNNGOOOOODO k=0,nz-2,,'triiiii CIOOOODO j=0,clist(idom)%Nm(2M-2,,'triiiii CIOOOOOOOODO i=0,clist(idom)%Nm(1M-2,,'triiiii CIOOOOOOOOGNNN index l id mecespe. box,foGNNNNNNNNNNNNNNNNNNNNNNNcbox = i + 1 + n1*j + n2*k,,'triiiii CIOOOOOOOOGNNN loop ove. eYs box-box psteracte I,,'triiiii CIOOOOOOOOGNNNDO ipster=1,nnp,foGNNNtriiiii CIOOOOOOOOGNNN depe.mine box psdioes forld is psteracte ,foGNNNtriiiii CIOOOOOOOOGNNNibox = cbox+(inp(1,ipster)+n1*inp(2,ipster)+s1p,'t&p,'ttttttttttttttttttttttttttttttn2*inp(3,ipster)MKi=CINNNNGOOOOOOOOOOOOOOOOOOOOOjbox = cbox+(jnp(1,ipster)+n1*jnp(2,ipster)+s1p,'t&p,'ttttttttttttttttttttttttttttttn2*jnp(3,ipster)MKi=CINNNNGOOOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 20,foGNNNtriiiii CIOOOOOOOOGNNN Read psdioes andNcheckbif box ps emptyKi=CINNNNGOOOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 20,foGNNNtriiiii CIOOOOOOOOGNNNistart iiclist(idom)%lhbx(ibox),foGNNNtriiiii CIOOOOOOOOGNNNiiese iiclist(idom)%lhbx(ibox+1M-1,foGNNNtriiiii CIOOOOOOOOGNNN (.Niiese.L(A istart) CYCLE ,'triiiii OOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 20,foGNNNtriiiii CIOOOOOOOOGNNN WTthiv_d mebox ptselfeuseNsymmetry andNavoid,foGNNNtriiiii CIOOOOOOOOGNNN adding tIT=particle itselfeW;iitsfown list,foGNNNNNNNNNNNOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 20,foGNNNtriiiii CIOOOOOOOOGNNN (.Nibox .EQ. jbox) 3N e,,'triiiii CIOOOOOOOOOOOOOOOOOOOODO ipart=istart,iies,,'triiiii CIOOOOOOOOOOOOOOOOOOOOOOOOip iiclist(idom)%lpdx(ipart),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNN (.Nlde .EQ. 1_e3N e,,'triiiii CIIIIIIIIIIIIIIIIIIIIIIIIIIIIIsumm = 0.0_MK,#i ETE_TISXF90 !CDIR NODEP,lies e,foGNU!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!DO jpart=(ipart+1M,iies,,'triiiii CIOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOjp iiclist(idom)%lpdx(jpart),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdx iixp(1,ip) - xp(1,jp),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdy iixp(2,ip) - xp(2,jp),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNN (.Np((Pdim .G(A 2) 3N e,,'triiiii CIOOOO CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdz iixp(3,ip) - xp(3,jp),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdij = (dx*dx)+(dy*dy)+(dz*dz),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNELSE,,'triiiii iii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdz = 0.0_MK,,'triiiii iii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdij = (dx*dx)+(dy*dy),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNEIF e,foGNNNiii GNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN (.Ndij .G(A cutoff2) CYCLE ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9 ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO eParticle ip psteractI=NTth ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO eparticle jp here... aes,,'triiiii CIOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO! vioe ve.saeW;iuseNsymmetry. ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9 #incluR, "gmcomprPp_kernels.inc",foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdm iieta*(p(ave(1,jp) -i 1p,'t&p,'tttttttttttttttttttttttttttttttttttttttttttp(ave(1,ip)),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNsumm = summ +Ndm,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdpd(1,jp) =Ndpd(1,jp) -Ndm,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNEIFDO,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNdpd(1,ip) =Ndpd(1,ip) + summ,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNELSE (.Nlde .EQ. 2) 3N e,,'triiiii CIOOOO CIOOOOOOOOGNNNOOOOGNNNsumm = 0.0_MK,,'triiiii CIOOOO CIOOOOOOOOGNNNOOOOGNNNsumm2 = 0.0_MK,#i ETE_TISXF90 !CDIR NODEP,lies e,foGNU!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!DO jpart=(ipart+1M,iies,,'triiiii CIOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOjp iiclist(idom)%lpdx(jpart),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdx iixp(1,ip) - xp(1,jp),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdy iixp(2,ip) - xp(2,jp),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNN (.Np((Pdim .G(A 2) 3N e,,'triiiii CIOOOO CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdz iixp(3,ip) - xp(3,jp),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdij = (dx*dx)+(dy*dy)+(dz*dz),foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNELSE,,'triiiii iii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdz = 0.0_MK,,'triiiii iii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdij = (dx*dx)+(dy*dy),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNEIF e,foGNNNiii GNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN (.Ndij .G(A cutoff2) CYCLE ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9 ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO eParticle ip psteractI=NTth ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO eparticle jp here... aes,,'triiiii CIOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO evioe ve.saeW;iuseNsymmetry. ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9 #incluR, "gmcomprPp_kernels.inc",foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdm iieta*(p(ave(1,jp) -i 1p,'t&p,'tttttttttttttttttttttttttttttttttttttttttttp(ave(1,ip)),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNsumm = summ +Ndm,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdpd(1,jp) =Ndpd(1,jp) -Ndm,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdm iieta*(p(ave(2,jp) -i 1p,'t&p,'tttttttttttttttttttttttttttttttttttttttttttp(ave(2,ip)),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNsumm2 = summ2 +Ndm,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdpd(2,jp) =Ndpd(2,jp) -Ndm,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNEIFDO,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNdpd(1,ip) =Ndpd(1,ip) + summ,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNdpd(2,ip) =Ndpd(2,ip) + summ2,,'triiiii CIOOOOOOOOGNNNOOOOGNNNNNNNELSE,,'triiiii iii CIOOOOOOOOGNNNOOOOGNNNNNNNDO jpart=(ipart+1M,iies,,'triiiii CIOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOjp iiclist(idom)%lpdx(jpart),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdx iixp(1,ip) - xp(1,jp),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdy iixp(2,ip) - xp(2,jp),foGNNNtriiiii (.Np((Pdim .G(A 2) 3N e,,'triiiii CIOOOO CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdz iixp(3,ip) - xp(3,jp),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdij = (dx*dx)+(dy*dy)+(dz*dz),foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNELSE,,'triiiii iii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdz = 0.0_MK,,'triiiii iii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdij = (dx*dx)+(dy*dy),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNEIF e,foGNNNiii GNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN (.Ndij .G(A cutoff2) CYCLE ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9 ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO eParticle ip psteractI=NTth ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO eparticle jp here... aes,,'triiiii CIOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO evioe ve.saeW;iuseNsymmetry. ,'triiiii CIOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9 #incluR, "gmcomprPp_kernels.inc",foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNDO ispec=1,lde,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNdm iieta*(p(ave(ispec,jp)- 1p,'t&p,'tttttttttttttttttttttttttttttttttttttttttttttttp(ave(ispec,ip)),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdpd(ispec,ip)=dpd(ispec,ip)+dm,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdpd(ispec,jp)=dpd(ispec,jp)-dm,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNEIFDO,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNEIFDO,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNEIF e,foGNNNiii GNNNNNNNNNNNNNNNNNNNNNNNEIFDO,foGNNNtriiiii CIOOOOOOOOGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 20,foGNNNtriiiii CIOOOOOOOOGNNN Forld meo'usr boxesNcheckbeYs particles,foGNNNtriiiii CIOOOOOOOOGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 20,foGNNNtriiiii CIOOOOOOOOGNNNELSE,,'triiiii iii CIOOOOOOOOGNNNOOOO!ige.epopspTrsli;ifirsteandNlasteparticle,,'triiiii iii CIOOOOOOOOGNNNOOOOjstart iiclist(idom)%lhbx(jbox),foGNNNtriiiii CIOOOOOOOOGNNNOOOOjiese iiclist(idom)%lhbx(jbox+1M-1,foGNNNtriiiii CIOOOOOOOOGNNNOOOO!iskip d is pispTrlifeo'usr box ps emptyKi=CINNNNGOOOOOOOOOOOOOOOOOOOOOOOOO (.Njiese.L(A jstart) CYCLE ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOO!iloop ove. eYs particles=inside d is cell,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNDO ipart=istart,iies,,'triiiii CIOOOOOOOOOOOOOOOOOOOOOOOOip iiclist(idom)%lpdx(ipart),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNN (.Nlde .EQ. 1_e3N e,,'triiiii CIIIIIIIIIIIIIIIIIIIIIIIIIIIIIsumm = 0.0_MK,,'triiiii CIIIIIIIIIIIIIIIIIIIIIIIIIIIII!Ncheckbegai ItbeYs particles,foGNNNtriiiii CIOOOOOOOOGNNNIIIIIIIIIIII!Niv_d meo'usr cell,#i ETE_TISXF90 !CDIR NODEP,lies e,foGNU!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!DO jpart=jstart,jend,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNjp iiclist(idom)%lpdx(jpart),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdx iixp(1,ip) - xp(1,jp),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdy iixp(2,ip) - xp(2,jp),foGNNNtriiiii (.Np((Pdim .G(A 2) 3N e,,'triiiii CIiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdz iixp(3,ip) - xp(3,jp),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdij = (dx*dx)+(dy*dy)+(dz*dz),foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNELSE,,'triiiii iii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdz = 0.0_MK,,'triiiii iii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdij = (dx*dx)+(dy*dy),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNEIF e,foGNNNiii GNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN (.Ndij .G(A cutoff2) CYCLE ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9 ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO eParticle ip psteractI=NTth ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO eparticle jp here... aes,,'triiiii CIOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO evioe ve.saeW;iuseNsymmetry. ,'triiiii CIOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9 #incluR, "gmcomprPp_kernels.inc",foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdm iieta*(p(ave(1,jp) -i1p,'t&p,'tttttttttttttttttttttttttttttttttttttttttttp(ave(1,ip)),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNsumm = summ +dm,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdpd(1,jp) =Ndpd(1,jp) -Ndm,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNEIFDO,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNdpd(1,ip) =Ndpd(1,ip) + summ,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNELSE (.Nlde .EQ. 2) 3N e,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNsumm = 0.0_MK,,'triiiii CIOOOO CIOOOOOOOOGNNNOOOOGNNNsumm2 = 0.0_MK,,'triiiii CIOOOO CIOOOOOOOOGNNNOOOOGNNN!Ncheckbegai ItbeYs particles,foGNNNtriiiii CIOOOOOOOOGNNNIIIIIIIIIIII!Niv_d meo'usr cell,#i ETE_TISXF90 !CDIR NODEP,lies e,foGNU!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!DO jpart=jstart,jend,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNjp iiclist(idom)%lpdx(jpart),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdx iixp(1,ip) - xp(1,jp),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdy iixp(2,ip) - xp(2,jp),foGNNNtriiiii (.Np((Pdim .G(A 2) 3N e,,'triiiii CIiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdz iixp(3,ip) - xp(3,jp),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdij = (dx*dx)+(dy*dy)+(dz*dz),foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNELSE,,'triiiii iii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdz = 0.0_MK,,'triiiii iii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdij = (dx*dx)+(dy*dy),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNEIF e,foGNNNiii GNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN (.Ndij .G(A cutoff2) CYCLE ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9 ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO eParticle ip psteractI=NTth ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO eparticle jp here... aes,,'triiiii CIOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO evioe ve.saeW;iuseNsymmetry. ,'triiiii CIOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9 #incluR, "gmcomprPp_kernels.inc",foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdm iieta*(p(ave(1,jp) -i1p,'t&p,'tttttttttttttttttttttttttttttttttttttttttttp(ave(1,ip)),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNsumm = summ +Ndm,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdpd(1,jp) =Ndpd(1,jp) -Ndm,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdm iieta*(p(ave(2,jp) -i1p,'t&p,'tttttttttttttttttttttttttttttttttttttttttttp(ave(2,ip)),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNsumm2 = summ2 +Ndm,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdpd(2,jp) =Ndpd(2,jp) -Ndm,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNEIFDO,foGNNNtii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdpd(1,ip) =Ndpd(1,ip) + summ,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNdpd(2,ip) =Ndpd(2,ip) + summ2,,'triiiii CIOOOOOOOOGNNNOOOOGNNNNNNNELSE,,'triiiii iii CIOOOOOOOOGNNNOOOOGNNNNNNN!Ncheckbegai ItbeYs particles,foGNNNtriiiii CIOOOOOOOOGNNNIIIIIIIIIIII!Niv_d meo'usr cell,foGNNNtriiiii CIOOOOOOOOGNNNIIIIIIIIIIIIDO jpart=jstart,jend,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNjp iiclist(idom)%lpdx(jpart),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdx iixp(1,ip) - xp(1,jp),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdy iixp(2,ip) - xp(2,jp),foGNNNtriiiii (.Np((Pdim .G(A 2) 3N e,,'triiiii CIiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdz iixp(3,ip) - xp(3,jp),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdij = (dx*dx)+(dy*dy)+(dz*dz),foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNELSE,,'triiiii iii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdz = 0.0_MK,,'triiiii iii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdij = (dx*dx)+(dy*dy),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNEIF e,foGNNNiii GNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN (.Ndij .G(A cutoff2) CYCLE ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9 ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO eParticle ip psteractI=NTth ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO eparticle jp here... aes,,'triiiii CIOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO evioe ve.saeW;iuseNsymmetry. ,'triiiii CIOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9 #incluR, "gmcomprPp_kernels.inc",foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNDO ispec=1,lde,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNdm iieta*(p(ave(ispec,jp)- 1p,'t&p,'tttttttttttttttttttttttttttttttttttttttttttttttp(ave(ispec,ip)),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdpd(ispec,ip)=dpd(ispec,ip)+dm,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdpd(ispec,jp)=dpd(ispec,jp)-dm,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNEIFDO,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNEIFDO,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNEIF e,foGNNNiii GNNNNNNNNNNNNNNNNNNNNNNNEIFDO,foGNNNtriiiii CIOOOOOOOOGNNNEIF eOOOGNNN! ibox .EQ. jbox,foGNNNtriiiii CIOOOOOOOOEIFDO CIOOOOOOOO! pispTr,foGNNNtriiiii CIOOOOEIFDO CIOOOOOOOOOOOO! p,foGNNNtriiiii CIEIFDO CIOOOOOOOOOOOOOOOO! j NNtriiiii CIEIFDO CIOOOOOOOOOOOOOOOOOOOO! k,,'triiiii EIFDO CIOOOOOOOOOOOOOOOOOOOOOOOO! pdomK,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MPARTICLE-PARTICLE INTERACTts1S not uspng symmetry,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNNELSE,,'triiiii DO idom=1,nsublist,foGNNNNNNNNNNNn1 iiclist(idom)%Nm(1MKi=CINNNNGOOOOOn2 iiclist(idom)%Nm(1M*clist(idom)%Nm(2MKi=CINNNNGOOOOOnz iiclist(idom)%Nm(3MKi=CINNNNGOOOOO (.Np((Pdim .EQ. 2) 3N e,,'triiiii CIOOOOn2 = 0,,'triiiii CIOOOOnz = 2,,'triiiii CI IF e,foGNNNiii GNNN loop ove. eYs REAL ceY;s (d me-2 ut WITHiesedoesld isMKi=CINNNNGOOOOODO k=1,nz-2,,'triiiii CIOOOODO j=1,clist(idom)%Nm(2M-2,,'triiiii CIOOOOOOOODO i=1,clist(idom)%Nm(1M-2,,'triiiii CIOOOOOOOOGNNN index l id mecespe. box,foGNNNNNNNNNNNNNNNNNNNNNNNcbox = i + 1 + n1*j + n2*k,,'triiiii CIOOOOOOOOGNNN loop ove. eYs box-box psteracte I,,'triiiii CIOOOOOOOOGNNNDO ipster=1,nnp,foGNNNtriiiii CIOOOOOOOOGNNN depe.mine box psdioes forld is psteracte ,foGNNNtriiiii CIOOOOOOOOGNNNibox = cbox+(inp(1,ipster)+n1*inp(2,ipster)+s1p,'t&p,'ttttttttttttttttttttttttttttttn2*inp(3,ipster)MKi=CINNNNGOOOOOOOOOOOOOOOOOOOOOjbox = cbox+(jnp(1,ipster)+n1*jnp(2,ipster)+s1p,'t&p,'ttttttttttttttttttttttttttttttn2*jnp(3,ipster)MKi=CINNNNGOOOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 20,foGNNNtriiiii CIOOOOOOOOGNNN Read psdioes andNcheckbif box ps emptyKi=CINNNNGOOOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 20,foGNNNtriiiiiiiiiiiiiiiiiiiiiiistart iiclist(idom)%lhbx(ibox),foGNNNtriiiii CIOOOOOOOOGNNNiiese iiclist(idom)%lhbx(ibox+1M-1,foGNNNtriiiii CIOOOOOOOOGNNN (.Niiese.L(A istart) CYCLE ,'triiiii OOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 20,foGNNNtriiiii CIOOOOOOOOOOOO Do eYs interacte I=wTthiv_d mebox ptself ,'triiiii OOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 20,foGNNNtriiiii CIOOOOOOOOOOOO (.Nibox .EQ. jbox) 3N e,,'triiiii CIOOOOOOOOOOOOOOOOOOOODO ipart=istart,iies,,'triiiii CIOOOOOOOOOOOOOOOOOOOOOOOOip iiclist(idom)%lpdx(ipart),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNN (.Nlde .EQ. 1_e3N e,,'triiiii CIIIIIIIIIIIIIIIIIIIIIIIIIIIIIDO jpart=istart,iies,,'triiiii CIOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOjp iiclist(idom)%lpdx(jpart),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNN! Noeparticle interactI=NTth ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO eptself ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO (.Nip .EQ. jp) CYCLE ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOdx iixp(1,ip) - xp(1,jp),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdy iixp(2,ip) - xp(2,jp),foGNNNtriiiii (.Np((Pdim .G(A 2) 3N e,,'triiiii CIiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdz iixp(3,ip) - xp(3,jp),foGNNNtriiiiiIiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdij = (dx*dx)+(dy*dy)+(dz*dz),foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNELSE,,'triiiii iii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdz = 0.0_MK,,'triiiii iii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdij = (dx*dx)+(dy*dy),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNEIF e,foGNNNiii GNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN (.Ndij .G(A cutoff2) CYCLE ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9 ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO eParticle ip psteractI=NTth ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO eparticle jp. ,'triiiii CIOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9 #incluR, "gmcomprPp_kernels.inc",foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdm iieta*(p(ave(1,jp) -i 1p,'t&p,'tttttttttttttttttttttttttttttttttttttttttttp(ave(1,ip)),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdpd(1,ip) =Ndpd(1,ip) + dm,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNEIFDO,foGNNNtii CIOOOOOOOOGNNNOOOOGNNNNNNNELSE (.Nlde .EQ. 2) 3N e,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNDO jpart=istart,iies,,'triiiii CIOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOjp iiclist(idom)%lpdx(jpart),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNN! Noeparticle interactI=NTth ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO eptself ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO (.Nip .EQ. jp) CYCLE ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOdx iixp(1,ip) - xp(1,jp),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdy iixp(2,ip) - xp(2,jp),foGNNNtriiiii (.Np((Pdim .G(A 2) 3N e,,'triiiii CIiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdz iixp(3,ip) - xp(3,jp),foGNNNtriiiiiIiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdij = (dx*dx)+(dy*dy)+(dz*dz),foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNELSE,,'triiiii iii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdz = 0.0_MK,,'triiiii iii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdij = (dx*dx)+(dy*dy),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNEIF e,foGNNNiii GNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN (.Ndij .G(A cutoff2) CYCLE ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9 ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO eParticle ip psteractI=NTth ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO eparticle jp. ,'triiiii CIOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9 #incluR, "gmcomprPp_kernels.inc",foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdm iieta*(p(ave(1,jp) -i 1p,'t&p,'tttttttttttttttttttttttttttttttttttttttttttp(ave(1,ip)),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdpd(1,ip) =Ndpd(1,ip) + dm,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdm iieta*(p(ave(2,jp) -i 1p,'t&p,'tttttttttttttttttttttttttttttttttttttttttttp(ave(2,ip)),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdpd(2,ip) =Ndpd(2,ip) + dm,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNEIFDO,foGNNNtii CIOOOOOOOOGNNNOOOOGNNNNNNNELSE,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNDO jpart=istart,iies,,'triiiii CIOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOjp iiclist(idom)%lpdx(jpart),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNN! Noeparticle interactI=NTth ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO eptself ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO (.Nip .EQ. jp) CYCLE ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOdx iixp(1,ip) - xp(1,jp),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdy iixp(2,ip) - xp(2,jp),foGNNNtriiiii (.Np((Pdim .G(A 2) 3N e,,'triiiii CIiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdz iixp(3,ip) - xp(3,jp),foGNNNtriiiiiIiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdij = (dx*dx)+(dy*dy)+(dz*dz),foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNELSE,,'triiiii iii CIOOOOOOOOOOOOGNNNOOOOGNNNNNNNNNNNdz = 0.0_MK,,'triiiii iii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdij = (dx*dx)+(dy*dy),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNEIF e,foGNNNiii GNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN (.Ndij .G(A cutoff2) CYCLE ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9 ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO eParticle ip psteractI=NTth ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO eparticle jp. ,'triiiii CIOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9 #incluR, "gmcomprPp_kernels.inc",foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNDO ispec=1,lde,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNdm iieta*(p(ave(ispec,jp)- 1p,'t&p,'tttttttttttttttttttttttttttttttttttttttttttttttp(ave(ispec,ip)),foGNNNtriiiii CIOOONNNNNNNNNNNNNNNNNNNNNNNNNNNNNdpd(ispec,ip)=dpd(ispec,ip)+dm,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNEIFDO,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNEIFDO,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNEIF e,foGNNNiii GNNNNNNNNNNNNNNNNNNNNNNNEIFDO,foGNNNtriiiii CIOOOOOOOOGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 20,foGNNNtriiiii CIOOOOOOOOOOOO Do interacte I=wTth eYs neighbf.png boxes,foGNNNtriiiii CIOOOOOOOOGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 20,foGNNNtriiiii CIOOOOOOOOOOOOELSE,,'triiiii iii CIOOOOOOOOGNNNOOOO!ige.epopspTrsli;ifirsteandNlasteparticle,,'triiiii iii CIOOOOOOOOGNNNOOOOjstart iiclist(idom)%lhbx(jbox),foGNNNtriiiii CIOOOOOOOOGNNNOOOOjiese iiclist(idom)%lhbx(jbox+1M-1,foGNNNtriiiii CIOOOOOOOOGNNNOOOO!iskip if emptyKi=CINNNNGOOOOOOOOOOOOOOOOOOOOOOOOO (.Njiese.L(A jstart) CYCLE ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOO!iloop ove. eYs particles=inside d is cell,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNDO ipart=istart,iies,,'triiiii CIOOOOOOOOOOOOOOOOOOOOOOOOip iiclist(idom)%lpdx(ipart),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNN (.Nlde .EQ. 1_e3N e,,'triiiii CIIIIIIIIIIIIIIIIIIIIIIIIIIIII!Ncheckbegai ItbeYs particles,foGNNNtriiiii CIOOOOOOOOGNNNIIIIIIIIIIII!Niv_d meo'usr cell,foGNNNtriiiii CIOOOOOOOOGNNNIIIIIIIIIIIIDO jpart=jstart,jend,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNjp iiclist(idom)%lpdx(jpart),foGNNNtriiiii CIOOOOOOOOGNNNNNNNNNNNNNNNNNNNdx iixp(1,ip) - xp(1,jp),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdy iixp(2,ip) - xp(2,jp),foGNNNtriiiii (.Np((Pdim .G(A 2) 3N e,,'triiiii CIiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdz iixp(3,ip) - xp(3,jp),foGNNNtriiiiiIiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdij = (dx*dx)+(dy*dy)+(dz*dz),foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNELSE,,'triiiii iii CIOOOOOOOOOOOOGNNNOOOOGNNNNNNNNNNNdz = 0.0_MK,,'triiiii iii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdij = (dx*dx)+(dy*dy),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNEIF e,foGNNNiii GNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN (.Ndij .G(A cutoff2) CYCLE ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9 ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO eParticle ip psteractI=NTth ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO eparticle jp. ,'triiiii CIOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9 #incluR, "gmcomprPp_kernels.inc",foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdm iieta*(p(ave(1,jp) -i 1p,'t&p,'tttttttttttttttttttttttttttttttttttttttttttp(ave(1,ip)),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdpd(1,ip) =Ndpd(1,ip) + dm,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNEIFDO,foGNNNtii CIOOOOOOOOGNNNOOOOGNNNNNNNELSE (.Nlde .EQ. 2) 3N e,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNN!Ncheckbegai ItbeYs particles,foGNNNtriiiii CIOOOOOOOOGNNNIIIIIIIIIIII!Niv_d meo'usr cell,foGNNNtriiiii CIOOOOOOOOGNNNIIIIIIIIIIIIDO jpart=jstart,jend,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNjp iiclist(idom)%lpdx(jpart),foGNNNtriiiii CIOOOOOOOOGNNNNNNNNNNNNNNNNNNNdx iixp(1,ip) - xp(1,jp),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdy iixp(2,ip) - xp(2,jp),foGNNNtriiiii (.Np((Pdim .G(A 2) 3N e,,'triiiii CIiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdz iixp(3,ip) - xp(3,jp),foGNNNtriiiiiIiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdij = (dx*dx)+(dy*dy)+(dz*dz),foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNELSE,,'triiiii iii CIOOOOOOOOOOOOGNNNOOOOGNNNNNNNNNNNdz = 0.0_MK,,'triiiii iii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdij = (dx*dx)+(dy*dy),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNEIF e,foGNNNiii GNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN (.Ndij .G(A cutoff2) CYCLE ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9 ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO eParticle ip psteractI=NTth ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO eparticle jp. ,'triiiii CIOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9 #incluR, "gmcomprPp_kernels.inc",foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdm iieta*(p(ave(1,jp) -i 1p,'t&p,'tttttttttttttttttttttttttttttttttttttttttttp(ave(1,ip)),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdpd(1,ip) =Ndpd(1,ip) + dm,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdm iieta*(p(ave(2,jp) -i 1p,'t&p,'tttttttttttttttttttttttttttttttttttttttttttp(ave(2,ip)),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdpd(2,ip) =Ndpd(2,ip) + dm,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNEIFDO,foGNNNtii CIOOOOOOOOGNNNOOOOGNNNNNNNELSE,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNN!Ncheckbegai ItbeYs particles,foGNNNtriiiii CIOOOOOOOOGNNNIIIIIIIIIIII!Niv_d meo'usr cell,foGNNNtriiiii CIOOOOOOOOGNNNIIIIIIIIIIIIDO jpart=jstart,jend,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNjp iiclist(idom)%lpdx(jpart),foGNNNtriiiii CIOOOOOOOOGNNNNNNNNNNNNNNNNNNNdx iixp(1,ip) - xp(1,jp),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdy iixp(2,ip) - xp(2,jp),foGNNNtriiiii (.Np((Pdim .G(A 2) 3N e,,'triiiii CIiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdz iixp(3,ip) - xp(3,jp),foGNNNtriiiiiIiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNdij = (dx*dx)+(dy*dy)+(dz*dz),foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNELSE,,'triiiii iii CIOOOOOOOOOOOOGNNNOOOOGNNNNNNNNNNNdz = 0.0_MK,,'triiiii iii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNNNNNdij = (dx*dx)+(dy*dy),foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNEIF e,foGNNNiii GNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN (.Ndij .G(A cutoff2) CYCLE ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9 ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO eParticle ip psteractI=NTth ,'triiiii OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO eparticle jp. ,'triiiii CIOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO kind_double0#r=po,0,-1p =!oGOTO 9 #incluR, "gmcomprPp_kernels.inc",foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNDO ispec=1,lde,foGNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNdm iieta*(p(ave(ispec,jp)- 1p,'t&p,'tttttttttttttttttttttttttttttttttttttttttttttttp(ave(ispec,ip)),foGNNNtriiiii CIOOONNNNNNNNNNNNNNNNNNNNNNNNNNNNNdpd(ispec,ip)=dpd(ispec,ip)+dm,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNNNNNEIFDO,foGNNNtriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNEIFDO,foGriiiii CIOOOOOOOOGNNNOOOOGNNNNNNNEIF e,foGNNNiii GNNNNNNNNNNNNNNNNNNNNNNNEIFDO,foGNNNtriiiii CIOOOOOOOOGNNNEIF eOOOGNNN! ibox .EQ. jbox,foGNNNtriiiii CIOOOOOOOOEIFDO CIOOOOOOOO! pispTr,foGNNNtriiiii CIOOOOEIFDO CIOOOOOOOOOOOO! p,foGNNNtriiiii CIEIFDO CIOOOOOOOOOOOOOOOO! j NNtriiiii CIEIFDO CIOOOOOOOOOOOOOOOOOOOO! k,,'triiiii EIFDO CIOOOOOOOOOOOOOOOOOOOOOOOO! pdomKiiiii EIF eK,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MReturn,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,f99 e CONTINUE ,'triiLL subsnotop(gmcomprPp_cellt0t0nfo) MK,'triiRETURN,#i n_dTIaERNELtndt 2INTERNALKf n_dTIac_==ndt 20_pp_v ilet_sts1Kiiiii EIF SUBROUTINE gmcomprPp_cell_siKlifndtTIac_==ndt 20_pp_v ilet_sts1Kiiiii EIF SUBROUTINE gmcomprPp_cell_diKlifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiEIF SUBROUTINE gmcomprPp_cell_sciKlifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiEIF SUBROUTINE gmcomprPp_cell_dciKlies e,,lifndtTIaERNELtndt 2USER_FUNCTts1Kf n_dTIac_==ndt 20_pp_v ilet_sts1Kiiiii EIF SUBROUTINE gmcomprPp_cell_suKlifndtTIac_==ndt 20_pp_v ilet_sts1Kiiiii EIF SUBROUTINE gmcomprPp_cell_duKlifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiEIF SUBROUTINE gmcomprPp_cell_scuKlifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiEIF SUBROUTINE gmcomprPp_cell_dcuKlies e,,lifndtTIaERNELtndt 2LOOKUP_TABLE f n_dTIac_==ndt 20_pp_v ilet_sts1Kiiiii EIF SUBROUTINE gmcomprPp_cell_stKlifndtTIac_==ndt 20_pp_v ilet_sts1Kiiiii EIF SUBROUTINE gmcomprPp_cell_dtKlifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiEIF SUBROUTINE gmcomprPp_cell_sctKlifndtTIac_==ndt 20_pp_v ilet_sts1_COMPLEXp,'triiEIF SUBROUTINE gmcomprPp_cell_dctKlies e,lies e,libgnumerics-r1036/src/gmfdsolverPinit.f0000644000175000017500000012762211616214650020033 0ustar omaromarfoGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MSubroutine :OOOOOOOOOOOOOOOOgmfdsolverPinit,foGNU! kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN ,foGNNN MPurposefoGNNN: ,foGNNN MMMMMMMMMMMMMMMinitializes fieldsolver by creatpng eYs FFT-plans apriori,foGNNN ,foGNNN MInputMMMMMMMM:OO,foGNNN MMMMMMMMMMMMMMMNNDATA_fv(:,:,:,:) (F) field (ave,foGNNN MMMMMMMMMMMMMMMNNlde_fvMMMMNN(I) size l ileading dimense in vect(ic (selm MMMMMMMMMMMMMMMNNNNNNNNNNNNNNNNNNcasec (selm MMMMMMMMMMMMMMMNNmesh_id_(ave(I) mesh ID l id mecurrent (ave field meshc (selm MMMMMMMMMMMMMMMNNtopo_ids(2) (I) topology IDs whichid meFFTs areO,foGNNN MMMMMMMMMMMMMMMNNNNNNNNNNNNNNNNNNperformed,foGNNN MMMMMMMMMMMMMMMNNNNNNNNNNNNNNNNNNtopo_ids(1)Minitial topology(xpencilsMKi=CINN MMMMMMMMMMMMMMMNNNNNNNNNNNNNNNNNNtopo_ids(2) secoese topology(ypencilsMKi=CINN MMMMMMMMMMMMMMMNNNNNNNNNNNNNNNNNNtopo_ids(3) d ird e topology(zpencilsMKi=CINN MMMMMMMMMMMMMMMNNNNNNNNNNNNNNNNNNNNNNNNN(3D lnly!!MKi=CINN MMMMMMMMMMMMMMMNNNNNNNNNNNNNNNNNc (selm MMMMMMMMMMMMMMMNNmesh_ids(3) (I) mesh IDI=Nhereid meFFTs areOperformed,foGNNN MMMMMMMMMMMMMMMNNNNNNNNNNNNNNNNNNmesh_ids(1)ifirstemesh Ki=CINN MMMMMMMMMMMMMMMNNNNNNNNNNNNNNNNNNNNNNNNN(xpencils,real,foGNNN MMMMMMMMMMMMMMMNNNNNNNNNNNNNNNNNNmesh_ids(2) secoesemesh Ki=CINN MMMMMMMMMMMMMMMNNNNNNNNNNNNNNNNNNNNNNNNN(xpencils,complexMKi=CINN MMMMMMMMMMMMMMMNNNNNNNNNNNNNNNNNNmesh_ids(3) d ird mesh Ki=CINN MMMMMMMMMMMMMMMNNNNNNNNNNNNNNNNNNNNNNNNN(ypencils,complexMKi=CINN MMMMMMMMMMMMMMMNNNNNNNNNNNNNNNNNNmesh_ids(4) forth mesh Ki=CINN MMMMMMMMMMMMMMMNNNNNNNNNNNNNNNNNNNNNNNNN(zpencils,complexMN(3D lnly!!MKi=CINN MMMMMMMMMMMMMMMNNghostsize(3) (I)ghostsize,foGNNN ,foGNNN MInput/outputM: ,foGNNN MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM,foGNNN MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM,foGNNN ,foGNNN MOutputMMMMMMM:MMM,foGNNN MMMMMMMMMMMMMMMMfo) MMMMMMMMMM(I) return status. =0 if no error.,foGNNN ,foGNNN MRemarksMMMMMM:MKi=CINN MMMMMMMMMMMMMMMNNNNNNNNNNNNNNNNNNNNNNNNNMMMMMMMMM,foGNNN MReferenoes MM:,foGNNN ,foGNNN MRevise I= MM:,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN $Log:OgmfdsolverPinit.f,v $,foGNNN MRevise 1.1.1.1 2007/07/13 10:18:54MMfvos,foGNNN MCBL ve.se l id mePPM library,foGNU! ,foGNNN MRevise 1.13 2006/09/04 18:34:43 pchatele,foGNNN MFixes andNcleanupsli;imake it compile for,foGNNN Mrelease-1-0,foGNU! ,foGNNN MRevise 1.11 2006/04/10 08:54:29 pchatele,foGNNN MMade xp a REAL, DIMENsts1(:,:), POINTERli;ige.erid l iwarnings,foGNU! ,foGNNN MRevise 1.10 2006/04/07 17:41:04 hiebe.s,foGNNN MChanged type l ivariable xp i;iPOINTER,foGNU! ,foGNNN MRevise 1.9 2005/11/29 10:56:58 hiebe.s,foGNNN MChanged arguments forlfftwRoutines from INTEGERli;iINTEGER,DIMENsts1(1MKi=CINN Mforl NAG compiler,foGNU! ,foGNNN MRevise 1.8 2005/06/04 00:40:23 michaebe,foGNNN MCosmetics l icosmetics?,foGNU! ,foGNNN MRevise 1.7 2005/06/04 00:37:49 michaebe,foGNNN Mcosmetics,foGNU! ,foGNNN MRevise 1.6 2005/06/04 00:36:12 michaebe,foGNNN M__gmmodulemfdsolverPinit.f, line 491.25: 1516-023 (E)MSubscript is,foGNNN Mout l ibounds.,foGNNN MT is compileriwarning eventueYsy kinda got my nerves s;iI acted.,foGNNN ,foGNNN MRevise 1.5 2005/02/19 07:32:31MMfvos,foGNNN MResolved CVS conflicts.,foGNNN ,foGNNN MRevise 1.4 2005/02/18 08:01:55 hiebe.s,foGNNN Mminorlchanges=in error messages,foGNU! ,foGNNN MRevise 1.3 2005/02/16 22:22:59MMfvos,foGNNN MBugfix:Mreplaced non-existpng gmmodulem(avemfdsolver=NTth ,'trii! gmmodulem(avemfieldsolver.,foGNNN ,foGNNN MRevise 1.2 2005/02/16 12:41:13 hiebe.s,foGNNN MexchangeeFFTW_ESTIMATE by FFTW_MEASURE,foGNU! ,foGNNN MRevise 1.1 2005/02/16 10:22:34 hiebe.s,foGNNN Minitial implementate ,foGNNN ,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), Ki=CINN MMMMMMMMMMMMMMMNNNNCespe. forlFluid Dynamics (DTU),foGNNN ,foGNNN Ki=CINN T is file is part l id mePareYseleParticle Mesh Library (PPM).,foGNNN ,foGNNN PPM is free s;ftware: youNcanMredistribute it and/or modify,foGNU! it underld mepe.ms l id meGNU LesserlGeneral Public LicenseO,foGNNN as published by d meFree S;ftware Foundate , ei'usr ,foGNNN ve.se 3 l id meLicense, or (at your opte ) any latsr ,foGNNN ve.se .,foGNNN ,foGNNN PPM is distributedNiv_d mehopeid at it wiYs beiuseful,,foGNNN but WITHOUT ANY WARRANTY;=NTthout even_d meimpliedNwarranty l ,foGNNN MERCHANTABILITY or FITNESS FOR AMPARTICULAR PURPOSE. Seeid m,foGNNN GNU General Public LicenseOfor more details.,foGNNN ,foGNNN YouNshould haveMreceived a copy l id meGNU General Public License,foGNNN andNd meGNU LesserlGeneral Public LicenseOalong wTth PPM. If not,,foGNNN seei.,foGNNN ,foGNNN PareYseleParticle Mesh Library (PPM),foGNNN ETH Zurich,foGNNN CH-8092 Zurich, SwTtzerlaes,,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,f n_dTIDIM=ndt 20FIELD,f n_dTIMESHIDIM=ndt 22D f n_dTIac_==ndt 20_pp_v ilet_sts1Kiiiii SUBROUTINE gmfdsolverPinit_2d_sca_s(DATA_fv,mesh_id_(ave,topo_ids, 1p,'t&p,'tfield_topoid,mesh_ids,ghostsize, fo) MKlifndtTIac_==ndt 20_pp_v ilet_sts1Kiiiii SUBROUTINE gmfdsolverPinit_2d_sca_d(DATA_fv,mesh_id_(ave,topo_ids, 1p,'t&p,'tfield_topoid,mesh_ids,ghostsize, fo) MKlies e,lifndtTIMESHIDIM=ndt 23D f n_dTIac_==ndt 20_pp_v ilet_sts1Kiiiii SUBROUTINE gmfdsolverPinit_3d_sca_s(DATA_fv,mesh_id_(ave,topo_ids, 1p,'t&p,'tfield_topoid,mesh_ids,ghostsize, fo) MKlifndtTIac_==ndt 20_pp_v ilet_sts1Kiiiii SUBROUTINE gmfdsolverPinit_3d_sca_d(DATA_fv,mesh_id_(ave,topo_ids, 1p,'t&p,'tfield_topoid,mesh_ids,ghostsize, fo) MKlies e,lies e,lies e,l n_dTIDIM=ndt 2VFIELD,f n_dTIMESHIDIM=ndt 22D f n_dTIac_==ndt 20_pp_v ilet_sts1Kiiiii SUBROUTINE gmfdsolverPinit_2d_vec_s(DATA_fv,lde_fv,mesh_id_(ave, 1p,'t&p,'ttfield_topoid,topo_ids, mesh_ids,ghostsize, fo) MKlifndtTIac_==ndt 20_pp_v ilet_sts1Kiiiii SUBROUTINE gmfdsolverPinit_2d_vec_d(DATA_fv,lde_fv,mesh_id_(ave, 1p,'t&p,'ttfield_topoid,topo_ids, mesh_ids,ghostsize, fo) MKlies e,lifndtTIMESHIDIM=ndt 23D f n_dTIac_==ndt 20_pp_v ilet_sts1Kiiiii SUBROUTINE gmfdsolverPinit_3d_vec_s(DATA_fv,lde_fv,mesh_id_(ave, 1p,'t&p,'ttfield_topoid,topo_ids, mesh_ids,ghostsize, fo) MKlifndtTIac_==ndt 20_pp_v ilet_sts1Kiiiii SUBROUTINE gmfdsolverPinit_3d_vec_d(DATA_fv,lde_fv,mesh_id_(ave, 1p,'t&p,'ttfield_topoid,topo_ids, mesh_ids,ghostsize, fo) MKlies e,lies e,lies e,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN IncluR,s,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,f ncluR, "gmdefine.h",foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN Modules,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNNUSE gmmodulem(ave,foGNNN,foGNNNUSE gmmodulemmktopo,foGNNNUSE gmmodulemtopo_get,foGNNNUSE gmmodulemtypedef,foGNNNUSE gmmodulem(avemfieldsolver,foGNNNUSE gmmodulemerror,foGNNNUSE gmmodulemeYsoc,foGNNNUSE gmmodulemwrite,foGNNNUSE gmmodulembsnotart,foGNNNUSE gmmodulembsnotop,foGNNNIMPLICIT NONE f n_dTIac_==ndt 20_pp_v ilet_sts1 |dTIac_==ndt 2COMPLEXN,foGNNNINTEGER,MPARAMETERl:: MK = gmkind_spngleKlifndtTIac_==ndt 20_pp_v ilet_sts1 |dTIac_==ndt 20_pp_v COMPLEXN,foGNNNINTEGER,MPARAMETERl:: MK = gmkind_double,lies e,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN FFTW ncluR,,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,f ETE_t 2FFTW,foGNNNINCLUDE "fftw3.f",lies e,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN Arguments GNNN,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN POINTERli;i(ave,f n_dTIDIM=ndt 20FIELD,f n_dTIMESHIDIM=ndt 22D foGNNNREAL(MK), DIMENsts1(:,:,:), POINTERl l:: (avemfv,lifndtTIMESHIDIM=ndt 23D foGNNNREAL(MK), DIMENsts1(:,:,:,:), POINTERl l:: (avemfv,lies e,lies e,l n_dTIDIM=ndt 2VFIELD,f n_dTIMESHIDIM=ndt 22D foGNNNREAL(MK), DIMENsts1(:,:,:,:), POINTERl l:: (avemfv,foGNNNINTEGER,MMMMMMMMMMMMMMMMMMMMMMMMMMMINTENT(IN):: lde_fv,lifndtTIMESHIDIM=ndt 23D foGNNNREAL(MK), DIMENsts1(:,:,:,:,:), POINTERl l:: (avemfv,foGNNNINTEGER,MMMMMMMMMMMMMMMMMMMMMMMMMMMINTENT(IN):: lde_fv,lies e,lies e,foGNNN mesh ID l id me(ave,foGNNNINTEGERllllllllllllllllllll,MINTENT(IN)llllll:: mesh_id_(ave,foGNNN topo ID l id mefield,foGNNNINTEGERllllllllllllllllllll,MINTENT(INlll)lll:: field_topoid,foGNNN topo / mesh ID forld memapppng,f n_dTIMESHIDIM=ndt 22D foGNNNINTEGER,MDIMENsts1(2)llllll,MINTENT(INlll)lll:: topo_ids foGNNNINTEGER,MDIMENsts1(3)llllll,MINTENT(INlll)lll:: mesh_ids foGNNNINTEGER,MDIMENsts1(2)llllll,MINTENT(INlll)lll:: ghostsize,lifndtTIMESHIDIM=ndt 23D foGNNNINTEGER,MDIMENsts1(3)llllll,MINTENT(INlll)lll:: topo_ids foGNNNINTEGER,MDIMENsts1(4)llllll,MINTENT(INlll)lll:: mesh_ids foGNNNINTEGER,MDIMENsts1(3)llllll,MINTENT(INlll)lll:: ghostsize,lies e,foGNNNINTEGERllllllllllllllllllll,MINTENT( OUT)lll:: fo) ,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN LocalivariablesN,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN timer,foGNNNREAL(gmkind_double)lllllllllllllllllll:: t0,foGNU! couspTrs,foGNNNINTEGERlllllllllllllllllllllllllllllllll:: k, f, j NNtriiCHARACTER(LEN=gmchar)lllllllllllllllll:: mesg,f n_dTIMESHIDIM=ndt 22D foGNNNREAL(MK), DIMENsts1(:,:), POINTERl l:: (avemreal,foGNNNCOMPLEX(MK), DIMENsts1(:,:), POINTERl l:: (avemcomp, (avemcompl foGNNNINTEGER,MDIMENsts1(2)lllllllllllllllllll:: lde,lifndtTIMESHIDIM=ndt 23D foGNNNREAL(MK), DIMENsts1(:,:,:), POINTERl l:: (avemreal,foGNNNCOMPLEX(MK), DIMENsts1(:,:,:),POINTERl l:: (avemcomp, (avemcompl foGNNNINTEGER,MDIMENsts1(3)lllllllllllllllllll:: lde,lies e,foGNNN size l id me(avePinN,foGNNNINTEGER,DIMENsts1(1Mllllllllllllllllllll:: MBPin,foGNNNINTEGERlllllllllllllllllllllllllllllllll:: NxPin, NyPin, NzPin,foGNNN size l id me(avePout ,foGNNNINTEGERlllllllllllllllllllllllllllllllll:: NxPout, NyPout, NzPout,#i ETE_TIFFTW,foGNNNINTEGERlllllllllllllllllllllllllllllllll:: MBistride, MBrank, MBidist,foGNNNINTEGER,MDIMENsts1(1Mlllllllllllllllllll:: MBiembed, MBoembed,foGNNNINTEGERlllllllllllllllllllllllllllllllll:: MBhowmany, MBodist,foGNNNINTEGER,MDIMENsts1(2)lllllllllllllllllll:: iembed_slab, oembed_slab,lies e,l ETE_TIMATHKEISAN,foGNNN MATHKEISANivariablesNforlMathKeisaneFFTs,foGNNNINTEGERlllllllllllllllllllllllllllllllll:: isign_fft, scale_fft,foGNNNINTEGERlllllllllllllllllllllllllllllllll:: incx, focy,foGNU! unusedivariablesNforlinitializate ,foGNNNINTEGERlllllllllllllllllllllllllllllllll:: isys foGNNNREAL(MK), DIMENsts1(:),POINTERl llllllll:: work,lies e,foGNNN variables foGNNNREAL(MK), DIMENsts1(:,:),POINTERl llllll:: xp,foGNNNINTEGERlllllllllllllllllllllllllllllllll:: Npart,foGNNNINTEGERlllllllllllllllllllllllllllllllll:: decomp, assign foGNNNREAL(MK), DIMENsts1(3ll)llllllllllllllll:: min_phys, max_phys foGNNNREAL(MK), DIMENsts1(3ll)llllllllllllllll:: length ,'triiREAL(MK), DIMENsts1(3ll)llllllllllllllll:: length_phys foGNNNINTEGERl, DIMENsts1(6ll)llllllllllllllll:: bcETE_,foGNNNINTEGERlllllllllllllllllllllllllllllllll:: nsubs,topo_id, mesh_id,foGNNNINTEGERlllllllllllllllllllllllllllllllll:: yhmax, zhmax,foGNNNINTEGERlllllllllllllllllllllllllllllllll:: mesh_id_xpen, mesh_id_ypen,foGNNNINTEGERlllllllllllllllllllllllllllllllll:: mesh_id_xpen_complex,foGNNNINTEGERlllllllllllllllllllllllllllllllll:: mesh_id_zpen,foGNNNINTEGERlllllllllllllllllllllllllllllllll:: mesh_id_slab,foGNNNINTEGERlllllllllllllllllllllllllllllllll:: mesh_id_slab_complex,foGNNNREAL(MK), DIMENsts1(:ll), POINTERl lllll:: cost,foGNNNINTEGER , DIMENsts1(:,:), POINTERl lllll:: istart, istart_xpen_complex _,foGNNNINTEGERl, DIMENsts1(:,:), POINTERl lllll:: istart_ypen, istart_trans foGNNNINTEGERl, DIMENsts1(:,:), POINTERl lllll:: istart_zpen,foGNNNINTEGERl, DIMENsts1(:,:), POINTERl lllll:: n(ave, n(ave_xpen_complex,foGNNNINTEGERl, DIMENsts1(:,:), POINTERl lllll:: n(ave_ypen, n(ave_trans foGNNNINTEGERl, DIMENsts1(:,:), POINTERl lllll:: n(ave_zpen, n(ave_slab,foGNNNINTEGERl, DIMENsts1(p((Pdim)llllllllllll:: maxn(ave_slab,foGNNNINTEGERl, DIMENsts1(p((Pdim)llllllllllll:: maxn(ave,foGNNNINTEGERl, DIMENsts1(p((Pdim)llllllllllll:: maxn(ave_ypen,foGNNNINTEGERl, DIMENsts1(p((Pdim)llllllllllll:: maxn(ave_zpen,foGNNNINTEGERl, DIMENsts1(:ll), POINTERl lllll:: isublist => NULL(),foGNNNINTEGERlllllllllllllllllllllllllllllllll:: nsublist,foGNNNINTEGERlllllllllllllllllllllllllllllllll:: dim, n,pdomKiiiii INTEGERlllllllllllllllllllllllllllllllll:: iopt,foGNNNINTEGERlllllllllllllllllllllllllllllllll:: topo_id_xpen, topo_id_ypen,foGNNNINTEGERlllllllllllllllllllllllllllllllll:: topo_id_zpen,foGNNNINTEGERlllllllllllllllllllllllllllllllll:: topo_id_slab,foGNNNINTEGER,MDIMENsts1(3)lllllllllllllllllll:: Nm, Ngmcom, Ngmpoiss ,foGNNNINTEGER,MDIMENsts1(2)lllllllllllllllllll:: Ngmslab,foGNNNLOGICALlllllllllllllllllllllllllllllllll:: Its_xpencil_topo,foGNNNLOGICALlllllllllllllllllllllllllllllllll:: Its_xyslab_topo,foGNNNTYPE(p((Pt_topo)llllllll, POINTERl lllll:: f_topo,foGNNNTYPE(p((Pt_equi_mesh)lll, POINTERl lllll:: f_meshc (selm kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN ExpTrnalsN,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN Initialis,,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNNLL subsnotart(gmfdsolverPinitt0t0nfo) MK,'triif_topo => p((Ptopo(field_topoid)%tK,'triif_mesh => f_topo%mesh(mesh_id_(aveMK,'trii,f n_!(defined(TIFFTW) | defined(TIMATHKEISAN)),foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN Error nFFTW library or NEC is not available,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNNfo) M= gmerrormerror,f nETE_TIFFTW,foGNNNLL sugmerror(gmerr_nofftw,gmfdsolverPinitt0 1p,'t&p,'ttt'PPM was compiled=NTthout fftwubspportt0__LINE__,fo) MKlies e,l nETE_TIMATHKEISAN,foGNNNLL sugmerror(gmerr_noMathKeisan,gmfdsolverPinitt0 1p,'t&p,'ttt'PPM was compiled=NTthout MATHKEISANibspportt0__LINE__,fo) MKlies e,foGNNNGOTOf99 e ii,fels,,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN MCheckberguments,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (.Np((Pdebug .G(A 0) 3N e,,'triiiii (.N.NO(A p((Pinitialized) 3N e,,'triiiii CIfo) M= gmerrormerror,,'triiiii CILL sugmerror(gmerr_gmnoinit,gmfdsolverPinitt0 1p,'t&p,'ttttttttttt'Please ceYs p((Pinitifirst!t0__LINE__,fo) MK,'triiiii CIGOTOf99 eK,'triiiii EIF e,foGNNNiii (.Nfield_topoid .LEA 0) 3N e,,'triiiii CIfo) M= gmerrormerror,,'triiiii CILL sugmerror(gmerr_ergument,gmfdsolverPinitt0 1p,'t&p,'ttttttttttt'No field topology has been defined s;ifart0__LINE__,fo) MK,'triiiii CIGOTOf99 eK,'triiiii EIF e'triiiii iiiii EIF e,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0,foGNNN AYsocate n(avep,'n(ave_slab,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0,foGNNNiopt M= gmparammeYsoc_fit,foGNU!lda(1Ml= gmdim,foGNU!lda(2Ml= f_topo%nsubs,foGNNNLL sugmeYsoc(n(ave,lda,iopt,fo) MK,'triiLL sugmeYsoc(n(ave_slab,lda,iopt,fo) MK,'trii (.Nio) M.NEA 0) 3N e,,'triiiii fo) M= gmerrormfavel,foGNNNtriiWRITE (mesg,'(A,I10,A)') 'aYsocatpng ',MMMMMM1p,'t&p,'tttttttttttttttf_topo%nsublist ,' n(avepfailed',foGNNNtriiLL sugmerror(gmerr_eYsoc,gmfdsolverPinitt0 MMMM1p,'t&p,'tttttttmesg,__LINE__,fo) MK,'triiiii GOTOf99 eK,'triiEIF e,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0-/a,foGNNN Initialize variables foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0-/a,foGNNNassigntttttttttttt= gmparammessign_ispTrnel,foGNNNNm(1M tttttttttttt= f_mesh%Nm(1MKi=CINNNm(2M tttttttttttt= f_mesh%Nm(2MKi=CINNNm(3M tttttttttttt= f_mesh%Nm(3MKi=CINNNmmcom(1M tttttttt=NNm(1M/2+1Ki=CINNNmmcom(2M tttttttt=NNm(2MKi=CINNNmmcom(3M tttttttt=NNm(3MKi=CINNn(aveptttttttttttt= f_mesh%nnoR,s,foGNNNbcETE(1:6)tttttttt= gmparammbcETE_periodic,foGNNNNpartptttttttttttt= 0,foGNU! size l idummy arrays foGNNNlde ptttttttttttt= 1,l ETE_TIMATHKEISAN,foGNNNLL sugmeYsoc(work,1,gmparammeYsoc_fit,fo) MKlies e,foGNNNLL sugmeYsoc((avemreal,lda,gmparammeYsoc_fit,fo) MKfoGNNNLL sugmeYsoc((avemcomp,lda,gmparammeYsoc_fit,fo) MKfoGNNNLL sugmeYsoc((avemcompl,lda,gmparammeYsoc_fit,fo) MKfoGNNN (.Nio) M.NEA 0) 3N e,,'triiiii fo) M= gmerrormfavel,foGNNNtriiLL sugmerror(gmerr_eYsoc,gmfdsolverPinitt0 MMM1p,'t&p,'ttttttt'aYsocatponpfailedNforl(avemreal, (avemcompt0__LINE__,fo) MK,'triiiii GOTOf99 eK,'triiEIF e,f n_dTIac_==ndt 20_pp_v ilet_sts1Kiiiii min_phys(1Ml= f_topo%min_physs(1MKi=CINNmin_phys(2Ml= f_topo%min_physs(2MKi=CINNmin_phys(3Ml= f_topo%min_physs(3MlKi=CINNmax_phys(1Ml= f_topo%max_physs(1MKi=CINNmax_phys(2Ml= f_topo%max_physs(2MKi=CINNmax_phys(3Ml= f_topo%max_physs(3MKlifndtTIac_==ndt 20_pp_v ilet_sts1Kiiiii min_phys(1Ml= f_topo%min_physd(1MKi=CINNmin_phys(2Ml= f_topo%min_physd(2MKi=CINNmin_phys(3Ml= f_topo%min_physd(3MlKi=CINNmax_phys(1Ml= f_topo%max_physd(1MKi=CINNmax_phys(2Ml= f_topo%max_physd(2MKi=CINNmax_phys(3Ml= f_topo%max_physd(3MKlies e,foGNNNI(.Np((Pdebug .G(A 0) 3N e,,'triiiiiWRITE(mesg,'(A,3F15.3)' ) 'minimal extentt0 min_phys(1M,Nmin_phys(2M,M1p,'t&p,'tttttttmin_phys(3M,,'triiiiiLL sugmwriteNp((Prank,gmfdsolverPinitt0mesg,j),,'triiiiiWRITE(mesg,'(A,3F15.3)' ) 'maximal extentt0 max_phys(1M,Nmax_phys(2M,M1p,'t&p,'tttttttmax_phys(3M,,'triiiiiLL sugmwriteNp((Prank,gmfdsolverPinitt0mesg,j),,'triiEIF e,foGNNNlength_phys(1Ml= max_phys(1Ml- min_phys(1M,foGNNNlength_phys(2Ml= max_phys(2Ml- min_phys(2M,foGNNNlength_phys(3Ml= max_phys(3Ml- min_phys(3),foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN Checkbndtx_pencil topology,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN ts_xpencil_topol= .TRUE.,foGNNN ts_xyslab_topo l= .TRUE.,foGNNNDO k=1,f_topo%nsublist,,'triiiiipdoml= f_topo%isublist(k),f n_dTIac_==ndt 20_pp_v ilet_sts1Kiiiii NNNlength(1Ml= f_topo%max_subs(1,idom)l- f_topo%min_subs(1,idom)Kiiiii NNNlength(2Ml= f_topo%max_subs(2,idom)l- f_topo%min_subs(2,idom)Kiiiii NNNIF( abs(length(1Ml-Nlength_phys(1M).G(ANp((Pmyepss) ) 3N e Kiiiii NNNNNN ts_xpencil_topo=.FALSE.,foGNNNfoGNNN ts_xyslab_topo =.FALSE.,foGNNNfoGEIF e,foGNNNiiiIF( abs(length(2Ml-Nlength_phys(2M).G(ANp((Pmyepss) ) 3N e Kiiiii NNNNNN ts_xyslab_topo =.FALSE.,foGNNNfoGEIF e,lifndtTIac_==ndt 20_pp_v ilet_sts1Kiiiii NNNlength(1Ml= f_topo%max_subd(1,idom)l- f_topo%min_subd(1,idom)Kiiiii NNNlength(2Ml= f_topo%max_subd(2,idom)l- f_topo%min_subd(2,idom)Kiiiii NNNIF( abs(length(1Ml-Nlength_phys(1M).G(ANp((Pmyepsd) ) 3N e Kiiiii NNNNNN ts_xpencil_topo=.FALSE.,foGNNNfoGNNN ts_xyslab_topo =.FALSE.,foGNNNfoGEIF e,foGNNNiiiIF( abs(length(2Ml-Nlength_phys(2M).G(ANp((Pmyepsd) ) 3N e Kiiiii NNNNNN ts_xyslab_topo =.FALSE.,foGNNNfoGEIF e,lies e,foGNNNEIFDO,foGNNNI(.Np((Pdebug .G(A 0) 3N e,,'triiiiiIF( ts_xpencil_topo) 3N e,,'triiiii WRITE(mesg,'(A)' ) 'X pencil topology' Kiiiii NNNNNNLL sugmwriteNp((Prank,gmfdsolverPinitt0mesg,j),,'triiiiiELSE,,'triiiii iiWRITE(mesg,'(A)' ) 'Not X pencil topology' Kiiiii NNNNNNLL sugmwriteNp((Prank,gmfdsolverPinitt0mesg,j),,'triiiiiEIF e,foGNNNiiiIF( ts_xyslab_topo) 3N e,,'triiiii WRITE(mesg,'(A)' ) 'XY slab topology' Kiiiii NNNNNNLL sugmwriteNp((Prank,gmfdsolverPinitt0mesg,j),,'triiiiiELSE,,'triiiii iiWRITE(mesg,'(A)' ) 'Not XY slab topology' Kiiiii NNNNNNLL sugmwriteNp((Prank,gmfdsolverPinitt0mesg,j),,'triiiiiEIF e,foGNNNEIF e,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0-/a,foGNNN Settpng l ix-pencil topologyNN,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNNIF( ts_xpencil_topo) 3N e,,'triiiiitopo_id_xpenl= field_topoid,foGNNN mesh_id_xpenl= mesh_id_(ave,!,'triiiiitopo_ids(1Mll= topo_id_xpen,,'triiiiitopo_id_ypenl= topo_ids(2),f nTIMESHIDIM=ndt 23D foGNNNiiitopo_id_zpenl= topo_ids(3MKlies e,foGNNN mesh_id_xpen_complex =Nmesh_ids(2),foGNNN mesh_id_ypenlllllllll=Nmesh_ids(3),f nTIMESHIDIM=ndt 23D foGNNNiiimesh_id_zpenlllllllll=Nmesh_ids(4MKlies e,foGNNNELSE,,'triiiiitopo_id_xpenl= topo_ids(1M,,'triiiiitopo_id_ypenl= topo_ids(2),f nTIMESHIDIM=ndt 23D foGNNNiiitopo_id_zpenl= topo_ids(3MKlies efoGNNNiii,foGNNN mesh_id_xpenlllllllll=Nmesh_ids(1),foGNNN mesh_id_xpen_complex =Nmesh_ids(2),foGNNN mesh_id_ypenlllllllll=Nmesh_ids(3),f nTIMESHIDIM=ndt 23D foGNNNiiimesh_id_zpenlllllllll=Nmesh_ids(4MKlies e,foGNNNEIF e,foGNNNI(.Np((Pdebug .G(A 0) 3N e,,'triiiiiWRITE(mesg,'(A)' ) ' ID topo lmesh' Kiiiii NNNLL sugmwriteNp((Prank,gmfdsolverPinitt0mesg,j),,'triiiiiWRITE(mesg,'(A)' ) 'Retur.5 2004/a Retur.5 2004/a04/a'Kiiiii NNNLL sugmwriteNp((Prank,gmfdsolverPinitt0mesg,j),,'triiiiiWRITE(mesg,'(A,2I4)' ) 'Original ',field_topoid, mesh_id_(ave Kiiiii NNNLL sugmwriteNp((Prank,gmfdsolverPinitt0mesg,j),,'triiiiiWRITE(mesg,'(A,2I4)' ) 'X Pencil ', topo_id_xpen, mesh_id_xpenKiiiii NNNLL sugmwriteNp((Prank,gmfdsolverPinitt0mesg,j),,'triiiiiWRITE(mesg,'(A,2I4)' ) 'X Pencil Complex', topo_id_xpen, 1p,'t&p,'ttttttmesh_id_xpen_complex,foGNNNNNNLL sugmwriteNp((Prank,gmfdsolverPinitt0mesg,j),,'triiiiiWRITE(mesg,'(A,2I4)' ) 'Y Pencil Complex', topo_id_ypen, mesh_id_ypen,foGNNNNNNLL sugmwriteNp((Prank,gmfdsolverPinitt0mesg,j),,'triiiiiWRITE(mesg,'(A,2I4)' ) 'Z Pencil Complex', topo_id_zpen, mesh_id_zpen,foGNNNNNNLL sugmwriteNp((Prank,gmfdsolverPinitt0mesg,j),,'triiEIF e,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0-/a,foGNNN Decomposefdomai in xy Slabs,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xyslab_topo) 3N e,,'triiiiiassignt= gmparammessign_ispTrnel,foGNNNNNNdecompt= gmparammdecomp_xy_slab,foGNNNNNNLL sugmmktopo(topo_id_xpen,mesh_id_xpen,xp,Npart,decomp,essign,1p,'t&p,'ttttttttttttttttttmin_phys,max_phys,bcETE,ghostsize,cost,Nm, 1p,'t&p,'ttttttttttttttttttfo) ,nsubsM,,'triiiiiLL sugmmeshfo) (topo_id_xpen,mesh_id_xpen,Nm,istart,n(ave_slab,1p,'t&p,'ttttttttttttttttttttmaxn(ave_slab,isublist,nsublist,fo) MK,'triiELSE,,'triiiii n(ave_slabt= n(ave,foGNNNEIF e,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0-/a,foGNNN Create Plan/ Table forlxy slab topology,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0-/a,foGNNNpdoml= f_topo%isublist(f_topo%nsublist),foGNNN bsnotract 1li;ifitug-convente ,foGNNNNxPin=n(ave_slab(1,idom)-1,foGNNNNyPin=n(ave_slab(2,idom)-1,f nTIMESHIDIM=ndt 23D foGNNNNzPin=n(ave_slab(3,idom)Klies e,foGNNNNxPoutt=NNxPin/2 + 1,foGNNNNyPoutt=NNyPinN,foGNNNNzPoutt=NNzPin,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0-/a,foGNNN FFTW ve.se xy slab,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0-/a,#i ETE_TIFFTW,f nTIMESHIDIM=ndt 23D foGNNNMBRankGNNN= 2 foGNNNMBIstridet= 1,foGNNNMBHowmanyt=NNzPin,foGNNNlda(1Ml= NxPin+1Ki=CINNlda(2Ml= NyPin+1Ki=CINNlda(3Ml= NzPin,f,foGNNNpopt M= gmparammeYsoc_fit,,foGNNNLL sugmeYsoc((avemreal,lda,iopt,fo) MK,'trii(avemrealt= 1.0_MK,,'triilda(1Ml= NxPout,i=CINNlda(2Ml= NyPoutt+ 1,foGNNNlda(3Ml= NzPout,i=CINNLL sugmeYsoc((avemcomp,lda,iopt,fo) MK,'trii(avemcompt= 1.0_MK,,foGNNNNm_slab(1Ml= NxPin,foGNNNNm_slab(2Ml= NyPin,,foGNNNiEmbed_slab(1Mll= NxPin+1Ki=CINNiEmbed_slab(2Mll= NyPin+1Ki=CINNoEmbed_slab(1Mll= NxPout ,foGNNNoEmbed_slab(2Mll= NyPoutt+ 1,foGNNNMBiDist M= (NxPin+1) * (NyPin+1),foGNNNMBoDist M= NxPout * (NyPout+1),f n_dTIac_==ndt 20_pp_v ilet_sts1Kiiiii LL subfftw_plan_many_dft_r2c(Plan_slab_fd_s,NMBRank,Nm_slab(1M,NMBHowmany, 1p,'t&ppppppp&i(avemreal(1,1,1M,NiEmbed_slab(1M,MBIstride,MBiDist, 1p,'t&ppppppp&i(avemcomp(1,1,1M,oEmbed_slab(1M,MBIstride,MBoDist,FFTW_MEASURE)Kiiiii LL subfftw_executeNPlan_slab_fd_sMKlifndtTIac_==ndt 20_pp_v ilet_sts1Kiiiii LL sudfftw_plan_many_dft_r2c(Plan_slab_fd_d,NMBRank,Nm_slab,NMBHowmany, 1p,'t&ppppppp&i(avemreal(1,1,1M,NiEmbed_slab,MBIstride,MBiDist, 1p,'t&ppppppp&i(avemcomp(1,1,1M,NoEmbed_slab,MBIstride,MBoDist,FFTW_MEASURE)Klies e,foGNNNoEmbed_slab(1Mll= NxPin+1Ki=CINNoEmbed_slab(2Mll= NyPin+1Ki=CINNiEmbed_slab(1Mll= NxPout ,foGNNNiEmbed_slab(2Mll= NyPoutt+ 1,foGNNNMBoDist M= (NxPin+1) * (NyPin+1),foGNNNMBiDist M= NxPout * (NyPout+1),f n_dTIac_==ndt 20_pp_v ilet_sts1Kiiiii LL subfftw_plan_many_dft_c2r(Plan_slab_bd_s,NMBRank,Nm_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppppppp&i(avemreal(1,1,1M,oEmbed_slab,MBIstride,MBoDist,FFTW_MEASURE)Kiiiii LL subfftw_executeNPlan_slab_bd_sMKlifndtTIac_==ndt 20_pp_v ilet_sts1Kiiiii LL sudfftw_plan_many_dft_c2r(Plan_slab_bd_d,NMBRank,Nm_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,NiEmbed_slab,MBIstride,MBiDist, 1p,'t&ppppppp&i(avemreal(1,1,1M,NoEmbed_slab,MBIstride,MBoDist,FFTW_MEASURE)Klies e,foGNNNLL sugmeYsoc((avemreal,lda,gmparammdeeYsoc,fo) MKlies e,lies e,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0-/a,foGNNN Decomposefdomai in xpencils,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e,,'triiiiiassignt= gmparammessign_ispTrnel,foGNNNNNN! xpencilsNdecomposite ,foGNNN NNdecompt= gmparammdecomp_xpencil,foGNNNNNNLL sugmmktopo(topo_id_xpen,mesh_id_xpen,xp,Npart,decomp,essign,1p,'t&p,'ttttttttttttttttttmin_phys,max_phys,bcETE,ghostsize,cost,Nm, 1p,'t&p,'ttttttttttttttttttfo) ,nsubsM,,'triiiiiLL sugmmeshfo) (topo_id_xpen,mesh_id_xpen,Nm,istart,n(ave,1p,'t&p,'ttttttttttttttttttttmaxn(ave,isublist,nsublist,fo) MK,foGNNNEIF e,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0-/a,foGNNN Create Plan/ Table forlxpencil topology,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNNpdoml= f_topo%isublist(f_topo%nsublist),foGNNN bsnotract 1li;ifitug-convente ,foGNNNNxPin=n(ave(1,idom)-1,foGNNNNyPin=n(ave(2,idom)Kf nTIMESHIDIM=ndt 23D foGNNNNzPin=n(ave(3,idom)Klies e,foGNNNNxPoutt=NNxPin/2 + 1,foGNNNNyPoutt=NNyPin,foGNNNNzPoutt=NNzPin,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0-/a,foGNNN FFTW ve.se xpencil,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0-/a,#i ETE_TIFFTW,f nTIMESHIDIM=ndt 22D foGNNNMBRankGNNN= 1,foGNNNMBiEmbed(1Mll= -1,foGNNNMBoEmbed(1Mll= -1,foGNNNMBIstridet= 1,foGNNNMBHowmanyt=NNyPin,,foGNNNiopt M= gmparammeYsoc_fit,foGNU!lda(1Ml= NxPin+1Ki=CINNlda(2Ml= NyPin,foGNNNLL sugmeYsoc((avemreal,lda,iopt,fo) MK,'triilda(1Ml= NxPout,i=CINNlda(2Ml= NyPout,i=CINNLL sugmeYsoc((avemcomp,lda,iopt,fo) MKf n_dTIac_==ndt 20_pp_v ilet_sts1Kiiiii MBiDist M= NxPin+1Ki=CINNMBoDist M= NxPout,i=CINNMBPin (1Mll= NxPinKiiiii LL subfftw_plan_many_dft_r2c(Plan_fd_s,NMBRank,MBPin,NMBHowmany, 1p,'t&ppppppp&i(avemreal(1,1M,NMBiEmbed(1M,MBIstride,MBiDist, 1p,'t&ppppppp&i(avemcomp(1,1M,MBoEmbed(1M,MBIstride,MBoDist,FFTW_MEASURE)Kiiiii MBiDist M= NxPout,i=CINNMBoDist M= NxPin+1Ki=CINNLL subfftw_plan_many_dft_c2r(Plan_bd_s,NMBRank,MBPin,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1M,NMBiEmbed(1M,MBIstride,MBiDist, 1p,'t&ppppppp&i(avemreal(1,1M,2r(Plan_bd_s,NMBRank,MBPin,NMBHowmany, 1p,'t-yPin+1Ki=CINNiEvBiEmbed(1M,MBIstride,MBiDist, 1p,'t&ppppppp&i(N MMMd!M,NMBiEmbed(1M,MBIstride,MBiDist, 1p,'t&ppppppp&i(avemreal(1,1M,2r(Plan_bd_s,NMBRank,MBPin,NMBHowmany, 1p,l,lda,iopt,fo) MK,'triilda(1Ml= NxPout,i=CINNlda(2Ml= NyPout,i=CINNLL sugmeYYl( :,1L subfftw_plan_many_dft_r2c(Plan_fd_s,NMBRank,MBPin,NMBHowmany, 1p,'t&pppppa0 1p,'t&pppppa0 1p,'t&pppppa0 1p,'t&pprax-&i(N MMMndt 20_pp_v ilet_sts1 |dTIL't&pppppa0 1p,'t&pppppa0 1p,'t&pnRansIL't&pppiF0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0-/a,foGNNN FFTW ve.se xpencil,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a0-/a,#i ETE_TIFFTW,f nTIMESHIDIM=ndt 22D foGNNNMBp&i(avemreal(1,1M,2r(Plan_bd_s,NMBRank,MBPin,NMBHowmany, 1p,'t-yiiiii MBiDist M= NxPout,i=CINNMBoDist M= NxPin+1Ki=CINNLL subfftw_plan_many_dft_c2r(Plan_bd_s,NMB+1Ki=CINNlda(2Ml= NyPin,foGNNNLL sugmeYsoc((avemreal,lda,iopt,fo) MK,'triilda(1Ml= NxPout,i=CINNldlda(2Ml= NyPout,i=CINNLL sugmeYsoc((avemcomp,lda,iopt,fo) MKf f n_dTIac_==ndt 20_pp_v ilet_sts1Kiiiii MBiDist M= NxPin+1Ki=CINNMBoDist M= NxPout,i=CINNMBPin (1Mll= NxPinKiiiii LL subfftw_plan_many_dft_r2c(Plan_fd_s,NMBRank,MBPin,NMBHowmany, 1p,'t&ppppppp&i(avemreal(1,1M,NMBiEmbed(1M,MBIstride,MBiDist, 1p,'t&ppppppMBp&i(avemreal(1,1M,2r(Plan_bd_s,NMBRank,MBPin,NMBHowmany, 1p,'t-yiiiii MBiDist M= NxPout,i=CINNMBoDist M= NxPin+1Ki=CINNLL subfftw_plan_many_dft_c2r(Plan_bd_s,NMBRank,MBPin,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1M,NMBiEmbed(1M,MBIstride,MBiDist, 1p,'t&ppppppp&p&i(avemreal(1,1M,2r(Plan_bd_s,NMBRank,MBPin,NMBHowmany, 1p,'t-yiiiii MBiDist M= NxPout,i=CINNMBoDist M= NxPdtTIac_==ndt 20_pp_v ilet_sts1Kiiiii SUBROUTINE gmfdsolverPinit_2d_vec_d(DATA_fv,lde_fv,mesh_id_(ave, 1p,'t&llllllllllll9m Retur.5 2004/a Retur.5 2004/a0-/a,foGNNN Create Plan/ Table forlxpencil topology,foGNNN kind_doublNNN kind_double0#;i(atparam= 2*bd_s,h_i64ist,FFTW_MEASURE)Kiiiii LL subfftw_executeNPlanp,'t&ppppptpara.5 20;i(atparaMKi=CINNNm(2M tttttttttttt= f_mesh%Nm(2MKi=CINNNtpara.b 20;i(atparaMKi=CINNNm(2M tttttttttttt= f_mes tttttttt=NNm(1M/2+1Ki=CINNNmmcom(2M tttttttt=NNm(2MKi=CINNNmmcom(3M tttttttt=NNm(3MKi=CINNn(aveptttttttttttt= f_mesh%nnoR,s,foGNNNbcETEtpara.5 2999m R sugmdGNNNNpartptttttttttttt= 0,foGNU! size l idummy arist,FFTW_MEASURE)Klies e,foGNNNoEmbed_slab(1Mp,'t&ppppptpara.5 d0;i(atparaMKi=CINNNm(2M tttttttttttt= f_mesh%Nm(2MKi=CINNNtpara.b d0;i(atparaMKi=CINNNm(2M tttttttttttt= f_mes tttttttt=NNm(1M/2+1Ki=CINNNmmcom(2M tttttttt=NNm(2MKi=CINNNmmcom(3M tttttttt=NNm(3MKi=CINNn(aveptttttttttttt= f_mesh%nnoR,s,foGNNNbcETEtpara.5 d999m R sugmdGNNNNpartptttttttttttt= 0,foGNU! size l idummy aripp_v ilet_s size l many, 1p,l,zPin,foGNm Retpo,0,-1p =!oGOTO 9999m st,FFTW_MEASURE)Kiiiii LL subfftw_executeNPlans oGN(zPin,foGNNN foGNNN size l ,1p,'t&ppppppp&i(a,foGNNN Decomposefdomai innnnnnnnnnnnnPout,i=CINNlda(2tpara.5 20lllll,stridt= f_mesh%Nm( csoGN(zPin,foGNNN foGNNN size l ,1p,'t&i=CINNlda(2,foGNNN Decomposefdomai innnnnnnnnnnnnPout,ppppppp&i(atpara.b 20lllll,stridt=rist,FFTW_MEASURE)Klies e,foGNNNoEmbed_slab(1M dzoGN(zPin,foGNNN foGNNN size l ,1p,'t&ppppppp&i(a,foGNNN Decomposefdomai innnnnnnnnnnnnPout,i=CINNlda(2tpara.5 d0lllll,stridt= f_mesh%Nm( zdoGN(zPin,foGNNN foGNNN size l ,1p,'t&i=CINNlda(2,foGNNN Decomposefdomai innnnnnnnnnnnnPout,ppppppp&i(atpara.b d0lllll,stridt=ri't&ppppppp&i(N MMMd!M,NMBiEmbed(1Mst,FFTW_MEASURE)Kiiiii LL subfftw_executeNPlans oGN(zPin,foGNNN foGNNN size l ,1p,'t&ppppppp&p&i(a,foGNNN Decomposefdomai innnnnnnnnnnnnPout,i=CINNldlda(2tpara.5 20lllll,stridt= f_mesh%Nm( csoGN(zPin,foGNNN foGNNN size l ,1p,'t&i=CINNldlda(2,foGNNN Decomposefdomai innnnnnnnnnnnnPout,ppppppp&p&i(atpara.b 20lllll,stridt==rist,FFTW_MEASURE)Klies e,foGNNNoEmbed_slab(1M dzoGN(zPin,foGNNN foGNNN size l ,1p,'t&ppppppp&p&i(a,foGNNN Decomposefdomai innnnnnnnnnnnnPout,i=CINNldlda(2tpara.5 d0lllll,stridt= f_mesh%Nm( zdoGN(zPin,foGNNN foGNNN size l ,1p,'t&i=CINNldlda(2,foGNNN Decomposefdomai innnnnnnnnnnnnPout,ppppppp&p&i(atpara.b d0lllll,stridt=ri't&ppppppp&i(ank,Nm_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppppppp&i(avemreal(1,1,yM,oEmbed_slab,MBIstride,MBoDist,FFTW_MEASURE)Kiiiii LL subfftw_executeNPlan_slab_bd_sMKlifndtTI&i(avemcomp(1,1,1M,NiEmbedy.5 2004/a ReBiDist, 1p,'t&ppppppp&i(ytur.5 2004/yM,NoEmbed_slab,MBIstride,MBmmdeeYsoc,fo) MKlies e,liefoGNNNLL sugmeYsoc((avemreal,lda,gmpardeeYsoc,fo) MKlies e,lie,foGNNN kind_doublr=po,0,-1p =!oGOTO 9999m Rytur.5 2004/yM,Nour.5 200/yM,Nod_zpen,foGN,foGNNN Decomposefdomai lex _,foGNNNIs,foGNNN kind_double0#r=po,0,-1p9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e,,'triiiiiassignt= gmparammessygn_ispTrnel,foGNNNNNN! xpencilsNdecomposite ,foGNNN NNdecompt= gmparammdecomp_xpencil,foGNNNNNNLL sugmmktopo(topo_id_xpen,mesh_id_xpen,xp,Npart,decomp,essign,1p,'t&p,'ttttttttttttttttttmin_phys,maxGNNNIgmmeshfo) tttttmiy_phys,maxGNNNI1 1p,'t&p,'ttttttttttttttttttfo) ,nsubsM,,'triGNNNIiiiLL sugmmeshfo) (topo_id_xpen,m ,foGNNN m,istart,n(ave,1p,'t&p,'ttttttttttttttttttttmaxn(ave,isublist,nsublist,fo) MK,foGNNNEIF e,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retuy.5 2004/a Retur.5 2004/a0-/a,foGNNN Create Plan/ Table forlxpencil topology,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retur.5 2004/a Retur.5 2004/a04/a,foGNNNpdoml= f_topo%isublist(f_topo%nsublist),foGNNN bsnotrINNMBPin (1Mll= NxPinKiiiii LL subfftw_plan_NxPinKiiiiil= Plan_fd_s,NMBRank,Mtract 1li;ifitugRank,MGNNNNyPin=n(ave(2,idom)Kf nTIMESHIDIM=ndt 23D foGNNNNzPin=n(aveoGOTO 9999m Retur.5 2004/h%Nm(2MKi=CINNNm(3M ttttttttttsIL't&pppiF0,-1p =!oGOTO 9999m Retur.5 2004/a ReturNNlda(2Ml= NyPin,foGNNNLpp&i(avemc_y(avemreal,lda,iopt,fo) MK,'triilda(1Ml= NxPout,i=CINNlda(2Ml= NyPout,i=CINNLL sugmeYsoc((avemcomp,lda,iopt,ttttt't-yPin+1Ki=CINNiEvBiEmbed(1M,MBIstrc((avemcomp,lda,oDistFORWARD, 't&ppppppp&i(avemcomp(1,1,1M,NoNyPin,foGNNNLpp&i(abemc_y(avemreal,lda,iopt,fo) MK,'triilda(1Ml= NxPout,i=CINNlda(2Ml= NyPout,i=CINNLL sugmeYsoc((avemcomp,lda,iopt,ttttt't-yPin+1Ki=CINNiEvBiEmbed(1M,MBIstrc((avemcomp,lda,oDistBACKWARD, 't&ppppppp&i(aDist,FFTW_MEASURE)Klies e,foGNNNoEmbed_slab(1Mll= NxPin+1Ki=CINNopp&i(avemcc_y(avemreal,lda,iopt,fo) MK,'triilda(1Ml= NxPout,i=CINNlda(2Ml= NyPout,i=CINNLL sugmeYsoc((avemcomp,lda,iopt,ttttt't-yPin+1Ki=CINNiEvBiEmbed(1M,MBIstrc((avemcomp,lda,oDistFORWARD, 't&ppppppp&i(avemcomp(1,1ll= NxPin+1Ki=CINNopp&i(abemcc_y(avemreal,lda,iopt,fo) MK,'triilda(1Ml= NxPout,i=CINNlda(2Ml= NyPout,i=CINNLL sugmeYsoc((avemcomp,lda,iopt,ttttt't-yPin+1Ki=CINNiEvBiEmbed(1M,MBIstrc((avemcomp,lda,oDistBACKWARD, 't&ppppppp&i(aDi't&ppppppp&i(N MMMd!M,NMBiEmbed(1M,MBIstride,MBiDist, 1p,'t&ppppppp&i(avemreal(1,1M,2r(Plan_bd_s,NMBRank,MBPin,NMBHowmany, 1p,l,ldINNMBPin (1Mll= NxPinKiiiii LL subfftw_plan_NxPinKiiiiil= Plan_fd_s,NMBRank,Mtract 1li;ifitu*list),foGNNN bsnotract 1li;ifitug-convente ,fdft_r2c(Plan_fd_s,NMBRank,MBPin,NMBHowmany, 1p,'oGOTO 9999m Retur.5 2004/h%Nm(2MKi=CINNNm(3M ttttttttttsIL't&pppiF0,-1p =!oGOTO 9999m Retur.5 2004/a ReturNNlda(2Ml= NyPin,foGNNNLpp&i(avemc_y(avemreal,lda,iopt,fo) MK,'mdeeYsoc,fo) MKlPout,i=CINNldlda(2Ml= NyPout,i=CINNLL sugmeYsocmcomp,ldaeeYsoc,fo) MKlPout,i=CI MKf f n_dTIac_==ndt 20_pp_v ilet_sts1cmcomp,ldaeeYsoc,fo) MKloDistFORWARD, 't&ppppppp&i(avemcomp(1,1,1M,NoNyPin,foGNNNLpp&i(abemc_y(avemreal,lda,iopt,fo) MK,'mdeeYsoc,fo) MKlPout,i=CINNldlda(2Ml= NyPout,i=CINNLL sugmeYsocmcomp,ldaeeYsoc,fo) MKlPout,i=CI MKf f n_dTIac_==ndt 20_pp_v ilet_sts1cmcomp,ldaeeYsoc,fo) MKloDistBACKWARD, 't&ppppppp&i(aDist,FFTW_MEASURE)Klies e,foGNNNoEmbed_slab(1Mll= NxPin+1Ki=CINNopp&i(avemcc_y(avemreal,lda,iopt,fo) MK,'triilda,fo) MKlPout,i=CINNldlda(2Ml= NyPout,i=CINNLL sugmeYsocmcomp,ldaeeYsoc,fo) MKlPout,i=CI MKf f n_dTIac_==ndt 20_pp_v ilet_sts1cmcomp,ldaeeYsoc,fo) MKloDistFORWARD, 't&ppppppp&i(avemcomp(1,1ll= NxPin+1Ki=CINNopp&i(abemcc_y(avemreal,lda,iopt,fo) MK,'triilda,fo) MKlPout,i=CINNldlda(2Ml= NyPout,i=CINNLL sugmeYsocmcomp,ldaeeYsoc,fo) MKlPout,i=CI MKf f n_dTIac_==ndt 20_pp_v ilet_sts1cmcomp,ldaeeYsoc,fo) MKloDistBACKWARD, 't&ppppppp&i(aDi't&ppppppp&i(_pp_v ilet_sts1Kiiiii SUBROUTINE gmfdsolverPinit_2d_vec_d(DATA_fv,lde_fv,mesh_id_(ave, 1p,'t&llllllllllll9m Retuy.5 2004/a Retur.5 2004/a0-/a,foGNNN Create Plan/ Table forlxpencil topology,foGNNN kind_doublNNN kind_double0#;i(atpara_ym= 2*bd_s,h_i64ist,FFTW_MEASURE)Kiiiii LL subfftw_executeNPlanp,'t&ppppptpara.5 c_y(;i(atpara_yMKi=CINNNm(2M tttttttttttt= f_mesh%Nm(2MKi=CINNNtpara.b c_y(;i(atpara_yMKi=CINNNm(2M tttttttttttt= f_mes tttttttt=NNm(1M/2+1Ki=CINNNmmcom(2M tttttttt=NNm(2MKi=CINNNmmcom(3M tttttttt=NNm(3MKi=CINNn(aveptttttttttttt= f_mesh%nomp,ldaeeYsoc,fo) MKlTEtpara.5 2999m R sugmdGNNNNpartptttttttttttt= 0,foGNU! size l idummy arist,FFTW_MEASURE)Klies e,foGNNNoEmbed_slab(1Mp,'t&ppppptpara.5 cc_y(;i(atpara_yMKi=CINNNm(2M tttttttttttt= f_mesh%Nm(2MKi=CINNNtpara.b cc_y(;i(atpara_yMKi=CINNNm(2M tttttttttttt= f_mes tttttttt=NNm(1M/2+1Ki=CINNNmmcom(2M tttttttt=NNm(2MKi=CINNNmmcom(3M tttttttt=NNm(3MKi=CINNn(aveptttttttttttt= f_mesh%nomp,ldaeeYsoc,fo) MKlTEtpara.5 d999m R sugmdGNNNNpartptttttttttttt= 0,foGNU! size l idummy aripp_v ilet_s size l many, 1p,l,zPin,foGNm RetNNmmcom(cxNNmmcoany, 1p,l,zncyNNmmcoany,po,0,-1p =!oGOTO 9999m st,FFTW_MEASURE)Kiiiii LL subfftw_executeNPlans oGN(zPin,foGNNN foGNNN size l ,1p,'t&i=CINNlda(2llllllmmdeeYsoc,fo) MKlies eiopt,ttttt't-yPizncyllmtpara.5 c_y(#;i(atpara_y,OTO 999tridt=rist,FFTW_MEASURE)Klies e,foGNNNoEmbed_slab(1M zoGN(zPin,foGNNN foGNNN size l ,1p,'t&i=CINNlda(2llllllmmdeeYsoc,fo) MKlies eiopt,ttttt't-yPizncyllmtpara.5 cc_y(#;i(atpara_y,OTO 999tridt=ri't&ppppppp&i(N MMMd!M,NMBiEmbed(1Mst,FFTW_MEASURE)Kiiiii LL subfftw_executeNPlans oGN(zPin,foGNNN foGNNN size l ,1p,'t&i=CINNldlda(2lllllldeeYsoc,fo) MKlies eiopt,ttttt't-y-yPizncyllmtpara.5 c_y(#;i(atpara_y,OTO 999tridt=rist,FFTW_MEASURE)Klies e,foGNNNoEmbed_slab(1M zoGN(zPin,foGNNN foGNNN size l ,1p,'t&i=CINNldlda(2lllllldeeYsoc,fo) MKlies eiopt,ttttt't-y-yPizncyllmtpara.5 cc_y(#;i(atpara_y,OTO 999tridt=ri't&ppppppp&i(pppp&i(N MMMd!M,NMBiEmbed(1M,MBIstNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppppppp&i(avemreal(1,1,zM,oEmbed_slab,MBIstride,MBoDist,FFTW_MEASURE)Kiiiii LL subfftw_executeNPlan_slab_bd_sMKlifndtTI&i(avemcomp(1,1,1M,NiEmbedz.5 2004/a ReBiDist, 1p,'t&ppppppp&i(ztur.5 2004/zM,NoEmbed_slab,MBIstride,MBmmdeeYsoc,fo) MKlies e,liefoGNNNLL sugmeYsoc((avemreal,lda,gmpardeeYsoc,fo) MKlies e,lie,foGNNN kind_doublr=po,0,-1p =!oGOTO 9999m Rztur.5 2004/zM,Nour.5 200/zM,Nod_zpenzfoGN,foGNNN Decomposefdomai lex _,foGzNNIs,foGNNN kind_double0#r=po,0,-1p9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e,,'triiiiiassignt= gmparammesszgn_ispTrnel,foGNNNNNN! xpencilsNdecomposite ,foGNNN NNdecompt= gmparammdecomp_xpencil,foGNNNNNNLL sugmmktopo(topo_id_xpen,mesh_id_xpen,xp,Npart,decomp,essign,1p,'t&p,'ttttttttttttttttttmin_phys,maxGzNNIiiiLL so) tttttmiy_phys,maxGzNNIgmmeshftfo) ,nsubsM,,'triGzNNI1 1p,'tttttmin_o_id_xpen,m ,f,foGNNN m,istart,n(ave,1p,'t&p,'ttttttttttttttttttttmaxn(ave,isublist,nsublist,fo) MK,foGNNNEIF e,foGNNN kind_double0#r=po,0,-1p =!oGOTO 9999m Retuz.5 2004/a Retur.5 2004/a0-/a,foGNNN Create Plan/ Table forlxpencil topology,foGNNN kind_double0#r=4/a Reride,MBiDiDist, 1p,'t&ppppppp&i(avmreal(1,1M,2r(Plan_bd_sNMBRank,MBPin,NMBHowm many, 1p,l,ldINNMBPin (1Mll= NxPinKiiiii LL subffftw_plan_NxPinKiiiiil= Plan_n_fd_s,NMBRank,Mtract 1li; ;ifitu*list),foGNNN bsnotract 1li;ifitug-convente ,fdft_r2c(Plan_fd_s,NMBRank,MBPin,NMBHowmany, 1p,'oGOTO 9999m Retur.5 2004/h%Nm(2MKi=CINNNm(3M ttttttttttsIL't&pppiF0,-1p =!oGOTO 9999m Retur.5 2004/a ReturNNlda(2Ml= NyPin,foGNNNLpp&i(avemc_z(avemreal,lda,iopt,fo) MK,'triilda(1Ml= NxPout,i=CINNldlda(2Ml= NyPout,i=CINNLL sugmeYsoc((avemcomp,lda,iopt,i=CI MKf f n_dTIac_==ndt 20_pp_v ilet_sts1c((avemcomp,lda,oDistFORWARD, 't&ppppppp&i(avemcomp(1,1,1M,NoNyPin,foGNNNLpp&i(abemc_z(avemreal,lda,iopt,fo) MK,'triilda(1Ml= NxPout,i=CINNldlda(2Ml= NyPout,i=CINNLL sugmeYsoc((avemcomp,lda,iopt,i=CI MKf f n_dTIac_==ndt 20_pp_v ilet_sts1c((avemcomp,lda,oDistBACKWARD, 't&ppppppp&i(aDist,FFTW_MEASURE)Klies e,foGNNNoEmbed_slab(1Mll= NxPin+1Ki=CINNopp&i(avemcc_z(avemreal,lda,iopt,fo) MK,'triilda(1Ml= NxPout,i=CINNldlda(2Ml= NyPout,i=CINNLL sugmeYsoc((avemcomp,lda,iopt,i=CI MKf f n_dTIac_==ndt 20_pp_v ilet_sts1c((avemcomp,lda,oDistFORWARD, 't&ppppppp&i(avemcomp(1,1ll= NxPin+1Ki=CINNopp&i(abemcc_z(avemreal,lda,iopt,fo) MK,'triilda(1Ml= NxPout,i=CINNldlda(2Ml= NyPout,i=CINNLL sugmeYsoc((avemcomp,lda,iopt,i=CI MKf f n_dTIac_==ndt 20_pp_v ilet_sts1c((avemcomp,lda,oDistBACKWARD, 't&ppppppp&i(aDi't&ppppppp&iomp,ldts1Kiiiii SUBROUTINE gmfdsolverPinit_2d_vec_d(DATA_fv,lde_fv,mesh_id_(ave, 1p,'t&llllllllllll9m Retuz.5 2004/a Retur.5 2004/a0-/a,foGNNN Create Plan/ Table forlxpencil topology,foGNNN kind_doublNNN kind_double0#;i(atpara_zm= 2*bd_s,h_i64ist,FFTW_MEASURE)Kiiiii LL subfftw_executeNPlanp,'t&ppppptpara.5 c_z(;i(atpara_zMKi=CINNNm(2M tttttttttttt= f_mesh%Nm(2MKi=CINNNtpara.b c_z(;i(atpara_zMKi=CINNNm(2M tttttttttttt= f_mes tttttttt=NNm(1M/2+1Ki=CINNNmmcom(2M tttttttt=NNm(2MKi=CINNNmmcom(3M tttttttt=NNm(3MKi=CINNn(aveptttttttttttt= f_mesh%nnoR,s,foGNNNbcETEtpara.5 2999m R sugmdGNNNNpartptttttttttttt= 0,foGNU! size l idummy arist,FFTW_MEASURE)Klies e,foGNNNoEmbed_slab(1Mp,'t&ppppptpara.5 cc_z(;i(atpara_zMKi=CINNNm(2M tttttttttttt= f_mesh%Nm(2MKi=CINNNtpara.b cc_z(;i(atpara_zMKi=CINNNm(2M tttttttttttt= f_mes tttttttt=NNm(1M/2+1Ki=CINNNmmcom(2M tttttttt=NNm(2MKi=CINNNmmcom(3M tttttttt=NNm(3MKi=CINNn(aveptttttttttttt= f_mesh%nnoR,s,foGNNNbcETEtpara.5 d999m R sugmdGNNNNpartptttttttttttt= 0,foGNU! size l idummy aripp_v ilet_s size l many, 1p,l,zPin,foGNm RetNNmmcom(cxNNmmcoany, 1p,l,zncyNNmmcoany,po,0FTW_MEASURE)Kiiiii LL subfftw_executeNPlans oGN(zPin,foGNNN foGNNN size l ,1p,'t&i=CINNldlda(2lllllldeeYsoc,fo) MKlies eiopt,ttttt't-y-yPizncyllmtpara.5 c_z(#;i(atpara_z,OTO 999tridt=rist,FFTW_MEASURE)Klies e,foGNNNoEmbed_slab(1M zoGN(zPin,foGNNN foGNNN size l ,1p,'t&i=CINNlda(2lllllldeeYsoc,fo) MKlies eiopt,ttttt't-y-yPizncyllmtpara.5 cc_z(#;i(atpara_z,OTO 999tridt=ri't&ppppppp&i(ank,Nm_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppppR sugm memorGNNNNNN! xpencilsNdecomposite ,foGNNN NNdecompt= gmparammdecomp_xpencil,foGNNNNNNLL suPoutcomp(1,1,1M,NiR su= f_mesh%Nm(2MKi=CINNNIfo) M= gmerrormerrables foGNNN kind_double0#r=po,0,-1p =!oGOTO 999gmerrormerra 20_pp_v ilet_sts1Kiiiii LL,gm 9999m Retur.5 2004/h%Nm(2MKi=CINNN5 2004 9999m Retur.5 2004/h%Nm(2MKi=CINNN5 200GNNNIs 9999m Retur.5 2004/h%Nm(2MKi=CINNN5 200GzNNIs 9999m Retur.5 2004/h%Nm(2MKi=CINNNIfo) M= gmerrormerror,,'triiiii CILL sugmeNNNIs 9999m Retur.5 2004/h%Nm(2MKi=CINNN _,foGzNNIs= gmerrormerror,,'triiiii CILL sugmerror(gmerr_ergument,g3D foGNNNNzPin=n(ave(3,idom)Klies e,foGNNNNxPoPin,NMBHowmany, 1p,'oGOTO 9999m Retur.5 2004/h%Nm(2MKi=CINNNm(3M ttttttttttsIL't&pppiF0 20_pp_v il tttttttt=NNm(1M/2+1Ki=CINNNmmcoELSE,,'triiiiito) 'could999m dpR sugm memorG'i=CINNNmmcom(2M tttttttt=NNmuble0#r=po,0,-1p(3M tttttttt=NNm(3MKi=C2r(Plan_,2I4)' ) 'X Pencil NNNpartpt,foGNNN Decomposefdomai innnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn(ave_slab,foGNNN kind_double0#r=po,0,-O 999CONTINUE 2004/h%Nm(comp,oplllllllllllllllll:: Its_xyslab_topo,RETURN ,po,0FTW_NMBiEmbedSFIEL1Mst,FFTW_1p =!oGOTO 9999m st,FFTW_MEASURE)Kiiiii LL subfftw_execute=po SUBROUTINE lllllllllllllll::_2 2cmer =rist,FFTW_MEASURE)Klies e,foGNNNoEmbed_sl=po SUBROUTINE lllllllllllllll::_2 2cmed pppppp&i(alN MMMd!M,NMBiEmbed(1Mst,FFTW_MEASURE)Kiiiii LL subfftw_execute=po SUBROUTINE lllllllllllllll::_3 2cmer =rist,FFTW_MEASURE)Klies e,foGNNNoEmbed_sl=po SUBROUTINE lllllllllllllll::_3 2cmed pppppp&i(appp&i(pppp&i(N FTW_NMBiEmbedVFIEL1Mst,FFTW_1p =!oGOTO 9999m st,FFTW_MEASURE)Kiiiii LL subfftw_execute=po SUBROUTINE lllllllllllllll::_2 vecer =rist,FFTW_MEASURE)Klies e,foGNNNoEmbed_sl=po SUBROUTINE lllllllllllllll::_2 vecedpppppp&i(alN MMMd!M,NMBiEmbed(1Mst,FFTW_MEASURE)Kiiiii LL subfftw_execute=po SUBROUTINE lllllllllllllll::_3 vecer=rist,FFTW_MEASURE)Klies e,foGNNNoEmbed_sl=po SUBROUTINE lllllllllllllll::_3 vecedpppppp&i(appp&i(appp&iliblllnumerics-r1036/src/0,-1podura_odei=CIdone.f0000644000175000017500000000523011616214650020764 0u 20 omaromarbed_slNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppModurab,foGNN:nnnnnnnnnnnn0,-1podura_odei=CIdonem_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&p 1p,'t&pppPuri(avefoGNN:nprocedurm modurabmess0,-1odei=CIonem_slab,N 1p,'t&pppRemarksefoGNN:nm_slab,N 1p,'t&pppReferencesGNN:nm_slab,N 1p,'t&pppRevi RetsefoG:m_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppp$Log:n0,-1podura_odei=CIdone.f,v $ 1p,'t&pppRevi Ret 1.1.1.1 2007/07/13 10:19:00nnnvos 1p,'t&pppCBLll9m Retuof the defio,0,-1pm_slab,N 1p,'t&pppRevi Ret 1.4 2004/07/26 11:57:45iefochaebe 1p,'t&pppreplacm modurabmunctttttby modurabprocedurm ;)m_slab,N 1p,'t&pppRevi Ret 1.3 2004/07/26 11:39:49iefochaebe 1p,'t&pppreplacmd modurabprocedurm by modurabmuncttttm_slab,N 1p,'t&pppRevi Ret 1.2 2004/07/26 11:20:13iefochaebe 1p,'t&pppaddmd ur.5 _slabfacmm_slab,N 1p,'t&pppRevi Ret 1.1 2004/07/26 07:45:46iefochaebe 1p,'t&pppProcedurm moduras cassigd1,1,the coursa Retatomizttttt.m_slab,N 1p,'t&pm_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppCopyright (c) 2010 CSE Lab (ETH Zuricha(2MOSAIC Group (ETH Zuricha(2 1p,'t&pppppppppppppppppppppCeslabbmessFluid Dynafocs (DTU)m_slab,N 1p,'t&p 1p,'t&ppThis firabis -1p =of the d1,1llel d1,ticrabMesh L,0,-1p (def).m_slab,N 1p,'t&p defiis free software: you canpredi_pp_bugm it and/essmodifpm_slab,N it undabbthe labms=of the GNU LessabbGene,1lpPublic L,censa m_slab,N as -xpen,hgd1by the Free Software Fouugttt, either m_slab,N l9m Retu3=of the L,censa, ess(at your IL'Ret) 1li;later m_slab,N l9m Ret.m_slab,N 1p,'t&p defiis di_pp_bugmd1,1,the hope lhat it will be useful, 1p,'t&p bug WITHOUT ANY WARRANTY; withtttteve1,the itttimd1w2004nty=ofe, 1p,'t&lERCHANTABILITY essFITNESS FOR A PARTICULAR PURPOSNm(See lhe 1p,'t&ppGNU Gene,1lpPublic L,censa fessmore details.m_slab,N 1p,'t&p You should9havepreceivmd1a copy=of the GNU Gene,1lpPublic L,censam_slab,N and the GNU LessabbGene,1lpPublic L,censa aIong with def. If999m, 1p,'t&p see .m_slab,N 1p,'t&p d1,1llel d1,ticrabMesh L,0,-1p (def) 1p,'t&p ETH Zurich 1p,'t&ppCH-8092 Zurich, Switzerlandpo,0,-1p9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e,,'triMODULEn0,-1podura_odei=CIdonem_slab,foG9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A _slab,foG9 Dr.5 _slabfacmm_slab,oG9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A _slab,foGINTERFACEs0,-1odei=CIdonem_slab,,'triMODULEnPROCEDUREs0,-1odei=CIdonem_slab,,'=po INTERFACEm_slab,,' 2004/hONTAINSMstnclude "0,-1odei=CIdone.f"po,0,-1p =!iMODULEn0,-1podura_odei=CIdonem_m_slab,,' liblllnumerics-r1036/src/0,-1hamjac_rell::_step_ref_3 .f0000644000175000017500000002646411616214650022240 0u 20 omaromar,0,-1p9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e,,'trippppppSubroutinvefo:nnnnnnnnnnn0,-1hamjac_rell::_step_ref_3 m_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppp,,' 2004/ppp,,'Puri(avefoGNN:nSllll Hafolton-Jacobi fessGowas rell::1,1,ref 1p,'t&pppppppppppppppppppppspc 1p,'t&ppppppp 1p,'t&ppppppInputpppppppp:2 1p,'t&ppppppppppppppppppppp 1p,'t&ppppppInput/Outputp:2 1p,'t&ppppppppppppppppppppp 1p,'t&ppppppOutputppppppp:2 1p,'t&ppppppp 1p,'t&ppppppRemarksefoGNN:nm_slab,Npppppppppppppppppppp 1p,'t&pppppp 1p,'t&ppppppReferencesGNN: 1p,'t&pppppp 1p,'t&ppppppRevi RetsefoG:m_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppp pp$Log:n0,-1hamjac_rell::_step_ref_3 .f,v $ 1p,'t&ppp ppRevi Ret 1.1.1.1 2006/07/25 15:18:19gmwrnahel 1p,'t&ppp ppll::i1lpittoran_many_! 1p,'t&ppp ppRevi Ret 1.2 2005/08/12 14:38:01nnnvos 1p,'t&ppppppbugfix:plldex bouus1,1,loop correcgmd.m_slab,N 1p,'t&p p ppRevi Ret 1.1 2005/07/25 00:34:05nnnvos 1p,'t&ppppppIl::i1lpcmin_-it.m_slab,N 1p,'t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppp ppd1,1llel d1,ticrabMesh L,0,-1p (def) 1p,'t&p ppppIlstitugm of Computgttt1lpScience 1p,'t&p ppppETH Zeslrum, Hirscmingrabe1,84 1p,'t&p ppppCH-8092 Zurich, Switzerlandp1p,'t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, Mst,FFTW_1ODEURE)KiiCAMst,FFTW_MEASURE)Kiiiii LL subfftw_executeSUBROUTINE llllhamjac_rell::_step_ref_3 s (phi,pcmi,ptphi,ptrgt,,res(2,foGNNN Decomposefdomai innnnnnnnnnnn 9999m gmfdsolve, emreal,lda &pppiF0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_slSUBROUTINE llllhamjac_rell::_step_ref_3 d (phi,pcmi,ptphi,ptrgt,,res(2,foGNNN Decomposefdomai innnnnnnnnnnn 9999m gmfdsolve, emreal,lda &pppiF0 ppp&i(alN MMMODEURE)KiVECi(att=N VECTOR NOT IMPLEMENTElll=NmesF0 ppp&im_slab,,'USEn0,-1podura_oGOTO 9999m,foGNNN mUSEn0,-1podura_uble0#r=po,0,-USEn0,-1podura_comp,aran_many_,-USEn0,-1podura_comp,opn_many_,-USEn0,-1podura_typedef 1p,'t& IMPLICIT NONEm_slab,,' st,FFTTW_MEASURE)Kiiiii LL subfftw_executeoGINTEGER, PARAMETER :: MK ttttttklld_singlei(alN FFTW_MEASURE)Klies e,foGNNNoE9999m,foGNNN mINTEGER, PARAMETER :: MK ttttttklld_doubleF0 ppp&im_slab,,'9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A _slab,foG9 Argumentsm_slab,,'9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A _slab,foGREAL(MK), DIMENNNoE(:,:,:,: ), POINTER :: pmi,ptphi_slab,foGREAL(MK), DIMENNNoE(:,:,:,:,:), POINTER :: chi_slab,foGINTEGER, INTENT(in)omai innnnnnnnnnnn:: 9999m gmfdsolve_slab,foGINTEGER, DIMENNNoE(3), INTENT(in)omai :: emreal,ld_slab,foGINTEGER, INTENT(inout)omai innnnnnnnn:: &ppp_slab,foGpppppmk),INTENT(out)omai innnnnnnnnnn:: res_slab,foGREAL(mk), INTENT(in)omai innnnnnnnnnn:: rgtim_slab,,'9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A _slab,foG9 Aliasesm_slab,,'9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A _slab,foGINTEGER, DIMENNNoE(:), POINTER nnnnnnn:: &_xpen,x_slab,foGINTEGERomai innnnnnnnnnnninnnnnnnnnnn:: n_xpen,x_slab,foGINTEGER, DIMENNNoE(:,:), POINTER nnnnn:: noGOTO 9999m,fINTEGERomai innnnnnnnnnnninnnnnnnnnnn:: lllllll=Nmesve_slab,foGREAL(MK), DIMENNNoE(:), POINTER nnnnnn:: foGNNNLL sugmeY_slab,foGTYPENm(3Mtet_stsmesh%noPOINTER nnnnnnn:: t_st_slab,foGTYPENm(3Mteequi1p =!), POINTER nnnnnnn:: p =!O 9999m,foGNNN m9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A _slab,foG9 p,anoGrd p,uffm_slab,,'9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A _slab,foGINTEGERomai innnnnnnnnnnninnnnnnnnnnn:: &_xps,foGN,i,j,k_slab,foGREAL(MK)mai innnnnnnnnnnninnnnnnnnnnn:: leGNNNLLpenlGNNN m9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A _slab,foG9 WENO p,uffm_slab,,'9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A _slab,foGREAL(mk)n:: oneg(3), _sts(3), wenoeps, wenotau, pbs_slab,foGREAL(mk)n:: laps(-1:1,3), rsts(3), rneg(3), dx(3), dxipenlGNNN mREAL(mk)n:: phip(3), phin(3), phimid(3), rms, dphi_dtlGNNN mREAL(mk)n:: dxihalf, dyihalf, dzihalf, phinx(3), phipxpenlGNNN mREAL(mk)n:: dxitwelll, dyitwelll, dzitwelll_slab,foGINTEGERom:: &lap, esder, jfoGlGNNN mREAL(mk)n:: jipe,3), jacpe,3)oGNNN mINTEGER, PARAMETER, DIMENNNoE(3,3)n:: offsc((avemcomp,ldNN =mRESHAPEN(/2,1,0,1,0,-1,0,-1,-2/),(/3,3/)nlGNNN mREAL(mk)n:: t0 O 9999m,foGNNN mh%Nm(comp,arallllllhamjac_step_3d Its_xyslab_topo,,foGNNN m9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A _slab,foG9 Get the p =! oGOTO 9999m,f9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A _slab,foGt_st =>ttttt't&ppppppp&i)%tlGNNN mp =! =>tesh_ip =!(fdsolve)lGNNN mp =!id =mp =!%IDlGNNN mn_xpen,x =mesh_id_xpen,xlGNNN mns(1),f =>tp =!%nnodesm_slab,,'i_xpen,x =>tesh_i&_xpen,x_st,FFTTW_MEASURE)Kiiiii LL subfftw_executeoGfoGNNNLL =>tesh_ipoGNNNLLsm_slab,,'sugmeY =>tesh_ipugmeYsi(alN FFTW_MEASURE)Klies e,foGNNNoE9999m,foGNNN mfoGNNNLL =>tesh_ipoGNNNLLdm_slab,,'sugmeY =>tesh_ipugmeYdF0 ppp&im_slab,,'leGNNNLLpnotrapugmeYpnot-mfoGNNNLL(1)m_slab,,'leGNNNLLp2otrapugmeYp2ot-mfoGNNNLL(2)m_slab,,'leGNNNLLp3otrapugmeYp3ot-mfoGNNNLL(3)oGNNN mdx(1)mai in='leGNNNLLpno/REAL(m =!%Nmpno-1,mk)oGNNN mdx(2)mai in='leGNNNLLp2o/REAL(m =!%Nmp2o-1,mk)oGNNN mdx(3)mai in='leGNNNLLp3o/REAL(m =!%Nmp3o-1,mk)oGNNN mdxi(1)mai i 2004/mk/dx(1)oGNNN mdxi(2)mai i 2004/mk/dx(2)oGNNN mdxi(3)mai i 2004/mk/dx(3)oGNNN mdxihalfai i 20.5/mk*dxi(1)oGNNN mdyihalfai i 20.5/mk*dxi(2)oGNNN mdzihalfai i 20.5/mk*dxi(3)oGNNN mdxitwelll i 2dxi(1)/1204/mkoGNNN mdyitwelll i 2dxi(2)/1204/mkoGNNN mdzitwelll i 2dxi(3)/1204/mkoGNNN moGNNN mwenoepsi 2004e-6/mkoGNNN mwenotaui 20.5/mk*MINVAL(dx)im_slab,,'bms== -HUGE(bms)im_slab,,'DO'i_xp=1,d_xpen,xlGNNN m ,'i_xpe== o_id_xpeno_ide_slab,foGNN'DO'k=1,d'triiiii_id_e_slab,foGNN'NN'DO'j=1,d'trii2ii_id_e_slab,foGNN'NN',,'DO'i=1,d'trii1ii_id_e__slab,foGNN'NN',,',,'DO'ilap=1,3_slab,foGNN'NN',,',,''''laps(2-&lap,notraphi(i+offsi1iilap),j,kii_id)mai&_slab,foGNN'NN',,',,'''''''''& -204/mk *aphi(i+offsi2iilap),j,kii_id)m&_slab,foGNN'NN',,',,'''''''''& +aphi(i+offsi3iilap),j,kii_id)_slab,foGNN'NN',,',,''''laps(2-&lap,2otraphi(i,j+offsi1iilap),kii_id)mai&_slab,foGNN'NN',,',,'''''''''& -204/mk *aphi(i,j+offsi2iilap),kii_id)m&_slab,foGNN'NN',,',,'''''''''& +aphi(i,j+offsi3iilap),kii_id)_slab,foGNN'NN',,',,''''laps(2-&lap,3otraphi(i,j,k+offsi1iilap),i_id)mai&_slab,foGNN'NN',,',,'''''''''& -204/mk *aphi(i,j,k+offsi2iilap),i_id)m&_slab,foGNN'NN',,',,'''''''''& +aphi(i,j,k+offsi3iilap),i_id)_slab,foGNN'NN',,',,' =!iDO__slab,foGNN'NN',,',,'rsts(notra(wenoepsi+'laps( y-yP**2)/(wenoepsi+'laps(0-yP**2)_slab,foGNN'NN',,',,'rneg(notra(wenoepsi+'laps(-y-yP**2)/(wenoepsi+'laps(0-yP**2)_slab,foGNN'NN',,',,'rsts(2otra(wenoepsi+'laps( y-2P**2)/(wenoepsi+'laps(0-2P**2)_slab,foGNN'NN',,',,'rneg(2otra(wenoepsi+'laps(-y-2P**2)/(wenoepsi+'laps(0-2P**2)_slab,foGNN'NN',,',,'rsts(3)tra(wenoepsi+'laps( y-3P**2)/(wenoepsi+'laps(0-3P**2)_slab,foGNN'NN',,',,'rneg(3)tra(wenoepsi+'laps(-y-3P**2)/(wenoepsi+'laps(0-3P**2)__slab,foGNN'NN',,',,'osts(notra004/mk/(004/mk+204/mk*rsts(no**2)_slab,foGNN'NN',,',,'osts(2otra004/mk/(004/mk+204/mk*rsts(2P**2)_slab,foGNN'NN',,',,'osts(3)tra004/mk/(004/mk+204/mk*rsts(3P**2)_slab,foGNN'NN',,',,'oneg(notra004/mk/(004/mk+204/mk*rneg(no**2)_slab,foGNN'NN',,',,'oneg(2otra004/mk/(004/mk+204/mk*rneg(2o**2)_slab,foGNN'NN',,',,'oneg(3)tra004/mk/(004/mk+204/mk*rneg(3)**2)__slab,foGNN'NN',,',,'phimid(notraphi(i+1,j,kii_id)-phi(i-1,j,kii_id)_slab,foGNN'NN',,',,'phimid(2otraphi(i,j+1,kii_id)-phi(i,j-1,kii_id)_slab,foGNN'NN',,',,'phimid(3otraphi(i,j,k+1ii_id)-phi(i,j,k-1ii_id)__slab,foGNN'NN',,',,'phip(notra0.5/mk*(phimid(not-m&_slab,foGNN'NN',,',,''''''&'osts(no*(m&_slab,foGNN'NN',,',,''''''&'N',,',,'phi(i+2,j,kii_id)m-m&_slab,foGNN'NN',,',,''''''&'304/mk*(phi(i+1,j,kii_id)m-mphi(i ,j,kii_id))m-m&_slab,foGNN'NN',,',,''''''&'N',,',,'phi(i-1,j,kii_id)))*dxi(1)oGNNN mNN'NN',,',,'phip(2otra0.5/mk*(phimid(2ot-m&_slab,foGNN'NN',,',,''''''&'osts(2o*(m&_slab,foGNN'NN',,',,''''''&'N',,',,'phi(i,j+2,kii_id)m-m&_slab,foGNN'NN',,',,''''''&'304/mk*(phi(i,j+1,kii_id)m-mphi(i ,j,kii_id))m-m&_slab,foGNN'NN',,',,''''''&'N',,',,'phi(i,j-1,kii_id)))*dxi(2)_slab,foGNN'NN',,',,'phip(3)tra0.5/mk*(phimid(3ot-m&_slab,foGNN'NN',,',,''''''&'osts(3o*(m&_slab,foGNN'NN',,',,''''''&'N',,',,'phi(i,j,k+2ii_id)m-m&_slab,foGNN'NN',,',,''''''&'304/mk*(phi(i,j,k+1ii_id)m-mphi(i ,j,kii_id))m-m&_slab,foGNN'NN',,',,''''''&'N',,',,'phi(i,j,k-1ii_id)))*dxi(3)_slab,foGNN'NN',,',,'phin(notra0.5/mk*(phimid(not-m&_slab,foGNN'NN',,',,''''''&'oneg(no*(m&_slab,foGNN'NN',,',,''''''&'N',,',,'phi(i+1,j,kii_id)m-m&_slab,foGNN'NN',,',,''''''&'304/mk*(phi(i ,j,kii_id)m-mphi(i-1,j,kii_id))m-m&_slab,foGNN'NN',,',,''''''&'N',,',,'phi(i-2,j,kii_id)))*dxi(1)oGNNN mNN'NN',,',,'phin(2otra0.5/mk*(phimid(2ot-m&_slab,foGNN'NN',,',,''''''&'oneg(2o*(m&_slab,foGNN'NN',,',,''''''&'N',,',,'phi(i,j+1,kii_id)m-m&_slab,foGNN'NN',,',,''''''&'304/mk*(phi(i,j ,kii_id)m-mphi(i,j-1,kii_id))m-m&_slab,foGNN'NN',,',,''''''&'N',,',,'phi(i,j-2,kii_id)))*dxi(2)_slab,foGNN'NN',,',,'phin(3)tra0.5/mk*(phimid(3ot-m&_slab,foGNN'NN',,',,''''''&'oneg(3)*(m&_slab,foGNN'NN',,',,''''''&'N',,',,'phi(i,j,k+1ii_id)m-m&_slab,foGNN'NN',,',,''''''&'304/mk*(phi(i,j,k ,i_id)m-mphi(i,j,k-1ii_id))m-m&_slab,foGNN'NN',,',,''''''&'N',,',,'phi(i,j,k-2ii_id)))*dxi(3)__slab,foGNN'NN',,',,'jfoG== o_idMstnclude "0,-1gmm_jacobian.tnc"__slab,foGNN'NN',,',,'phinx(notrajacpy-yP*phin(no+jacp2-yP*phin(2o+jacp3-yP*phin(3)_slab,foGNN'NN',,',,'phinx(2otrajacpy-2P*phin(no+jacp2-2P*phin(2o+jacp3-2P*phin(3)_slab,foGNN'NN',,',,'phinx(3otrajacpy-3P*phin(no+jacp2-3P*phin(2o+jacp3-3P*phin(3)_slab,foGNN'NN',,',,'phipx(notrajacpy-yP*phip(no+jacp2-yP*phip(2o+jacp3-yP*phip(3)_slab,foGNN'NN',,',,'phipx(2otrajacpy-2P*phip(no+jacp2-2P*phip(2o+jacp3-2P*phip(3)_slab,foGNN'NN',,',,'phipx(3otrajacpy-3P*phip(no+jacp2-3P*phip(2o+jacp3-3P*phip(3)_slab,foGNN'NN',,',,'_slab,foGNN'NN',,',,'_slab,foGNN'NN',,',,'9m R collect_slab,foGNN'NN',,',,'IF(phi(i,j,kii_id).GT.004/mkM/2+1Ki=CINNNmmcoGNN'NN',,',,'pbs== SQRT(m&_slab,foGNN'NN',,',,'''''' ''&'MAX(-MIN(phipx(no,004/mkM,MAX(phinx(no,004/mkM)**2+&_slab,foGNN'NN',,',,'''''' ''&'MAX(-MIN(phipx(2o,004/mkM,MAX(phinx(2o,004/mkM)**2+&_slab,foGNN'NN',,',,'''''' ''&'MAX(-MIN(phipx(3o,004/mkM,MAX(phinx(3o,004/mkM)**2)&_slab,foGNN'NN',,',,'''''''''& - rgtiNN'NN',,',,'''''''''ELSEIF(phi(i,j,kii_id).LT.004/mkM/2+1Ki=CINNNmmcoGNN'NN',,',,'pbs== SQRT(m&_slab,foGNN'NN',,',,'''''' ''&'MAX(MAX(phipx(no,004/mkM,-MIN(phinx(no,004/mkM)**2+&_slab,foGNN'NN',,',,'''''' ''&'MAX(MAX(phipx(2o,004/mkM,-MIN(phinx(2o,004/mkM)**2+&_slab,foGNN'NN',,',,'''''' ''&'MAX(MAX(phipx(3o,004/mkM,-MIN(phinx(3o,004/mkM)**2)&_slab,foGNN'NN',,',,'''''''''& - rgtiNN'NN',,',,'''''''''ELSEi=CINNNmmcoGNN'NN',,',,'pbs== 004/mkoGNNN m',,'''''''''Epo IFoGNNN m',,'''''''''dphi_dt== 'pbs=*aphi(i,j,k,i_id)m/m&_slab,foGNN'NN',,',,''''''&'SQRT(phi(i,j,k,i_id)**2+0.25/mk*SUM(phimid**2))'_slab,foGNN'NN',,',,'tphi(i,j,k,i_id)m=aphi(i,j,k,i_id)m-mwenotaui* dphi_dtl_slab,foGNN'NN',,',,'rms== MAX(rms,ABS(dphi_dt))__slab,foGNN'NN',,' =!iDO__slab,foGNN'NN' =!iDO__slab,foGNN' =!iDO__slab,foG =!iDO__slab,foGres== rms__slab,foGh%Nm(comp,opllllllhamjac_step_3d Its_xyslabMst,FFTW_MEASURE)Kiiiii LL subfftw_execute=po SUBROUTINE llllhamjac_rell::_step_ref_3 s =rist,FFTW_MEASURE)Klies e,foGNNNoEmbed_sl=po SUBROUTINE llllhamjac_rell::_step_ref_3 d F0 ppp&im_slab,_slab,foGNN'NN',,',,'_l_slab,foGNN'NN',,',,' N'NN',,',,' N'NN',,',,' O 9999m,foGNNN moGNNN moGNNN moliblllnumerics-r1036/src/0,-1pg(2M tttttel .f0000644000175000017500000004375311616214650020106 0u 20 omaromarNN mpMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppSubroutinvefo:nnnnnnnnnnnnnnnn0,-1pg(2M tttttel NN mpMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&p 1p,'t&pppPuri(avefoGNN:nDoes=the (re)R sugRetuof 2004ys=of type 1p,'t&p pppppppppppppppppg(ttel . I =offers=the same R sugRet 1p,'t&p pppppppppppppppptypes as -MKi=CINN fessregul20 2004ys.m_slab,N 1p,'t&p pInputpppppppp:2(Pla:)mai (I) number=of commreal(s + 1p,'t&p ppppppppppppppppppppppppppppppnumbers=of levels 1p,'t&p ppppppppppppppppPout mai (I) =CINN actttt. Onm of: 1p,'t&p pppppppppppppppppppppppppppppp omp(1,1,1M,2M tttttt_preserve 1p,'t&p pppppppppppppppppppppppppppppp omp(1,1,1M,2M tttttt 1p,'t&p pppppppppppppppppppppppppppppp omp(1,1,1M,2M tttgrow_preserve 1p,'t&p pppppppppppppppppppppppppppppp omp(1,1,1M,2M tttgrow 1p,'t&p pppppppppppppppppppppppppppppp omp(1,1,1M,NiR su= f_mesN 1p,'t&p pInput/outputp:2ttel (T) 2004y=of TYPENpg(ttel ) 1p,'t&p ppppppppppppppppppppppppppppppwhichiis to be (re)R sugmd.m_slab,N 1p,'t&p pOutputppppppp:2m(2M (I) Return p,atus. 0 t,Feverything OK.m_slab,N 1p,'t&p pRemarksefoGNN:m_slab,N 1p,'t&p pReferencesGNN: 1p,'t&p 1p,'t&p pRevi RetsefoG:m_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppp$Log:n0,-1pg(2M tttttel .f,v $ 1p,'t&pppRevi Ret 1.1.1.1 2007/07/13 10:18:56nnnvos 1p,'t&pppCBLll9m Retuof the defio,0,-1pm_slab,N 1p,'t&pppRevi Ret 1.8 2006/07/21 11:30:57 kotsalie 1p,'t&p pFRIDAYm_slab,N 1p,'t&pppRevi Ret 1.7 2004/10/01 16:33:39nnnvos 1p,'t&pppcosmetics.m_slab,N 1p,'t&p pRevi Ret 1.6 2004/10/01 16:09:10nnnvos 1p,'t&pppReplacmd REAL(ttttklld_double)n:: t0 with REAL(MK)mt0.m_slab,N 1p,'t&p pRevi Ret 1.5 2004/09/22 18:24:06 kotsalie 1p,'t&p pMG newll9m Retm_slab,N 1p,'t&p pRevi Ret 1.4 2004/07/26 13:49:18nnnvos 1p,'t&pppRemovmd1Routinvs sectttts from,the headabbcomment.m_slab,N 1p,'t&p pRevi Ret 1.3 2004/07/26 11:59:39nnnvos 1p,'t&pppFixes to makm it ttttile.m_slab,N 1p,'t&p pRevi Ret 1.2 2004/07/26 07:46:37nnnvos 1p,'t&pppChangmd1to uavesingle-_slabfacm moduras. Updsigd12M -USEnp,atements.m_slab,N 1p,'t&p pRevi Ret 1.1 2004/06/29 14:42:16 kotsalie 1p,'t&p pNeedmd fessmyptype R sugRet 1p,'t&pm_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppCopyright (c) 2010 CSE Lab (ETH Zuricha(2MOSAIC Group (ETH Zuricha(2 1p,'t&pppppppppppppppppppppCeslabbmessFluid Dynafocs (DTU)m_slab,N 1p,'t&p 1p,'t&ppThis firabis -1p =of the d1,1llel d1,ticrabMesh L,0,-1p (def).m_slab,N 1p,'t&p defiis free software: you canpredi_pp_bugm it and/essmodifpm_slab,N it undabbthe labms=of the GNU LessabbGene,1lpPublic L,censa m_slab,N as -xpen,hgd1by the Free Software Fouugttt, either m_slab,N l9m Retu3=of the L,censa, ess(at your IL'Ret) 1li;later m_slab,N l9m Ret.m_slab,N 1p,'t&p defiis di_pp_bugmd1,1,the hope lhat it will be useful, 1p,'t&p bug WITHOUT ANY WARRANTY; withtttteve1,the itttimd1w2004nty=ofe, 1p,'t&lERCHANTABILITY essFITNESS FOR A PARTICULAR PURPOSNm(See lhe 1p,'t&ppGNU Gene,1lpPublic L,censa fessmore details.m_slab,N 1p,'t&p You should9havepreceivmd1a copy=of the GNU Gene,1lpPublic L,censam_slab,N and the GNU LessabbGene,1lpPublic L,censa aIong with def. If999m, 1p,'t&p see .m_slab,N 1p,'t&p d1,1llel d1,ticrabMesh L,0,-1p (def) 1p,'t&p ETH Zurich 1p,'t&ppCH-8092 Zurich, Switzerlandpo,0,-1p9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e(N MMNMBiEmbedSFIEL1Mst,FMMMd!M,NMBiTO 9999m st,FW_MEASURE)Kiiiii LL subfftw_executeSUBROUTINE llllpg(2M tttttel _2 2cmer(ttel tttttsIL't&pppiF0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_slSUBROUTINE llllpg(2M tttttel _2 2cmed(ttel tttttsIL't&pppiF0 ppp&i(alN MMMd!M,NMBiEmbed(1Mst,FW_MEASURE)Kiiiii LL subfftw_executeSUBROUTINE llllpg(2M tttttel _3 2cmer(ttel tttttsIL't&pppiF0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_slSUBROUTINE llllpg(2M tttttel _3 2cmed(ttel tttttsIL't&pppiF0 ppp&i(appp&i(alN MMNMBiEmbedVFIEL1Mst,FMMMd!M,NMBiTO 9999m st,FW_MEASURE)Kiiiii LL subfftw_executeSUBROUTINE llllpg(2M tttttel _2 vecer(ttel tttttsIL't&pppiF0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_slSUBROUTINE llllpg(2M tttttel _2 veced(ttel tttttsIL't&pppiF0 ppp&i(alN MMMd!M,NMBiEmbed(1Mst,FW_MEASURE)Kiiiii LL subfftw_executeSUBROUTINE llllpg(2M tttttel _3 vecer(ttel tttttsIL't&pppiF0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_slSUBROUTINE llllpg(2M tttttel _3 veced(ttel tttttsIL't&pppiF0 ppp&i(appp&i(appp&im_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppIncludeed_slab,MBIstride,MBoDist,FFTW_MEASURE)Kiiiii LL subfftw_executeNPlan_slab_bd_sMKlistnclude "0,-1definv.h"m_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppModuram_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&USEn0,-1podura_oGOTO 9999mUSEn0,-1podura_oGOTlpgO 9999mUSEn0,-1podura_comp,aran_many_USEn0,-1podura_comp,opn_many_USEn0,-1podura_uble0#r=po,0USEn0,-1podura_writem_slab,fIMPLICIT NONEmst,FFTTW_MEASURE)Kiiiii LL subfftw_ |TW_MEASURE)Kiiiii LL subfftw__COMPLEX_slab,fINTEGER, PARAMETER :: MK ttttttklld_singlei(alsam_slab,INTEGER, PARAMETER :: MK ttttttklld_doubleF0 ppp&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppArgumentsp,'t&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&INTEGERomai innnnnnnnnn, DIMENNNoE(: ), INTENT(IE999)n:: lda 1p,'t&INTEGERomai innnnnnnnnnmai innnnnnnnnn, INTENT(IE999)n:: sIL'e(N MMNMBiEmbedSFIEL1Mst,FMMMd!M,NMBiO 9999m st,FW_MEASUREKiiiii LL subfftw_ 1p,'t&TYPENpg(ttel _2 2cmer), DIMENNNoE(:,:), POINTER :: ttel 0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_slTYPENpg(ttel _2 2cmed), DIMENNNoE(:,:), POINTER :: ttel 0 ppp&i(alN MMMd!M,NMBiEmbed(1Mst,FW_MEASUREKiiiii LL subfftw_executeTYPENpg(ttel _3 2cmer), DIMENNNoE(:,:), POINTER :: ttel =rist,FFTW_MEASURE)Klies e,foGNNNoEmbed_slTYPENpg(ttel _3 2cmed),DIMENNNoE(:,:), POINTER n:: ttel 0 ppp&i(appp&i(alN MMNMBiEmbedVFIEL1Mst,FMMMd!M,NMBiO 9999m st,FW_MEASUREKiiiii LL subfftw_mbed_slTYPENpg(ttel _2 vecer), DIMENNNoE(:,:), POINTER :: ttel 0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_slTYPENpg(ttel _2 veced), DIMENNNoE(:,:), POINTER :: ttel 0 ppp&i(alN MMMd!M,NMBiEmbed(1Mst,FW_MEASUREKiiiii LL subfftw_executeTYPENpg(ttel _3 vecer), DIMENNNoE(:,:), POINTER :: ttel 0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_slTYPENpg(ttel _3 veced),DIMENNNoE(:,:), POINTER n:: ttel 0 ppp&i(appp&i(appp&im 1p,'t&INTEGERomai innnnnnnnnnmai innnn, INTENT( OUT)n:: &ppp_slab,fNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppLoc1lpvariparas&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&INTEGERomai innnnnnnn:: &,jm_slab,INTEGER, DIMENNNoE(2)n:: ld= f_mesREAL(MK)mai innnnnnnn:: t0 O(N MMNMBiEmbedSFIEL1Mst,FMMMd!M,NMBiO 9999m st,FW_MEASUREKiiiii LL subfftw_ 1p,'t&TYPENpg(ttel _2 2cmer), DIMENNNoE(:,:), POINTER :: OTO _ttel 0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_slTYPENpg(ttel _2 2cmed), DIMENNNoE(:,:), POINTER :: OTO _ttel 0 ppp&i(alN MMMd!M,NMBiEmbed(1Mst,FW_MEASUREKiiiii LL subfftw_executeTYPENpg(ttel _3 2cmer), DIMENNNoE(:,:), POINTER :: OTO _ttel 0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_slTYPENpg(ttel _3 2cmed), DIMENNNoE(:,:), POINTER :: OTO _ttel 0 ppp&i(appp&i(alN MMNMBiEmbedVFIEL1Mst,FMMMd!M,NMBiO 9999m st,FW_MEASUREKiiiii LL subfftw_mbed_slTYPENpg(ttel _2 vecer), DIMENNNoE(:,:), POINTER :: OTO _ttel 0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_slTYPENpg(ttel _2 veced), DIMENNNoE(:,:), POINTER :: OTO _ttel 0 ppp&i(alN MMMd!M,NMBiEmbed(1Mst,FW_MEASUREKiiiii LL subfftw_executeTYPENpg(ttel _3 vecer), DIMENNNoE(:,:), POINTER :: OTO _ttel 0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_slTYPENpg(ttel _3 veced), DIMENNNoE(:,:), POINTER :: OTO _ttel 0 ppp&i(appp&i(appp&im_slab,LOGICALi innnnnnnn:: lcopy,l(Plan_lrr(Plan_lNiR su= f_mesNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppExternals&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&m_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppIn::i1lisa m_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&h%Nm(comp,arallllllpg(2M tttttel Its_xyslabM_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppCmin_ argumentsm_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&IF (0,-1debug .GT. 0 .AND.pPout=NNm(mp(1,1,1M,NiR suM/2+1Ki=CINNNmmcoIF (SIZE(tttt1) .LT. 2M/2+1Ki=CINNNmmcoGNN'm(2M tttttttt=NNmuble0#r=po,0,-1p,'t&h%Nm(ttttttt=NNm(3MKi=CIrgument,lllllpg(2M tttttel ImmdeeYsoc,fo) MKlies e'ttt must be at least=of length 2GNNNNpartptttttttttttt= 0,fffffN kind_double0#rrrrr=po,0,-CINNNmmcoIF ( bsnot.LT. 1M/2+1Ki=CINNNmmcoGNN'm(2M tttttttt=NNmuble0#r=po,0,-1p,'t&h%Nm(ttttttt=NNm(3MKi=CIrgument,lllllpg(2M tttttel ImmdeeYsoc,fo) MKlies e'tttsnotmust be >= 0GNNNNpartptttttttttttt= 0,fffffN kind_double0#rrrrr=po,0,-CINNNmmcoIF ( bs2ot.LT. 1M/2+1Ki=CINNNmmcoGNN'm(2M tttttttt=NNmuble0#r=po,0,-1p,'t&h%Nm(ttttttt=NNm(3MKi=CIrgument,lllllpg(2M tttttel ImmdeeYsoc,fo) MKlies e'ttts2otmust be >= 0GNNNNpartptttttttttttt= 0,fffffN kind_double0#rrrrr=po,0,-CINNN=po,0,M_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppCmin_ a sugRetutype 1p,'t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&lcopy,'t&= .FALSE.m_slab,l(Plan't&= .FALSE.m_slab,lrr(Plan&= .FALSE.m_slab,ldr(Plan&= .FALSE.m_slab, ttttPout=EQ.omp(1,1,1M,2M tttttt_preserveM/2+1Ki=CINNNmmcopMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDi=CINNNmmcopppFit memorG and preserve the present ttntentsm_slab,,'copMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDi=CINNNmmco tttASSOCIATED(ttel )M/2+1Ki=CINNNmmcoGNN'ld(notraSIZE(ttel t1)oGNNN mNN'NN'ld(2otraSIZE(ttel t2)_slab,foGNN'NN' ttt(ld(not=NNm(tttsnoot=OR. (ld(2ot=NNm(ttts2))M/2+1Ki=CINNNmmcoGNN'lab,l(Plan't&= .TRUE.m_slab,mmcoGNN'lab,lrr(Plan&= .TRUE.m_slab,mmcoGNN'lab,lcopy,'t&= .TRUE.m_slab,mmcoGNN'=po,0,-CINNNmmcoELSEi=CINNNmmcoGNN'l(Plan&= .TRUE.m_slab,mmco=po,0,-CINNN=LSEIFtttPout=EQ.omp(1,1,1M,2M ttttttM/2+1Ki=CINNNmmcopMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDi=CINNNmmcopppFit memorG and di2cmrd the present ttntentsm_slab,,'copMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDi=CINNNmmco tttASSOCIATED(ttel )M/2+1Ki=CINNNmmcoGNN'ld(notraSIZE(ttel t1)oGNNN mNN'NN'ld(2otraSIZE(ttel t2)_slab,foGNN'NN' ttt(ld(not=NNm(tttsnoot=OR. (ld(2ot=NNm(ttts2))M/2+1Ki=CINNNmmcoGNN'lab,l(Plan't&= .TRUE.m_slab,mmcoGNN'lab,lrr(Plan&= .TRUE.m_slab,mmcoGNN'lab,ldr(Plan&= .TRUE.m_slab,mmcoGNN'=po,0,-CINNNmmcoELSEi=CINNNmmcoGNN'l(Plan&= .TRUE.m_slab,mmco=po,0,-CINNN=LSEIFtttPout=EQ.omp(1,1,1M,2M tttgrow_preserveM/2+1Ki=CINNNmmcopMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDi=CINNNmmcopppFit memorG and preserve the present ttntentsm_slab,,'copMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDi=CINNNmmco tttASSOCIATED(ttel )M/2+1Ki=CINNNmmcoGNN'ld(notraSIZE(ttel t1)oGNNN mNN'NN'ld(2otraSIZE(ttel t2)_slab,foGNN'NN' ttt(ld(not=LT. tttsnoot=OR. (ld(2ot=LT. ttts2))M/2+1Ki=CINNNmmcoGNN'lab,l(Plan't&= .TRUE.m_slab,mmcoGNN'lab,lrr(Plan&= .TRUE.m_slab,mmcoGNN'lab,lcopy,'t&= .TRUE.m_slab,mmcoGNN'=po,0,-CINNNmmcoELSEi=CINNNmmcoGNN'l(Plan&= .TRUE.m_slab,mmco=po,0,-CINNN=LSEIFtttPout=EQ.omp(1,1,1M,2M tttgrowM/2+1Ki=CINNNmmcopMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDi=CINNNmmcopppFit memorG and di2cmrd the present ttntentsm_slab,,'copMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDi=CINNNmmco tttASSOCIATED(ttel )M/2+1Ki=CINNNmmcoGNN'ld(notraSIZE(ttel t1)oGNNN mNN'NN'ld(2otraSIZE(ttel t2)_slab,foGNN'NN' ttt(ld(not=LT. tttsnoot=OR. (ld(2ot=LT. ttts2))M/2+1Ki=CINNNmmcoGNN'lab,l(Plan't&= .TRUE.m_slab,mmcoGNN'lab,lrr(Plan&= .TRUE.m_slab,mmcoGNN'lab,ldr(Plan&= .TRUE.m_slab,mmcoGNN'=po,0,-CINNNmmcoELSEi=CINNNmmcoGNN'l(Plan&= .TRUE.m_slab,mmco=po,0,-CINNN=LSEIFtttPout=EQ.omp(1,1,1M,NiR suM/2+1Ki=CINNNmmcopMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDi=CINNNmmcopppppR sugmm_slab,,'copMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDi=CINNNmmco tttASSOCIATED(ttel )M/2+1Ki=CINNNmmcoGNN'ld(notraSIZE(ttel t1)oGNNN mNN'NN'ld(2otraSIZE(ttel t2)_slab,foGNN'NN'lrr(Plan&= .TRUE.m_slab,mmcoGNN'ldr(Plan&= .TRUE.m_slab,mmco=po,0,-CINNN=po,0,_slab,mmcoGNN'M_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppPerform,the actual =CINN acttttm_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&IF (lR suM/2+1Ki=CINNNmmcopMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDi=CINNNmmcopppA sugm newl2004y=with newll,ld and nullify12M -membersi=CINNNmmcopMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDi=CINNNmmco%NmOCATE(OTO _ttel ( bsno,ttts2)),STAT=ttttttttttt= 0,f tttttttt=NNm(1M/2+1Ki=CINNNmmcooooom(2M tttttttt=NNmfatali=CINNNmmcoooooh%Nm(ttttttt=NNm(3MKi=CIPlan_,2I4)pg(2M tttttel ImmdeeYsoc,fo) MKlies e'newlmgttel WORKMMd!MGNNNNpartptttttttttttt= 0,fffffN kind_double0#rrrrr=po,0,-CINNNmmcoDO'j=1,ttts2)tttttt= 0,fffffDO'i=1, bsnom_slab,mmcoGNN'lab,NULLIFY(OTO _ttel (i,j)%ucom_slab,mmcoGNN'lab,NULLIFY(OTO _ttel (i,j)%fcom_slab,mmcoGNN'lab,NULLIFY(OTO _ttel (i,j)%Ki=om_slab,mmcoGNN'lab,NULLIFY(OTO _ttel (i,j)%bcvalueom_slab,mmcoGNN'=poDO b,mmcoGNN'=poDO b,mmco=po,0,M_slab,IF (lcopyM/2+1Ki=CINNNmmcopMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDi=CINNNmmcopppSave the ol ttntentsm_slab,,'copMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDi=CINNNmmcoDO'j=1,MIN(ld(2o,ttts2))tttttt= 0,fffffDO'i=1,MIN(ld(no,ttts1))tttttt= 0,fffffffffOTO _ttel (i,j)%uc =>tttel (i,j)%uctttttt= 0,fffffffffOTO _ttel (i,j)%fc =>tttel (i,j)%fctttttt= 0,fffffffffOTO _ttel (i,j)%Ki= =>tttel (i,j)%Ki=tttttt= 0,fffffffffOTO _ttel (i,j)%bcvalue =>tttel (i,j)%bcvaluem_slab,mmcoGNN'=poDO b,mmcoGNN'=poDO b,mmco=po,0,b,mmcoIF ( iR suM/2+1Ki=CINNNmmcopMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDi=CINNNmmcopppppR sugm the ol ttntentsm_slab,,'copMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDi=CINNNmmcoDO'j=1,ld(2otttttt= 0,fffffDO'i=1, csnom_slab,mmcoGNN'lab, tttASSOCIATED(ttel (i,j)%ucoM/2+1Ki=CINNNmmcoGNN'NN',,',,DE%NmOCATE(ttel (i,j)%uc,STAT=ttttttttttt= 0,fmmcoGNN'lab, tttttttt=NNm(1M/2+1Ki=CINNNmmcooooooooooooooooom(2M tttttttt=NNmuble0#r=po,0,-1p,'t&&&&&&&&&&&&&(3M tttttttt=NNm(3MKi=C2r(Plan_,2I4)pg(2M tttttel I,foGNNN Decomposefdomai innn'ttel correcgRetuFIEL1%UCGNNNNpartptttttttttttt= 0,fffffffffffff=po,0,_slab,mmcoGNN'''''''''NULLIFY(ttel (i,j)%ucom_slab,mmcoGNN'lab,=po,0,_slab,mmcoGNN''''' tttASSOCIATED(ttel (i,j)%fcoM/2+1Ki=CINNNmmcoGNN'NN',,',,DE%NmOCATE(ttel (i,j)%fc,STAT=ttttttttttt= 0,fmmcoGNN'lab, tttttttt=NNm(1M/2+1Ki=CINNNmmcooooooooooooooooom(2M tttttttt=NNmuble0#r=po,0,-1p,'t&&&&&&&&&&&&&(3M tttttttt=NNm(3MKi=C2r(Plan_,2I4)pg(2M tttttel I,foGNNN Decomposefdomai innn'att=N restricgRetuFIEL1%FCGNNNNpartptttttttttttt= 0,fffffffffffff=po,0,_slab,mmcoGNN'''''''''NULLIFY(ttel (i,j)%fcom_slab,mmcoGNN'lab,=po,0,_slab,mmcoGNN''''' tttASSOCIATED(ttel (i,j)%Ki=oM/2+1Ki=CINNNmmcoGNN'NN',,',,DE%NmOCATE(ttel (i,j)%Ki=,STAT=ttttttttttt= 0,fmmcoGNN'lab, tttttttt=NNm(1M/2+1Ki=CINNNmmcooooooooooooooooom(2M tttttttt=NNmuble0#r=po,0,-1p,'t&&&&&&&&&&&&&(3M tttttttt=NNm(3MKi=C2r(Plan_,2I4)pg(2M tttttel I,foGNNN Decomposefdomai innn'residual FIEL1%ERRGNNNNpartptttttttttttt= 0,fffffffffffff=po,0,_slab,mmcoGNN'''''''''NULLIFY(ttel (i,j)%Ki=om_slab,mmcoGNN'lab,=po,0,_slab,mmcoGNN''''' tttASSOCIATED(ttel (i,j)%bcvalueoM/2+1Ki=CINNNmmcoGNN'NN',,',,DE%NmOCATE(ttel (i,j)%bcvalue,STAT=ttttttttttt= 0,fmmcoGNN'lab, tttttttt=NNm(1M/2+1Ki=CINNNmmcooooooooooooooooom(2M tttttttt=NNmuble0#r=po,0,-1p,'t&&&&&&&&&&&&&(3M tttttttt=NNm(3MKi=C2r(Plan_,2I4)pg(2M tttttel I,foGNNN Decomposefdomai innn'bouu-1p values FIEL1%BCVALUEGNNNNpartptttttttttttt= 0,fffffffffffff=po,0,_slab,mmcoGNN'''''''''NULLIFY(ttel (i,j)%bcvalueom_slab,mmcoGNN'ffff=po,0,_slab,mmcoGNN'=poDO b,mmcoGNN'=poDO b,mmco=po,0,M_slab,IF (lriR suM/2+1Ki=CINNNmmcopMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDi=CINNNmmcopppppR sugm ol po_slabl2004ym_slab,,'copMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDi=CINNNmmcoDE%NmOCATE(ttel ,STAT=ttttttttttt= 0,f tttttttt=NNm(1M/2+1Ki=CINNNmmcooooom(2M tttttttt=NNmuble0#r=po,0,-1p,'t&h%Nm(ttttttt=NNm(3MKi=C2r(Plan_,2I4)pg(2M tttttel ImmdeeYsoc,fo) MKlies e'mgttel s(1),FIEL1GNNNNpartptttttttttttt= 0,f=po,0,_slab,mmcoNULLIFY(ttel ) b,mmco=po,0,M_slab,IF (lR suM/2+1Ki=CINNNmmcopMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDi=CINNNmmcopppPo_sl result1to newl2004yi=CINNNmmcopMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDi=CINNNmmcottel =>tOTO _ttel b,mmco=po,0,M_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppReturn M_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1d_do/hONTINUEi=CINNNh%Nm(comp,opllllllpg(2M tttttel Its_xyslab=CINNNRETURNO(N MMNMBiEmbedSFIEL1Mst,FMMMd!M,NMBiO 9999m st,FW_MEASURE)Kiiiii LL subfftw_execute=po SUBROUTINE llllpg(2M tttttel _2 2cmeri(alN FFTW_MEASURE)Klies e,foGNNNoEexecute=po SUBROUTINE llllpg(2M tttttel _2 2cme 0 ppp&i(alN MMMd!M,NMBiEmbed(1Mst,F FTW_MEASURE)Kiiiii LL subfftw_execute=po SUBROUTINE llllpg(2M tttttel _3 2cmeri(alN FFTW_MEASURE)Klies e,foGNNNoEexecute=po SUBROUTINE llllpg(2M tttttel _3 2cme 0 ppp&i(appp&i(alN MMNMBiEmbedVFIEL1Mst,FMMMd!M,NMBiO 9999m st,FW_MEASURE)Kiiiii LL subfftw_execute=po SUBROUTINE llllpg(2M tttttel _2 veceri(alN FFTW_MEASURE)Klies e,foGNNNoEexecute=po SUBROUTINE llllpg(2M tttttel _2 veced 0 ppp&i(alN MMMd!M,NMBiEmbed(1Mst,F FTW_MEASURE)Kiiiii LL subfftw_execute=po SUBROUTINE llllpg(2M tttttel _3 veceri(alN FFTW_MEASURE)Klies e,foGNNNoEexecute=po SUBROUTINE llllpg(2M tttttel _3 veced 0 ppp&i(appp&i(appp&im liblllnumerics-r1036/src/0,-1podura_pg(restricg.f0000644000175000017500000000665711616214650021057 0u 20 omaromar_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppModuraCINNNmmco:nnnnnnnnnnnn0,-1podura_pg(restricgM_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&p 1p,'t&p 1p,'t&ppPuri(avefoGNNo:nmultigrid modura 1p,'t&pppppppppppppppp 1p,'t&p 1p,'t&ppRemarksefoGNNN: 1p,'t&p 1p,'t&p ReferencesGNNN:nm_slab,N 1p,'t&p Revi RetsefoGG:m_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppp$Log:n0,-1podura_pg(restricg.f,v $ 1p,'t&pppRevi Ret 1.1.1.1 2007/07/13 10:19:00nnnvos 1p,'t&pppCBLll9m Retuof the defio,0,-1pm_slab,N 1p,'t&pppRevi Ret 1.1 2004/09/22 18:36:53 kotsalie 1p,'t&p pMG newll9m Retm_slab,N 1p,'t&pm_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppCopyright (c) 2010 CSE Lab (ETH Zuricha(2MOSAIC Group (ETH Zuricha(2 1p,'t&pppppppppppppppppppppCeslabbmessFluid Dynafocs (DTU)m_slab,N 1p,'t&p 1p,'t&ppThis firabis -1p =of the d1,1llel d1,ticrabMesh L,0,-1p (def).m_slab,N 1p,'t&p defiis free software: you canpredi_pp_bugm it and/essmodifpm_slab,N it undabbthe labms=of the GNU LessabbGene,1lpPublic L,censa m_slab,N as -xpen,hgd1by the Free Software Fouugttt, either m_slab,N l9m Retu3=of the L,censa, ess(at your IL'Ret) 1li;later m_slab,N l9m Ret.m_slab,N 1p,'t&p defiis di_pp_bugmd1,1,the hope lhat it will be useful, 1p,'t&p bug WITHOUT ANY WARRANTY; withtttteve1,the itttimd1w2004nty=ofe, 1p,'t&lERCHANTABILITY essFITNESS FOR A PARTICULAR PURPOSNm(See lhe 1p,'t&ppGNU Gene,1lpPublic L,censa fessmore details.m_slab,N 1p,'t&p You should9havepreceivmd1a copy=of the GNU Gene,1lpPublic L,censam_slab,N and the GNU LessabbGene,1lpPublic L,censa aIong with def. If999m, 1p,'t&p see .m_slab,N 1p,'t&p d1,1llel d1,ticrabMesh L,0,-1p (def) 1p,'t&p ETH Zurich 1p,'t&ppCH-8092 Zurich, Switzerlandpo,0,-1p9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e #definv)Kiiiii LL subfftw_ 1 #definv)KiKlies e,foGNNNoE92 #definv)KiINTEGERomai innn3 #definv)KiLOGICALi innnnnn4 #definv)Ki2D 7 #definv)Ki3D 8 #definv)KiiFIEL1 9 #definv)KiVFIEL1 10 MODULEn0,-1podura_pg(restricg pp 1p9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N , 1p!Moduras 1p9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N ,N , 1p9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N ,N , t&ppINCLUDE/2+1 SOURCES 1p9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N ,N , hONTAINS #definv)KiNMBiedSFIEL1Msdefinv)KiMd!M,NMBi999m sdefinv)KiW_MEAKiiiii LL subfftw_estnclude "0,-1pg(restricg.f" #unda,FW_MEAS sdefinv)KiW_MEAKiKlies e,foGNNNoEestnclude "0,-1pg(restricg.f" #unda,FW_MEAS #unda,FW_Md!M,NMB Msdefinv)KiMd!M,NMBi993m sdefinv)KiW_MEAKiiiii LL subfftw_estnclude "0,-1pg(restricg.f" #unda,FW_MEAS sdefinv)KiW_MEAKiKlies e,foGNNNoEestnclude "0,-1pg(restricg.f" #unda,FW_MEAS #unda,FW_Md!M,NMB #unda,FW_NMB M #definv)KiNMBiedVFIEL1Msdefinv)KiMd!M,NMBi999m sdefinv)KiW_MEAKiiiii LL subfftw_estnclude "0,-1pg(restricg.f" #unda,FW_MEAS sdefinv)KiW_MEAKiKlies e,foGNNNoEestnclude "0,-1pg(restricg.f" #unda,FW_MEAS #unda,FW_Md!M,NMB Msdefinv)KiMd!M,NMBi993m sdefinv)KiW_MEAKiiiii LL subfftw_estnclude "0,-1pg(restricg.f" #unda,FW_MEAS sdefinv)KiW_MEAKiKlies e,foGNNNoEestnclude "0,-1pg(restricg.f" #unda,FW_MEAS #unda,FW_Md!M,NMB #unda,FW_NMB M =po MODULEn0,-1podura_pg(restricgim liblllnumerics-r1036/src/0,-1hamjac_ext_step_3d.f0000644000175000017500000002251011616214650020676 0u 20 omaromar,0,-1p9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e1p,'t&ppppppSubroutinvefo:nnnnnnnnnnnnnn0,-1hamjac_ext_step_3dm_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppp 2 1p,'t&ppppppPuri(avefoGNN:nExten Retm_slab,N pp 2 1p,'t&ppppppInputpppppppp:2 1p,'t&ppppppppppppppppppppp 1p,'t&ppppppInput/Outputp:2 1p,'t&ppppppppppppppppppppp 1p,'t&ppppppOutputppppppp:2m_slab,N pp 2 1p,'t&ppppppRemarksefoGNN:2 1p,'t&ppppppppppppppppppppp 1p,'t&pppppp 1p,'t&ppppppReferencesGNN: 1p,'t&pppppp 1p,'t&ppppppRevi RetsefoG:m_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppp pp$Log:n0,-1hamjac_ext_step_3d.f,v $ 1p,'t&ppp ppRevi Ret 1.1.1.1 2007/07/13 10:18:55nnnvos 1p,'t&ppp ppCBLll9m Retuof the defio,0,-1pm_slab,N 1p,'t&ppp pRevi Ret 1.3 2006/03/27 08:17:33 mfochaeba 1p,'t&ppppppbug fixm_slab,N 1p,'t&ppp pRevi Ret 1.2 2005/08/12 14:38:00nnnvos 1p,'t&ppppppbugfix: &pdex bouus1,1,loop correcgmd.m_slab,N 1p,'t&p p ppRevi Ret 1.1 2005/07/25 00:34:01nnnvos 1p,'t&ppppppIn::i1l cmin_-it.m_slab,N 1p,'t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppp ppd1,1llel d1,ticrabMesh L,0,-1p (def) 1p,'t&p ppppInstitugm of Computgttt1l Science 1p,'t&p ppppETH Zentrum, Hirscmingrabe1,84 1p,'t&ppp ppCH-8092 Zurich, Switzerlandp1p,'t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, st,FFTW_MODEURE)KiiCAMst,FFTW_MEASURE)Kiiiii LL subfftw_executeSUBROUTINE llllhamjac_ext_step_3ds (phi, psi, tpsi, res,m&_slab,foGNN' Decomposefdomai innn oGt_st_id, fdsolve, ghostl,ld, &pppiF0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_slSUBROUTINE llllhamjac_ext_step_3dd (phi, psi, tpsi, res,m&_slab,foGNN' Decomposefdomai innn oGt_st_id, fdsolve, ghostl,ld, &pppiF0 ppp&i(alN MMMODEURE)KiVECMst,FFTW_MEASURE)Kiiiii LL subfftw_executeSUBROUTINE llllhamjac_ext_step_3dsv (phi, psi, tttt tpsi, res,m&_slab,foGNN' Decomposefdomai innn oGt_st_id, fdsolve, ghostl,ld, &pppiF0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_slSUBROUTINE llllhamjac_ext_step_3ddv (phi, psi, tttt tpsi, res,m&_slab,foGNN' Decomposefdomai innn oGt_st_id, fdsolve, ghostl,ld, &pppiF0 ppp&i(appp&i innn oGUSEn0,-1podura_oGOTO 9999m moGNNN mUSEn0,-1podura_comp,aran_many_y_USEn0,-1podura_comp,opn_many_y_USEn0,-1podura_uble0#r=po,0y_USEn0,-1podura_R su= f_mesy_USEn0,-1podura_typeda,= f_mesy_IMPLICIT NONEmst,FFTTW_MEASURE)Kiiiii LL subfftw_= f_mesy_INTEGER, PARAMETER :: MK ttttttklld_singlei(alN FFTW_MEASURE)Klies e,foGNNNoE9999m moGNNN mINTEGER, PARAMETER :: MK ttttttklld_doubleF0 ppp&i_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slai_slab,t&pppArgumentsi_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slai_slab,t&REAL(MK), DIMENNNoE(:,:,:,:), POINTER :: phi st,FFTW_MODEURE)KiiCAM_slab,t&REAL(mkM, DIMENNNoE(:,:,:,: ), POINTER :: psi, tpsii(alN MMMODEURE)KiVECM_slab,t&REAL(mkM, DIMENNNoE(:,:,:,:,:), POINTER :: psi, tpsiiGNNN mINTEGER, INTENT(in)mai innnnnnnnnnnnnn:: lda 0 ppp&i_slab,t&INTEGER, INTENT(in)mai innnnnnnnnnnnn:: t_st_id, fdsolvei_slab,t&INTEGER, DIMENNNoE(3), INTENT(in)mai :: ghostl,ldi_slab,t&INTEGER, INTENT(inout)mai innnnnnnnnn:: &ppp_slab,ft&REAL(mkM,INTENT(out)mai innnnnnnnnnnn:: resi_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slai_slab,t&pppA iasesi_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slai_slab,t&INTEGER, DIMENNNoE(:), POINTER nnnn:: &sxpen,ti_slab,t&INTEGERmai innnnnnnnnnnnnnnnnnnnnnnnn:: nsxpen,ti_slab,t&INTEGER, DIMENNNoE(:,:), POINTER nnnn:: noGOTO 9999m mINTEGERmai innnnnnnnnnnnnnnnnnnnnnnnn:: fdsovei_slab,t&REAL(mkM, DIMENNNoE(:), POINTER nnnnnn:: fin_phys,mmax_physi_slab,t&TYPENttttt_t_st), POINTER nnnnnnn:: t_sti_slab,t&TYPENttttt_equi_fdso), POINTER nnnnnnn:: fdsoi_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slai_slab,t&pppp,au-1dpp,uf&i_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slai_slab,t&INTEGERmai innnnnnnnnnnnnnnnnnnnnnnnn:: &sxp,i_idl,i,j,ki_slab,t&REAL(mkMai innnnnnnnnnnnnnnnnnnnnnnnn:: len_phys(3)_slab,foGpMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slai_slab,t&pppWENOpp,uf&i_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slai_slab,t&REAL(mkMa:: oneg(3),'osts(3o,mwenoeps,mwenotau,'pbs, n(3)_slab,foGREAL(mkMa:: laps(-1:y-3P, rsts(3o,mrneg(3),'dx(3),'dxi(3)_slab,foGREAL(mkMa:: phip(3),'phin(3),'phimid(3o, rms, sijmst,FFTTW_MODEURE)KiiCAM_slab,t&REAL(MK)m:: dphi_dtl(alN MMMODEURE)KiVECM_slab,t&REAL(mkMm:: dphi_dt(10iF0 ppp&_slab,t&i_slab,t&INTEGERma:: &lapoGNNN mINTEGER, PARAMETER, DIMENNNoE(3-3Pa:: offsm&_slab,foGNN'NN& ttRESHAPEN(/2,1,0,1,0,-1,0,-1,-2/),(/3-3/))_slab,foGREAL(mkMa:: t0,'dxavg_slab,foGdphi_dt== 004/mkoGNNN mh%Nm(comp,arallllllhamjac_ext_step_3d Its_xyslab=CINNNoGpMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slai_slab,t&pppGet the fdso oGOTO 9999m mpMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slai_slab,t&t_st =>tttttt_st(t_st_id)%ti_slab,t&fdso =>tt_st%fdso(fdsolve)i_slab,t&fdsoid== fdso%IDi_slab,t&nsxpen,t== t_st%nsxpen,ti_slab,t&noGOTb,t&=>tfdso%nnodesi_slab,t&isxpen,t==>tt_st%&sxpen,tist,FFTTW_MEASURE)Kiiiii LL subfftw_= f_mesy_fin_phys =>tt_st%fin_physsi_slab,t&max_phys =>tt_st%fax_physri(alN FFTW_MEASURE)Klies e,foGNNNoEslab,t&i_slab,t&fin_phys =>tt_st%fin_physdi_slab,t&max_phys =>tt_st%fax_physd 0 ppp&i_slab,t&len_phys(notrafax_phys(not-mfin_physsnom_slab,mmlen_phys(2otrafax_phys(2ot-mfin_physs2om_slab,mmlen_phys(3otrafax_phys(3ot-mfin_physs3)_slab,foGdx(nottttttt=&len_phys(no/REAL(mdso%nm(no-1,mkM_slab,foGdx(2ottttttt=&len_phys(2o/REAL(mdso%nm(2o-1,mkM_slab,foGdx(3ottttttt=&len_phys(3o/REAL(mdso%nm(3o-1,mkM_slab,foGdxavgttttttt=&SUM(dx(n:3))/304/mkoGNNN mdxi(1)tttttt=&104/mk/dx(nooGNNN mdxi(2)tttttt=&104/mk/dx(2ooGNNN mdxi(3)tttttt=&104/mk/dx(3)_slab,foGwenoepst=&104e-6/mkoGNNN mwenotauira0.5/mk*MINVAL(dx)_slab,foGrms== -HUGE(rms)_slab,foGDO'isxp=1,nsxpen,ti_slab,t& t&isxpe== o_iden,t(i_id)i_slab,t& t&DO'k=1,noGOT(3-o_ideotttttt= 0,fffffDO'j=1,noGOT(2-o_ideotttttt= 0,fffff ffDO'i=1,noGOT(1-o_ideotttttt= 0,fffff ff ,'IF(ABS(phi(i,j,k,i_id)).GT.704/mk*dx(no) CYCLEi=CINNNmmcoGNN'NN',,'! TODO'replacm,the h-1dcodmd 71by an argumenttttttt= 0,fffff ff ,'IF(ABS(phi(i,j,k,i_id)).LT.dx(no) 2+1Kist,FFTW_MODEURE)KiiCAM_slab,t&&&&&&&&&&&&&&&&tpsi(i,j,k,i_id)m=apsi(i,j,k,i_id)i(alN MMMODEURE)KiVECM_slab,t&&&&&&&&&&&&&&&&tpsi(1:tttts,j,k,i_id)m=apsi(1:tttts,j,k,i_id) 0 ppp&i_slab,t&&&&&&&&&&&&&ELSEi=CINNNmmcoGNN'NN',,'phimid(1)m=aphi(i+1,j,k,i_id)-phi(i-1,j,k,i_id)i=CINNNmmcoGNN'NN',,'phimid(2)m=aphi(i,j+1,k,i_id)-phi(i,j-1,k,i_id)i=CINNNmmcoGNN'NN',,'phimid(3)m=aphi(i,j,k+1,i_id)-phi(i,j,k-1,i_id)i=CINNNmmcoGNN'NN',,'sij'NN',,'=aphi(i,j,k,i_id)m&_slab,foGNN'NN',,',,''''''&'''''''/SQRT(phi(i,j,k,i_id)**2+dxavg**2)_slab,foGNN'NN',,',,'nNN',,',,'='phimid /'SQRT(SUM(phimid**2))ist,FFTW_MODEURE)KiiCAM_slab,t&&&&&&&&&&&&&dphi_dt=,,'='&_slab,foGNN'NN',,',,''''''&'MAX(n(1)*sij,004/mkM*dxi(1)*,',,''''''&_slab,foGNN'NN',,',,''''''&'(psi(i,j,k,i_id)-psi(i-1,j,k,i_id)) +'&_slab,foGNN'NN',,',,''''''&'MIN(n(1)*sij,004/mkM*dxi(1)*,',,''''''&_slab,foGNN'NN',,',,''''''&'(psi(i+1,j,k,i_id)-psi(i,j,k,i_id)) +'&_slab,foGNN'NN',,',,''''''&'MAX(n(2)*sij,004/mkM*dxi(2)*,',,''''''&_slab,foGNN'NN',,',,''''''&'(psi(i,j,k,i_id)-psi(i,j-1,k,i_id)) +'&_slab,foGNN'NN',,',,''''''&'MIN(n(2)*sij,004/mkM*dxi(2)*,',,''''''&_slab,foGNN'NN',,',,''''''&'(psi(i,j+1,k,i_id)-psi(i,j,k,i_id)) +'&_slab,foGNN'NN',,',,''''''&'MAX(n(3)*sij,004/mkM*dxi(3)*,',,''''''&_slab,foGNN'NN',,',,''''''&'(psi(i,j,k,i_id)-psi(i,j,k-1,i_id)) +'&_slab,foGNN'NN',,',,''''''&'MIN(n(3)*sij,004/mkM*dxi(3)*,',,''''''&_slab,foGNN'NN',,',,''''''&'(psi(i,j,k+1,i_id)-psi(i,j,k,i_id)) _slab,foGNN'NN',,',,'tpsi(i,j,k,i_id)m=apsi(i,j,k,i_id)m-mwenotaui* dphi_dtlslab,foGNN'NN',,',,'rms== MAX(rms,ABS(dphi_dt))_(alN MMMODEURE)KiVECM_slab,t&&&&&&&&&&&&&dphi_dt(1:ttt)tttt='&_slab,foGNN'NN',,',,''''''&'MAX(n(1)*sij,004/mkM*dxi(1)*,',,''''''&_slab,foGNN'NN',,',,''''''&'(psi(1:tttts,j,k,i_id)-psi(1:tttts-1,j,k,i_id)) +'&_slab,foGNN'NN',,',,''''''&'MIN(n(1)*sij,004/mkM*dxi(1)*,',,''''''&_slab,foGNN'NN',,',,''''''&'(psi(1:tttts+1,j,k,i_id)-psi(1:tttts,j,k,i_id)) +'&_slab,foGNN'NN',,',,''''''&'MAX(n(2)*sij,004/mkM*dxi(2)*,',,''''''&_slab,foGNN'NN',,',,''''''&'(psi(1:tttts,j,k,i_id)-psi(1:tttts,j-1,k,i_id)) +'&_slab,foGNN'NN',,',,''''''&'MIN(n(2)*sij,004/mkM*dxi(2)*,',,''''''&_slab,foGNN'NN',,',,''''''&'(psi(1:tttts,j+1,k,i_id)-psi(1:tttts,j,k,i_id)) +'&_slab,foGNN'NN',,',,''''''&'MAX(n(3)*sij,004/mkM*dxi(3)*,',,''''''&_slab,foGNN'NN',,',,''''''&'(psi(1:tttts,j,k,i_id)-psi(1:tttts,j,k-1,i_id)) +'&_slab,foGNN'NN',,',,''''''&'MIN(n(3)*sij,004/mkM*dxi(3)*,',,''''''&_slab,foGNN'NN',,',,''''''&'(psi(1:tttts,j,k+1,i_id)-psi(1:tttts,j,k,i_id)) _slab,foGNN'NN',,',,'tpsi(1:tttts,j,k,i_id)m=apsi(1:tttts,j,k,i_id)'&_slab,foGNN'NN',,',,''''''&'-mwenotaui* dphi_dt(1:ttt)lslab,foGNN'NN',,',,'rms== MAX(rms,SUM(ABS(dphi_dt))) 0 ppp&i_slab,t&&&&&&&&&&=po,0,_slab,mmcoGNN''''=po DO b,mmcoGNN'''''=po DO b,mmcoGNN''=po DO b,mmcoGN=po DO b,mmcoGNres== rmsoGNNN mh%Nm(comp,opllllllhamjac_ext_step_3d Its_xyslabst,FFTW_MODEURE)KiiCAMst,FFTW_MEASURE)Kiiiii LL subfftw_execute=po SUBROUTINE llllhamjac_ext_step_3ds F0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_sl=po SUBROUTINE llllhamjac_ext_step_3d =rippp&i(alN MMMODEURE)KiVECMst,FFTW_MEASURE)Kiiiii LL subfftw_execute=po SUBROUTINE llllhamjac_ext_step_3dsv F0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_sl=po SUBROUTINE llllhamjac_ext_step_3d v F0 ppp&i(appp&iliblllnumerics-r1036/src/0,-1podura_gmm_finalize.f0000644000175000017500000000522111616214650021160 0u 20 omaromarbed_slNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppModuraNNN m:nnnnnnnnnnnnn0,-1podura_gmm_finalize bed_slNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&p 1p,'t&pppPuri(avefoGNN:nThis podura tncludes,the source codm fessthe 1p,'t&ppppppppppppppppppfinalizgReturoutinveof the marching method.m_slab,N 1p,'t&p pRemarksefoGNN:m_slab,N 1p,'t&p pReferencesGNN: 1p,'t&p 1p,'t&p pRevi RetsefoG:m_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppp$Log:n0,-1podura_gmm_finalize.f,v $ 1p,'t&pppRevi Ret 1.1.1.1 2007/07/13 10:18:58nnnvos 1p,'t&pppCBLll9m Retuof the defio,0,-1pm_slab,N 1p,'t&pppRevi Ret 1.1 2005/03/10 01:37:16 nvos 1p,'t&pppIn::i1l cmin_-it. BEWARE: Not tesgmd1,1,p1,1llel yetN 1p,'t&pm_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppCopyright (c) 2010 CSE Lab (ETH Zuricha(2MOSAIC Group (ETH Zuricha(2 1p,'t&pppppppppppppppppppppCeslabbmessFluid Dynafocs (DTU)m_slab,N 1p,'t&p 1p,'t&ppThis firabis -1p =of the d1,1llel d1,ticrabMesh L,0,-1p (def).m_slab,N 1p,'t&p defiis free software: you canpredi_pp_bugm it and/essmodifpm_slab,N it undabbthe labms=of the GNU LessabbGene,1lpPublic L,censa m_slab,N as -xpen,hgd1by the Free Software Fouugttt, either m_slab,N l9m Retu3=of the L,censa, ess(at your IL'Ret) 1li;later m_slab,N l9m Ret.m_slab,N 1p,'t&p defiis di_pp_bugmd1,1,the hope lhat it will be useful, 1p,'t&p bug WITHOUT ANY WARRANTY; withtttteve1,the itttimd1w2004nty=ofe, 1p,'t&lERCHANTABILITY essFITNESS FOR A PARTICULAR PURPOSNm(See lhe 1p,'t&ppGNU Gene,1lpPublic L,censa fessmore details.m_slab,N 1p,'t&p You should9havepreceivmd1a copy=of the GNU Gene,1lpPublic L,censam_slab,N and the GNU LessabbGene,1lpPublic L,censa aIong with def. If999m, 1p,'t&p see .m_slab,N 1p,'t&p d1,1llel d1,ticrabMesh L,0,-1p (def) 1p,'t&p ETH Zurich 1p,'t&ppCH-8092 Zurich, Switzerlandpo,0,-1p9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e0,-1po,0,-1pMODULEn0,-1podura_gmm_finalize b,mmcoGNN9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) b,mmcoGNN9ppppfinv)_slabfacesGton0,-1gmm_finalize bed_slGNN9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) b,mmcoGNNINTERFACEn0,-1gmm_finalize bed_slGNN-1pMODULEnPROCEDUREn0,-1gmm_finalize bed_slGNN=po INTERFACE b,mmcoGNN9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) b,mmcoGNN9pptnclude the source b,mmcoGNN9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) b,mmcoGNhONTAINS #tnclude "0,-1gmm_finalize.f" b,mmco=po MODULEn0,-1podura_gmm_finalize liblllnumerics-r1036/src/0,-1pg(res_coarse.f0000644000175000017500000004332611616214650017772 0u 20 omaromar9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N ,N ,) !ppSubroutinvefo:nnnnnnnnnnnn0,-1pg(res 9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N ,N ,) !ppPuri(avefoGNN:nI1,this routinvewe compute the residula1,1,each level ppppppppppppp ppppppppppppppppppp ppp !ppInputppppppp: !ppInput/outputp: !p !ppOutputppppppp:2m(2M (I) return 2tus. 0 upetusuccess ! p pRemarksefoGNN:m! p pReferencesGNN: ! p pRevi RetsefoG:m9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N ,N ,) !pp$Log:n0,-1pg(res_coarse.f,v $ pppRevi Ret 1.1.1.1 2007/07/13 10:18:56 nvos pppCBLll9m Retuof the defio,0,-1pm! pppRevi Ret 1.8 2006/07/21 11:30:56 kotsalie pppFRIDAYm! pppRevi Ret 1.6 2006/02/08 19:56:24 kotsalie pppfixmd1multiprabdomainsm! pppRevi Ret 1.5 2005/12/08 12:44:45 kotsalie pppcomm::ing dirichletm! pppRevi Ret 1.4 2005/03/14 13:21:51 kotsalie pppCOMMITED/2+1 VECTOR CASNm(IT IS FOR LDA=3m! pppRevi Ret 1.3 2004/09/28 14:07:40 kotsalie pppChangesGconcerning 4th ordabm! pppRevi Ret 1.2 2004/09/23 12:16:49 kotsalie pppAddmd USEn 2tementt! pppRevi Ret 1.1 2004/09/22 18:47:32 kotsalie pppMG newll9m Retm!m9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N ,N , !ppP1,1llel d1,ticrabMesh L,0,-1p (def) !ppInstitugm of Computgttt1l Science !ppETH Zentrum, Hirscmingrabe1,84 !ppCH-8092 Zurich, Switzerlandp9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N ,N ,)O(N MMNMBiEmbedSFIEL1Mst,FMMMd!M,NMBiO 9999m st,F FTW_MEASURE)Kiiiii LL subfftw_executeSUBROUTINE llllpg(res_coarse99m 2cmer(t_st_id,mlev,c1,c2,c3,c4,E,&pppiF0 st,FFFTW_MEASURE)Klies e,foGNNNoEmbed_slSUBROUTINE llllpg(res_coarse99m 2cmed(t_st_id,mlev,c1,c2,c3,c4,E,&pppiF0 ppp&i(alN MMMd!M,NMBiEmbed(1Mst,F FTW_MEASURE)Kiiiii LL subfftw_executeSUBROUTINE llllpg(res_coarse93m 2cmer(t_st_id,mlev,c1,c2,c3,c4,c5I,foGNNN Decomposefdomai innnnnnnnnnnnnnnnnnE,&pppiF0 st,FFFTW_MEASURE)Klies e,foGNNNoEmbed_slSUBROUTINE llllpg(res_coarse93m 2cmed(t_st_id,mlev,c1,c2,c3,c4,c5I,foGNNN Decomposefdomai innnnnnnnnnnnnnnnnnE,&pppiF0 ppp&i(appp&i(alN MMNMBiEmbedVFIEL1Mst,FMMMd!M,NMBiO 9999m st,F FTW_MEASURE)Kiiiii LL subfftw_executeSUBROUTINE llllpg(res_coarse99m vecer(t_st_id,mlev,c1,c2,c3,c4,E,&pppiF0 st,FFFTW_MEASURE)Klies e,foGNNNoEmbed_slSUBROUTINE llllpg(res_coarse99m veced(t_st_id,mlev,c1,c2,c3,c4,E,&pppiF0 ppp&i(alN MMMd!M,NMBiEmbed(1Mst,F FTW_MEASURE)Kiiiii LL subfftw_executeSUBROUTINE llllpg(res_coarse93m vecer(t_st_id,mlev,c1,c2,c3,c4,c5I,foGNNN Decomposefdomai innnnnnnnnnnnnnnnnnE,&pppiF0 st,FFFTW_MEASURE)Klies e,foGNNNoEmbed_slSUBROUTINE llllpg(res_coarse93m veced(t_st_id,mlev,c1,c2,c3,c4,c5I,foGNNN Decomposefdomai innnnnnnnnnnnnnnnnnE,&pppiF0 ppp&i(appp&i(appp&i_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slail_topo) 3N ,N ,)O_slab,t&pppIncludesi_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slail_topo) 3N ,N ,)- #tnclude "0,-1definv.h"i_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slail_topo) 3N ,NO_slab,t&pppModuras i_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slail_topo) 3N ,N ,)- _slab,t&USEn0,-1podura_oGOTO 9999m mUSEn0,-1podura_oGOTlpgO 9999m mUSEn0,-1podura_wrigmm_slab,,'USEn0,-1podura_comp,aran_many_y_USEn0,-1podura_comp,opn_many_y_USEn0,-1podura_uble0#r=po,0y_USEn0,-1podura_R su= f_mesy_IMPLICIT NONEmst,FFTTW_MEASURE)Kiiiii LL subfftw_= f_mesy_INTEGER, PARAMETER :: MK ttttttklld_singlei(alsdi_slab,t&INTEGER, PARAMETER :: MK ttttttklld_doubleF0 ppp&i_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slaopo) 3N ,N ,)- _slab,t&pppArgumentsab,t&i_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slail_topo) 3N ,N ,)- _slab,t&INTEGER, INTENT(IN)tttttt:: mlev, t_st_id _slab,t&REAL(MK), INTENT(OUT)mai :: Emst,FFMMMd!M,NMBiO 9999m _slab,t&REAL(MK), INTENT(IN)tttttt:: c1,c2,c3,c4 i(alN MMMd!M,NMBiEmbed(1M_slab,t&REAL(MK), INTENT(IN)tttttt:: c1,c2,c3,c4,c5 0 ppp&i_slab,t&INTEGER, INTENT(INOUT)mai:: &ppp_slab,ft&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDi=CINNNmmpppLoc1l variabras i_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slail_topo) 3N ,N ,)- _slab,t&CHARACTER(LEN=256Ma:: cbu&i_slab,t&INTEGER :: &,j,i_id,cole0#r=po,0y_INTEGER :: &ttttssweep,counti_slab,t&INTEGERmai innnnnnnnnnnnnnnnnnnnnnnnn :: aa,bd,cc,dd,ee,ggM_slab,t&REAL(MK)ai innnnnnnnnnnnnnnnnnnnnnnnn :: c11,c22,c33,c44,c55&i_slab,t&INTEGERmai innnnnnnnnnnnnnnnnnnnnnnnn :: k,idomM_slab,t&REAL(MK)ai innnnnnnnnnnnnnnnnnnnnnnnn :: x,yM_slab,t&REAL(MK)ai innnnnnnnnnnnnnnnnnnnnnnnn :: resist,FMMMd!M,NMBiO 9999m _slab,t&INTEGER,DIMENNNoE(4)ai innnnnnnnnnnnnnnnnn:: ldl4,ldu4 _slab,t&INTEGER,DIMENNNoE(3)ai innnnnnnnnnnnnnnnnn:: ldl3,ldu3i(appp&i(N MMMd!M,NMBiEmbed(1M_slab,t&INTEGER,DIMENNNoE(5)ai innnnnnnnnnnnnnnnnn:: ldl5,ldu5 _slab,t&INTEGER,DIMENNNoE(4)ai innnnnnnnnnnnnnnnnn:: ldl4,ldu4 0 ppp&i_slab,t&INTEGERai innnnnnnnnnnnnnnnnnnnnnnnnnnnnnn:: tPou,iface,t_stid _slab,t&REAL(MK)i innnnnnnnnnnnnnnnnnnnnnnnnnnnnnn:: t0O(N MMNMBiEmbedSFIEL1Mst,FMMMd!M,NMBiO 9999m st,FW_MEASURE)Kiiiii LL subfftw_executet&TYPENpg(ttel _2 2cmer),DIMENNNoE(:,:),POINTER :: mgttel F0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_slt&TYPENpg(ttel _2 2cmed),DIMENNNoE(:,:),POINTER :: mgttel F0 ppp&i(alN MMMd!M,NMBiEmbed(1Mst,FW_MEASURE)Kiiiii LL subfftw_executet&TYPENpg(ttel _3 2cmer),DIMENNNoE(:,:),POINTER :: mgttel F0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_slt&TYPENpg(ttel _3 2cmed),DIMENNNoE(:,:),POINTER :: mgttel F0 ppp&i(appp&i(alN MMNMBiEmbedVFIEL1Mst,FMMMd!M,NMBiO 9999m st,FW_MEASURE)Kiiiii LL subfftw_executet&TYPENpg(ttel _2 vecer),DIMENNNoE(:,:),POINTER :: mgttel F0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_slt&TYPENpg(ttel _2 veced),DIMENNNoE(:,:),POINTER :: mgttel F0 ppp&i(alN MMMd!M,NMBiEmbed(1Mst,FW_MEASURE)Kiiiii LL subfftw_executet&TYPENpg(ttel _3 vecer),DIMENNNoE(:,:),POINTER :: mgttel F0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_slt&TYPENpg(ttel _3 veced),DIMENNNoE(:,:),POINTER :: mgttel F0 ppp&i(appp&i(appp&i(N MMNMBiEmbedSFIEL1Mst,FMMMd!M,NMBiO 9999m ab,t&REAL(MK),DIMENNNoE(:,:),POINTER :: tuci(alN MMMd!M,NMBiEmbed(1M_slabREAL(MK),DIMENNNoE(:,:,:),POINTER :: tuci(appp&i(alN MMNMBiEmbedVFIEL1Mst,FMMMd!M,NMBiO 9999m _slabREAL(MK),DIMENNNoE(:,:,:),POINTER :: tuci(alN MMMd!M,NMBiEmbed(1M_slabREAL(MK),DIMENNNoE(:,:,:,:),POINTER :: tuci(appp&i(appp&i_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slail_topo) 3N ,N ,)Di=CINNNmmpExternalsi_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slail_topo) 3N ,N ,)- i_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slail_topo) 3N ,N ,)Di=CINNNmmpIn::i1lize bed_slGNpMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slail_topo) 3N ,N ,)- _slab,t&C%Nm(comp,arallllllpg(res Its_xyslab=CINNNoGIF (l_printM/2+1Ki=CINNNmmcWRITE(cbu&,*) 'RESIDUAL1,1,LEVEL:',mlevi=CINNNmmcC%Nm(PPM_WRITE(llllrank,'pg(res_coarse',cbu&,xyslab=CINNNoG=po,0,_slab,mmpMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slail_topo) 3N ,N ,)Di=CINNNmmpppCheck argumentsi_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slail_topo) 3N ,N ,)- =CINNNoGIF (0,-1debug .GT.(1M/2+1Ki=CINNNmmcoIF (c1.LE.004/MK)i2+1Ki=CINNNmmcooooom(2M tttttttt=NNmuble0#r=po,0,-1p,'t&h%Nm(ttttttt=NNm(3MKi=Cargument_,2I4)pg(smooth ImmdeeYsoc,fo) MKlies e'Factor c1 must be >0GNNNNpartptttttttttttt= 0,fffffN kind_double0#rrrrr=po,0,-CINNNmmcoIF (c2.LE.004/MK)i2+1Ki=CINNNmmcooooom(2M tttttttt=NNmuble0#r=po,0,-1p,'t&h%Nm(ttttttt=NNm(3MKi=Cargument_,2I4)pg(smooth ImmdeeYsoc,fo) MKlies e'Factor c2 must be >0GNNNNpartptttttttttttt= 0,fffffN kind_double0#rrrrr=po,0,-CINNNmmcoIF (c3.LE.004/MK)i2+1Ki=CINNNmmcooooom(2M tttttttt=NNmuble0#r=po,0,-1p,'t&h%Nm(ttttttt=NNm(3MKi=Cargument_,2I4)pg(smooth ImmdeeYsoc,fo) MKlies e'Factor c3 must be >0GNNNNpartptttttttttttt= 0,fffffN kind_double0#rrrrr=po,0,(N MMMd!M,NMBiEmbed(1M_slab,t&coIF (c4.LE.004/MK)i2+1Ki=CINNNmmcooooom(2M tttttttt=NNmuble0#r=po,0,-1p,'t&h%Nm(ttttttt=NNm(3MKi=Cargument_,2I4)pg(smooth ImmdeeYsoc,fo) MKlies e'Factor c4 must be >0GNNNNpartptttttttttttt= 0,fffffN kind_double0#rrrrr=po,0,(appp&i_slab,t&=po,0,_slab,mmpMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slail_topo) 3N ,N ,)Di=CINNNmmpppfinitRetuof necess-1p variabras and R sugRetuof 2004ysi_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slail_topo) 3N ,N ,)- =CINNNoGt_stid=t_st_id (N MMNMBiEmbedSFIEL1Mst,FMMMd!M,NMBiO 9999m st,FW_MEASURE)Kiiiii LL subfftw_executet&mgttel =>mgttel _2 2cmeri(alN FTW_MEASURE)Klies e,foGNNNoEmbed_slt&mgttel =>mgttel _2 2cme F0 ppp&i(alN MMMd!M,NMBiEmbed(1Mst,FW_MEASURE)Kiiiii LL subfftw_executet&mgttel =>mgttel _3 2cmeri(alN FTW_MEASURE)Klies e,foGNNNoEmbed_slt&mgttel =>mgttel _3 2cme 0 ppp&i(appp&i(alN MMNMBiEmbedVFIEL1Mst,FMMMd!M,NMBiO 9999m st,FW_MEASURE)Kiiiii LL subfftw_executet&mgttel =>mgttel _2 veceri(alN FTW_MEASURE)Klies e,foGNNNoEmbed_slt&mgttel =>mgttel _2 veced 0 ppp&i(alN MMMd!M,NMBiEmbed(1Mst,FW_MEASURE)Kiiiii LL subfftw_executet&mgttel =>mgttel _3 veceri(alN FTW_MEASURE)Klies e,foGNNNoEmbed_slt&mgttel =>mgttel _3 veced 0 ppp&i(appp&i(appp&ist,FFMMNMBiEmbedSFIEL1Mst,FFMMMd!M,NMBiO 9999m _slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slail_topo) 3N ,N ,)Di=CINNNmmpImplementgReti_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slail_topo) 3N ,N ,)O_slab,t& E=-HUGE(Ettttttt= 0,fDO'isxp=1,nsxpstttttt= 0,ffftuc=>mgttel (i_id,mlev)%uc tttttt= 0,fffDO'j=p,aral2-o_id,mlev)-o_,opl2-o_id,mlev)tttttt= 0,ffffffDO'i=p,aral1-o_id,mlev)-o_,opl1-o_id,mlev)tttttt= 0,ffffffffffffres==(tuc(i-1,j)+,foGNNN Decomposefdomai intuc(i+1,j))*c2 +mdeeYsoc,fo) MKlies eeeeeeeee(tuc(i,j-1)+Ysoc,foGNNN Decomposefdomai intuc(i,j+1))*c3 -c,foGNNN Decomposefdomai intuc(i,j)*c4 -c,foGNNN Decomposefdomai inmgttel (i_id,mlev)%fc(i,j)tttttt= 0,ffffffffffffE=MAX(ABS(res),E)tttttt= 0,ffffffffffffmgttel (i_id,mlev)%Ki=(i,j)=-resi_slab,t&fffffffEpoDO b,mmcoGNN'N'=poDO b,mmcoGNN'=poDO (alN MMMd!M,NMBiEmbed(1M_slab,t&& E=-HUGE(Ettttttt= 0,f ,fDO'isxp=1,nsxpstttttt= 0,fff fftuc=>mgttel (i_id,mlev)%uc tttttt= 0,fff aa=0tttttt= 0,fff bb=0tttttt= 0,fff cc=0tttttt= 0,fff dd=0tttttt= 0,fff ee=0tttttt= 0,fff gg=0tttttt= 0,fff IF (.NOT.lperiodiM/2+1Ki=CINNNmmco 0,f ,fDO'iface=1,6tttttt= 0,fffffffffffIF (bcdef 2cm(i_id,iface).EQ.2I4)p1,1m_bcdef periodiM/2+1Ki=CINNNmmco 0,f ,fmmppO NOTHiiitttttt= 0,fffffffffffELSEIF (bcdef 2cm(i_id,iface).EQ.2I4)p1,1m_bcdef dirichletM/2+1Ki=CINNNmmcooooooooooooo ttttface.EQ.1M/2+1Ki=CINNNmmcoooooooooooooooaa=1i=CINNNmmcoooooooooooooELSEIF (tface.EQ.2M/2+1Ki=CINNNmmcooooooooooooooobb=1i=CINNNmmcoooooooooooooELSEIF (tface.EQ.3M/2+1Ki=CINNNmmcoooooooooooooocc=1i=CINNNmmcoooooooooooooELSEIF (tface.EQ.4M/2+1Ki=CINNNmmcoooooooooooooodd=1i=CINNNmmcoooooooooooooELSEIF (tface.EQ.5M/2heni=CINNNmmcooooooooooooooee=1i=CINNNmmcoooooooooooooELSEIF (tface.EQ.6M/2heni=CINNNmmcoooooooooooooogg=1i=CINNNmmcooooooooooooooooooooEpo,0,_slab,mmcoGNN''''''''Epo,0 _slab,foGNN'NN',,',,'=poDO !tface_slab,foGNN'NN',,', ppp&_!periodi _slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slail_topo) 3N ,N ,)Di=CINNNmmpImplementgReti_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slail_topo) 3N ,N ,)O_slab,t&DO'k=p,aral3-o_id,mlev)+ee-o_,opl3-o_id,mlev)-ggM_slab,t&b,t&DO'j=p,aral2-o_id,mlev)+cc-o_,opl2-o_id,mlev)-dd_slab,foGNN'NN',DO'i=p,aral1-o_id,mlev)+aa-o_,opl1-o_id,mlev)-bbtttttt= 0,ffffffffffffres==(tuc(i-1,j,k)+,foGNNN Decomposefdomai inintuc(i+1,j,k))*c2 +mdeeYsoc,fo) MKlies eeeeeeeeeee(tuc(i,j-1,k)+Ysoc,foGNNN Decomposefdomai inintuc(i,j+1,k))*c3 +,foGNNN Decomposefdomai ini(tuc(i,j,k-1)+Ysoc,foGNNN Decomposefdomai inintuc(i,j,k+1))*c4 -,foGNNN Decomposefdomai inintuc(i,j,k)*c5 -c,foGNNN Decomposefdomai ininmgttel (i_id,mlev)%fc(i,j,k)tttttt= 0,ffffffffffffE=MAX(ABS(res),E)tttttt= 0,ffffffffffffmgttel (i_id,mlev)%Ki=(i,j,k)=-resi_slab,t&fffffffffEpoDO b,mmcoGNN'N'ffEpoDO b,mmcoGNN'NEpoDO b,mmcoGN=poDO (appp&i(alN MMNMBiEmbedVFIEL1Mst,FFMMMd!M,NMBiO 9999m _slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slail_topo) 3N ,N ,)Di=CINNNmmpImplementgReti_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slail_topo) 3N ,N ,)O_slab,t&E=-HUGE(Ettttttt= 0DO'isxp=1,nsxpstttttt= 0,fftuc=>mgttel (i_id,mlev)%uc tttttt= 0,ffDO'j=p,aral2-o_id,mlev)-o_,opl2-o_id,mlev)tttttt= 0,fffffDO'i=p,aral1-o_id,mlev)-o_,opl1-o_id,mlev)tttttt= 0,ffffffDO'ilda=1,vecdimtttttt= 0,fffffffffffres==(tuc(itttts-1,j)+,foGNNN Decomposefdomai ituc(itttts+1,j))*c2 +mdeeYsoc,fo) MKlies eeeeeeee(tuc(itttts,j-1)+Ysoc,foGNNN Decomposefdomai ituc(itttts,j+1))*c3 -c,foGNNN Decomposefdomai ituc(itttts,j)*c4 -c,foGNNN Decomposefdomai imgttel (i_id,mlev)%fc(itttts,j)_slab,foGNN'NN',,',,'==MAX(ABS(res),E)tttttt= 0,fffffffffffmgttel (i_id,mlev)%Ki=(itttts,j)=-resi_slab,t&fffffffEpoDO b,mmcoGNN'N'ffEpoDO b,mmcoGNN'NEpoDO b,mmcoGN=poDO (alN MMMd!M,NMBiEmbed(1M_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slail_topo) 3N ,N ,)Di=CINNNmmpImplementgReti_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slail_topo) 3N ,N ,)O_slab,t&',,',,'==-HUGE(Ettttttt= 0,f ,f,fDO'isxp=1,nsxpstttttt= 0,fff fffffftuc=>mgttel (i_id,mlev)%uc tttttt= 0,fff aa=0tttttt= 0,fff bb=0tttttt= 0,fff cc=0tttttt= 0,fff dd=0tttttt= 0,fff ee=0tttttt= 0,fff gg=0tttttt= 0,fff fDO'ilda=1,vecdimtttttt= 0,fffffffIF (.NOT.lperiodiM/2+1Ki=CINNNmmco 0,f ,fDO'iface=1,6tttttt= 0,fffffffffffIF (bcdef vec(itttts_id,iface).EQ.2I4)p1,1m_bcdef periodiM/2+1Ki=CINNNmmco 0,f ,fmmppO NOTHiiitttttt= 0,fffffffffffELSEIF (bcdef vec(itttts_id,iface).EQ.2I4)p1,1m_bcdef dirichletM/2+1Ki=CINNNmmcooooooooooooo ttttface.EQ.1M/2+1Ki=CINNNmmcoooooooooooooooaa=1i=CINNNmmcoooooooooooooELSEIF (tface.EQ.2M/2+1Ki=CINNNmmcooooooooooooooobb=1i=CINNNmmcoooooooooooooELSEIF (tface.EQ.3M/2+1Ki=CINNNmmcoooooooooooooocc=1i=CINNNmmcoooooooooooooELSEIF (tface.EQ.4M/2+1Ki=CINNNmmcoooooooooooooodd=1i=CINNNmmcoooooooooooooELSEIF (tface.EQ.5M/2heni=CINNNmmcooooooooooooooee=1i=CINNNmmcoooooooooooooELSEIF (tface.EQ.6M/2heni=CINNNmmcoooooooooooooogg=1i=CINNNmmcooooooooooooooooooooEpo,0,_slab,mmcoGNN''''''''Epo,0 _slab,foGNGNN''''''''EpoDO !tface_slab,foGNN'NN',,',ooooeppp&_!periodi _slab,t&N''''''''EpoDOtttttt= 0,f ,fDO'k=p,aral3-o_id,mlev)+ee-o_,opl3-o_id,mlev)-ggM_slab,t&b,t& t&DO'j=p,aral2-o_id,mlev)+cc-o_,opl2-o_id,mlev)-dd_slab,foGNN'NN', ',DO'i=p,aral1-o_id,mlev)+aa-o_,opl1-o_id,mlev)-bbtst,da,FW_VECTORi=CINNNmmcooooooooooooooores==(tuc(1,i-1,j,k)+,foGNNN Decomposefdomai inin tuc(1,i+1,j,k))*c2 +mdeeYsoc,fo) MKlies eeeeeeeeeee (tuc(1,i,j-1,k)+Ysoc,foGNNN Decomposefdomai inin tuc(1,i,j+1,k))*c3 +,foGNNN Decomposefdomai ini (tuc(1,i,j,k-1)+Ysoc,foGNNN Decomposefdomai inin tuc(1,i,j,k+1))*c4 -,foGNNN Decomposefdomai inin tuc(1,i,j,k)*c5 -c,foGNNN Decomposefdomai ininimgttel (i_id,mlev)%fc(1,i,j,k)i=CINNNmmcoooooooooooooooE=MAX(ABS(res),E)tttttt= 0,ffffffffffffinimgttel (i_id,mlev)%Ki=(1,i,j,k)=-resi_slab,t&ffffffffffffffffres==(tuc(2,i-1,j,k)+,foGNNN Decomposefdomai inin tuc(2,i+1,j,k))*c2 +mdeeYsoc,fo) MKlies eeeeeeeeeee (tuc(2,i,j-1,k)+Ysoc,foGNNN Decomposefdomai inin tuc(2,i,j+1,k))*c3 +,foGNNN Decomposefdomai ini (tuc(2,i,j,k-1)+Ysoc,foGNNN Decomposefdomai inin tuc(2,i,j,k+1))*c4 -,foGNNN Decomposefdomai inin tuc(2,i,j,k)*c5 -c,foGNNN Decomposefdomai ininimgttel (i_id,mlev)%fc(2,i,j,k)i=CINNNmmcoooooooooooooooE=MAX(ABS(res),E)tttttt= 0,ffffffffffffinimgttel (i_id,mlev)%Ki=(2,i,j,k)=-resi_slab,t&ffffffffffffffffres==(tuc(3,i-1,j,k)+,foGNNN Decomposefdomai inin tuc(3,i+1,j,k))*c2 +mdeeYsoc,fo) MKlies eeeeeeeeeee (tuc(3,i,j-1,k)+Ysoc,foGNNN Decomposefdomai inin tuc(3,i,j+1,k))*c3 +,foGNNN Decomposefdomai ini (tuc(3,i,j,k-1)+Ysoc,foGNNN Decomposefdomai inin tuc(3,i,j,k+1))*c4 -,foGNNN Decomposefdomai inin tuc(3,i,j,k)*c5 -c,foGNNN Decomposefdomai ininimgttel (i_id,mlev)%fc(3,i,j,k)i=CINNNmmcoooooooooooooooE=MAX(ABS(res),E)tttttt= 0,ffffffffffffinimgttel (i_id,mlev)%Ki=(3,i,j,k)=-resi(alsdi_slab,t&&&&&&&&&&&&DO'ilda=1,vecdimtttttt= 0,fffffffffffffffres==(tuc(itttts-1,j,k)+,foGNNN Decomposefdomai inin tuc(itttts+1,j,k))*c2 +mdeeYsoc,fo) MKlies eeeeeeeeeee (tuc(itttts,j-1,k)+Ysoc,foGNNN Decomposefdomai inin tuc(itttts,j+1,k))*c3 +,foGNNN Decomposefdomai ini (tuc(itttts,j,k-1)+Ysoc,foGNNN Decomposefdomai inin tuc(itttts,j,k+1))*c4 -,foGNNN Decomposefdomai inin tuc(itttts,j,k)*c5 -c,foGNNN Decomposefdomai ininimgttel (i_id,mlev)%fc(itttts,j,k)i=CINNNmmcoooooooooooooooE=MAX(ABS(res),E)tttttt= 0,ffffffffffffinimgttel (i_id,mlev)%Ki=(itttts,j,k)=-resi_slab,t&fffffffffff=poDO (appp&islab,t&fffffffffff=poDO b,t&fffffffffff=poDO b,t&ffffffff=poDO b,t&fffff=poDO (appp&i(appp&i_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slail_topo) 3N ,N ,)O_slab,t&pppReturn M_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slail_topo) 3N ,N ,)Did_dob,t&hONTINUEi=CINNNmmh%Nm(comp,opllllllpg(res Its_xyslab=CINNNoGRETURN (N MMNMBiEmbedSFIEL1Mst,FFFMMMd!M,NMBi iO 9999m st,F FTW_MEASURE)Kiiiii LL subfftw_execute=po SUBROUTINE llllpg(res_coarse99m 2cmerF0 st,FFFTW_MEASURE)Klies e,foGNNNoEmbed_sl=po SUBROUTINE llllpg(res_coarse99m 2cmed 0 ppp&i(alN MMMd!M,NMBiEmbed(1Mst,F FTW_MEASURE)Kiiiii LL subfftw_execute=po SUBROUTINE llllpg(res_coarse93m 2cmerF0 st,FFFTW_MEASURE)Klies e,foGNNNoEmbed_sl=po SUBROUTINE llllpg(res_coarse93m 2cmed 0 ppp&i(appp&i(alN MMNMBiEmbedVFIEL1Mst,FFFMMMd!M,NMBi iO 9999m st,F FTW_MEASURE)Kiiiii LL subfftw_execute=po SUBROUTINE llllpg(res_coarse99m veceri(alN FFTW_MEASURE)Klies e,foGNNNoEmbed_sl=po SUBROUTINE llllpg(res_coarse99m veced 0 ppp&i(alN MMMd!M,NMBiEmbed(1Mst,F FTW_MEASURE)Kiiiii LL subfftw_execute=po SUBROUTINE llllpg(res_coarse93m veceri(alN FFTW_MEASURE)Klies e,foGNNNoEmbed_sl=po SUBROUTINE llllpg(res_coarse93m veced 0 ppp&i(appp&i(appp&iliblllnumerics-r1036/src/0,-1util_gmres_solveupper.f0000644000175000017500000001324711616214650021617 0u 20 omaromarlab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slail_topo) 3N ,N ,)Dt, 1p,'t&pppSubroutinvefo:nnnnnnnnnnnnnnnnn0,-1util_gmres_solveupper lab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slail_topo) 3N ,N ,)Dt, 1p,'t&p 1p,'t&pppPuri(avefoGNN:nSolve Ux=b 1p,'t&p 1p,'t&pppInputpppppppN:nUnnnnnnnnnn(F) upper triangul20 matrix 1p,'t&ppppppppppppppppppbnnnnnnnnnn(F) Right-hand side 1p,'t&ppppppppppppppppppnnnnnnnnnnn(I) l,ldi_slab,p 1p,'t&pppOutputppppppp:2m(2M (I) return 2tus. 1p,'t&ppppppppppppppppppxnnnnnnnnnn(F) SolugReti_slab,N 1p,'t&p pRemarksefoGNN:m_slab,N 1p,'t&p pReferencesGNN: m_slab,N 1p,'t&p 1p,'t&p pRevi RetsefoG:m_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppp$Log:n0,-1util_gmres_solveupper.f,v $ 1p,'t&pppRevi Ret 1.1.1.1 2007/07/13 10:19:01nnnvos 1p,'t&pppCBLll9m Retuof the defio,0,-1pm_slab,N 1p,'t&pppRevi Ret 1.1 2006/05/11 10:27:00nn0chatela 1p,'t&pppIn::i1l insergReti_slab,N 1p,'t&pm_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppCopyright (c) 2010 CSE Lab (ETH Zuricha(2MOSAIC Group (ETH Zuricha(2 1p,'t&pppppppppppppppppppppCeslabbmessFluid Dynafocs (DTU)m_slab,N 1p,'t&p 1p,'t&ppThis firabis -1p =of the d1,1llel d1,ticrabMesh L,0,-1p (def).m_slab,N 1p,'t&p defiis free software: you canpredi_pp_bugm it and/essmodifpm_slab,N it undabbthe labms=of the GNU LessabbGene,1lpPublic L,censa m_slab,N as -xpen,hgd1by the Free Software Fouugttt, either m_slab,N l9m Retu3=of the L,censa, ess(at your IL'Ret) 1li;later m_slab,N l9m Ret.m_slab,N 1p,'t&p defiis di_pp_bugmd1,1,the hope lhat it will be useful, 1p,'t&p bug WITHOUT ANY WARRANTY; withtttteve1,the itttimd1w2004nty=ofe, 1p,'t&lERCHANTABILITY essFITNESS FOR A PARTICULAR PURPOSNm(See lhe 1p,'t&ppGNU Gene,1lpPublic L,censa fessmore details.m_slab,N 1p,'t&p You should9havepreceivmd1a copy=of the GNU Gene,1lpPublic L,censam_slab,N and the GNU LessabbGene,1lpPublic L,censa aIong with def. If999m, 1p,'t&p see .m_slab,N 1p,'t&p d1,1llel d1,ticrabMesh L,0,-1p (def) 1p,'t&p ETH Zurich 1p,'t&ppCH-8092 Zurich, Switzerlandpo,0,-1p9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N est,FFTW_MEASURE)Kiiiii LL subfftw_executeSUBROUTINE llllutil_gmres_solveupper_s(U,b,x,n,&pppiF0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_slSUBROUTINE llllutil_gmres_solveupper_d(U,b,x,n,&pppiF0 ppp&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppIncludesi_slab,9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N estnclude "0,-1definv.h"ii_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppModurasi_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&USEn0,-1podura_oGOTO 9999mUSEn0,-1podura_comp,aran_many_USEn0,-1podura_comp,opn_many_USEn0,-1podura_uble0#r=po,0USEn0,-1podura_R su= f_mesIMPLICIT NONEmest,FFTW_MEASURE)Kiiiii LL subfftw_executeINTEGER, PARAMETER :: MK ttttttklld_singlei(alt,FFTW_MEASURE)Klies e,foGNNNoEmbed_slINTEGER, PARAMETER :: MK ttttttklld_doubleF0 ppp&ii_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppArgumentsi_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&REAL(MK), DIMENNNoE(:,:), INTENT(IN)tt:: U 1p,'t&REAL(MK), DIMENNNoE(:), POINTER nnnn:: x 1p,'t&REAL(MK), DIMENNNoE(:), INTENT(IN)tt:: bmbed_slINTEGER , INTENT(IN)tttt:: n mbed_slINTEGER , INTENT(OUT)mai:: &ppp_slab,fNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppLoc1l variabrasi_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&REAL(MK) :: t0,'lmyeps 1p,'t&REAL(W_ME(1.0D0)) :: summbed_slINTEGER :: i,jii_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDis 1p,'t&pppc1ll comp,aran_many_NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDis 1p,'t&C%Nm(comp,arallllllutil_gmres_solveupper Its_xyslabi_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDis 1p,'t&pppcheck inputpargumentsi_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDis 1p,'t&IF (0,-1debug .GT.(1M/2+1Ki=CINNNmmcIF (n.LT.1M/2+1Ki=CINNNmmcooooom(2M tttttttt=NNmuble0#r=po,0,-1p,'t&h%Nm(ttttttt=NNm(3MKi=Cargument_,2I4)util_gmres_solveupper ImmdeeYsoc,fo) MKlies e'passad1a neggtvepl,ld nGNNNNpartptttttttttttt= 0,fffffN kind_double0#rrrrr=po,0,-CINNN=po,0,est,FFTW_MEASURE)Kiiiii LL subfftw_executelmyeps ttttttmyepsri(alN FTW_MEASURE)Klies e,foGNNNoEmbed_sllmyeps ttttttmyepsd 0 ppp&i_slab,i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDis 1p,'t&pppElimingReti_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDis 1p,'t&DO'i=n,1,-1i=CINNNmmcsum ttb(ittttttt= 0,DO'j== o+1,ni=CINNNmmcooosum ttsum - U(i,j)*x(j)_slab,foGN=po DO b,mmcoGNNIF (ABS(U(i,i)).GT.lmyepsM/2+1Ki=CINNNmmcooox(it ttsum/U(i,i)_slab,foGN=LSEi=CINNNmmcoGNm(2M tttttttt=NNmuble0#r=po,0,-1p,'h%Nm(ttttttt=NNm(3MKi=Cargument_,2I4)util_gmres_solveupper ImmdeeYsoc,fo) MKlies e'a pivo =of Uiis nullGNNNNpartptttttttttttt= 0,fffN kind_double0#rrrr=po I0,-CINNN=po DO b,mmco_slab,fNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppReturn_slab,fNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1d_dobhONTINUEi=CINNNh%Nm(comp,opllllllutil_gmres_solveupper Its_xyslab=CINNNRETURN (N FTW_MEASURE)Kiiiii LL subfftw_e=po SUBROUTINE llllutil_gmres_solveupper_si(alN FTW_MEASURE)Klies e,foGNNNoEm=po SUBROUTINE llllutil_gmres_solveupper_di(appp&iliblllnumerics-r1036/src/0,-1hamjac_reinit_russo_3d.f0000644000175000017500000002712411616214650021576 0u 20 omaromarslab,fNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppp ppSubroutinvefo:nnnnnnnnnnnnnnnnn0,-1hamjac_reinit_3d_slab,fNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppmco_slab,fNlab,fPuri(avefoGNN:nSolve Hamilton-Jacobi fessGowas reinit 1p,'t&ppppppp 1p,'t&ppppppInputpppppppN:n 1p,'t&ppppppppppppppppppppp 1p,'t&ppppppInput/Outputp:n 1p,'t&ppppppppppppppppppppp 1p,'t&ppppppOutputppppppp:2 1p,'t&ppppppp 1p,'t&ppppppRemarksefoGNN:n 1p,'t&ppppppppppppppppppppp 1p,'t&pppppp 1p,'t&ppppppReferencesGNN: 1p,'t&pppppp 1p,'t&ppppppRevi RetsefoG:m_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppp pp$Log:n0,-1hamjac_reinit_3d.f,v $ 1p,'t&ppp ppRevi Ret 1.1.1.1 2006/07/25 15:18:19 menahel 1p,'t&ppp ppin::i1l imporan_many_N 1p,'t&ppp ppRevi Ret 1.1 2005/07/25 00:34:02nnnvos 1p,'t&ppp ppIn::i1l cmin_-it. 1p,'t&pm_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppppppd1,1llel d1,ticrabMesh L,0,-1p (def) 1p,'t&p p ppInstitugm of Computgttt1l Science 1p,'t&p p ppETH Zentrum, Hirscmingrabe1,84 1p,'t&p p ppCH-8092 Zurich, Switzerlandp_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, (N FTW_MODEURE)KiiCAMst,FFTW_MEASURE)Kiiiii LL subfftw_executeSUBROUTINE llllhamjac_reinit_russo_3ds (0hi, 0higrad, t_l, maxstep,'&_slab,foGNN' Decomposefdomai int_st_id, mesh_id, ghostl,ld,Nm(2M,Nm(dxiF0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_slSUBROUTINE llllhamjac_reinit_russo_3dd (0hi, 0higrad, t_l, maxstep,'&_slab,foGNN' Decomposefdomai int_st_id, mesh_id, ghostl,ld,Nm(2M,Nm(dxiF0 ppp&i(alN MMMODEURE)KiVECMsttt=N VECTOR NOTsIMPLEMENTED///////F0 ppp&ii_slab,t&USEn0,-1podura_oGOTO 9999m mi_slab,t&USEn0,-1podura_uble0#r=po,0y_USEn0,-1podura_wrigmm_slab,,'USEn0,-1podura_comp,aran_many_y_USEn0,-1podura_R su= f_mesy_USEn0,-1podura_comp,opn_many_y_USEn0,-1podura_mapn_many_y_USEn0,-1podura_map(ttel n_many_y_USEn0,-1podura_map(ttel _ghostn_many_y_IMPLICIT NONEmest,FFTFW_MEASURE)Kiiiii LL subfftw_executet&INTEGER, PARAMETER :: MK ttttttklld_singlei(alt,FFFTW_MEASURE)Klies e,foGNNNoE9999m mi_slab,t&INTEGER, PARAMETER :: MK ttttttklld_doubleF0 ppp&iist,da,FW_MPImbed_slINCLUDEU 'mpif.h'i(appp&i_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slai_slab,t&pppArgumentsi_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slai_slab,t&REAL(MK), DIMENNNoE(:,:,:,: ), POINTER :: 0hii_slab,t&REAL(MK), DIMENNNoE(:,:,:,:,:), POINTER :: 0higradi_slab,t&INTEGER, INTENT(in) :: t_st_id, mesh_idi_slab,t&INTEGER, DIMENNNoE(3), INTENT(in) :: ghostl,ldi_slab,t&INTEGER, INTENT(inout) :: &ppp_slab,ft&INTEGER, INTENT(in) :: maxstepi_slab,t&REAL(mk), INTENT(in) :: t_l_slab,ft&INTEGER,INTENT(IN),OPTNoEAL :: &pdxi_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slai_slab,t&pppAliasesi_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slai_slab,t&INTEGER, DIMENNNoE(:), POINTER :: &sxpen,ti_slab,t&REAL(mk), DIMENNNoE(:,:,:,: ), POINTER :: 0hi0,0hirhs,0hiprevi=CINNNmmINTEGER :: nsxpen,ti_slab,t&INTEGER, DIMENNNoE(:,:), POINTER :: noGOTO 9999m mINTEGER :: t_stid,meshid _slab,t&REAL(mk), DIMENNNoE(:), POINTER :: min_phys, max_physi_slab,t&INTEGER, DIMENNNoE(6) :: orgbcdefO 9999m mINTEGER :: s2didx, mpi_pre= f_mesy_TYPENttttt_t_st), POINTER :: t_st= f_mesy_TYPENttttt_equi_mesh), POINTER :: meshi_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slai_slab,t&pppp,anoGrdpp,uf&i_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slai_slab,t&INTEGER :: i_id,isxpets,j,k,maptype-o_,ep,tPoui_slab,t&INTEGER :: ldl(4), ldu(4), noGOTlpax(3) _slab,t&REAL(mk) :: len_phys(3), dx(3) _slab,t&REAL(mk) :: t0,'res, gres,tau _slab,t&CHARACTER(len=256Ma :: msgii_slab,t&C%Nm(comp,arallllllhamjac_reinit_russo_3d Its_xyslabi_slab,NNIF(,foSENT(indxiM/2+1Ki=CINNNmmcooos2didx=&pdxi_slab,t&=LSEi=CINNNmmcoGNs2didx= -1i=CINNNmm=po I0,ist,da,FW_MPI=CINNNmmi_slab,NNIF (0,-1klld.EQ.2I4)klld_singleM/2+1Ki=CINNNmmcooMPIe,foG ttMPIeREALi_slab,t&=LSEi=CINNNmmcoGMPIe,foG ttMPIeKlies e,foGNNNoEmbed_slt&=po,0,(appp&i_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slai_slab,t&pppGet the mesh oGOTO 9999m mpMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slai_slab,t&t_st =>tttttt_st(t_st_id)%ui_slab,t&mesh =>tt_st%mesh(mesh_id)i_slab,t&meshid ttmesh%I1M_slab,t&nsxpen,t ttt_st%nsxpen,ti_slab,t&noGOTb,t&=>tmesh%nnodesi_slab,t&isxpen,t t>tt_st%&sxpen,tist,FFTFW_MEASURE)Kiiiii LL subfftw_executet&min_phys =>tt_st%min_physsi_slab,t&max_phys =>tt_st%max_physri(alN FFTW_MEASURE)Klies e,foGNNNoECINNNmmi_slab,NNmin_phys =>tt_st%min_physdi_slab,t&max_phys =>tt_st%max_physdF0 ppp&ii_slab,t&len_phys(1t ttmax_phys(1t -Nmin_phys(1ti_slab,t&len_phys(2t ttmax_phys(2t -Nmin_phys(2ti_slab,t&len_phys(3t ttmax_phys(3t -Nmin_phys(3) _slab,t& _slab,t&dx(1Ma =&len_phys(1t/REAL(mesh%Nm(1t-1,mk)i=CINNNmmdx(2Ma =&len_phys(2t/REAL(mesh%Nm(2t-1,mk)i=CINNNmmdx(3Ma =&len_phys(3t/REAL(mesh%Nm(3t-1,mk)i=CINNNmmi_slab,t&pptimestepi_slab,t&tau =&0.25_mk*MINVAL(dxiF=CINNNmmi_slab,t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slai_slab,t&pppR suge lampor-1p p,orage bed_slGNpMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slai_slab,t&ldl(1:3t tt1 -Nghostl,ld(1:3t; ldl(4) tt1i_slab,t&noGOTlpax(1t ttMAXVAL(noGOT(1,1:nsxpen,t))i_slab,t&noGOTlpax(2t ttMAXVAL(noGOT(2,1:nsxpen,t))i_slab,t&noGOTlpax(3t ttMAXVAL(noGOT(3,1:nsxpen,t))i_slab,t&ldu(1Ma =&noGOTlpax(1t +Nghostl,ld(1)i_slab,t&ldu(2Ma =&noGOTlpax(2t +Nghostl,ld(2)i_slab,t&ldu(3Ma =&noGOTlpax(3t +Nghostl,ld(3)i_slab,t&ldu(4Ma =&nsxpen,ti_slab,t&tPou =&2I4)p1,1m_R su(ttti_slab,t&h%Nm(ttttR su(0hi0,ldl,ldu,tPou,itttttttttt= 0h%Nm(ttttR su(0hirhs,ldl,ldu,tPou,itttttttttt= 0h%Nm(ttttR su(0hiprev,ldl,ldu,tPou,itttttttttt= 0IF(ittt.NE.1M/2+1Ki=CINNNmmcoom(2M tttttttt=NNmfGOTli=CINNNmmcooh%Nm(ttttttt=NNm(3MKi=Ca su,lllllhamjac_reinit_russo_3d I'&_slab,foGNN'''''' Decomp'lamp p,orage fesshamjacGNNNNpartptttttttttttt= 0,ffN kind_double0#rrr=po I0,-CINNNmmi_slab,t&ppfill 0hi0 with in::i1l copppgReti_slab,t&DO'isxp=1,nsxpen,ti_slab,t& t&isxpe== osxpen,t(i_idttttttt= 0,ffDO'k=1,noGOT(3,osxpettttttt= 0,ffDO'j=1,noGOT(2,osxpettttttt= 0,ff,t&DO'i=1,noGOT(1,osxpettttttt= 0,ff,t& 0hi0(i,j,k,osxpt tt0hi(i,j,k,osxpttttttt= 0,ff,t& 0hiprev(i,j,k,osxpt tt0hi(i,j,k,osxpttttttt= 0,ff,t& 0higrad(1:3,i,j,k,osxpt tt004/mktttttt= 0,ff,t&=po DO b,mmcoGNN,t&=po DO b,mmcoGNN,t&=po DO b,mmcoGN=po DO b,mmcoGNtttttt= 0h%Nm(ttttmap(ttel _ghost_get(t_st_id,mesh_id,ghostl,ld,itttttttttt= 0h%Nm(ttttmap(ttel _push(t_st_id,mesh_id,0hi0,itttttttttt= 0h%Nm(ttttmap(ttel _s pp(itttttttttt= 0h%Nm(ttttmap(ttel _pop(t_st_id,mesh_id,0hi0,ghostl,ld,itttttttttt= 0b,mmcoGNtttttt= 0pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slai_slab,t&ppp,araptime integragRetuloop: using TVD RK3tttttt= 0pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slai_slab,t&i_slab,t&DO'istep=1,maxstepi_slab,t&= 0pMBHtmap the ghostli=CINNNmmcooh%Nm(ttttmap(ttel _ghost_get(t_st_id,mesh_id,ghostl,ld,itttttttttt= 0= 0h%Nm(ttttmap(ttel _push(t_st_id,mesh_id,0hi,itttttttttt= 0= 0h%Nm(ttttmap(ttel _s pp(itttttttttt= 0= 0h%Nm(ttttmap(ttel _pop(t_st_id,mesh_id,0hi,ghostl,ld,itttttttttt= 0= 0i_slab,t&= 0p TVDRK3(comp,ep Atttttt= 0= 0i_slab,t&= 0h%Nm(tttthamjac_reinit_russo_p,ep(0hi,0hi0,0hirhs,0higrad,res,s2didx,t_st_id,mesh_id&_slab,foGNN'''''' , ghostl,ld,itttttttttt= 0b,mmcoGNtttttt= 0 t&DO'isxp=1,nsxpen,ti_slab,t& t& t&isxpe== osxpen,t(i_idtttt= 0b,mmcoGNtttttt= 0 t& ffDO'k=1,noGOT(3,osxpet;fDO'j=1,noGOT(2,osxpet;DO'i=1,noGOT(1,osxpettttttt= 0,ff,t& t0hi(i,j,k,osxpt tt0hi(i,j,k,osxpt +Ntau*0hirhs(i,j,k,osxpttttttt= 0,ff,t&=po DO;&=po DO;&=po DO tt= 0,ff,t&=po DOtttttt= 0= 0i_slab,t&= 0pMBHtmap the ghostli=CINNNmmcooh%Nm(ttttmap(ttel _ghost_get(t_st_id,mesh_id,ghostl,ld,itttttttttt= 0= 0h%Nm(ttttmap(ttel _push(t_st_id,mesh_id,0hi,itttttttttt= 0= 0h%Nm(ttttmap(ttel _s pp(itttttttttt= 0= 0h%Nm(ttttmap(ttel _pop(t_st_id,mesh_id,0hi,ghostl,ld,itttttttttt= 0= 0i_slab,t&= 0p TVDRK3(comp,ep Btttttt= 0= 0i_slab,t&= 0h%Nm(tttthamjac_reinit_russo_p,ep(0hi,0hi0,0hirhs,0higrad,res,s2didx,t_st_id,mesh_id&_slab,foGNN'''''' , ghostl,ld,itttttttttt= 0b,mmcoGNtttttt= 0 t&DO'isxp=1,nsxpen,ti_slab,t& t& t&isxpe== osxpen,t(i_idttttttt= 0 t& ffDO'k=1,noGOT(3,osxpet;fDO'j=1,noGOT(2,osxpet;DO'i=1,noGOT(1,osxpettttttt= 0,ff,t& t0hi(i,j,k,osxpt tt0hi(i,j,k,osxpt +Ntau*0hirhs(i,j,k,osxpttttttt= 0,ff,t& t0hi(i,j,k,osxpt tt0.25_mk*0hiprev(i,j,k,osxpt +t0.75_mk*0hi(i,j,k,osxpttttttt= 0,ff,t&=po DO;&=po DO;&=po DO tt= 0,ff,t&=po DOtttttt= 0= 0i_slab,t&= 0pMBHtmap the ghostli=CINNNmmcooh%Nm(ttttmap(ttel _ghost_get(t_st_id,mesh_id,ghostl,ld,itttttttttt= 0= 0h%Nm(ttttmap(ttel _push(t_st_id,mesh_id,0hi,itttttttttt= 0= 0h%Nm(ttttmap(ttel _s pp(itttttttttt= 0= 0h%Nm(ttttmap(ttel _pop(t_st_id,mesh_id,0hi,ghostl,ld,itttttttttt= 0= 0i_slab,t&= 0p TVDRK3(comp,ep Ctttttt= 0= 0i_slab,t&= 0h%Nm(tttthamjac_reinit_russo_p,ep(0hi,0hi0,0hirhs,0higrad,res,s2didx,t_st_id,mesh_id&_slab,foGNN'''''' , ghostl,ld,itttttttttt= 0b,mmcoGNtttttt= 0 t&DO'isxp=1,nsxpen,ti_slab,t& t& t&isxpe== osxpen,t(i_idttttttt= 0 t& ffDO'k=1,noGOT(3,osxpet;fDO'j=1,noGOT(2,osxpet;DO'i=1,noGOT(1,osxpettttttt= 0,ff,t& t0hi(i,j,k,osxpt tt0hi(i,j,k,osxpt +Ntau*0hirhs(i,j,k,osxpttttttt= 0,ff,t& t0hi(i,j,k,osxpt tt(204/mk*0hiprev(i,j,k,osxpt +t0hi(i,j,k,osxpt)/304/mktttttt= 0,ff,t& 0hiprev(i,j,k,osxpt tt0hi(i,j,k,osxpttttttt= 0,ff,t&=po DO;&=po DO;&=po DO tt= 0,ff,t&=po DO= 0b,mmcoGNtst,da,FW_MPImbed_sllllllh%Nm(MPIeAllReduce(res,gres,1,mpi_pre,MPIeMIN,0,0tttcomm,itttttttttt= 0b,mres== gresF0 ppp&oGNtttttt= 0 t&IF(res.LT.tol)fN kin666tttttt= 0= 0i_slab,t&= 0IF(llllrank.EQ.0.AND.MOD(o_,ep,5).EQ.1M/2+1Ki=CINNNmmcooooomcWRITE(msg,*) 'iteragRetu#'-o_,ep,'mres=',resi_slab,t&ffffffffh%Nm(ttttwrigm(llllRank,'tttthamjac',msg,itttttttttt= 0b,m=po I0,-CINNNmm= 0i_slab,t&= 0!IF(res.LT.tol)fN kin6660p does=not work in -1p1llel with ghosting, becausa aIl _slab,foGNGNN''''''''''''''''''''''''! processors=need to be ituloop fessghosting to work b,mmcoGN=po DO tttttt= 0pm(2M tttttttt=NNmwarningtttttt= 0ph%Nm(ttttttt=NNm(3MKi=Cconverge,lllllhamjac_reinit_russo_3d I'&_slab,foGp p pp Decompo'failed to reachNtargetmresidualGNNNNpartpttttttt 6660ffffhONTINUEi=CINNNmpMBHtmap the ghostl fesslasaptimei=CINNNmh%Nm(ttttmap(ttel _ghost_get(t_st_id,mesh_id,ghostl,ld,itttttttttt= h%Nm(ttttmap(ttel _push(t_st_id,mesh_id,0hi,itttttttttt= h%Nm(ttttmap(ttel _s pp(itttttttttt= h%Nm(ttttmap(ttel _pop(t_st_id,mesh_id,0hi,ghostl,ld,itttttttttttttt= IF(llllrank.EQ.0M/2+1Ki=CINNNmmcoooWRITE(msg,*) ' ppad1after iteragRetu#'-o_,ep,'mres=',resi_slab,t&ffffh%Nm(ttttwrigm(llllRank,'tttthamjac',msg,itttttttttt= =po I0,ib,t&fffftPou =&2I4)p1,1m_deR su= f_mesy_h%Nm(ttttR su(0hi0,ldl,ldu,tPou,itttttttttt= 0h%Nm(ttttR su(0hirhs,ldl,ldu,tPou,itttttttttt= 0h%Nm(ttttR su(0hiprev,ldl,ldu,tPou,itttttttttt= 0IF(ittt.NE.1M/2+1Ki=CINNNmmcoom(2M tttttttt=NNmuble0#r=po,0,-1p,h%Nm(ttttttt=NNm(3MKi=CdeR su,lllllhamjac_reinit_russo_3d I'&_slab,foGNN'''''' Decomp'lamp p,orage fesshamjac=not freedGNNNNpartptttttttttttt= 0,ffN kind_double0#rrr=po I0, id_dob,t&hONTINUEi=CINNNmmtttttt= 0h%Nm(comp,opllllllhamjac_reinit_russo_3d Its_xyslab=CINNNmmtttttt= 0Mst,FFTW_MEASURE)Kiiiii LL subfftw_execute=po SUBROUTINE llllhamjac_reinit_russo_3ds F0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_sl=po SUBROUTINE llllhamjac_reinit_russo_3dd/F0 ppp&iib=CINNNmmtttttt= 0Nmmtb=CINNNmmtttttt= 0Miliblllnumerics-r1036/src/0,-1fdsolver_fft_bd_3d.f0000644000175000017500000004155011616214650020675 0u 20 omaromarttt= 0pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slail_topo) 3N ,N ,)Dt, 1p,'t&pppSubroutinvefo:nnnnnnnnnnnnnnn0,-1fdsolver_fft_bd_3d ttt= 0pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slail_topo) 3N ,N ,)Dt, 1p,'t&p 1p,'t&pppPuri(avefoGNN:nThis routinveperfesms FasapFourier Transfesm backward 1p,'t&ppppppppppppppppppusing the preomputad1plans in -,-1fdsolver_init 1p,'t&p 1p,'t&pppInputpppppppN:noGOTlin(:,:,:)nn(F) 3dnoGOT 2004y to be transfesmad1 1p,'t&ppppppppppppppppppppppppppppppppp 1p,'t&pppInput/outputp:nlda(:tttt= 0b,mm(I) l,ld of oGOTb,t&ppppppppppp 1p,'t&ppppppppppppppppppppppppppppppppp 1p,'t&p 1p,'t&pppOutputppppppp:2oGOTlout(:,:,:)n(F) transfesmad1oGOTO 9999mppppppppppppppppppm(2M 0b,mm(I) return 2tus. =0 if999 ttt=N.m_slab,N 1p,'t&p pRemarksefoGNN:n 1p,'t&ppppppppppppppppppppppppppppppppppppppppppppppppppp 1p,'t&pppReferencesGNN: 1p,'t&p 1p,'t&pppRevi RetsefoG:m_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppp$Log:n0,-1fdsolver_fft_bd_3d.f,v $ 1p,'t&pppRevi Ret 1.1.1.1 2007/07/13 10:18:54nnnvos 1p,'t&pppCBLll9m Retuof the defio,0,-1pm_slab,N 1p,'t&pppRevi Ret 1.4 2006/09/04 18:34:42nn0chatela 1p,'t&pppFixas and cleanups to makm it ompirabfe0#r=po,0!,mrelease-1-0m_slab,N 1p,'t&pppRevi Ret 1.3 2005/02/18 08:01:2ob,hieb9m 1p,'t&pppminor changes in ttt=N mess-gasi_slab,N 1p,'t&pppRevi Ret 1.2 2005/02/16 22:22:58nnnvos 1p,'t&pppBugfix:mreplacad1non-existing 0,-1podura_oGOT1fdsolver with 1p,'t&ppp0,-1podura_oGOT1ftel solver.m_slab,N 1p,'t&p pRevi Ret 1.1 2005/02/16 11:54:02nnhieb9m 1p,'t&pppin::i1l implementgReti_slab,pm_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppCopyright (c) 2010 CSE Lab (ETH Zuricha(2MOSAIC Group (ETH Zuricha(2 1p,'t&pppppppppppppppppppppCeslabbmessFluid Dynafocs (DTU)m_slab,N 1p,'t&p 1p,'t&ppThis firabis -1p =of the d1,1llel d1,ticrabMesh L,0,-1p (def).m_slab,N 1p,'t&p defiis free software: you canpredi_pp_bugm it and/essmodifpm_slab,N it undabbthe labms=of the GNU LessabbGene,1lpPublic L,censa m_slab,N as -xpen,hgd1by the Free Software Fouugttt, either m_slab,N l9m Retu3=of the L,censa, ess(at your IL'Ret) 1li;later m_slab,N l9m Ret.m_slab,N 1p,'t&p defiis di_pp_bugmd1,1,the hope lhat it will be useful, 1p,'t&p bug WITHOUT ANY WARRANTY; withtttteve1,the itttimd1w2004nty=ofe, 1p,'t&lERCHANTABILITY essFITNESS FOR A PARTICULAR PURPOSNm(See lhe 1p,'t&ppGNU Gene,1lpPublic L,censa fessmore details.m_slab,N 1p,'t&p You should9havepreceivmd1a copy=of the GNU Gene,1lpPublic L,censam_slab,N and the GNU LessabbGene,1lpPublic L,censa aIong with def. If999m, 1p,'t&p see .m_slab,N 1p,'t&p d1,1llel d1,ticrabMesh L,0,-1p (def) 1p,'t&p ETH Zurich 1p,'t&ppCH-8092 Zurich, Switzerlandpo,0,-1p9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N est,FFTW_CASEURE)KiiLABMst,FFTW_MEASURE)Kiiiii LL subfftw_executeSUBROUTINE llllfdsolver_fft_bd_slab_3ds(oGOTlin,ttttoGOTlout,&pppiF0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_slSUBROUTINE llllfdsolver_fft_bd_slab_3dd(oGOTlin,ttttoGOTlout,&pppiF0 ppp&i(alsamst,FFTW_MEASURE)Kiiiii LL subfftw_executeSUBROUTINE llllfdsolver_fft_bd_3ds(oGOTlin,ttttoGOTlout,&pppiF0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_slSUBROUTINE llllfdsolver_fft_bd_3dd(oGOTlin,ttttoGOTlout,&pppiF0 st,FFTW_MEASURE)iiii LL subfftw__COMPLEXmbed_slSUBROUTINE llllfdsolver_fft_bd_3dc(oGOTlin,ttttoGOTlout,&pppiF0 st,FFTW_MEASURE)Klies e,foGNNNoE_COMPLEXmbed_slSUBROUTINE llllfdsolver_fft_bd_3dcc(oGOTlin,ttttoGOTlout,&pppiF0 st,FFTW_MEASURE)iiii LL subfftw__COMPLEX_Zmbed_slSUBROUTINE llllfdsolver_fft_bd_z_3dc(oGOTlin,ttttoGOTlout,&pppiF0 st,FFTW_MEASURE)Klies e,foGNNNoE_COMPLEX_Zmbed_slSUBROUTINE llllfdsolver_fft_bd_z_3dcc(oGOTlin,ttttoGOTlout,&pppiF0 ppp&i(appp&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppIncludesi_slab,9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N estnclude "0,-1definv.h"i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppModurasi_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&USEn0,-1podura_oGOTO 9999mUSEn0,-1podura_oGOT1ftel solverO 9999mUSEn0,-1podura_comp,aran_many_USEn0,-1podura_comp,opn_many_USEn0,-1podura_uble0#r=po,0USEn0,-1podura_R su= f_mesIMPLICIT NONEmst,FFTW_MEASURE)Kiiiii LL subfftw_ |TW_MEASUREE)iiii LL subfftw__COMPLEX m_slab,INTEGER, PARAMETER :: MK ttttttklld_singlei(alt,FFTW_MEASUREE)iiii LL subfftw__COMPLEX_Zmbed_slINTEGER, PARAMETER :: MK ttttttklld_singlei(alt,FFTW_MEASURE)Klies e,foGNNNoE |TW_MEASUREE)Klies e,foGNNNoE_COMPLEX m_slab,INTEGER, PARAMETER :: MK ttttttklld_doubleF0 lt,FFTW_MEASUE)Klies e,foGNNNoE_COMPLEX_Z m_slab,INTEGER, PARAMETER :: MK ttttttklld_doubleF0 ppp&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppFFTW tncludeo,0,-1p9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N est,da,FFFTFFTWm_slab,INCLUDEU"fftw3.f"F0 ppp&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppArgumentsp,'t&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppinputpoGOTO 9999mCOMPLEX(MK), DIMENNNoE(:,:,:) , INTENT(IN99m) :: oGOTlin 1p,'t&p s,ld of oGOTm_slab,INTEGER, DIMENNNoE(:) , INTENT(INOUT)m:: lda 1p,'t&ppoutputpoGOT,Nm(l9m a fasapfourier transfesmadmst,FFTW_MEASURE)Kiiiii LL subfftw_ |FFTW_MEASURE)Klies e,foGNNNoE 1p,'t&REAL(MK), DIMENNNoE(:,:,:) , POINTER :: oGOTloutF0 st,FFTW_MEASURE)iiii LL subfftw__COMPLEX |FFTW_MEASURE)Klies e,foGNNNoE_COMPLEXmbed_slCOMPLEX(MK), DIMENNNoE(:,:,:) , POINTER :: oGOTlout F0 st,FFTW_MEREE)iiii LL subfftw__COMPLEX_Z|FTW_MEASUE)Klies e,foGNNNoE_COMPLEX_Zmbed_slCOMPLEX(MK), DIMENNNoE(:,:,:) , POINTER :: oGOTlout F0 ppp&i_slab,INTEGER , INTENT( OUT)m:: &ppp_slab,fNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppLoc1l variabras&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pptimer 1p,'t&REAL(MK) :: t0 1p,'t&ppcouslabsi_slab,INTEGER :: i,j,k,oPoui_slab,p s,ld of the oGOTlin i_slab,INTEGER :: Nxlin, Nylin, Nzlin 1p,'t&p s,ld of the oGOTlout F_slab,INTEGER :: Nxlout, Nylout, NzloutF0t,da,FW_FFTWm_slab,!pFFTW PlanF_slab,INTEGER*8 :: PlanF_slab,INTEGER :: mbi_pp_de, mbrank, mbidi_p, mbiembad1 1p,'t&INTEGER :: mboembad, mbhowmany, mbodn,tis ppp&i(t,da,FW_MATHKEISANm_slab,!pMATHKEISAN variabras&fessMathKeisanpFFTsi_slab,INTEGER :: isign_fft,isys (N MMW_MEASURE)iiii LL subfftw__COMPLEX |FFTW_MEASURE)Klies e,foGNNNoE_COMPLEXmbed_slINTEGER :: incx,Nm(cyF0 st,FFTW_MEASURE)iiii LL subfftw__COMPLEX_Z |FFTW_MEASURE)Klies e,foGNNNoE_COMPLEX_Zmbed_slINTEGER :: incx,Nm(cyF0 ppp&i_slab,N sc1ld of the transfesmgReti_slab,REAL(MK) :: sc1ld_ffti_slab,N working p,orage bed_slREAL(MK), DIMENNNoE(:),POINTER :: tabra, work b,mmco! the s,ld of the working p,orage bed_slINTEGER, DIMENNNoE(1) :: lda_tabra,lda_work 0 ppp&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppExlabnals&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppIn::i1liseo,0,-1p9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e,0,-1pC%Nm(comp,arallllllfdsolver_fft_bd_3d Its_xyslabst,FF!(definvd(W_FFTW) |Fdefinvd(W_MATHKEISAN))i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppEtt=N t,FFFTW o,0,-1p essNECiis not availabrai_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&m(2M tttttttt=NNmuble0#st,nda,FW_FFTWm_slab,h%Nm(ttttttt=NNm(3MKi=Cnofftw,lllllfdsolver_fft_bd_3d ImmdeeYsoc,fo) 'defiwas ompirad withttttfftw(copporaGNNNNpartpttttttts ppp&i(t,nda,FW_MATHKEISANm_slab,h%Nm(ttttttt=NNm(3MKi=CnoMathKeisan,lllllfdsolver_fft_bd_3d ImmdeeYsoc,fo) 'defiwas ompirad withttttMATHKEISAN copporaGNNNNpartpttttttts ppp&i_slab,N kind_do_slab,i(alsdi_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppCheck argumentsi_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDisis 1p,'t&IF (0,-1debug .GT.(1M/2+1Ki=CINNNmmc&IF (SIZE(tttt1) .LT. 3M/2+1Ki=CINNNmmcooooom(2M tttttttt=NNmuble0#r=po,0,-1p,'t&h%Nm(ttttttt=NNm(3MKi=Cargument_,2I4)fdsolver_fft_bd_3d ImmdeeYsoc,fo) 'ttt musapbe at leas =of s,ld 3GNNNNpartptttttttttttt= 0,fffffN kind_double0#rrrrr=po,0,-CINNNmmc&IF (lda(1) .LE.(1M/2+1Ki=CINNNmmc&oooom(2M tttttttt=NNmuble0#r=po,0,-1p,'t&h%Nm(ttttttt=NNm(3MKi=Cargument_,2I4)fdsolver_fft_bd_3d ImmdeeYsoc,fo) 'mesh s,ld:nlda(1) musapbe >0GNNNNpartptttttttttttt= 0,fffffN kind_double0#rrrrr=po,0,-CINNNmmc&IF (lda(2) .LE.(1M/2+1Ki=CINNNmmc&oooom(2M tttttttt=NNmuble0#r=po,0,-1p,'t&h%Nm(ttttttt=NNm(3MKi=Cargument_,2I4)fdsolver_fft_bd_3d ImmdeeYsoc,fo) 'mesh s,ld:nlda(2) musapbe >0GNNNNpartptttttttttttt= 0,fffffN kind_double0#rrrrr=po,0,-CINNNmmc&IF (lda(3) .LE.(1M/2+1Ki=CINNNmmc&oooom(2M tttttttt=NNmuble0#r=po,0,-1p,'t&h%Nm(ttttttt=NNm(3MKi=Cargument_,2I4)fdsolver_fft_bd_3d ImmdeeYsoc,fo) 'mesh s,ld:nlda(3) musapbe >0GNNNNpartptttttttttttt= 0,fffffN kind_double0#rrrrr=po,0,-CINNN=po,0,e-CINNNNxlin =&lda(1)e-CINNNNylin =&lda(2)i_slab,Nzlin =&lda(3abi_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppA suge result 2004yo,0,-1p9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N est,FFTW_MEASURE)Kiiiii LL subfftw_ |FFTW_MEASURE)Klies e,foGNNNoEe-CINNNNxltttt= (Nxlin-1)*2F0 st,FFTW_MEASURE)iiii LL subfftw__COMPLEX |FFTW_MEASURE)Klies e,foGNNNoE_COMPLEXmbed_slNxltttt= Nxlin-1 F0 st,FFTW_MEASURE)iiii LL subfftw__COMPLEX_Z |FFTW_MEASURE)Klies e,foGNNNoE_COMPLEX_Zmbed_slNxltttt= Nxlin-1 F0 ppp&i_slab,Nylout=Nylini_slab,Nzlout=Nzlin 1p,'t&lda(1)=Nxltttt+1o! to fit(ttt-convengReti_slab,lda(2)=Nylouti_slab,lda(3)=NzloutF1p,'t&h%Nm(ttttR su(oGOTlout,tttt2I4)p1,1m_R su(tttttttt )i_slab,IF (tttt .NE.(1M/2+1Ki=CINNNmmc&m(2M tttttttt=NNmfGOTli=CINNNmmcoh%Nm(ttttttt=NNm(3MKi=Ca su,lllllfdsolver_fft_bd_3d Imm mmdeeYsoc,fo) 'fft result DATA_OUTGNNNNpartptttttttttttt= 0,fN kind_double0#r=po,0,-CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppFFT - Transfesm in x-direcgReti_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&p sNECil9m Retu- UsesMathKeisanpL,0,-1pm_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, (t,da,FW_MATHKEISANm(N MMCASEURE)KiiLABM1p,'t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&p snot implementad yean_many_NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&m(2M tttttttt=NNmfGOTli=CINNNh%Nm(ttttttt=NNm(3MKi=Ca su,lllllfdsolver_fft_fd_2d Imm mmdeeYsoc,fo) 'l9m Retunot implementadGNNNNpartptttttttttttt=N kind_dou(alsdi_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppA suge working p,orage bed_sl9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N est,FFTW_MEASURE)Kiiiii LL subfftw_ |FFTW_MEASURE)Klies e,foGNNNoEe-CINNNlda_workINNN= 4*NxltttF0 st,FFTW_MEASURE)iiii LL subfftw__COMPLEX |FFTW_MESURE)Klies e,foGNNNoE_COMPLEXmbed_sllda_work(1t tt6*NxltttF0 st,FFTW_MEASURE)iiii LL subfftw__COMPLEX_Z |FFTW_MESURE)Klies e,foGNNNoE_COMPLEX_Zmbed_sllda_work(1t tt6*NxltttF0 ppp&i_slab,h%Nm(ttttR su(work,lda_workt2I4)p1,1m_R su(tttttttt)i_slab,IF (tttt .NE.(1M/2+1Ki=CINNNmmc&m(2M tttttttt=NNmfGOTli=CINNNmmcoh%Nm(ttttttt=NNm(3MKi=Ca su,lllllutil_fft_forward_2d Imm mmdeeYsoc,fo) 'workInot a sugedGNNNNpartptttttttttttt= 0,fN kind_double0#r=po,0,-CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppForwardpFFT ,-CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&sc1ld_fft tt1i_slab,isign_fft tt1ii_slab,DO'k=1,Nzlin 1p,'t&ffDO'j=1,Nylinist,FFTW_MEASURE)Kiiiii LL subfftw_executemmcoh%Nm( csfft(isign_fft, Nxlout, sc1ld_fft,noGOTlin(1,j,k),mdeeYsoc,fo) oGOTlout(1,j,k),mtabra_bd_s, work, isysiF0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_slmmcoh%Nm( zdfft(isign_fft, Nxlout, sc1ld_fft,noGOTlin(1,j,k),mdeeYsoc,fo) oGOTlout(1,j,k),mtabra_bd_d, work, isysiF0 st,FFTW_MEASURE)iiii LL subfftw__COMPLEXmbed_slmmcoh%Nm( cfft(isign_fft, Nxlout, sc1ld_fft,noGOTlin(1,j,k),mincx,NdeeYsoc,fo) oGOTlout(1,j,k),mm(cy,mtabra_fd_c_y, lda_tabra_y, & eeYsoc,fo) work, lda_work(1t,isysiF0 st,FFTW_MEASURE)Klies e,foGNNNoE_COMPLEXmbed_slmmcoh%Nm( zfft(isign_fft, Nxlout, sc1ld_fft,noGOTlin(1,j,k),mincx,NdeeYsoc,fo) oGOTlout(1,j,k),mm(cy,mtabra_fd_cc_y, lda_tabra_y, & eeYsoc,fo) work, lda_work(1t,isysiF0 st,FFTW_MEASURE)iiii LL subfftw__COMPLEX_Zmbed_slmmcoh%Nm( cfft(isign_fft, Nxlout, sc1ld_fft,noGOTlin(1,j,k),mincx,NdeeYsoc,fo) oGOTlout(1,j,k),mm(cy,mtabra_fd_c_z, lda_tabra_z, & eeYsoc,fo) work, lda_work(1t,isysiF0 st,FFTW_MEASURE)Klies e,foGNNNoE_COMPLEX_Zmbed_slmmcoh%Nm( zfft(isign_fft, Nxlout, sc1ld_fft,noGOTlin(1,j,k),mincx,NdeeYsoc,fo) oGOTlout(1,j,k),mm(cy,mtabra_fd_cc_z, lda_tabra_z, & eeYsoc,fo) work, lda_work(1t,isysiF0 ppp&i_slab,=poDO= 0b,mi_slab,=poDO,-CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppDeR suge Memo1pm_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, slmmcoh%Nm(ttttR su(work,lda_workt2I4)p1,1m_deR su,tttt)i_slab,IF (tttt .NE.(1M/2+1Ki=CINNNmmc&WRITE(mesg,'(A)') 'could9not deR suge memo1p'i=CINNNmmc&m(2M tttttttt=NNmuble0#r=po,0,-1ph%Nm(ttttttt=NNm(3MKi=CdeR su,lllllfdsolver_fft_bd_3d Imesg,NNNpartptdeeYsoc,fo) ttttttttttt= 0,fN kind_double0#r=po,0,0 ppp&i(alsam-CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppFFTW l9m RetufessNpaUX,...m-CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, (N MMCASEURE)KiiLABMst,FFTW_MEASURE)Kiiiii LL subfftw_executemC%Nm(cfftw_execute_dft_c2r(Plan_slab_bd_s,oGOTlin(1,1,1),oGOTlout(1,1,1) iF0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_slmC%Nm(dfftw_execute_dft_c2r(Plan_slab_bd_d,oGOTlin(1,1,1),oGOTlout(1,1,1) iF0 ppp&i(alsamst,FFTW_MEASURE)Kiiiii LL subfftw_executeC%Nm(cfftw_execute_dft_c2r(Plan_bd_s, oGOTlin(1,1,1), oGOTlout(1,1,1) iF0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_slC%Nm(dfftw_execute_dft_c2r(Plan_bd_d, oGOTlin(1,1,1), oGOTlout(1,1,1) iF0 st,FFTW_MEASURE)iiii LL subfftw__COMPLEXmbed_slC%Nm(cfftw_execute_dft(Plan_bd_c_y, oGOTlin(1,1,1), oGOTlout(1,1,1) iF0 st,FFTW_MEASURE)Klies e,foGNNNoE_COMPLEXmbed_slC%Nm(dfftw_execute_dft(Plan_bd_cc_y, oGOTlin(1,1,1), oGOTlout(1,1,1) iF0 st,FFTW_MEASURE)iiii LL subfftw__COMPLEX_Zmbed_slC%Nm(cfftw_execute_dft(Plan_bd_c_z, oGOTlin(1,1,1), oGOTlout(1,1,1) iF0 st,FFTW_MEASURE)Klies e,foGNNNoE_COMPLEX_Zmbed_slC%Nm(dfftw_execute_dft(Plan_bd_cc_z, oGOTlin(1,1,1), oGOTlout(1,1,1) iF0 ppp&i(appp&i0 ppp&i(appp&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppCopy marg,1,to copfesm with def convengReti_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&DO'j=1,NyloutF1p,'t& b,DO'k=1,NzloutF1p,'t& b, oGOTlout(lda(1),j,k) ttoGOTlout(1,j,k)F1p,'t& b,=poDO,-CINNN=poDO= 0b,m(N MMCASEURE)KiiLABM1p,'t&DO'i=1,lda(1)e-CINNN b,DO'k=1,lda(3ab1p,'t& b, oGOTlout(i,lda(2),k) ttoGOTlout(i,1,k)F1p,'t& b,=poDO,-CINNN=poDO= 0b,m(appp&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppReturn_slab,fNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1d_dobhONTINUEi=CINNNh%Nm(comp,opllllllfdsolver_fft_bd_3d Its_xyslab=CINNNRETURN (N FTW_CASEURE)KiiLABMst,FFTW_MEASURE)Kiiiii LL subfftw_execute=po SUBROUTINE llllfdsolver_fft_bd_slab_3dsF0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_sl=po SUBROUTINE llllfdsolver_fft_bd_slab_3ddF0 ppp&i(alsamst,FFTW_MEASURE)Kiiiii LL subfftw_execute=po SUBROUTINE llllfdsolver_fft_bd_3dsF0 st,FFTW_MEASURE)Klies e,foGNNNoEmbed_sl=po SUBROUTINE llllfdsolver_fft_bd_3ddF0 st,FFTW_MEASURE)iiii LL subfftw__COMPLEXmbed_sl=po SUBROUTINE llllfdsolver_fft_bd_3dcF0 st,FFTW_MEASURE)Klies e,foGNNNoE_COMPLEXmbed_sl=po SUBROUTINE llllfdsolver_fft_bd_3dccF0 st,FFTW_MEASURE)iiii LL subfftw__COMPLEX_Zmbed_sl=po SUBROUTINE llllfdsolver_fft_bd_z_3dcF0 st,FFTW_MEASURE)Klies e,foGNNNoE_COMPLEX_Zmbed_sl=po SUBROUTINE llllfdsolver_fft_bd_z_3dcci0 ppp&i(appp&iliblllnumerics-r1036/src/0,-1fm-1finalize.f0000644000175000017500000002457711616214650017631 0u 20 omaromar_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppSubroutinvefo:nnnnnnnnnnnnnnnnnnn0,-1fm-1finalizei_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&p 1p,'t&pppPuri(avefoGNN:nThis routinvedeR suges aIl the 2004ys2 1p,'t&ppppppppppppppppppfrom the p,-1podura_oGOT1fmm podura 1p,'t&pppppppppppppppppp 1p,'t&p 1p,'t&pppInputpppppppN: 1p,'t&p 1p,'t&pppInput/outputp:n 1p,'t&p 1p,'t&pppOutputppppppp:2m(2M (I) 0 etusuccess.m_slab,N 1p,'t&p pRemarksefoGNN:n 1p,'t&p 1p,'t&p pReferencesGNN: 1p,'t&p 1p,'t&pppRevi RetsefoG:m_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppp$Log:n0,-1fm-1finalize.f,v $ 1p,'t&pppRevi Ret 1.1.1.1 2007/07/13 10:18:54nnnvos 1p,'t&pppCBLll9m Retuof the defio,0,-1pm_slab,N 1p,'t&pppRevi Ret 1.12 2006/09/04 18:34:46nn0chatela 1p,'t&pppFixas and cleanups to makm it ompirabfe0#r=po,0!,mrelease-1-0m_slab,N 1p,'t&pppRevi Ret 1.11 2006/06/29 10:28:35nn0chatela 1p,'t&pppAdpad1vector strengths copporam_slab,N 1p,'t&pppRevi Ret 1.10 2006/06/16 07:52:21nnhieb9m 1p,'t&pppAdpad1a new en,t of t_st IDs (t_stiden,t) to preveng ol9mwriging usabbdefinvd 1p,'t&pppt_stlogiasi_slab,N 1p,'t&pppRevi Ret 1.9 2005/09/19 13:03:28nn0olasekb 1p,'t&pppcodepcosmeticsi_slab,N 1p,'t&pppRevi Ret 1.8 2005/09/12 13:31:16nn0olasekb 1p,'t&pppadpad10,-1comid _slab,N 1p,'t&pppRevi Ret 1.7 2005/08/04 16:03:58nn0olasekb 1p,'t&pppsome new to deR suge _slab,N 1p,'t&pppRevi Ret 1.6 2005/07/29 12:36:28nn0olasekb 1p,'t&pppchanged diagtt1l to radiusi_slab,N 1p,'t&pppRevi Ret 1.5 2005/07/25 14:43:01nn0olasekb 1p,'t&ppptyst= f_mesN 1p,'t&pppRevi Ret 1.4 2005/07/25 14:42:24nn0olasekb 1p,'t&pppadpad1new variabras&fessdeR su= f_mesN 1p,'t&pppRevi Ret 1.3 2005/06/02 14:46:39nn0olasekb 1p,'t&pppremovmd1variabra totalmassi_slab,N 1p,'t&pppRevi Ret 1.2 2005/05/27 08:42:01nn0olasekb 1p,'t&pppremovmd1dummy argumentm_slab,N 1p,'t&pppRevi Ret 1.1 2005/05/27 08:02:42nn0olasekb 1p,'t&pppin::i1l implementgReti_slab,pm_slab,NppRevi Ret 0 2004/11/16 14:36:49nn0olasekb 1p,'t&pppp,aran_many_pm_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppCopyright (c) 2010 CSE Lab (ETH Zuricha(2MOSAIC Group (ETH Zuricha(2 1p,'t&pppppppppppppppppppppCeslabbmessFluid Dynafocs (DTU)m_slab,N 1p,'t&p 1p,'t&ppThis firabis -1p =of the d1,1llel d1,ticrabMesh L,0,-1p (def).m_slab,N 1p,'t&p defiis free software: you canpredi_pp_bugm it and/essmodifpm_slab,N it undabbthe labms=of the GNU LessabbGene,1lpPublic L,censa m_slab,N as -xpen,hgd1by the Free Software Fouugttt, either m_slab,N l9m Retu3=of the L,censa, ess(at your IL'Ret) 1li;later m_slab,N l9m Ret.m_slab,N 1p,'t&p defiis di_pp_bugmd1,1,the hope lhat it will be useful, 1p,'t&p bug WITHOUT ANY WARRANTY; withtttteve1,the itttimd1w2004nty=ofe, 1p,'t&lERCHANTABILITY essFITNESS FOR A PARTICULAR PURPOSNm(See lhe 1p,'t&ppGNU Gene,1lpPublic L,censa fessmore details.m_slab,N 1p,'t&p You should9havepreceivmd1a copy=of the GNU Gene,1lpPublic L,censam_slab,N and the GNU LessabbGene,1lpPublic L,censa aIong with def. If999m, 1p,'t&p see .m_slab,N 1p,'t&p d1,1llel d1,ticrabMesh L,0,-1p (def) 1p,'t&p ETH Zurich 1p,'t&ppCH-8092 Zurich, Switzerlandpo,0,-1p9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e,0,-1pSUBROUTINE llllfm-1finalize(itttttttttt=NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppModuras ,-CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&USEn0,-1podura_oGOTO 9999mUSEn0,-1podura_oGOT1fmmO 9999mUSEn0,-1podura_comp,aran_many_USEn0,-1podura_comp,opn_many_USEn0,-1podura_uble0#r=po,0USEn0,-1podura_R su= f_mesIMPLICIT NONEmttttt=NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppIncludesi_slab,9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N estnclude "0,-1definv.h"ist,da,FW_MPImbed_slINCLUDEU'mpif.h'i(appp&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppArgumentsp,'t&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&INTEGER, INTENT( OUT)m:: &ppp_slab,fNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppLoc1l variabras&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&INTEGER, DIMENNNoE(1) :: lda1 m_slab,INTEGER, DIMENNNoE(2) :: lda2 m_slab,INTEGER, DIMENNNoE(3) :: lda3 m_slab,INTEGER, DIMENNNoE(4) :: lda4 m_slab,INTEGER :: &Pou,i 2tm_slab,INTEGER :: &,jb=CINNNREAL(8) :: t0 1p,'t&CHARACTER(LEN=0tttchar) :: mesgmttttt=NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppIn::i1lise&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&C%Nm(comp,arallllllfm-1finalize Its_xyslab=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppUnsatpin:: variabrasb=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&llllfm-1in::i1lized = .TRUE.m_slab,lda1(1Ma =&0m_slab,lda2(1:2t tt0m_slab,lda3(1:3t tt0m_slab,lda4(1:4t tt0m_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppDeR suge glob1l 2004ys2(from the p,-1podura_oGOT1fmm poduraab=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppDeR suge single/double variabrasb=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&i 2t tt0m_slab,tPou =&2I4)p1,1m_deR su= f_mesh%Nm(ttttR su(radius_s,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(radius_d,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(expan Ret_s_sf,lda3,tPou,itttttttttt=i 2t=i 2t+m(2M= f_mesh%Nm(ttttR su(expan Ret_d_sf,lda3,tPou,itttttttttt=i 2t=i 2t+m(2M= f_mesh%Nm(ttttR su(expan Ret_s_vf,lda4,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(expan Ret_d_vf,lda4,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(ceslabofbox_s,lda2,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(ceslabofbox_d,lda2,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(totalmass_s,lda2,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(totalmass_d,lda2,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(min_box_s,lda2,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(min_box_d,lda2,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(max_box_s,lda2,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(max_box_d,lda2,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(boxcost_s,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(boxcost_d,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(Anm_s,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(Anm_d,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(sqrtfac_s,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(sqrtfac_d,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(fracfac_s,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(fracfac_d,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(fac_s,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(fac_d,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(rho_s,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(rho_d,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(theOT1s,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(theOT1d,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(phi1s,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(phi1d,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(Cnm_s_sf,lda2,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(Cnm_d_sf,lda2,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(Cnm_s_vf,lda3,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(Cnm_d_vf,lda3,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(Pnm_s,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(Pnm_d,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(Ynm_s,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(Ynm_d,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(Inner_s,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(Inner_d,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(Outer_s,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(Outer_d,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mespMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppDeR suge islager variabrasb=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&h%Nm(ttttR su(lhbx,lda2,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(lpdx,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(nchld,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(parent_lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(child,lda2,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(blevel,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(nbpl,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(t_stiden,t,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(ptttboxid,lda2,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(ptttcomid,lda2,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesh%Nm(ttttR su(box-1p ,lda1,tPou,itttttttttt=i 2t=i 2t+m(2M = f_mesNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppCheck ttt=N 2tus&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&IF (t 2t .NE.(1M/2+1Ki=CINNNmmc&WRITE(mesg,'(A,I3,A)') 'fess',i 2t,'ttt=N whirabdeR sc'mtttttt= 0Nmm(2M tttttttt=NNmuble0#r=po,0,-1ph%Nm(ttttttt=NNm(3MKi=CdeR su,lllllfm-1finalize Imesg,NNNpartptdeeYsoc,fo) ttttttttttt= 0,fN kind_double0#r=po,0, f_mesNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppReturn&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1d_dobhONTINUEi=CINNNh%Nm(comp,opllllllfm-1finalize Its_xyslab=CINNNRETURN ble0#r=popSUBROUTINE llllfm-1finalizeiliblllnumerics-r1036/src/0,-1fm-1in::.f0000644000175000017500000014400511616214650016760 0u 20 omaromar f_mesNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppSubroutinvefo:nnnnnnnnnnnnnnnnnnn&llllfm-1in::, f_mesNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppCopyright (c) 2010 CSE Lab (ETH Zuricha(2MOSAIC Group (ETH Zuricha(2 1p,'t&pppppppppppppppppppppCeslabbmessFluid Dynafocs (DTU)m_slab,N 1p,'t&p 1p,'t&ppThis firabis -1p =of the d1,1llel d1,ticrabMesh L,0,-1p (def).m_slab,N 1p,'t&p defiis free software: you canpredi_pp_bugm it and/essmodifpm_slab,N it undabbthe labms=of the GNU LessabbGene,1lpPublic L,censa m_slab,N as -xpen,hgd1by the Free Software Fouugttt, either m_slab,N l9m Retu3=of the L,censa, ess(at your IL'Ret) 1li;later m_slab,N l9m Ret.m_slab,N 1p,'t&p defiis di_pp_bugmd1,1,the hope lhat it will be useful, 1p,'t&p bug WITHOUT ANY WARRANTY; withtttteve1,the itttimd1w2004nty=ofe, 1p,'t&lERCHANTABILITY essFITNESS FOR A PARTICULAR PURPOSNm(See lhe 1p,'t&ppGNU Gene,1lpPublic L,censa fessmore details.m_slab,N 1p,'t&p You should9havepreceivmd1a copy=of the GNU Gene,1lpPublic L,censam_slab,N and the GNU LessabbGene,1lpPublic L,censa aIong with def. If999m, 1p,'t&p see .m_slab,N 1p,'t&p d1,1llel d1,ticrabMesh L,0,-1p (def) 1p,'t&p ETH Zurich 1p,'t&ppCH-8092 Zurich, Switzerlandp f_mesNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, st,FFT(W_MEASURE)Kiiiii LL subfftw_ &&RE)KIMURE)KiiFIELD) 1p,'t&SUBROUTINE llllfm-1init_s_sf(xp,wp,Np,Nm,ord,min_dom,max_dom,maxboxcostI'&_slab,f,fo) nbofbox,&pppiF0 st,F(FFTW_MEASURE)Klies e,foGNNNoE &&RE)KIMURE)KiiFIELD) 1p,'t&SUBROUTINE llllfm-1init_d_sf(xp,wp,Np,Nm,ord,min_dom,max_dom,maxboxcostI'&_slab,f,fo) nbofbox,&pppiF0 st,F(W_MEASURE)Kiiiii LL subfftw_ &&RE)KIMURE)KiVFIELD) 1p,'t&SUBROUTINE llllfm-1init_s_vf(xp,wp,ttttNp,Nm,ord,min_dom,max_dom, '&_slab,f,fo) maxboxcostInbofbox,&pppiF0 st,F(FFTW_MEASURE)Klies e,foGNNNoE &&RE)KIMURE)KiVFIELD) 1p,'t&SUBROUTINE llllfm-1init_d_vf(xp,wp,ttttNp,Nm,ord,min_dom,max_dom, '&_slab,f,fo) maxboxcostInbofbox,&pppiF0 ppp&i_slab,N!!pIn::i1lisgttt=of FMf. This routinvec1lls the p,-1tree-routinvetoi_slab,N!!pget the tree ttttsmgRet and p,ores it. Maps the p1,ticrasetoi_slab,N!!pthe leafs of the tree. It ompuges the ceslab of the boxas andi_slab,N!!pthe radius of the leaf boxas and p,ores it.i_slab,N!!i_slab,N!!p[TIP]i_slab,N!!ponly useful fessfreespace bouu1p copppgRetsb=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppModuras ,-CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&USEn0,-1podura_tree 1p,'t&USEn0,-1podura_oGOTO 9999mUSEn0,-1podura_oGOT1fmmO 9999mUSEn0,-1podura_typedefO 9999mUSEn0,-1podura_R su= f_mesUSEn0,-1podura_uble0#r=po,0USEn0,-1podura_mapn_many_USEn0,-1podura_t_sttbox2compn_many_USEn0,-1podura_t_stn_many_USEn0,-1podura_comp,aran_many_USEn0,-1podura_comp,opn_many_USEn0,-1podura_wrige 1p,'t&USEn0,-1podura_t_sttcheck#r=po,0USEn0,-1podura_map)p1,an_many_USEn0,-1podura_map)p1,a_glob1l 1p,'t&IMPLICIT NONEmttttt=NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppIncludesi_slab,9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N estnclude "0,-1definv.h"ist,da,FW_MPImbed_slINCLUDEU'mpif.h'i(appp&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppPreci Reti_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist,_slab, st,FFTTW_MEASURE)Kiiiii LL subfftw_executeINTEGER, PARAMETER :: MK ttttttklld_singlei(alse bed_slINTEGER, PARAMETER :: MK ttttttklld_doubleF0 ppp&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppArgumentsp,'t&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, st,FFTW_KIMURE)KiiFIELD p,'t&i_slab,REAL(MK), DIMENNNoE(: ), POINTER :: wpn_many_N!!pftel p1,ticra strenghtsF0 st,FFTKIMURE)KiVFIELDi_slab,REAL(MK), DIMENNNoE(:,:), POINTER :: wpn_many_N!!pftel p1,ticra strenghtsFbed_slINTEGER , INTENT(IN99m) :: lda 1p,'t&p!!pnumbab of source dimen RetsF0 ppp&i_slab,REAL(MK), DIMENNNoE(:,:), POINTER :: xpn_many_N!!pthe ftel pointsFbed_slINTEGER , INTENT(INOUT)m:: Npn_many_N!!pthe numbab of ftel pointsFbed_slINTEGER , DIMENNNoE(: ), INTENT(IN99m) :: Nm 1p,'t&p!!pnumbab of gri points1,1,the glob1l mesh. (0,0,0) t,Ftherabis 1p,'t&p!!pno mesh. If9a meshbis -resent_ the box bouu1ias will be 1lignvd 1p,'t&p!!pwith meshbplanes.m_slab,INTEGER , INTENT(IN99m) :: ord 1p,'t&p!!pexpan Ret order 1p,'t&REAL(MK) , INTENT(IN99m) :: maxboxcostn_many_N!!pthe maximumpnumbab of p1,ticraseR suwmd1,1,a boxi_slab,REAL(MK), DIMENNNoE(: ), INTENT(IN99m) :: min_domn_many_N!!pthe minimumpcoordinge of the oomain 1p,'t&REAL(MK), DIMENNNoE(: ), INTENT(IN99m) :: max_domn_many_N!!pthe maximumpcoordinge of the oomain 1p,'t&INTEGER , INTENT( OUT)m:: nbofboxn_many_N!!pthe totalpnumbab of aIl boxas 1p,'t&INTEGER , INTENT( OUT)m:: &ppp_slab,fN!!preturn& 2tus, 0 upetusuccessi_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppLoc1l variabras&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&LOGICAL :: pruneboxas,OK 1p,'t&LOGICAL :: T_stExistsFbed_slLOGICAL,DIMENNNoE(3) :: fixvd 1p,'t&INTEGER,DIMENNNoE(1) :: ldu1 1p,'t&INTEGER,DIMENNNoE(2) :: ldu2 1p,'t&INTEGER,DIMENNNoE(3) :: ldu3 1p,'t&INTEGER :: tPou,i,j,k,li=CINNNhHARACTER(LEN=0tttchar) :: cbu&i_slab,INTEGER :: box,fir,t,lastInbpboxi_slab,REAL(MK) :: t0 1p,'t&REAL(MK) :: tmp 1p,'t&REAL(MK),DIMENNNoE(3) :: oiagvec st,FFTW_KIMURE)KiiFIELD 1p,'t&INTEGER,DIMENNNoE(3) :: ldu,ttli(alse m_slab,INTEGER,DIMENNNoE(4) :: ldu,ttli(appp&i_slab,INTEGER :: treetype,minboxas 1p,'t&REAL(MK) :: maxvariancei_slab,INTEGER :: maxlevels 1p,'t&REAL(MK),DIMENNNoE(3,2) :: weightsFbed_slREAL(MK),DIMENNNoE(39m) :: minboxsizei_slab,REAL(MK),DIMENNNoE(:,:), POINTER :: min_box,max_boxi_slab,REAL(MK),DIMENNNoE(:), POINTER :: boxcost i_slab,REAL(MK),DIMENNNoE(:) , POINTER :: fac,fracfaci_slab,REAL(MK),DIMENNNoE(:,:), POINTER :: Anm,sqrtfaci_slab,INTEGER :: n,m,levelm_slab,INTEGER,DIMENNNoE(:), POINTER :: box2proc,boxid i_slab,REAL(MK),DIMENNNoE(:), POINTER :: costn_many_REAL(MK) :: ghostsizei_slab,INTEGER :: deomp,assigm_slab,INTEGER,DIMENNNoE(6) :: bcdefO 9999mREAL(MK),DIMENNNoE(:,:), POINTER :: min_sub,max_sub 1p,'t&INTEGER :: ncomp,t_stidm_slab,INTEGER,DIMENNNoE(:), POINTER :: new_comp2proc,comp2proc 1p,'t&INTEGER :: Mp1,an_many_INTEGER :: t 2t O 9999mREAL(MK),DIMENNNoE(: ), POINTER :: radius,totalmassi_slab,REAL(MK),DIMENNNoE(:,:), POINTER :: ceslabofbox O 9999mREAL(MK),DIMENNNoE(:,:), POINTER :: treep1,anst,FFTW_KIMURE)KiiFIELD p,'t& O 9999mREAL(MK),DIMENNNoE(: ), POINTER :: treewpn0 st,FFTKIMURE)KiVFIELDi_slab,REAL(MK),DIMENNNoE(:,:), POINTER :: treewpn0 ppp&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppIn::i1lize&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&C%Nm(comp,arallllllfm-1init Its_xyslab=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppCheck argumentsi_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDisis 1p,'t&IF (0,-1debug.GT.1M/2+1K mtttttt= 0NDO'i=1,0,-1dimtttttt= 0N't&IF (min_dom(i) .GT.(max_dom(i)M/2+1Ki=CINNNmmc&ooooom(2M tttttttt=NNmuble0#r=po,0,-1p,'t&&h%Nm(ttttttt=NNm(3MKi=Cargument_,2I4)fm-1init I '&_slab,f,fo) 'min_dom musapbe <=(max_dom !GNNNNpartptttttttttttt= 0,ffffffN kind_double0#rrrrrrr=po,0,-CINNNmmc=poDO,-CINNN=po,0, f_mesNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppSatpin:: variabrasb=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&llllfm-1in::i1lized = .TRUE.m_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppDefinv glob1l variabrasb=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&order = ord 1p,'t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppSatptree ttputpvariabras&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&treetype = 2I4)p1,1m_tree_ocan_many_minboxas = 2I4)nproc 1p,'t&pruneboxas = .FALSE.m_slab,minboxsize = (/0.001_MK,0.001_MK,0.001_MK/ttttttt=maxvariance = -1.0_MKtttttt=fixvd = (/.FALSE.,.FALSE.,.FALSE./ttttttt=weights(:,1t tt(/1.0_MK,0.0_MK,0.0_MK/ttttttt=weights(:,2) = (/0.0_MK,0.0_MK,1.0_MK/ttttttt=maxlevels = 20est,FFTW_MEASURE)Kiiiii LL subfftw_ 1p,'t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppBuild the tree - single -reci Reti_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&C%Nm(p,-1tree(xp,Np,Nm,min_dom,max_dom,treetype,minboxas, &_slab,f,fo) pruneboxas,minboxsize,maxvariance,maxboxcostImaxlevels,fixvd,&_slab,f,fo) weights,min_box_s,max_box_s,lhbx,lpdx,boxcost_s,parent_nchld,&_slab,f,fo) child,blevel,nbox,nbpl,nlevel,ttttttttttt=min_box => min_box_stttttt=max_box => max_box_stttttt=boxcost => boxcost_si(alsam-CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppBuild the tree - double -reci Reti_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&C%Nm(p,-1tree(xp,Np,Nm,min_dom,max_dom,treetype,minboxas, &_slab,f,fo) pruneboxas,minboxsize,maxvariance,maxboxcostImaxlevels,fixvd,&_slab,f,fo) weights,min_box_d,max_box_d,lhbx,lpdx,boxcost_d,parent_nchld,&_slab,f,fo) child,blevel,nbox,nbpl,nlevel,ttttttttttt=min_box => min_box_dtttttt=max_box => max_box_dtttttt=boxcost => boxcost_di(appp&i_slab,IF (tttt .NE.(1M/2+1Ki=CINNNmmc&m(2M tttttttt=NNmuble0#r=po,0,-1ph%Nm(ttttttt=NNm(3MKi=Ccom_fairad_,2I4)fm-1init I &_slab,ff,fo) 'Calling tree fairad.GNNNNpartptttttttttttt= 0,fN kind_double0#r=po,0,-CINNNnbofbox ttnboxi_slab,IF (0,-1debug.GT.1M/2+1K mtttttt= 0Nh%Nm(ttttwrige(0,-1rank_,2I4)fm-1init I &tttttt= 0N,fo) 'calling tree successful'tttttttttttt= 0,WRITE (cbu&,'(A,I6)') 'nbox tt',nboxi_slab, 0Nh%Nm(ttttwrige(0,-1rank_,2I4)fm-1init Icbu&,ttttttttttt==po,0, f_mesNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppA suge t_stiden,t, f_mesNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&tPou =&2I4)p1,1m_R su(ttt 1p,'t&ldu1(1t ttnlevelm_slab,h%Nm(ttttR su(t_stiden,t,ldu1,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt=,fo) 'ttt=N R suging t_stiden,tGNNNNpartptttttttttttt=N kind_douttttt==po,0, f_mesNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppA suge box-1p , f_mesNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&tPou =&2I4)p1,1m_R su(ttt 1p,'t&ldu1(1t ttNpn_many_h%Nm(ttttR su(box-1p ,ldu1,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt=,fo) 'ttt=N R suging box-1p GNNNNpartptttttttttttt=N kind_douttttt==po,0, f_mesDO'i=1,Npn_many_ box-1p (i) = 0.0_MKtttttt==poDO,-CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppS,ore which p1,ticra is1,1,which leaf boxi_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDisis 1p,'t&IF (Np .GT.(1M/2+1Ki=CINNNmmDO'i=1,nboxi_slab, 0N&IF (nchld(i) .EQ.(1M/2+1Ki=CINNNmmc&oooDO'j=lhbx(1,t),lhbx(2,t)tttttt= 0,ffffff box-1p (lpdx(j)) = itttttt= 0,ffff=poDO,-CINNNtttt==po,0, f_mesmc=poDO,-CINNN=po,0, f_mesNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppmakm t_s levelpt_stlogy seperge _slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, st,da,F)KiVECTOR, f_mesDO'i=1,nlevelm_slab,N&IF (nbpl(i) .GE.(2I4)nprocM/2+1Ki=CINNNmmc&olevelp= itttttt= 0=po,0,-CINNN=poDO,(alsam-CINNNDO'i=1,nlevelm_slab,N&IF (nbpl(i) .GE.(2I4)nprocM/2+1Ki=CINNNmmc&olevelp= itttttt= 0NNN=XITtttttt= 0=po,0,-CINNN=poDO,(appp&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppA suge ptttboxid,10,-1comid, box2proc and co,t, f_mesNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ldu2(1t ttnboxi_slab,ldu2(2t ttnlevelm_slab,h%Nm(ttttR su(ptttboxid,ldu2,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0N,fo) 'ttt=N R suging ptttboxidGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0, f_mesh%Nm(ttttR su(ptttcomid,ldu2,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0N,fo) 'ttt=N R suging ptttboxidGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0, f_mesldu1(1t ttnboxi_slab,h%Nm(ttttR su(box2proc,ldu1,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0N,fo) 'ttt=N R suging box2procGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0, f_mesldu1(1t ttMAXVAL(nbpl(:))i_slab,h%Nm(ttttR su(costIldu1,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0N,fo) 'ttt=N R suging box2procGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0, f_mespMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppSatpp1,1llelisgttt=ttputpvariabras, f_mespMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&DO'i=1,nboxi_slab, 0Nbox2proc(i) = 0.0_MKtttttt= t&DO'j=1,nlevelm_slab,N&&&&&ptttboxid(i,j) = 0.0_MKtttttt=N&&&&&ptttcomid(i,j) = 0.0_MKtttttt=N&&=poDO,-CINNN=poDO 1p,'t&DO'i=1,size(costI1)e-CINNN b,cost(i) = 1.0_MKtttttt==poDO,-CINNNdeomp = 2I4)p1,1m_deomp_usab_definvd 1p,'t&assig = 2I4)p1,1m_assign_islarnTli=CINNNghostsize = 0.0_MKtttttt=bcdef(1:6) = 2I4)p1,1m_bcdef_freespace, f_mespMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppTransttsming leaf boxas islo(comoomains and crege thept_stlogiasi_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&C%Nm(p,-1t_sttbox2comp(min_box,max_box_nchld,nbox,min_sub,max_subI &tttttt= 0Noc,fo) ncomp,tttt,boxid,-level,blevel,childttttttt=IF (tttt.NE.1M/2+1Ki=CINNNmmch%Nm(ttttwrige(0,-1rank_,2I4)fm-1init I &tttttt= 0N,fo) 't_sttbox2comp fairad',ttttttttttt==po,0,po,0,-1p9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e,0,-1p! Crege fir,tpt_stlogy based etuleaf boxase,0,-1p! (this usas thept_st_mkgeom implementgRet of p,-1pkt_stn_many_NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&C%Nm(p,-1pkt_st(t_stid,deomp,assig,min_dom,max_dom,bcdef,ghostsize,mdeeYsoc,fo) costItttt,min_sub,max_subIncomp,comp2procttttttt=IF (tttt.NE.1M/2+1Ki=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ccom_fairad_,2I4)fm-1init I &tttttt= 0Nocsoc,fo) 'pkt_st fairad',NNNpartptttttttttttt==po,0, f_mest_stiden,t(level) = t_stidm 1p,'t&DO'i = 1Incomptttttt= 0Nptttboxid(i,level) = boxid(i),-CINNN=poDO 1p,'t&DO'j=1,SIZE(boxid)tttttt= 0Nptttcomid(boxid(j),level) = j,-CINNN=poDO 1p,'t&DO'i=1,ncomptttttt= 0Nbox2proc(boxid(i)) = comp2proc(i),-CINNN=poDO 1p,'t&9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e,0,-1p! Lo_s ol9m the levels of the tree and regn,t9m each levelpaspt_stlogy 1p,'t&9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e,0,-1passig = 2I4)p1,1m_assign_usab_definvd 1p,'t& 1p,'t&DO'i=level+1,nlevelmtttttt= 09m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3tttttt= 09 Call comroutinvetopget comptttttt= 0!pchanged the level argumentpfrom -t_stidetop-itttttt= 09m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3tttttt= 0C%Nm(p,-1t_sttbox2comp(min_box,max_box_nchld,nbox,min_sub,max_subI &tttttt= 0No,fo) ncomp,tttt,boxid,-i,blevel,childttttttt=t=IF (tttt.NE.1M/2+1Ki=CINNNmmcmch%Nm(ttttwrige(0,-1rank_,2I4)fm-1init I &tttttt= 0N0N,fo) 't_sttbox2comp fairad',ttttttttttt=t==po,0,pttttt= 09m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3tttttt= 09 A suge new comp2proc 1p,'t& 09m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3tttttt= 0tPou =&2I4)p1,1m_R su(growtttttt= 0ldu1(1t ttncomptttttt= 0h%Nm(ttttR su(new_comp2proc,ldu1,tPou,itttttttttt=b,IF (tttt .NE.(1M/2+1Ki=CINNNmmc&cm(2M tttttttt=NNmfGOTli=CINNNmmcmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0,fo) 'ttt=N R suging new_comp2procGNNNNpartptttttttttttt= 0N kind_double0#rrr=po,0, f_mesmcDO'j=1,ncomptttttt= 0N new_comp2proc(j) = box2proc(parent(boxid(j)))tttttt= 0,ffbox2proc(boxid(j)) = new_comp2proc(j), f_mesmc=poDO,-CINNN 09m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3tttttt= 09 Call p,-1pkt_stetopget t_stlogy 1p,'t& 09m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3t t&C%Nm(p,-1pkt_st(t_stid,deomp,assig,min_dom,max_dom,bcdef,ghostsize,deeYsoc,fo) costItttt,min_sub,max_subIncomp,new_comp2procttttttt=t=IF (tttt.NE.1M/2+1Ki=CINNNmmcmch%Nm(ttttttt=NNm(3MKi=Ccom_fairad_,2I4)fm-1init I &tttttt= 0Noc,fo) 'pkt_st fairad',NNNpartptttttttttttt=rr=po,0, f_mesmcptttboxid(1:ncomp,t) = boxid(1:ncomp), f_mesmcDO'j=1,SIZE(boxid)tttttt= 0N0Nptttcomid(boxid(j),iMa =&j, f_mesmc=poDO,-CINNN=poDO= 1p,'t&9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e,0,-1p! Map fessthe lowe,tplevel (leafs of treeab=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&t_stide=st_stiden,t(nlevelttttttt=IF (2I4)nproc .GT.(1M/2+1Ki=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppMap the p1,ticraseoslo(the ftne,tptree t_stlogy =st_stid=nlevelm_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&C%Nm(p,-1pap)p1,a_glob1l(t_stid,xp,Np,ttttt't&pppospgRetsb=CINNNIF (tttt .NE.(1M/2+1Ki=CINNNmmc&h%Nm(ttttwrige(0,-1rank_,2I4)fm-1init I &tttttt= 0N0,fo) 'Fairadetopp,ara glob1l mapping.'tttttttttttt= 0,fN kind_double0#r=po,0, f_mesNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppPush aIong the strength of the p1,ticraseRnd the box-1p , f_mesNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, f_mes st,FFTW_KIMURE)KiiFIELD p,'t&i_slab,C%Nm(p,-1pap)p1,a_push(wp,Np,ttttt't&ppstrengths,(alsam-CINNNC%Nm(p,-1pap)p1,a_push(wp,ttttNp,ttttt't&ppstrengths,(appp&i_slab,IF (tttt .NE.(1M/2+1Ki=CINNNmmc&h%Nm(ttttwrige(0,-1rank_,2I4)fm-1init I &tttttt= 0N0,fo) 'Fairadetoppushpstrengths.'tttttttttttt= 0,fN kind_double0#r=po,0, f_mesC%Nm(p,-1pap)p1,a_push(box-1p ,Np,ttttt't&ppbox-1p , f_mesIF (tttt .NE.(1M/2+1Ki=CINNNmmc&h%Nm(ttttwrige(0,-1rank_,2I4)fm-1init I &tttttt= 0N0,fo) 'Fairadetoppushpstrengths.'tttttttttttt= 0,fN kind_double0#r=po,0,, f_mesC%Nm(p,-1pap)p1,a_sapp(Np,Mp1,a,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmc&h%Nm(ttttwrige(0,-1rank_,2I4)fm-1init I &tttttt= 0N0,fo) 'Fairadetoppapp p1,ticras.'tttttttttttt= 0,fN kind_double0#r=po,0,, f_mesC%Nm(p,-1pap)p1,a_pop(box-1p ,Np,Mp1,a,itttt't&ppbox-1p , f_mesIF (tttt .NE.(1M/2+1Ki=CINNNmmc&h%Nm(ttttwrige(0,-1rank_,2I4)fm-1init I &tttttt= 0N0,fo) 'Fairadetoppushpstrengths.'tttttttttttt= 0,fN kind_double0#r=po,0,st,FFTW_KIMURE)KiiFIELD p,'t&i_slab,C%Nm(p,-1pap)p1,a_pop(wp,Np,Mp1,a,itttt't&ppstrengths,(alsam-CINNNC%Nm(p,-1pap)p1,a_pop(wp,ttttNp,Mp1,a,itttt't&ppstrengths,(appp&i_slab,IF (tttt .NE.(1M/2+1Ki=CINNNmmc&h%Nm(ttttwrige(0,-1rank_,2I4)fm-1init I &tttttt= 0N0,fo) 'Fairadetoppoppstrengths.'tttttttttttt= 0,fN kind_double0#r=po,0,, f_mesC%Nm(p,-1pap)p1,a_pop(xp,0,-1dimtNp,Mp1,a,itttt't&pppospgRetsb=CINNNIF (tttt .NE.(1M/2+1Ki=CINNNmmc&h%Nm(ttttwrige(0,-1rank_,2I4)fm-1init I &tttttt= 0N0,fo) 'FairadetoppopppospgRets.'tttttttttttt= 0,fN kind_double0#r=po,0, f_mesNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppUpdge and p,ore and new numbab of p1,ticrase, f_mesNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&Np ttM-1p , f_mesIF (0,-1debug .GT.(1M/2+1Ki=CINNNmmh%Nm(ttttwrige(0,-1rank_,2I4)fm-1init I &tttttt= 0,fo) 'Done mapping p1,ticras.'tttttttttttt= 0WRITE(cbu&,'(A,I6)') 'Loc1l numbab of p1,ticraseis now: ',Npn_many_ h%Nm(ttttwrige(0,-1rank_,2I4)fm-1init Icbu&,ttttttttttt==po,0 = f_mesNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppCheck lhat p1,ticrasehavepbeen mapped correctly 1p,'t&9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e,0,-1pC%Nm(p,-1t_sttcheck(t_stid,xp,Np,OK,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmch%Nm(ttttwrige(0,-1rank_,2I4)fm-1init I &tttttt= 0N,fo) 'Fairadetopcheck l_stlogy.',ttttttttttt==po,0,ttttt=tttttt=IF (.NOT.OKM/2+1Ki=CINNNmmc&h%Nm(ttttwrige(0,-1rank_,2I4)fm-1init I &tttttt= 0N0,fo) 'P1,ticrasenot mapped correctly!',ttttt tttttt= 0,fN kind_double0#r=po,0, f_mesNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppRebuild the tree topget the correct lpdx and lhbx 2004ys 1p,'t&pp(aft9m mapping p1,ticraspchangedab=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, st,FFTW_MEASURE)Kiiiii LL subfftw_, f_mesNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppBuild the tree - single -reci Reti_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&C%Nm(p,-1tree(xp,Np,Nm,min_dom,max_dom,treetype,minboxas, &_slab,f,fo) pruneboxas,minboxsize,maxvariance,maxboxcostImaxlevels,fixvd,&_slab,f,fo) weights,min_box_s,max_box_s,lhbx,lpdx,boxcost_s,parent_nchld,&_slab,f,fo) child,blevel,nbox,nbpl,nlevel,ttttttttttt=min_box => min_box_stttttt=max_box => max_box_stttttt=boxcost => boxcost_si(alsam-CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppBuild the tree - double -reci Reti_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&C%Nm(p,-1tree(xp,Np,Nm,min_dom,max_dom,treetype,minboxas, &_slab,f,fo) pruneboxas,minboxsize,maxvariance,maxboxcostImaxlevels,fixvd,&_slab,f,fo) weights,min_box_d,max_box_d,lhbx,lpdx,boxcost_d,parent_nchld,&_slab,f,fo) child,blevel,nbox,nbpl,nlevel,ttttttttttt=min_box => min_box_dtttttt=max_box => max_box_dtttttt=boxcost => boxcost_di(appp&i_slab,IF (tttt .NE.(1M/2+1Ki=CINNNmmc&m(2M tttttttt=NNmuble0#r=po,0,-1ph%Nm(ttttttt=NNm(3MKi=Ccom_fairad_,2I4)fm-1init I &_slab,ffb,f,fo) 'Calling tree (2t fairad.GNNNNpartptttttttttttt= 0,fN kind_double0#r=po,0,-CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppS,ore numbab of boxas is nbofboxn_many_NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&nbofbox ttnboxi_slab,IF (0,-1debug.GT.1M/2+1Ki=CINNNmmc&h%Nm(ttttwrige(0,-1rank_,2I4)fm-1init I &tttttt= 0N0,fo) 'calling tree (2t successful'tttttttttttt= 0,,WRITE (cbu&,'(A,I6)') 'nbox tt',nboxi_slab, 0NNh%Nm(ttttwrige(0,-1rank_,2I4)fm-1init Icbu&,ttttttttttt==po,0, f_mes=po,0 !(2I4)nrpco .GT.(1,-CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppA suge all oGOT (single/doubleab=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppA suge and in::i1lise sqrtfac,Anm, Outer, fracfac (single/doubleab=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&tPou =&2I4)p1,1m_R su(ttt st,FFTW_MEASURE)Kiiiii LL subfftw_, f_mesldl(1t tt0, f_mesldl(2t tt-order 1p,'t&ldu(1t ttorder 1p,'t&ldu(2t ttorder 1p,'t&h%Nm(ttttR su(sqrtfac_s,ldl,ldu,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt=,fo) 'ttt=N R suging sqrtfacGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0, f_mesh%Nm(ttttR su(Anm_s,ldl,ldu,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt=,fo) 'ttt=N R suging AnmGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0, f_mesh%Nm(ttttR su(Outer_s,ldl,ldu,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt=,fo) 'ttt=N R suging OuterGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0, f_mesldl(1t tt0, f_mesldu(1t ttorder 1p,'t&h%Nm(ttttR su(fracfac_s,ldl,ldu,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt=,fo) 'ttt=N R suging frac_facGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0, f_mes!pIn::i1tise variabras, f_mesAnmf_mes=> Anm_s, f_messqrtfacs=> sqrtfac_s, f_mesfracfac => fracfac_si(alsam-CINNNldl(1t tt0, f_mesldl(2t tt-order 1p,'t&ldu(1t ttorder 1p,'t&ldu(2t ttorder 1p,'t&h%Nm(ttttR su(sqrtfac_d,ldl,ldu,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt=,fo) 'ttt=N R suging sqrtfacGNNNNpartptttttttttttt=N kind_douttttt==po,0, f_mesh%Nm(ttttR su(Anm_d,ldl,ldu,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt=,fo) 'ttt=N R suging AnmGNNNNpartptttttttttttt=N kind_douttttt==po,0, f_mesh%Nm(ttttR su(Outer_d,ldl,ldu,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt=,fo) 'ttt=N R suging OuterGNNNNpartptttttttttttt=N kind_douttttt==po,0, f_mesldl(1t tt0, f_mesldu(1t ttorder 1p,'t&h%Nm(ttttR su(fracfac_d,ldl,ldu,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt=,fo) 'ttt=N R suging fracfacGNNNNpartptttttttttttt=N kind_douttttt==po,0, f_mesNpIn::i1tise variabras, f_mesAnmf_mes=> Anm_dtttttt=sqrtfacs=> sqrtfac_dtttttt=fracfac => fracfac_d,(appp&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppA suge and in::i1lise expan Retsi_slab,9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N est,FFT(W_MEASURE)Kiiiii LL subfftw_ &&RE)KIMURE)KiiFIELD) 1p,'t&ldl(1t = 1, f_mesldl(2t tt0, f_mesldl(3t tt-order 1p,'t&ldu(1t ttnboxi_slab,ldu(2t ttorder 1p,'t&ldu(3t ttorder 1p,'t&h%Nm(ttttR su(expan Ret_s_sf,ldl,ldu,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt=,fo) 'ttt=N R suging expan RetGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0t& 1p,'t&DO'j=0,order 1p,'t&'t&DO'k=-order,order 1p,'t&'t& mmDO'i=1,nboxi_slab, 0N&&&&&&expan Ret_s_sf(i,j,k) = 0.0_MKtttttt=N&&&&&=poDO,-CINNNttt=poDO,-CINNN=poDO 0 st,F(W_MEASURE)KiKlies e,foGNNNoE &&RE)KIMURE)KiiFIELD)-CINNN 1p,'t&ldl(1t = 1, f_mesldl(2t tt0, f_mesldl(3t tt-order 1p,'t&ldu(1t ttnboxi_slab,ldu(2t ttorder 1p,'t&ldu(3t ttorder 1p,'t&h%Nm(ttttR su(expan Ret_d_sf,ldl,ldu,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt=,fo) 'ttt=N R suging expan RetGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0 1p,'t&DO'j=0,order 1p,'t&'t&DO'k=-order,order 1p,'t&'t& mmDO'i=1,nboxi_slab, 0N&&&&&&expan Ret_d_sf(i,j,k) = 0.0_MKtttttt=N&&&&&=poDO,-CINNNttt=poDO,-CINNN=poDO 0 st,F(W_MEASURE)Kiiiii LL subfftw_ &&RE)KIMURE)KiVFIELD) 1p,'t&ldl(1t = 1, f_mesldl(2t tt1, f_mesldl(3t tt0, f_mesldl(4t tt-order 1p,'t&ldu(1t ttlda 1p,'t&ldu(2t ttnboxi_slab,ldu(3t ttorder 1p,'t&ldu(4t ttorder 1p,'t&h%Nm(ttttR su(expan Ret_s_vf,ldl,ldu,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt=,fo) 'ttt=N R suging expan RetGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0 1p,'t&DO'j=0,order 1p,'t&'t&DO'k=-order,order 1p,'t&'t& mmDO'i=1,nboxi_slab, 0N&&&&&&DO'l=1,lda 1p,'t&&&&&&&&&&&&&expan Ret_s_vf(l,i,j,k) = 0.0_MKtttttt=N&&&&& ff=poDO,-CINNNtttt=&=poDO,-CINNNttt=poDO,-CINNN=poDO 0 st,F(W_MEASURE)KiKlies e,foGNNNoE &&RE)KIMURE)KiVFIELD)-CINNN 1p,'t&ldl(1t = 1, f_mesldl(2t tt1, f_mesldl(3t tt0, f_mesldl(4t tt-order 1p,'t&ldu(1t ttlda 1p,'t&ldu(2t ttnboxi_slab,ldu(3t ttorder 1p,'t&ldu(4t ttorder = f_mesh%Nm(ttttR su(expan Ret_d_vf,ldl,ldu,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0N,fo) 'ttt=N R suging expan RetGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0 1p,'t&DO'j=0,order 1p,'t&'t&DO'k=-order,order 1p,'t&'t& mmDO'i=1,nboxi_slab, 0N&&&&&&DO'l=1,lda 1p,'t&&&&&&&&&&&&&expan Ret_d_vf(l,i,j,k) = 0.0_MKtttttt=N&&&&& ff=poDO,-CINNNtttt=&=poDO,-CINNNttt=poDO,-CINNN=poDO 0 ppp&-CINNNi_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppA suge multipole coefficientpvariabras&CINNNi_slab,N Pnm, Ynm, fac, rho_ theta, phi-CINNNi_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, st,FFTW_MEASURE)Kiiiii LL subfftw_, f_mesldl(1t tt0, f_mesldu(1t tt2*order 1p,'t&h%Nm(ttttR su(fac_s,ldl,ldu,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0N,fo) 'ttt=N R suging facGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0, f_mesldu1(1t tt2I4)nproc*Npn_many_h%Nm(ttttR su(rho_s,ldu1,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0N,fo) 'ttt=N R suging rhoGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0, f_mesh%Nm(ttttR su(theta_s,ldu1,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0N,fo) 'ttt=N R suging thetaGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0, f_mesh%Nm(ttttR su(phi_s,ldu1,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0N,fo) 'ttt=N R suging phiGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0 1p,'t&DO'i = 1Ildu1(1ttttttt= 0,rho_s(iMa =&0.0_MKtttttt=N&&theta_s(i) = 0.0_MKtttttt====phi_s(iMa =&0.0_MKtttttt==poDO,-CINNNldl(1t tt0, f_mesldl(2t tt-order 1p,'t&ldu(1t ttorder 1p,'t&ldu(2t ttorder 1p,'t&h%Nm(ttttR su(Ynm_s,ldl,ldu,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0N,fo) 'ttt=N R suging YnmGNNNNpartptttttttttttt=N kind_douttttt==po,0, f_mesh%Nm(ttttR su(Pnm_s,ldl,ldu,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0N,fo) 'ttt=N R suging PnmGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0, f_mesldl(1t tt0, f_mesldl(2t tt-2*order 1p,'t&ldu(1t tt2*order 1p,'t&ldu(2t tt2*order 1p,'t&h%Nm(ttttR su(Inner_s,ldl,ldu,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0N,fo) 'ttt=N R suging InnerGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0 1p,'t&DO'i=ldl(1t,ldu(1t 1p,'t&'t&DO'j=ldl(2t,ldu(2t,-CINNNtttt=&Inner_s(i,j) = 0.0_MKtttttt=N&&=poDO,-CINNN=poDO 1p,'t&NpIn::i1tise variabras, f_mesfac => fac_si(alsam-CINNNldl(1t tt0, f_mesldu(1t tt2*order 1p,'t&h%Nm(ttttR su(fac_d,ldl,ldu,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0N,fo) 'ttt=N R suging facGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0, f_mesldu1(1t tt2I4)nproc*Npn_many_h%Nm(ttttR su(rho_d,ldu1,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0N,fo) 'ttt=N R suging rhoGNNNNpartptttttttttttt= 0N kind_douttttt==po,0, f_mesh%Nm(ttttR su(theta_d,ldu1,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0N,fo) 'ttt=N R suging thetaGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0, f_mesh%Nm(ttttR su(phi_d,ldu1,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0N,fo) 'ttt=N R suging phiGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0 1p,'t&DO'i = 1Ildu1(1ttttttt= 0,rho_d(iMa =&0.0_MKtttttt=N&&theta_d(i) = 0.0_MKtttttt====phi_d(iMa =&0.0_MKtttttt==poDO,-CINNNldl(1t tt0, f_mesldl(2t tt-order 1p,'t&ldu(1t ttorder 1p,'t&ldu(2t ttorder 1p,'t&h%Nm(ttttR su(Ynm_d,ldl,ldu,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0N,fo) 'ttt=N R suging YnmGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0 1p,'t&h%Nm(ttttR su(Pnm_d,ldl,ldu,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0N,fo) 'ttt=N R suging PnmGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0, f_mesldl(1t tt0, f_mesldl(2t tt-2*order 1p,'t&ldu(1t tt2*order 1p,'t&ldu(2t tt2*order 1p,'t&h%Nm(ttttR su(Inner_d,ldl,ldu,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt=,fo) 'ttt=N R suging InnerGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0 1p,'t&DO'i=ldl(1t,ldu(1t 1p,'t&'t&DO'j=ldl(2t,ldu(2t,-CINNNtttt=&Inner_d(i,j) = 0.0_MKtttttt=N&&=poDO,-CINNN=poDO 1p,'t&NpIn::i1tise variabras, f_mesfac => fac_d,(appp&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppIn::i1lise fac with zertn_many_NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&DO'i = 0,2*order 1p,'t&mesfac(iMa =&0.0_MKtttttt==poDO,-CINNN9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e,0,-1p! Compute fac, rho_ phi_ thetaeRnd t_stidm_slab,9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e,0,-1pfac(0) tt1, f_mesDO'i=1,order*2 1p,'t&mesfac(iMa=sfac(i-1)*REAL(i,MK),-CINNN=poDO 1p,'t&DO'n=0,order 1p,'t&'t&DO'm=-n,n,-CINNNtttt=&sqrtfac(n,mMa=sSQRT(fac(n-ABS(m))/fac(n+ABS(m))t,-CINNNtttt=&Anm(n,mMa = (-1)**n/SQRT(fac(n-m)*fac(n+m)t,-CINNNttt=poDO,-CINNN=poDO 1p,'t&DO'm=0,order 1p,'t&'t&fracfac(mMa=sfac(2*m)/(2.**m*fac(mM),-CINNN=poDO 1p,'t&9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e,0,-1p! A suge Cnm 1p,'t&9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N est,FFT(W_MEASURE)Kiiiii LL subfftw_ &&RE)KIMURE)KiiFIELD)1p,'t&,-CINNNldl(1t tt0, f_mesldl(2t tt-order 1p,'t&ldu(1t ttorder 1p,'t&ldu(2t ttorder 1p,'t&h%Nm(ttttR su(Cnm_s_sf,ldl,ldu,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0N,fo) 'ttt=N R suging CnmGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0,0 st,F(W_MEASURE)KiKlies e,foGNNNoE &&RE)KIMURE)KiiFIELD)-CINNN 1p,'t&ldl(1t tt0, f_mesldl(2t tt-order 1p,'t&ldu(1t ttorder 1p,'t&ldu(2t ttorder 1p,'t&h%Nm(ttttR su(Cnm_d_sf,ldl,ldu,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0N,fo) 'ttt=N R suging CnmGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0,0 st,F(W_MEASURE)iiii LL subfftw_ &&RE)KIMURE)KiVFIELD)N 1p,'t&ldl(1t tt1, f_mesldl(2t tt0, f_mesldl(3t tt-order 1p,'t&ldu(1t ttlda 1p,'t&ldu(2t ttorder 1p,'t&ldu(3t ttorder 1p,'t&h%Nm(ttttR su(Cnm_s_vf,ldl,ldu,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0N,fo) 'ttt=N R suging CnmGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0,0 st,F(W_MEASURE)KiKlies e,foGNNNoE &&RE)KIMURE)KiVFIELD)-CINNN 1p,'t&ldl(1t tt1, f_mesldl(2t tt0, f_mesldl(3t tt-order 1p,'t&ldu(1t ttlda 1p,'t&ldu(2t ttorder 1p,'t&ldu(3t ttorder 1p,'t&h%Nm(ttttR su(Cnm_d_vf,ldl,ldu,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0N,fo) 'ttt=N R suging CnmGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0,0 ppp&-CINNNi_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppA suge radius (single/doubleab=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&tPou =&2I4)p1,1m_R su(ttt st,FFTW_MEASURE)Kiiiii LL subfftw_, f_mesldu1 ttnboxi_slab,h%Nm(ttttR su(radius_s,ldu1,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0N,fo) 'ttt=N R suging radiusGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0,0 ssam-CINNNldu1 ttnboxi_slab,h%Nm(ttttR su(radius_d,ldu1,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0N,fo) 'ttt=N R suging radiusGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0,0 ppp&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppA suge ceslabofbox (single/doubleab=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, st,FFTW_MEASURE)Kiiiii LL subfftw_, f_mesldu2(1t tt2I4)dimtttttt=ldu2(2t ttnboxi_slab,h%Nm(ttttR su(ceslabofbox_s,ldu2,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0N,fo) 'ttt=N R suging ceslabofboxGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0,0 ssam-CINNNldu2(1t tt2I4)dimtttttt=ldu2(2t ttnboxi_slab,h%Nm(ttttR su(ceslabofbox_d,ldu2,tPou,itttttttttt=IF (tttt .NE.(1M/2+1K tttttt= 0,fm(2M tttttttt=NNmfGOTli=CINNNmmcch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0NN,fo) 'ttt=N R suging ceslabofboxGNNNNpartptttttttttttt= 0,,N kind_douttttt==po,0,0 ppp&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppA suge totalmass (single/doubleab=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, st,FFTW_MEASURE)Kiiiii LL subfftw_, f_mesldu1 ttnboxi_slab,h%Nm(ttttR su(totalmass_s,ldu1,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0N,fo) 'ttt=N R suging totalmassGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0,0 ssam-CINNNldu1 ttnboxi_slab,h%Nm(ttttR su(totalmass_d,ldu1,tPou,itttttttttt=IF (tttt .NE.(1M/2+1K tttttt= 0,fm(2M tttttttt=NNmfGOTli=CINNNmmcch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt= 0NN,fo) 'ttt=N R suging totalmassGNNNNpartptttttttttttt= 0,,N kind_douttttt==po,0,0 ppp&i_slab,IF (0,-1debug.GT.1M/2+1K mtttttt= 0Nh%Nm(ttttwrige(0,-1rank_,2I4)fm-1init I'R su oGOT successful' &tttttt= 0N,fo) ,ttttttttttt==po,0, f_mesNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppCheck -reci ReteRnd poinging to the correct variabras, f_mespMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, st,FFTW_MEASURE)Kiiiii LL subfftw_, f_mesceslabofbox => ceslabofbox_s, f_mestotalmass => totalmass_s, f_mesradius => radius_s, f_mesmaxboxcost_s =smaxboxcost,0 ssam-CINNNceslabofbox => ceslabofbox_d, f_mestotalmass => totalmass_d, f_mesradius => radius_d, f_mesmaxboxcost_d =smaxboxcost,0 ppp&i_slab,N in::i1lise ceslabofbox with zertn_many_DO'j=1,nboxi_slab, 0NDO'i=1,2I4)dimtttttt=-CINNNceslabofbox(i,j) = 0.0_MKtttttt=N&&=poDO,-CINNN=poDO 1p,'t&NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, _slab,N A suge treep1,teRnd treewp 1p,'t&NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, _slab,tPou =&2I4)p1,1m_R su(ttt 1p,'t&ldu2(1t tt2I4)dimtttttt=ldu2(2t ttNpn_many_h%Nm(ttttR su(treep1,t,ldu2,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt=,fo) 'ttt=N R suging treep1,tGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0,0t,FFTW_KIMURE)KiiFIELD p,'t&&&&&&&m-CINNNldu1 ttNpn_many_h%Nm(ttttR su(treewp,ttu1,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt=,fo) 'ttt=N R suging treewpGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0,0 st,FE)KIMURE)KiVFIELD 1p,'t&ldu2(1t ttlda 1p,'t&ldu2(2t ttNpn_many_h%Nm(ttttR su(treewp,ttu2,tPou,itttttttttt=IF (tttt .NE.(1M/2+1Ki=CINNNmmcm(2M tttttttt=NNmfGOTli=CINNNmmch%Nm(ttttttt=NNm(3MKi=Ca su,lllllfm-1init I &tttttt=,fo) 'ttt=N R suging treewpGNNNNpartptttttttttttt= 0,N kind_douttttt==po,0es s ppp&-CINNNi_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppLo_s ol9m the boxas topcompute the ceslabofbox of eachi_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&DO'box=1,nboxi_slab, 0NIF (nchld(box) .NE.(1M/CYCLEi_slab, 0Nfir,tp= lhbx(1,box)i_slab, 0Nla,tpp= lhbx(2,box)i_slab, 0NNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDii_slab, 0NN Compute new 2004y with p1,ticra order from tree NN and necessarycm(2MrmgRet (nr. of p1,t. is box)i_slab, 0NNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDii_slab, 0Nnrpbox ttla,t-fir,t+1 NDO'j=fir,t,la,ttttttt=-CINNNtreep1,t(1,j) = xp(1,lpdx(j))tttttt=-CINNNtreep1,t(2,j) = xp(2,lpdx(j))tttttt=-CINNNIF(2I4)dim.EQ.3)2+1Ki=CINNNmmc&oooNNtreep1,t(3,j) = xp(3,lpdx(j))tttttt=-CINNN=po,0,0t,FFTTTTTTTW_KIMURE)KiiFIELD p,'t&&&tttttt=-CINNNtreewp(j) pp= wp(lpdx(j))t0 ssam-CINNNNNNNNNDO'i=1,lda 1p,'t&&&&&&&&&&treewp(i,j) = wp(i,lpdx(j))tttttt=-CINNN=poDO 0 ppp&-tttttt=N&&=poDO,-CINNN 0NNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDii_slab, 0NN Computing the total mass,-CINNN 0NNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDii0t,FFTTTTW_KIMURE)KiiFIELD p,'t&&&&,-CINNN 0Ntotalmass(box) = 0.0_MKtttttt= t&DO'i=fir,t,la,ttttttt=-CINNNtotalmass(box) = totalmass(box) + ABS(treewp(i)t,-CINNNttt=poDO,0 ssa&,-CINNN 0Ntotalmass(box) = 0.0_MKtttttt= t&DO'i=fir,t,la,ttttttt=-CINNNDO'j=1,lda 1p,'t&&&&&&&&&&totalmass(box) = totalmass(box) + treewp(j,i)*treewp(j,i)tttttt=-CINNN=poDO tt=-CINNN=poDO&,-CINNN 0Ntotalmass(box) = SQRT(totalmass(box)) 0 ppp&-tttttt=N&&NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDii_slab, 0NN Compute the ceslabs of the leaf boxase,0,-1pN&&NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDii_slab, 0NIF (nrpbox .GT.(1M/2+1Ki0t,FFTTTTTTTW_KIMURE)KiiFIELDtttttt=-CINNNIF(2I4)dim.EQ.2)2+1Ki=CINNNmmc&oooNNceslabofbox(1,box) = 0.0_MKtttttt=N&&&&& ffceslabofbox(2,box) = 0.0_MKtttttt=N&&&&& ffDO'j=fir,t,la,ttttttt=-CINNN&oooNNceslabofbox(1,box) = ceslabofbox(1,box) +Ntreep1,t(1,j)* &tttttt= 0Nocsoccccccccccccccccc,fo)ABS(treewp(j))tttttt=-CINNN&&& ffceslabofbox(2,box) = ceslabofbox(2,box) +Ntreep1,t(2,j)* &tttttt= 0Nocsoccccccccccccccccc,fo)ABS(treewp(j))tttttt=-CINNN&&&=poDO,-CINNNtttt=&&&&tmp tt1.0_MK/totalmass(box)i=CINNNmmc&oooNNceslabofbox(1,box) = ceslabofbox(1,box) *&tmptttttt=N&&&&& ffceslabofbox(2,box) = ceslabofbox(2,box) *&tmptttttt=N&&&&&=po,0, f_mesmcccccIF(2I4)dim.EQ.3)2+1Ki=CINNNmmc&oooNNceslabofbox(1,box) = 0.0_MKtttttt=N&&&&& ffceslabofbox(2,box) = 0.0_MKtttttt=N&&&&& ffceslabofbox(3,box) = 0.0_MKtttttt=N&&&&& ffDO'j=fir,t,la,ttttttt=-CINNN&oooNNceslabofbox(1,box) = ceslabofbox(1,box) +Ntreep1,t(1,j)* &tttttt= 0Nocsoccccccccccccccccc,fo)ABS(treewp(j))tttttt=-CINNN&&& ffceslabofbox(2,box) = ceslabofbox(2,box) +Ntreep1,t(2,j)* &tttttt= 0Nocsoccccccccccccccccc,fo)ABS(treewp(j))tttttt=-CINNN&&& ffceslabofbox(3,box) = ceslabofbox(3,box) +Ntreep1,t(3,j)* &tttttt= 0Nocsoccccccccccccccccc,fo)ABS(treewp(j))tttttt=-CINNN&&&=poDO,-CINNNtttt=&&&&tmp tt1.0_MK/totalmass(box)i=CINNNmmc&oooNNceslabofbox(1,box) = ceslabofbox(1,box) *tmptttttt=N&&&&& ffceslabofbox(2,box) = ceslabofbox(2,box) *tmptttttt=N&&&&& ffceslabofbox(3,box) = ceslabofbox(3,box) *tmptttttt=N&&&&&=po,0,0 ssam-CINNNNNNNNNIF(2I4)dim.EQ.2)2+1Ki=CINNNmmc&oooNNceslabofbox(1,box) = 0.0_MKtttttt=N&&&&& ffceslabofbox(2,box) = 0.0_MKtttttt=N&&&&& ffDO'j=fir,t,la,ttttttt=-CINNN&oooNNtmp tt0.0_MKtttttt=N&&&&& ff ffDO'l = 1Ilda 1p,'t&&&&&&&&&&&&&NNtmp tttmp + treewp(l,j)*treewp(l,j) 1p,'t&&&&&&&&&&&&&=poDO,-CINNNtttt=&&&&oNNceslabofbox(1,box) = ceslabofbox(1,box)+ &tttttt= 0Nocsoccccc,fo) SQRT(tmp)*treep1,t(1,j)tttttt=-CINNN&&& ffceslabofbox(2,box) = ceslabofbox(2,box)+ &tttttt= 0Nocsoccccc,fo) SQRT(tmp)*treep1,t(2,j)tttttt=-CINNN&&&=poDO,-CINNNtttt=&&&&tmp tt1.0_MK/totalmass(box)i=CINNNmmc&oooNNceslabofbox(1,box) = ceslabofbox(1,box) *&tmptttttt=N&&&&& ffceslabofbox(2,box) = ceslabofbox(2,box) *&tmptttttt=N&&&&&=po,0, f_mesmcccccIF(2I4)dim.EQ.3)2+1Ki=CINNNmmc&oooNNceslabofbox(1,box) = 0.0_MKtttttt=N&&&&& ffceslabofbox(2,box) = 0.0_MKtttttt=N&&&&& ffceslabofbox(3,box) = 0.0_MKtttttt=N&&&&& ffDO'j=fir,t,la,ttttttt=-CINNN&oooNNtmp tt0.0_MKtttttt=N&&&&& ff ffDO'l = 1Ilda 1p,'t&&&&&&&&&&&&&NNtmp tttmp + treewp(l,j)*treewp(l,j) 1p,'t&&&&&&&&&&&&&=poDO,-CINNNtttt=&&&&oNNceslabofbox(1,box) = ceslabofbox(1,box)+ &tttttt= 0Nocsoccccc,fo) SQRT(tmp)*treep1,t(1,j)tttttt=-CINNN&&& ffceslabofbox(2,box) = ceslabofbox(2,box)+ &tttttt= 0Nocsoccccc,fo) SQRT(tmp)*treep1,t(2,j)tttttt=-CINNN&&& ffceslabofbox(3,box) = ceslabofbox(3,box)+ &tttttt= 0Nocsoccccc,fo) SQRT(tmp)*treep1,t(3,j)tttttt=-CINNN&&&=poDO,-CINNNtttt=&&&&tmp tt1.0_MK/totalmass(box)i=CINNNmmc&oooNNceslabofbox(1,box) = ceslabofbox(1,box) *&tmptttttt=N&&&&& ffceslabofbox(2,box) = ceslabofbox(2,box) *&tmptttttt=N&&&&& ffceslabofbox(3,box) = ceslabofbox(3,box) *&tmptttttt=N&&&&&=po,0,0 ppp&i ELSE, f_mesmcccccIF(2I4)dim.EQ.2)2+1Ki=CINNNmmc&oooNNceslabofbox(1,box) = 0.5_MK*(max_box(1,box) +Nmin_box(1,box))i=CINNNmmc&oooNNceslabofbox(2,box) = 0.5_MK*(max_box(2,box) +Nmin_box(2,box))i=CINNNmmc&oo=po,0, f_mesmcccccIF(2I4)dim.EQ.3)2+1Ki=CINNNmmc&oooNNceslabofbox(1,box) = 0.5_MK*(max_box(1,box) +Nmin_box(1,box))i=CINNNmmc&oooNNceslabofbox(2,box) = 0.5_MK*(max_box(2,box) +Nmin_box(2,box))i=CINNNmmc&oo ffceslabofbox(3,box) = 0.5_MK*(max_box(3,box) +Nmin_box(3,box))i=CINNNmmc&oo=po,0, f_mesmcc=po,0, f_mes=poDO,-CINNNIF (0,-1debug.GT.1M/2+1K mtttttt= 0Nh%Nm(ttttwrige(0,-1rank_,2I4)fm-1init I'computed ceslabs',ttttttttttt==po,0,ttttt=9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e,0,-1p! Compute the radius of the leaf boxase,0,-1pNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&DO'box=1,nboxi_slab, 0Nradius(box) = -1.0_MKtttttt==poDO,-CINNNIF(2I4)dim.EQ.2)2+1Ki=CINNNmmcDO'box=1,nboxi_slab, 0N 0NIF (nchld(box) .NE.(1M/CYCLEi_slab, 0N 0Nfir,tp= lhbx(1,box)i_slab, 0N 0Nla,tpp= lhbx(2,box)i_slab, 0N ffDO'j=fir,t,la,ttttttt=-CINNN&oodiagvec(1t tttreep1,t(1,j) -Nceslabofbox(1,box)tttttt=-CINNN&oodiagvec(2t tttreep1,t(2,j) -Nceslabofbox(2,box)i_slab, 0N ff &&tmp ttdiagvec(1t*diagvec(1t +odiagvec(2t*diagvec(2ti_slab, 0N ff &&tmp ttSQRT(tmp)i_slab, 0N ff &&IF (tmp .GT.(radius(box)M/2+1Ki=CINNNmmcmccccccccradius(box) = tmptttttt=N&&&&& ff=po,0t& 1p,'t&&&& ff=poDO,-CINNNttt=poDO,-CINNN=po,0,ttttt=IF(2I4)dim.EQ.3)2+1Ki=CINNNmmcDO'box=1,nboxi_slab, 0N 0NIF (nchld(box) .NE.(1M/CYCLEi_slab, 0N 0Nfir,tp= lhbx(1,box)i_slab, 0N 0Nla,tpp= lhbx(2,box)i_slab, 0N ffDO'j=fir,t,la,ttttttt=-CINNN&oodiagvec(1t tttreep1,t(1,j) -Nceslabofbox(1,box)tttttt=-CINNN&oodiagvec(2t tttreep1,t(2,j) -Nceslabofbox(2,box)i_slab, 0N ff &&diagvec(3t tttreep1,t(3,j) -Nceslabofbox(3,box)i_slab, 0N ff &&tmp ttdiagvec(1t*diagvec(1t +odiagvec(2t*diagvec(2ti_slab, 0N ff &&tmp tttmp +&diagvec(3t*diagvec(3ti_slab, 0N ff &&tmp ttSQRT(tmp)i_slab, 0N ff &&IF (tmp .GT.(radius(box)M/2+1Ki=CINNNmmcmccccccccradius(box) = tmptttttt=N&&&&& ff=po,0t& 1p,'t&&&& ff=poDO,-CINNNttt=poDO,-CINNN=po,0,ttttt=IF (0,-1debug.GT.1M/2+1K mtttttt= 0Nh%Nm(ttttwrige(0,-1rank_,2I4)fm-1init I'computed radiusGNttttttttttt==po,0,ttttt=9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e,0,-1p! dea suge loc1l variabras, f_mespMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, f_mesldu1 tt0, f_mesldu2(1t tt0, f_mesldu2(2t tt0, f_mesistat tt0, f_mestPou =&2I4)p1,1m_dea su tt= 0Nh%Nm(ttttR su(treep1,t,ldu2,tPou,itttttttttt=istat=istat+ittt tt= 0Nh%Nm(ttttR su(treewp,ttu1,tPou,itttttttttt=istat=istat+ittt tt= 0Nh%Nm(ttttR su(box2proc,ttu1,tPou,itttttttttt=istat=istat+ittt tt= 0Nh%Nm(ttttR su(boxid,ldu1,tPou,itttttttttt=istat=istat+ittt tt= 0Nh%Nm(ttttR su(costIldu1,tPou,itttttttttt=istat=istat+ittt tt= 0Nh%Nm(ttttR su(comp2proc,ldu1,tPou,itttttttttt=istat=istat+ittt tt= 0Nh%Nm(ttttR su(new_comp2proc,ldu1,tPou,itttttttttt=istat=istat+ittt ,ttttt=IF (istat .NE.(1M/2+1Ki=CINNNmmc&WRITE(cbu&,'(A,I3,A)') 'fessGNtstat,'ttt=N while dea su'i=CINNNmmc&m(2M tttttttt=NNmeble0#r=po,0,-1ph%Nm(ttttttt=NNm(3MKi=Cdea su_,2I4)fm-1init Icbu&,NNNpartptttttttttttt= 0,fN kind_double0#r=po,0,-CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp Nullify oGOT poingabs,-CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&NULLIFY(min_box) 1p,'t&NULLIFY(max_box) 1p,'t&NULLIFY(boxcost) 1p,'t&NULLIFY(ceslabofbox) 1p,'t&NULLIFY(totalmass) 1p,'t&NULLIFY(radiusab=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp Returti_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, d_do1phONTINUE tt= 0Nh%Nm(comptop(,2I4)fm-1init It0tttttttttttt=RETURN est,FFT(W_MEASURE)Kiiiii LL subfftw_ &&RE)KIMURE)KiiFIELD) 1p,'t&=po SUBROUTINE 2I4)fm-1init_s_sf,0 st,F(W_MEASURE)KiKlies e,foGNNNoE &&RE)KIMURE)KiiFIELD) 1p,'t&=po SUBROUTINE 2I4)fm-1init_d_sf,0 st,F(W_MEASURE)Kiiiii LL subfftw_ &&RE)KIMURE)KiVFIELD) 1p,'t&=po SUBROUTINE 2I4)fm-1init_s_vf,0 st,F(W_MEASURE)KiKlies e,foGNNNoE &&RE)KIMURE)KiVFIELD) 1p,'t&=po SUBROUTINE 2I4)fm-1init_d_vf,0 ppp&i_slab, lib2I4numerics-r1036/src/2I4)module)fm-1poteslial.f0000644000175000017500000000673011616214650021363 0ustar omaromar=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppModuletttt= 0,f: 2I4)module)fm-1poteslialb=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&p 1p,'t&ppPurposett= 0,f: fa,tpmultipole method module, poteslial routine 1p,'t&pp 1p,'t&p 1p,'t&ppRemarkstt= 0,f: 1p,'t&p 1p,'t&ppReferencas&CIN: 1p,'t&p 1p,'t&ppRevi Retstt= 0:b=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp $Log: 2I4)module)fm-1poteslial.f,v $ 1p,'t&pp Revi Ret 1.1.1.1 2007/07/13 10:18:58c&mvos 1p,'t&pp CBL vabsRet of the PPM library 1p,'t&p 1p,'t&pp Revi Ret 1.3 2006/06/29 10:28:37 2chgela 1p,'t&pp Added vect=N strengths(coppop , f_mesp 1p,'t&pp Revi Ret 1.2 2005/09/19 13:03:32 polasekb 1p,'t&pp code cosmetics, f_mesp 1p,'t&pp Revi Ret 1.1 2005/05/27 08:01:48 polasekb 1p,'t&pp in::i1l implemeslgRet 1p,'t&pp 1p,'t&pp Revi Ret 0 2004/11/25 16:38:33 polasekb 1p,'t&pp St1p , f_mes9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e,0,-1p! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1p,'t&pp Ceslab fessFluid Dynamics (DTU), f_mesp 1p,'t&p 1p,'t&ppThis file is p1,teof the P1,1llel P1,ticra Mesh Library (PPM). 1p,'t&p 1p,'t&ppPPM is free software: you can redtstribute iteRnd/essmodify 1p,'t&ppiteund9m the labms of the GNU Less9m Gene,1lpPublic Licessa&,-CINNN! as published by the Free Software FoundgRet, either&,-CINNN! vabsRet 3 of the Licessa, ess(at your PouRet)eRny later&,-CINNN! vabsRet. 1p,'t&p 1p,'t&ppPPM is dtstributed in the hope lhat itewill be useful, 1p,'t&ppbut WITHOUT ANY WARRANTY; without even the implied w2004nty of 1p,'t&ppMERCHANTABILITY essFITNESS FOR A PARTICULAR PURPOSE.(See the 1p,'t&ppGNU Gene,1lpPublic Licessa&fessmore details. 1p,'t&p 1p,'t&ppYou should have received a copy of the GNU Gene,1lpPublic Licessa,-CINNN! and the GNU Less9m Gene,1lpPublic Licessa&along with PPM. Ifenot, 1p,'t&ppsee . 1p,'t&p 1p,'t&ppP1,1llel P1,ticra Mesh Library (PPM) 1p,'t&ppETH Zuriche,0,-1p! CH-8092 Zurich, Switzerland , f_mes9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e #define)Kiiiii LL subfftw_ 1 #define)KiKlies e,foGNNNoE 2 !#define)KiINTEGER 3 !#define)KiLOGIh%N 4 !#define)Ki2D p,'t&&&&&&&&&&7 !#define)Ki3D p,'t&&&&&&&&&&8 #define)KiiFIELD p,'t&&&&&&9 #define)KiVFIELD p,'t&&&&&10 MODULE 2I4)module)fm-1poteslial&&& , f9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N -N e,0! Define)Islabface, f9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N -N - , fINTERFACE 2I4)fm-1poteslialb MODULE PROCEDURE 2I4)fm-1poteslial_s_sf, MODULE PROCEDURE 2I4)fm-1poteslial_d_sf, MODULE PROCEDURE 2I4)fm-1poteslial_s_vf, MODULE PROCEDURE 2I4)fm-1poteslial_d_vfp 1p=po INTERFACE , f9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N -N e,0! INCLUDE/2+1 SOURCES, f9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N -N - ,hONTAINSe #define)KiMEASUKiiiii LL subfftw_,#define)KiKIM)KiiFIELDt#include "2I4)fm-1poteslial.f" #und9f)KiMEASe #define)KiMEASUKiKlies e,foGNNNoEt#include "2I4)fm-1poteslial.f" #und9f)KiMEASe#und9f)KiKIM)e #define)KiMEASUKiiiii LL subfftw_,#define)KiKIM)KiVFIELDt#include "2I4)fm-1poteslial.f" #und9f)KiMEASe #define)KiMEASUKiKlies e,foGNNNoEt#include "2I4)fm-1poteslial.f" #und9f)KiMEASe#und9f)KiKIM =po MODULE 2I4)module)fm-1poteslial lib2I4numerics-r1036/src/2I4)fm-1travabse.f0000644000175000017500000004645611616214650017663 0ustar omaromar f_mes9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e,0,-1p! Subroutine ,f: 2I4)fm-1travabseb=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&p 1p,'t&pppPurposett= 0,: RecubsRve routine to travabse the lree. 1p,'t&ppppppppppppppppppC1lled by the 2I4)fm-1expan Ret(comroutine. 1p,'t&p 1p,'t&pp)Isputpppppppp: rootpppppppp (I) index of the rootpbox. 1p,'t&pppppppppppppppppp-recpppppppp (I) not used dummy argumesl 1p,'t&pp to detabmine -reci Ret 1p,'t&p 1p,'t&pp)Isput/outputp: 1p,'t&p 1p,'t&pp)Outputppppppp: 1p,'t&pp m(2M ppppppp (I) returt status. 0 upet(coccess, f_mesp 1p,'t&pp Remarkstt= 0,:pThe recurrencas&will not vect=Nize, f_mesp 1p,'t&pp Referencas&CI:, f_mesp 1p,'t&pp Revi Retstt= :b=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp $Log: 2I4)fm-1travabse.f,v $ 1p,'t&pp Revi Ret 1.1.1.1 2007/07/13 10:18:54c&mvos 1p,'t&pp CBL vabsRet of the PPM library 1p,'t&p 1p,'t&pp Revi Ret 1.15 2006/09/04 18:34:47 2chgela 1p,'t&pp Fixas and craanups topmake itecompile fe0#r=po,0pp reraase-1-0 1p,'t&p 1p,'t&pp Revi Ret 1.14 2006/06/29 10:28:36 2chgela 1p,'t&pp Added vect=N strengths(coppop , f_mesp 1p,'t&pp Revi Ret 1.13 2006/06/16 07:52:22 hiebabs,-CINNNNp Added a new listeof topo IDs (t_stidlist) top-reventpol9mwriging us9m defined,-CINNNNp t_stlogies, f_mesp 1p,'t&pp Revi Ret 1.12 2005/09/19 13:03:30 polasekb 1p,'t&pp code cosmetics, f_mesp 1p,'t&pp Revi Ret 1.11 2005/09/05 06:27:59 polasekb 1p,'t&pp checking if box is et proc, f_mesp 1p,'t&pp Revi Ret 1.10 2005/08/23 14:11:55 polasekb 1p,'t&pp fixad the sign&fessthe Dnm 1p,'t&9 1p,'t&pp Revi Ret 1.9 2005/08/08 13:37:08 polasekb 1p,'t&pp nullify some oGOT poingabs,-CINNNN 1p,'t&pp Revi Ret 1.8 2005/08/04 16:03:17 polasekb 1p,'t&pp moved oGOT R sugiet topin::,-CINNNN 1p,'t&pp Revi Ret 1.7 2005/07/29 12:35:54c&polasekb 1p,'t&pp changed oiagonal&topradius,-CINNNN 1p,'t&pp Revi Ret 1.6 2005/07/27 14:59:57 polasekb 1p,'t&pp nowpcomputing ceslabofbox from children,-CINNNN 1p,'t&pp Revi Ret 1.5 2005/07/25 14:38:19 polasekb 1p,'t&pp changed cR s&topcomroutine, 1p,'t&pp nowpsaving cetstants in module)oGOT)fm- file,-CINNNN 1p,'t&pp Revi Ret 1.4 2005/07/21 13:17:03 polasekb 1p,'t&pp bugfix in do-loop,-CINNNN 1p,'t&pp Revi Ret 1.3 2005/06/02 14:24:01 polasekb 1p,'t&pp removed variabraNtotalmass 1p,'t&pp bugfix cR sing cart2sph,-CINNNN 1p,'t&pp Revi Ret 1.2 2005/05/27 12:44:28 polasekb 1p,'t&pp removed some oebug output, f_mesp 1p,'t&pp Revi Ret 1.1 2005/05/27 07:59:30 polasekb 1p,'t&pp in::i1l implemeslgRet 1p,'t&pp TODO: remove oebug outputs,-CINNNN 1p,'t&pp Revi Ret 0 2004/12/02 15:59:14 polasekb 1p,'t&pp st1p , f_mes9, f_mes9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e,0,-1p! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1p,'t&pp Ceslab fessFluid Dynamics (DTU), f_mesp 1p,'t&p 1p,'t&ppThis file is p1,teof the P1,1llel P1,ticra Mesh Library (PPM). 1p,'t&p 1p,'t&ppPPM is free software: you can redtstribute iteRnd/essmodify 1p,'t&ppiteund9m the labms of the GNU Less9m Gene,1lpPublic Licessa&,-CINNN! as published by the Free Software FoundgRet, either&,-CINNN! vabsRet 3 of the Licessa, ess(at your PouRet)eRny later&,-CINNN! vabsRet. 1p,'t&p 1p,'t&ppPPM is dtstributed in the hope lhat itewill be useful, 1p,'t&ppbut WITHOUT ANY WARRANTY; without even the implied w2004nty of 1p,'t&ppMERCHANTABILITY essFITNESS FOR A PARTICULAR PURPOSE.(See the 1p,'t&ppGNU Gene,1lpPublic Licessa&fessmore details. 1p,'t&p 1p,'t&ppYou should have received a copy of the GNU Gene,1lpPublic Licessa,-CINNN! and the GNU Less9m Gene,1lpPublic Licessa&along with PPM. Ifenot, 1p,'t&ppsee . 1p,'t&p 1p,'t&ppP1,1llel P1,ticra Mesh Library (PPM) 1p,'t&ppETH Zuriche,0,-1p! CH-8092 Zurich, Switzerland , f_mes9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N est,FFT(W_MEASURE)Kiiiii LL subfftw_ &&RE)KIMURE)KiiFIELD) 1p,'t&subURSIVE SUBROUTINE 2I4)fm-1travabse_s_sf(root,-recttttttt0 st,F(W_MEASURE)KiKlies e,foGNNNoE &&RE)KIMURE)KiiFIELD) 1p,'t&subURSIVE SUBROUTINE 2I4)fm-1travabse_d_sf(root,-recttttttt0 st,F(W_MEASURE)Kiiiii LL subfftw_ &&RE)KIMURE)KiVFIELD) 1p,'t&subURSIVE SUBROUTINE 2I4)fm-1travabse_s_vf(root,lda,-recttttttt0 st,F(W_MEASURE)KiKlies e,foGNNNoE &&RE)KIMURE)KiVFIELD) 1p,'t&subURSIVE SUBROUTINE 2I4)fm-1travabse_d_vf(root,lda,-rectttttt ,0 ppp&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppModulesNi_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&USE 2I4)module)oGOT 1p,'t&USE 2I4)module)oGOT)fm- 1p,'t&USE 2I4)module)eble0#r=po,0USE 2I4)module)typedef#r=po,0USE 2I4)module)util_cart2sph,-CINNNUSE 2I4)module)wrige,-CINNNUSE 2I4)module)compt1p , f_mesUSE 2I4)module)comptop,, f_mesIMPLICIT NONEi_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppIncludes, f_mespMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, stnclude "2I4)define.h" est,d9f)KiMPI, f_mesINCLUDE/'mpif.h',0 ppp&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppPreci Ret 1p,'t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist,1p,'t& st,FFTW_MEASURE)Kiiiii LL subfftw_, f_mesINTEGER, PARAMETER :: MK ttttttkind_single,0 ssam-CINNNINTEGER, PARAMETER :: MK ttttttkind_double,0 ppp&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppArgumeslstt= 0i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&INTEGER ,&INTENT(IN ) :: root 1p,'t&suAL(MK) ,&INTENT(IN ) :: -recp!dummy arg&fess-rec. 1p,'t&INTEGER ,&INTENT( OUT) :: ittt 0t,FFTW_KIMURE)KiVFIELD 1p,'t&INTEGER ,&INTENT(IN ) :: lda 1p,'t& s ppp&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppLoc1l variabrasNi_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppauxiliary variabrasNi_slab,LOGIh%N :: onloc1lproc, f_mesINTEGER :: m,n,l,j,i,p,tPou, f_mesINTEGER :: fir,la,,boxNtstat,t_stidm_slab,INTEGER :: fir,t,la,ttttttt=suAL(MK) :: sine,cosine,val,-rodtttttt=suAL(MK) :: angle,reci,t0tttttt=suAL(MK) :: dx,dy,dz,tmp tttttt=suAL(MK),KIMENftw_(: ),POINTER :: box_rho_box_theta_box_phitttttt=COMPLEX(MK) :: csumtttttt=COMPLEX(MK),PARAMETER :: CI=(0.0_MK,1.0_MK) 1p,'t&CHARACTER(LEN=ttttchar) :: cbu& 1p,'t&TYPENm(3Mt_t_st), POINTER :: t_st 1p,'t&ppfm- tttttt=suAL(MK),KIMENftw_(: ),POINTER :: fracfac,totalmass,radius,-CINNNsuAL(MK),KIMENftw_(:,:),POINTER :: Pnm,Anm,sqrtfac,ceslabofboxtttttt=COMPLEX(MK),KIMENftw_(:,:),POINTER :: Inner,Ynm,0t,FFTW_KIMURE)KiiFIELDtttttt=COMPLEX(MK),KIMENftw_(:,:,:) ,POINTER :: expan Ret,0 ssam-CINNNCOMPLEX(MK),KIMENftw_(:,:,:,:),POINTER :: expan Ret,0 ppp&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pppIn::i1lizeNi_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&h%Nm(compt1,t('2I4)fm-1travabse It0tttttttttttt=NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppCheck -reci ReteRnd poinging tree oGOT topcorrect variabras, f_mespMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, st,FFTW_MEASURE)Kiiiii LL subfftw_, f_mesceslabofbox => ceslabofbox_s, f_mestotalmass => totalmass_s ,0t,FFTW_KIMURE)KiiFIELD p,'t&, f_mesexpan Ret( => expan Ret_s_sf,0 ssam-CINNNexpan Ret( => expan Ret_s_vf,0 ppp& m-CINNNradius => radius_s, f_mesAnm => Anm_s, f_messqrtfac => sqrtfac_s, f_mesfracfac => fracfac_s, f_mesYnm => Ynm_s, f_mesPnm => Pnm_s, f_mesbox_rho => rho_s, f_mesbox_thetae => theta_s, f_mesbox_phi => phi_s, f_mesInner => Inner_s,0 ssam-CINNNceslabofbox => ceslabofbox_d, f_mestotalmass => totalmass_d,0t,FFTW_KIMURE)KiiFIELD p,'t&, f_mesexpan Ret( => expan Ret_d_sf,0 ssam-CINNNexpan Ret( => expan Ret_d_vf,0 ppp& m-CINNNradius => radius_d, f_mesAnm => Anm_d, f_messqrtfac => sqrtfac_d, f_mesfracfac => fracfac_d, f_mesYnm => Ynm_d, f_mesPnm => Pnm_d, f_mesbox_rho => rho_d, f_mesbox_thetae => theta_d, f_mesbox_phi => phi_d, f_mesInner => Inner_d,(appp&i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppCheck p& current rootpis a leaf, 1p,'t&ppp& yes, no shifging has topbe ooneb=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&IF (nchld(root) .EQ.(1M/2+1K tttttt= 0,fIF (0,-1debug .GT.(1M/2+1Ki h%Nm(ttttwrige(0,-1rank_,2I4)fm-1travabse I'leaf box'tttttttttttt= 0,f=po,0,ttttt=9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e,0,-1p! Current rootphas more children, cR s&routine recubsRvely,ttttt=9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e,0,-1pELSE, f_mesmccNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDii_slab, 0NN Check p& box et(loc1l proc., p& not, no computgiet fessthis boxi_slab, 0N! loop ooesnt vect=Nize, f_mesmccNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDii onloc1lproc = .FALSE.i IF (nbpl(bravel(root)) .LT.(2I4)nprocM/2+1Ki !ravel t_stlogy not defined,-CINNNNNNNNNonloc1lproc = .TRUE.,-CINNNNNNELSE, f_mesmcccct_stid = tostidlist(bravel(root)), f_mesmcccct_st => p(3Mt_st(t_stid)%ttttttt=-CINNDO'i=1,t_st%nsublisttttttt=-CINNN&oIF(2I4)boxid(t_st%isublist(i),bravel(root)) .EQ.(root)2+1Ki=CINNNmmcmccccccconloc1lproc = .TRUE.,-CINNNNNNCINNNNNNEXIT,-CINNNNNNCINNN=po,0, f_mesmcccc=poDO,-CINNNttt=po,0, IF (onloc1lprocM/2+1Ki DO'i=1,nchld(root)i0t,FFTTTTTTTW_KIMURE)KiiFIELD ,-CINNNNNNCINNNNh%Nm(ttttfm-1travabse(child(i,root),-recttttttt0 ssa&,-CINNN 0NCINNNNh%Nm(ttttfm-1travabse(child(i,root),lda,-recttttttt0 ppp&i_slab,=-CINNN&oIF (0,-1debug .GT.(1M/2+1Ki CINNNNh%Nm(ttttwrige(0,-1rank_,2I4)fm-1travabse I &tttttt= 0Nocsoccc&ttt= 0Nocsoccc'C1lled travabse Ittttttttttt= 0,fCINNN=po,0, f_mesmccccc=poDO,-CINNNtt9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3,-CINNNtt9 Now R s children have been c1lled recubsRvely, computgiet can pt1p , f_mestt9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3,-CINNNtt9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3,-CINNNtt9 Compute ceslabofbox Rnd t_talmass 1p,'t&tt9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3,-CINNNttttttfir = child(1,root),-CINNNttttttlas = child((nchld(root)),root),-CINNNtttttttotalmass(root) tt0.0_MKtttttt=N&&&&&DO'i=fir,la,tttttt= 0,fCINNNtotalmass(root) tttotalmass(root) +ttotalmass(i)tttttt=-CINNN=poDO tt=-CINNN ccIF(2I4)dim.EQ.2)2+1Ki=CINNNmmc&oooNNceslabofbox(1,root) tt0.0_MKtttttt=N&&&&& NNceslabofbox(2,root) tt0.0_MKtttttt=N&&&&& NNDO'i= fir,la,tttttt= 0,fCINNNoNNceslabofbox(1,root) ttceslabofbox(1,root) + &tttttt= 0Nocsoccccc,fo) ceslabofbox(1,i)*totalmass(i)tttttt=-CINNN&&& NNceslabofbox(2,root) ttceslabofbox(2,root) + &tttttt= 0Nocsoccccc,fo) ceslabofbox(2,i)*totalmass(i)tttttt=-CINNN&&&=poDO,-CINNNtttt=&&&&tmp tt1.0_MK/totalmass(root),-CINNNttttttoNNceslabofbox(1,root) ttceslabofbox(1,root)*tmptttttt=N&&&&& ffceslabofbox(2,root) ttceslabofbox(2,root)*tmptttttt=N&&&&&=po,0,ttttt=N&&&&&IF(2I4)dim.EQ.3)2+1Ki=CINNNmmc&oooNNceslabofbox(1,root) tt0.0_MKtttttt=N&&&&& NNceslabofbox(2,root) tt0.0_MKtttttt=N&&&&& NNceslabofbox(3,root) tt0.0_MKtttttt=N&&&&& NNDO'i= fir,la,tttttt= 0,fCINNNoNNceslabofbox(1,root) ttceslabofbox(1,root) + &tttttt= 0Nocsoccccc,fo) ceslabofbox(1,i)*totalmass(i)tttttt=-CINNN&&& NNceslabofbox(2,root) ttceslabofbox(2,root) + &tttttt= 0Nocsoccccc,fo) & NNceslabofbox(2,i)*totalmass(i)tttttt=-CINNN&&& NNceslabofbox(3,root) ttceslabofbox(3,root) + &tttttt= 0Nocsoccccc,fo) & NNceslabofbox(3,i)*totalmass(i)tttttt=-CINNN&&&=poDO,-CINNNtttt=&&&&tmp tt1.0_MK/totalmass(root),-CINNNttttttoNNceslabofbox(1,root) ttceslabofbox(1,root)*tmptttttt=N&&&&& ffceslabofbox(2,root) ttceslabofbox(2,root)*tmptttttt=N&&&&& NNceslabofbox(3,root) ttceslabofbox(3,root)*tmptttttt=N&&&&&=po,0,ttttt=N&9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3,-CINNNtt9 In::i1tRet of spheric1l coordinatas topzertn_many_tt9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3,-CINNNttttttDO'i=1,nchld(root)ittttt=N&&&&& NNbox_rho(i) tt0.0_MKtttttt=N&&&&& NNbox_phi(i) tt0.0_MKtttttt=N&&&&& NNbox_theta(i) tt0.0_MKtttttt=N&&&&&=poDO,-CINNNtt9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3,-CINNNtt9 Compute spheric1l coordinatas of child boxase,0,-1pN&9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3,-CINNNtttttth%Nm(ttttutil_cart2sph(ceslabofbox(1,fir:la,),ceslabofbox(2,fir:la,), &tttttt= 0Nocs&tceslabofbox(3,fir:la,),nchld(root), &tttttt= 0Nocs&tceslabofbox(1,root),ceslabofbox(2,root),ceslabofbox(3,root), &tttttt= 0Nocs&tbox_rho(1:nchld(root)),box_theta(1:nchld(root)), &tttttt= 0Nocs&tbox_phi(1:nchld(root)),ttttttttttt= 0,fCIIF (tttt .NE.(1M/2+1Ki=CINNNmmctttttth%Nm(ttttttt=NNm(3MKi=Csub_failed_,2I4)fm-1travabse I &tttttt= 0Nocsocc& 'Failed cR sing util_cart2sphGNNNNpartptttttttttttt= 0,,&&=po,0,ttttt=N&&&&&DO'i=1,nchld(root)ittttt=N&&&&& NNfir,tp= lhbx(1,child(i,root))ittttt=N&&&&& NNla,tpp= lhbx(2,child(i,root))ittttt=N&&&&& NNIF (la,t-fir,t+1 .EQ.(1M/CYCLEi N&9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topoittttt=N&&&&9 Compute radius,-CINNNN&&&&9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topoittttt=N&&&&&&&&box ttchild(i,root)ittttt=N&&&&&&&&dx = ceslabofbox(1,box) -Nceslabofbox(1,root)ittttt=N&&&&&&&&dy = ceslabofbox(2,box) -Nceslabofbox(2,root)ittttt=N&&&&&&&&dz = ceslabofbox(3,box) -Nceslabofbox(3,root)ittttt=N&&&&&&&&tmp ttSQRT(dx**2 +&dy**2 +&dz**2) + radius(box)ittttt=N&&&&& NNIF (tmp .GT.(radius(root)) 2+1Ki=CINNNmmcmccccccccradius(root) tttmptttttt=N&&&&& ff=po,0,-CINNNN&&&&9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topoittttt=N&&&&! Compute Legendre polynomiTli=CINNNmmcc&9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topoittttt=N&&&&&&&&reci&&&&&&tt1.0_MK/box_rho(i)ittttt=N&&&&&&&&sine ,f&&&ttSIN(box_theta(i)),-CINNNttttttoNNcosine ,f&= COS(box_theta(i)),-CINNNttttttoNNval&&& ,f&= -sine 1p,'t&&&&&&&&&&-rod&&&&&&tt1.0_MKtttttt=N&&&&& NNDO'm=0,orderi=CINNNmmcmccccccccPnm(m,m) ttfracfac(m)*-rodtttttt='t&&&&&&&&&&-rod&&&&&=&-rod&*Nvaltttttt=-CINNN&&&=poDO,-CINNNtttt=&&&&DO'm=0,order-1i=CINNNmmcmccccccccPnm(m+1,m) ttcosine*suAL(2*m + 1,MK)*Pnm(m,m)tttttt=-CINNN&&&=poDO,-CINNNtttt=&&&&DO'n=2,orderi=CINNNmmcmccccccccval&ttcosine*suAL(2*n-1,MK)i=CINNNmmcmccccccccDO'm=0,n-1i=CINNNmmcmcccccccccccPnm(n,m)=(val*Pnm(n-1,m)-suAL(n+m-1,MK)* &tttttt= 0NocsoccccccccPnm(n-2,m))/suAL(n-m,MK)i=CINNNmmcmcccccccc=poDO,-CINNNtttt=&&&&=poDO,-CINNNtttt=&&&&IF (0,-1debug .GT.(1M/2+1Ki CINNNNh%Nm(ttttwrige(0,-1rank_,2I4)fm-1travabse I'Computed Pnm Ittttttttttt= 0,fCINNN=po,0, f_mesmcccc9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topoittttt=N&&&&! Compute Ynm(n,m) Rnd Ynm(n,-m)tttttt=-CINN9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topoittttt=N&&&&&&&&DO'n=0,orderi=CINNNmmcmccccccccm tt0, f_messsssssssssssangle ttsuAL(m,MK)*box_phi(i), f_messsssssssssssYnm(n,m) = sqrtfac(n,m)*Pnm(n,m)* &tttttt= 0Nocsoccccc& CMPLX(COS(angle),SIN(angle))i=CINNNmmcmccccccccDO'm=1,ntttttt= 0Nocsoccccccccangle ttsuAL(m,MK)*box_phi(i), f_messssssssssssssssYnm(n,m) = sqrtfac(n,m)*Pnm(n,m)* &tttttt= 0Nocsocccccccc& CMPLX(COS(angle),SIN(angle))i=CINNNmmcmccccccccsssYnm(n,-m) = CONJG(Ynm(n,m))i=CINNNmmcmcccccccc=poDO,-CINNNtttt=&&&&=poDO,-CINNNtttt=&&&&IF (0,-1debug .GT.(1M/2+1Ki CINNNNh%Nm(ttttwrige(0,-1rank_,2I4)fm-1travabse I'Computed Ynm Ittttttttttt= 0,fCINNN=po,0, N&9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topoittttt=N&&&&9 Compute Inner expan Ret,ttttt=N&&&&9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topoittttt=N&&&&&&&&DO'n=0,orderi=CINNNmmcmccccccccDO'm=-n,ntttttt= 0NocsoccccccccInner(n,m)=CI**(-ABS(m))*Anm(n,m)*box_rho(i)**n*Ynm(n,m)i=CINNNmmcmcccccccc=poDO,-CINNNtttt=&&&&=poDO,-CINNNtttt=&&&&IF (0,-1debug .GT.(1M/2+1Ki CINNNNh%Nm(ttttwrige(0,-1rank_,2I4)fm-1travabse I'Computed Inner Ittttttttttt= 0,fCINNN=po,0, f_mesmcccc9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topoittttt=N&&&&! Compute Dnm(n,m) = expan Ret(coefficiesl 1p,'t&mcccc9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topoi0t,FFTTTTTTW_KIMURE)KiiFIELDtttttt=-CINNN ffDO'l=0,orderi=CINNNmmcmccccccccDO'j=-l,ltttttt=-CINNN&&&&&&&&&csum = (0.0_MK,0.0_MK) 1p,'t&NNNmmcmccccccccDO'n=0,l&&&!orderi=CINNNmmcmccccccccccccccDO'm=MAX(j+n-l,-n),MIN(j+l-n,n)c9mn,ntttttt= 0Nocsocccccccc&&&&&&csum = csum + (-1)**(l-n)*Inner((l-n),(j-m)) &tttttt= 0Nocsoccccccccc,fo) *expan Ret(child(i,root),n,m)i=CINNNmmcmcccccccccccccc=poDO,-CINNNtttt=&&&&oNNccc=poDO,-CINNNtttt=&&&&o! add t_ expan Ret(inpfm-)module)oGOT file,-CINNNNNNNNNNNNNNNNNNexpan Ret(root,l,j) = expan Ret(root,l,j) + csumtttttt=t=&&&&oNNccc=poDO,-CINNNtttt=&&&&=poDO,0 ssatttttt=-CINNN ffDO'l=0,orderi=CINNNmmcmccccccccDO'j=-l,ltttttt=-CINNN&&&&&&&&&DO'p=1,lda 1p,'t&&&&&&&&&&&&&&&&&&&csum = (0.0_MK,0.0_MK) 1p,'t&NNNmmcmcccccccc ccDO'n=0,l&!orderi=CINNNmmcmcccccccccccccc ccDO'm=MAX(j+n-l,-n),MIN(j+l-n,n)c9mn,ntttttt= 0Nocsocccccccc&&&&&& &&csum = csum + (-1)**(l-n)*Inner((l-n),(j-m)) &tttttt= 0Nocsocccccccccccccccccccccc,fo) *expan Ret(p,child(i,root),n,m)i=CINNNmmcmcccccccccccccc cc=poDO,-CINNNtttt=&&&&oNNccc cc=poDO,-CINNNtttt=&&&&o! add t_ expan Ret(inpfm-)module)oGOT file,-CINNNNNNNNNNNNNNNNNN NNexpan Ret(p,root,l,j) = expan Ret(p,root,l,j) + csumtttttt=t=&&&&oNNccc cc=poDO,-CINNNtttt=&&&&oNN=poDO,-CINNNtttt=&&&&=poDO,0 ppp&i_slab,=-CINNN&oIF (0,-1debug .GT.(1M/2+1Ki CINNNh%Nm(ttttwrige(0,-1rank_,2I4)fm-1travabse I'Computed Dnm Ittttttttttt= 0,fCINN=po,0, f_mesmcccc=poDO,-CINNNtt=po,0t&&&&&&&&&&&&&&&&&&&&!et(loc1l proc ,fCINN=po,0, f_mesNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp Nullify oGOT poingabs,-CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&NULLIFY(ceslabofbox) 1p,'t&NULLIFY(radiusab=CINNNNULLIFY(expan Retab=CINNNNULLIFY(Anmab=CINNNNULLIFY(sqrtfacab=CINNNNULLIFY(fracfacab=CINNNNULLIFY(Ynmab=CINNNNULLIFY(Pnmab=CINNNNULLIFY(Innerab=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp Returti_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, d_do1p1phONTINUE h%Nm(comptop(,2I4)fm-1travabse It0ttttttt RETURN est,FFT(W_MEASURE)Kiiiii LL subfftw_ &&RE)KIMURE)KiiFIELD) 1p,'t&=po SUBROUTINE 2I4)fm-1travabse_s_sf,0 st,F(W_MEASURE)KiKlies e,foGNNNoE &&RE)KIMURE)KiiFIELD) 1p,'t&=po SUBROUTINE 2I4)fm-1travabse_d_sf,0 st,F(W_MEASURE)Kiiiii LL subfftw_ &&RE)KIMURE)KiVFIELD) 1p,'t&=po SUBROUTINE 2I4)fm-1travabse_s_vf,0 st,F(W_MEASURE)KiKlies e,foGNNNoE &&RE)KIMURE)KiVFIELD) 1p,'t&=po SUBROUTINE 2I4)fm-1travabse_d_vf,0 ppp&ilib2I4numerics-r1036/src/2I4)module)fieldsolvab.f0000644000175000017500000000307511616214650021042 0ustar omaromar=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp Moduletttt= 0: 2I4)module)fieldsolvabb=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&p 1p,'t&pp Purposett= 0,: This module cettains the us9m-cR sabraNfunctRetstof 1p,'t&ppppppppppppppppppthe FFT-based fieldsolvab. 1p,'t&ppppppppppppppppp 1p,'t&pp Remarkstt= 0,: 1p,'t&p 1p,'t&pp Referencas&CI:, f_mesp 1p,'t&pp Revi Retstt= :b=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp $Log: 2I4)module)fieldsolvab.f,v $ 1p,'t&pp Revi Ret 1.1.1.1 2007/07/13 10:18:58c&mvos 1p,'t&pp CBL vabsRet of the PPM library 1p,'t&p 1p,'t&pp Revi Ret 1.3 2004/07/26 13:40:29c&mvos 1p,'t&pp In::i1l implemeslgRet.pThesa&are meta-modulesNfessthe us9m- 1p,'t&pp cR sabraNfunctRets. Only thesa&mod filesewill be given away 1p,'t&pp to the us9m. 1p,'t&p 1p,'t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp Pe,1llel P1,ticra Mesh Library (PPM) 1p,'t&pp Institute of Computgiet1l Sciesce 1p,'t&pp ETH Zeslrum, Hirschengraben 84 1p,'t&pp CH-8092 Zurich, Switzerland 1p,'t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&MODULE 2I4)module)fieldsolvabb, f_mesmccNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDii_slab, 0NN PPM modules, f_mesmccNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDii_slab, 0NUSE 2I4)module)fdsolvab_poisset,ttttt=N&&USE 2I4)module)fdsolvab_solva,ttttt=N&& 1p,'t&=po MODULE 2I4)module)fieldsolvabblib2I4numerics-r1036/src/2I4)module)mg_smooth.f0000644000175000017500000001143111616214650020513 0ustar omaromar 1p,'t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppModuletttt= 0,f: 2I4)module)mg_smoothb=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&p 1p,'t&ppPurposett= 0,f: multigrid module 1p,'t&pppppppppppppppp 1p,'t&p 1p,'t&ppRemarkstt= 0,f: 1p,'t&p 1p,'t&ppReferencas&CIN: 1p,'t&p 1p,'t&ppRevi Retstt= 0:b=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp$Log: 2I4)module)mg_smooth.f,v $ 1p,'t&ppRevi Ret 1.1.1.1 2007/07/13 10:19:00c&mvos 1p,'t&ppCBL vabsRet of the PPM library 1p,'t&p 1p,'t&ppRevi Ret 1.2 2004/11/05 18:08:49c&kotsalie 1p,'t&ppFINAL SPEEDUP BEFORE TEST 1p,'t&p 1p,'t&ppRevi Ret 1.1 2004/09/22 18:41:49c&kotsalie 1p,'t&ppMG new vabsRet 1p,'t&p 1p,'t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppCopyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1p,'t&pp Ceslab fessFluid Dynamics (DTU), f_mesp 1p,'t&p 1p,'t&ppThis file is p1,teof the P1,1llel P1,ticra Mesh Library (PPM). 1p,'t&p 1p,'t&ppPPM is free software: you can redtstribute iteRnd/essmodify 1p,'t&ppiteund9m the labms of the GNU Less9m Gene,1lpPublic Licessa&,-CINNN! as published by the Free Software FoundgRet, either&,-CINNN! vabsRet 3 of the Licessa, ess(at your PouRet)eRny later&,-CINNN! vabsRet. 1p,'t&p 1p,'t&ppPPM is dtstributed in the hope lhat itewill be useful, 1p,'t&ppbut WITHOUT ANY WARRANTY; without even the implied w2004nty of 1p,'t&ppMERCHANTABILITY essFITNESS FOR A PARTICULAR PURPOSE.(See the 1p,'t&ppGNU Gene,1lpPublic Licessa&fessmore details. 1p,'t&p 1p,'t&ppYou should have received a copy of the GNU Gene,1lpPublic Licessa,-CINNN! and the GNU Less9m Gene,1lpPublic Licessa&along with PPM. Ifenot, 1p,'t&ppsee . 1p,'t&p 1p,'t&ppP1,1llel P1,ticra Mesh Library (PPM) 1p,'t&ppETH Zuriche,0,'t&ppCH-8092 Zurich, Switzerland , f_mes9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e #define)Kiiiii LL subfftw_ 1 #define)KiKlies e,foGNNNoE 2 #define)KiINTEGER 3 #define)KiLOGIh%N 4 #define)Ki2D p,'t&&&&&&&&&&7 #define)Ki3D p,'t&&&&&&&&&&8 #define)KiiFIELD p,'t&&&&&&9 #define)KiVFIELD p,'t&&&&&10 #define)KiWITHOUTMASKS && , MODULE 2I4)module)mg_smooth pp 1p9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N - 1p9Modules, f9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N -N e,0, f9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N -N fINTERFACE 2I4)mg_smooth_sca 1p,'tMODULE PROCEDURE 2I4)mg_smooth_coabse_2D_sca_s, f_meMODULE PROCEDURE 2I4)mg_smooth_coabse_2D_sca_d, f_meMODULE PROCEDURE 2I4)mg_smooth_coabse_3D_sca_s, f_meMODULE PROCEDURE 2I4)mg_smooth_coabse_3D_sca_d, f_meMODULE PROCEDURE 2I4)mg_smooth_fine_2D_sca_s, f_meMODULE PROCEDURE 2I4)mg_smooth_fine_2D_sca_d, f_meMODULE PROCEDURE 2I4)mg_smooth_fine_3D_sca_s, f_meMODULE PROCEDURE 2I4)mg_smooth_fine_3D_sca_d, f=po INTERFACE , fINTERFACE 2I4)mg_smooth_vec, f_meMODULE PROCEDURE 2I4)mg_smooth_fine_2D_vec_s, f_meMODULE PROCEDURE 2I4)mg_smooth_fine_2D_vec_d, f_meMODULE PROCEDURE 2I4)mg_smooth_fine_3D_vec_s, f_meMODULE PROCEDURE 2I4)mg_smooth_fine_3D_vec_d, f_meMODULE PROCEDURE 2I4)mg_smooth_coabse_2D_vec_s, f_meMODULE PROCEDURE 2I4)mg_smooth_coabse_2D_vec_d, f_meMODULE PROCEDURE 2I4)mg_smooth_coabse_3D_vec_s, f_meMODULE PROCEDURE 2I4)mg_smooth_coabse_3D_vec_d, f=po INTERFACE && , f9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N -N e,0! INCLUDE/2+1 SOURCES, f9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N -N - ,hONTAINSe #define)KiKIM)KiiFIELDt#define)KiMESHiKIM)Ki2D #define)KiMEASUKiiiii LL subfftw_,#tnclude "2I4)mg_smooth_coabse.f" #tnclude "2I4)mg_smooth_fine.f" #und9f)KiMEASe #define)KiMEASUKiKlies e,foGNNNoEt#include "2I4)mg_smooth_coabse.f" #tnclude "2I4)mg_smooth_fine.f" #und9f)KiMEASe#und9f)KiMESHiKIM) t#define)KiMESHiKIM)Ki3D #define)KiMEASUKiiiii LL subfftw_,#tnclude "2I4)mg_smooth_coabse.f" #tnclude "2I4)mg_smooth_fine.f" #und9f)KiMEASe #define)KiMEASUKiKlies e,foGNNNoEt#include "2I4)mg_smooth_coabse.f" #tnclude "2I4)mg_smooth_fine.f" #und9f)KiMEASe#und9f)KiMESHiKIMe#und9f)KiKIM #define)KiKIM)KiVFIELDt#define)KiMESHiKIM)Ki2D #define)KiMEASUKiiiii LL subfftw_,#tnclude "2I4)mg_smooth_coabse.f" #tnclude "2I4)mg_smooth_fine.f" #und9f)KiMEASe #define)KiMEASUKiKlies e,foGNNNoEt#include "2I4)mg_smooth_coabse.f" #tnclude "2I4)mg_smooth_fine.f" #und9f)KiMEASe#und9f)KiMESHiKIMet#define)KiMESHiKIM)Ki3D #define)KiMEASUKiiiii LL subfftw_,#tnclude "2I4)mg_smooth_coabse.f" #tnclude "2I4)mg_smooth_fine.f" #und9f)KiMEASe #define)KiMEASUKiKlies e,foGNNNoEt#include "2I4)mg_smooth_coabse.f" #tnclude "2I4)mg_smooth_fine.f" #und9f)KiMEASe#und9f)KiMESHiKIMe#und9f)KiKIM =po MODULE 2I4)module)mg_smoothb lib2I4numerics-r1036/src/2I4)mg_core.f0000644000175000017500000006162311616214650016575 0ustar omaromar f_mes9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3 1p,'t&pp Subroutine ,f: 2I4)mg_core 0i_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDis 1p,'t&p 1p,'t&pp Referencas&CI:, f_mesp 1p,'t&pp Revi Retstt= :b=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp $Log: 2I4)mg_core.f,v $ 1p,'t&pp Revi Ret 1.1.1.1 2007/07/13 10:18:56c&mvos 1p,'t&pp CBL vabsRet of the PPM library 1p,'t&p 1p,'t&pp Revi Ret 1.4 2006/05/15 14:48:57 kotsalie 1p,'t&pp cosmetics, f_mesp 1p,'t&pp Revi Ret 1.3 2004/10/14 08:45:12 kotsalie 1p,'t&p 1p,'t&pp Changed the crigerium&fessgoing down topcoabser ravels, f_mesp 1p,'t&pp Revi Ret 1.2 2004/09/23 12:40:23 kotsalie 1p,'t&pp Added logic1l variabra&fessdtstinguishing between v and w cycle,-CINNNN 1p,'t&pp Revi Ret 1.1 2004/09/22 18:31:37 kotsalie 1p,'t&pp MG new vabsRet 1p,'t&p 1p,'t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDispp 1p,'t&ppCopyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1p,'t&pp Ceslab fessFluid Dynamics (DTU), f_mesp 1p,'t&p 1p,'t&ppThis file is p1,teof the P1,1llel P1,ticra Mesh Library (PPM). 1p,'t&p 1p,'t&ppPPM is free software: you can redtstribute iteRnd/essmodify 1p,'t&ppiteund9m the labms of the GNU Less9m Gene,1lpPublic Licessa&,-CINNN! as published by the Free Software FoundgRet, either&,-CINNN! vabsRet 3 of the Licessa, ess(at your PouRet)eRny later&,-CINNN! vabsRet. 1p,'t&p 1p,'t&ppPPM is dtstributed in the hope lhat itewill be useful, 1p,'t&ppbut WITHOUT ANY WARRANTY; without even the implied w2004nty of 1p,'t&ppMERCHANTABILITY essFITNESS FOR A PARTICULAR PURPOSE.(See the 1p,'t&ppGNU Gene,1lpPublic Licessa&fessmore details. 1p,'t&p 1p,'t&ppYou should have received a copy of the GNU Gene,1lpPublic Licessa,-CINNN! and the GNU Less9m Gene,1lpPublic Licessa&along with PPM. Ifenot, 1p,'t&ppsee . 1p,'t&p 1p,'t&ppP1,1llel P1,ticra Mesh Library (PPM) 1p,'t&ppETH Zuriche,0,'t&ppCH-8092 Zurich, Switzerland , f_mes9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N ,0t,FW_KIMURE)KiiFIELDt0t,FW_MESHiKIM)RE)Ki2Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_messubURSIVE SUBROUTINE 2I4)mg_core_2d_sca_s(mrav,iger1,iger2ttttttt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_messubURSIVE SUBROUTINE 2I4)mg_core_2d_sca_d(mrav,iger1,iger2ttttttt0 ppp&i0 st,FW_MESHiKIM)RE)Ki3Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_messubURSIVE SUBROUTINE 2I4)mg_core_3d_sca_s(mrav,iger1,iger2ttttttt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_messubURSIVE SUBROUTINE 2I4)mg_core_3d_sca_d(mrav,iger1,iger2ttttttt0 ppp&i0 ppp&i0 st,FW_KIMURE)KiVFIELD 0t,FW_MESHiKIM)RE)Ki2Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_messubURSIVE SUBROUTINE 2I4)mg_core_2d_vec_s(mrav,iger1,iger2ttttttt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_messubURSIVE SUBROUTINE 2I4)mg_core_2d_vec_d(mrav,iger1,iger2ttttttt0 ppp&i0 st,FW_MESHiKIM)RE)Ki3Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_messubURSIVE SUBROUTINE 2I4)mg_core_3d_vec_s(mrav,iger1,iger2ttttttt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_messubURSIVE SUBROUTINE 2I4)mg_core_3d_vec_d(mrav,iger1,iger2ttttttt0 ppp&i0 ppp&i0 ppp&i f_mes9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3i f_mes9pIncludes, f_meses9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3istnclude "2I4)define.h" f_mes9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3i f_mes9ppModulesNi_slab,es9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3i f_mesUSE 2I4)module)oGOT 1p,'t&t&USE 2I4)module)oGOT)mg 1p,'t&t&USE 2I4)module)mg_prolong 1p,'t&t&USE 2I4)module)mg_restrict 1p,'t&t&USE 2I4)module)mg_smoothb=CINNNt&USE 2I4)module)mg_resb=CINNNt&USE 2I4)module)compt1p , f_mesesUSE 2I4)module)comptop, f_mesesUSE 2I4)module)eble0#r=po,0esUSE 2I4)module)R su#r=po,0esUSE 2I4)module)wrige,-CINNNesIMPLICIT NONEi0t,FFTTW_MEASURE)Kiiiii LL subfftw_, f_mesesINTEGER, PARAMETER :: MK ttttttkind_single,0 ssam-CINNNNNINTEGER, PARAMETER :: MK ttttttkind_double,0 ppp&i_slab,es9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) i f_mes9ppArgumeslstt= 0i_slab,ccNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDii_slab, 0INTEGER, INTENT(IN ) :: mravi_slab, 0INTEGER, INTENT(IN ) :: iger1i_slab, 0INTEGER, INTENT(IN ) :: iger2i_slab, 0INTEGER, INTENT(INOUT) :: ittt _slab,ccNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDii_slab, 0pppLoc1l variabras _slab,ccNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDii_slab, 0suAL(MK) :: t0i_slab, 0suAL(MK) :: scale1,scale2 i_slab, 0suAL(MK) :: E,resb=CINNNt&INTEGER :: isub,i,jb=CINNNt&INTEGER :: ilda 1p,'t&&&CHARACTER(LEN=256) :: cbu& i_slab, 0suAL(MK) :: c1,c2,c3,c4 b=CINNNt&INTEGER :: ncR ss=0i_slab, 0suAL(MK) :: rdx2,rdy2 i_slab, 0suAL(MK) :: dxl,dyl i_slab, 0suAL(MK) :: dx,dy 0t,FW_MESHiKIM)RE)Ki3Di_slab, 0suAL(MK) :: c5,dzl,scale3i_slab, 0suAL(MK) :: dz,rdz2i_slab, 0INTEGER :: ki0 ppp&i0t,FW_KIMURE)KiiFIELDt0t,FW_MESHiKIM)RE)Ki2Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_mest&TYPENmg_field_2d_sca_s),KIMENftw_(:,:),POINTER :: mgfieldt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mest&TYPENmg_field_2d_sca_d),KIMENftw_(:,:),POINTER :: mgfieldt0 ppp&i0 st,FW_MESHiKIM)RE)Ki3Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_mest&TYPENmg_field_3d_sca_s),KIMENftw_(:,:),POINTER :: mgfieldt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mest&TYPENmg_field_3d_sca_d),KIMENftw_(:,:),POINTER :: mgfieldt0 ppp&i0 ppp&i0 st,FW_KIMURE)KiVFIELD 0t,FW_MESHiKIM)RE)Ki2Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_mest&TYPENmg_field_2d_vec_s),KIMENftw_(:,:),POINTER :: mgfieldt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mest&TYPENmg_field_2d_vec_d),KIMENftw_(:,:),POINTER :: mgfieldt0 ppp&i0 st,FW_MESHiKIM)RE)Ki3Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_mest&TYPENmg_field_3d_vec_s),KIMENftw_(:,:),POINTER :: mgfieldt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mest&TYPENmg_field_3d_vec_d),KIMENftw_(:,:),POINTER :: mgfieldt0 ppp&i0 ppp&i0 ppp&i f_mes9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3i f_mes9Exgernals, f_meses9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3ii f_mes9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3i f_mes9In::i1lizei f_mes9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3i f_mesh%Nm(compt1,t('2I4)mg_core It0tttttttttttt=es9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) i f_mes9ppCheck argumeslsi_slab,ccNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDii_slab, 0IF (0,-1debug .GT.(1M/2+1Ki IF (mrav.LE.1M/2+1Ki CINNNNtttt =(ttttttt=N)eble0#r=po,0esssssssssssh%Nm(ttttttt=NNm(3MKi=Cargumesl,'2I4)mg_core I &tttttt&po,0esssssssssss'ravel must be >1GNNNNpartptttttttttttt= 0,,&&&&&&&&GOTO d_dotttttt= 0,,&&=po,0, f_mesmc=po,0,ttttt=N&9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3,-CINNNtt9DefinitRet of necessary variabrasNand R su1tRet of 2004ys, f_meses9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3ist,FW_MESHiKIM)RE)Ki2Dt0t,FW_MEASURE)Kiiiii LL subfftw_,0t,FW_KIMURE)KiiFIELDt f_mesesmgfield=>mgfield_2d_sca_si0 st,FW_KIMURE)KiVFIELD f_mesesmgfield=>mgfield_2d_vec_s,0 ppp&i f_mesrdx2=rdx2_si f_mesrdy2=rdy2_si f_mesdx = dx_si f_mesdy = dy_si0 st,FW_MEASURE)KiKlies e,foGNNNoE,0t,FW_KIMURE)KiiFIELDt f_mesesmgfield=>mgfield_2d_sca_di0 st,FW_KIMURE)KiVFIELD f_mesesmgfield=>mgfield_2d_vec_d,0 ppp&i f_mesrdx2=rdx2_di f_mesrdy2=rdy2_di f_mesdx = dx_di f_mesdy = dy_dt0 ppp&i0 st,FW_MESHiKIM)RE)Ki3Dt0t,FW_MEASURE)Kiiiii LL subfftw_,0t,FW_KIMURE)KiiFIELDt f_mesesmgfield=>mgfield_3d_sca_si0 st,FW_KIMURE)KiVFIELD f_mesesmgfield=>mgfield_3d_vec_s,0 ppp&i f_mesrdx2=rdx2_si f_mesrdy2=rdy2_si f_mesrdz2=rdz2_si f_mesdx = dx_si f_mesdy = dy_si f_mesdz = dz_si0 st,FW_MEASURE)KiKlies e,foGNNNoE,0t,FW_KIMURE)KiiFIELDt f_mesesmgfield=>mgfield_3d_sca_di0 st,FW_KIMURE)KiVFIELD f_mesesmgfield=>mgfield_3d_vec_d,0 ppp&i f_mesrdx2=rdx2_di f_mesrdy2=rdy2_di f_mesrdz2=rdz2_di f_mesdx = dx_di f_mesdy = dy_dt f_mesdz = dz_dt0 ppp&i0 ppp&i f_mes9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topi f_mes9prestrict the solugiet from the previous fine grid to the currenti f_mes9pcoabser gridi f_mes9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_toi0t,FW_KIMURE)KiiFIELDt0t,FW_MESHiKIM)RE)Ki2Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_mest&h%Nm(ttttmg_restrict_2d_sca_s(ttttpara3Mt_st_und9fined,mrav,ittttt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mest&h%Nm(ttttmg_restrict_2d_sca_d(ttttpara3Mt_st_und9fined,mrav,ittttt0 ppp&i0 st,FW_MESHiKIM)RE)Ki3Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_mest&h%Nm(ttttmg_restrict_3d_sca_s(ttttpara3Mt_st_und9fined,mrav,ittttt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mest&h%Nm(ttttmg_restrict_3d_sca_d(ttttpara3Mt_st_und9fined,mrav,ittttt0 ppp&i0 ppp&i0 st,FW_KIMURE)KiVFIELD 0t,FW_MESHiKIM)RE)Ki2Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_mest&h%Nm(ttttmg_restrict_2d_vec_s(ttttpara3Mt_st_und9fined,mrav,ittttt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mest&h%Nm(ttttmg_restrict_2d_vec_d(ttttpara3Mt_st_und9fined,mrav,ittttt0 ppp&i0 st,FW_MESHiKIM)RE)Ki3Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_mest&h%Nm(ttttmg_restrict_3d_vec_s(ttttpara3Mt_st_und9fined,mrav,ittttt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mest&h%Nm(ttttmg_restrict_3d_vec_d(ttttpara3Mt_st_und9fined,mrav,ittttt0 ppp&i0 ppp&i0 ppp&i f_mes9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_toi f_mes9In::i1tRet,ttttt=N&9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_toi0t,FW_KIMURE)KiiFIELDt0t,FW_MESHiKIM)RE)Ki2Dtttttt=N&scale1=suAL((fact=N(1)*fact=N(1))**(mrav-1),MK) tttttt=N&scale2=suAL((fact=N(2)*fact=N(2))**(mrav-1),MK)tttttt=N&c2 = srdx2/scale1tttttt=N&c3 = srdy2/scale2 i f_mesc1 = s1.0_MK/(2.0_MK*(c2+c3)) tttttt=N&c4 = s1.0_MK/c1i f_mesdxl&ttsdx*SQRT(scale1)i f_mesdyl&ttsdy*SQRT(scale2ttttttt=es9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topotttttt=es9Compute correctiet using gauss-seidel algorithmtttttt=es9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topotttttt=esh%Nm(ttttmg_smooth_sca(ttttpara3Mt_st_und9fined,iger1,mrav,c1,c2,c3,ttttttttttt=es9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_toptttttt=es9Compute residualtttttt=-C9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_toptttttt=esh%Nm(ttttmg_res_sca(ttttpara3Mt_st_und9fined,mrav,c1,c2,c3,c4,Etttttttttttt=es9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topotttttt=es9Go to the next (coabser) multigrid ravel if the solugiet is, f_meses9not convergedi f_mes9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topotttttt=eIF (l_printM/2+1Ki WRITE(cbu&,*) 'E:',Etttttt=esh%Nm(PPM_WRITE(0,-1rank_,mg_core Icbu&,ttttttttttt=e=po,0ttttttt=eIF (mrav.LT.maxravM/2+1K t0t,FW_MEASURE)Kiiiii LL subfftw_, f_mest&esh%Nm(ttttmg_core_2d_sca_s(mrav+1,iger1,iger2tttttt ttttttt=eIF (w_cycleM/2+1Ki h%Nm(ttttmg_prolong_2d_sca_s(mrav,itttttttttt= 0,,h%Nm(ttttmg_smooth_sca(ttttpara3Mt_st_und9fined,iger2,mrav,c1,&tttttt&po,0essssssssssssssssssssssc2,c3,ttttttttttt=esesh%Nm(ttttmg_res_sca(ttttpara3Mt_st_und9fined,mrav,c1,c2,c3,c4,&tttttt&po,0esssssssssssssssssssEtttttttttttt=esesh%Nm(ttttmg_core_2d_sca_s(mrav+1,iger1,iger2tttttt ttttttt=ec=po,0,0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mest&h%Nm(ttttmg_core_2d_sca_d(mrav+1,iger1,iger2tttttt ttttttt=ecIF (w_cycleM/2+1Ki h%Nm(ttttmg_prolong_2d_sca_d(mrav,itttttttttt= 0,,,h%Nm(ttttmg_smooth_sca(ttttpara3Mt_st_und9fined,iger2,mrav,c1,&tttttt&po,0esssssssssssssssssssssssc2,c3,ttttttttttt=esessh%Nm(ttttmg_res_sca(ttttpara3Mt_st_und9fined,mrav,c1,c2,c3,c4,&tttttt&po,0essssssssssssssssssssEtttttttttttt=eses&h%Nm(ttttmg_core_2d_sca_d(mrav+1,iger1,iger2tttttt ttttttt=ec=po,0,0 ppp&i f_mesELSE, f_mesmccccGOTO d_dotttttt= 0=po,0,ttttt=N&9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo),ttttt=N&9 ssa&GO BACK TO ApFINER LEVEL AASUhONTINUEssubUSRSIVELY TO ,ttttt=N&92+1 NEXTpFINER LEVELS,ttttt=N&9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo),0t,FW_MEASURE)Kiiiii LL subfftw_, f_mest&h%Nm(ttttmg_prolong_2d_sca_s(mrav,ittttt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mest&h%Nm(ttttmg_prolong_2d_sca_d(mrav,ittttt0 ppp&i f_messcale1=suAL((fact=N(1)*fact=N(1))**(mrav-1),MK)tttttt=N&scale2=suAL((fact=N(2)*fact=N(2))**(mrav-1),MK)tttttt=N&c2 = srdx2/scale1tttttt=N&c3 = srdy2/scale2i f_mesc1 = s1.0_MK/(2.0_MK*(c2+c3))i f_mesdxl&ttsdx*SQRT(scale1)i f_mesdyl&ttsdy*SQRT(scale2ttttttt=es9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topotttttt=es9SolvaNfessthe prolongated correctiets, f_meses9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topotttttt=esh%Nm(ttttmg_smooth_sca(ttttpara3Mt_st_und9fined,iger2,mrav,c1,c2,c3,&tttttt&po,0essssssssssssssssssssttttttttttt=es9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topotttttt=es9Returti_slab,es9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topot0 st,FW_MESHiKIM)RE)Ki3Dt f_messcale1=suAL((fact=N(1)*fact=N(1))**(mrav-1),MK) t f_messcale2=suAL((fact=N(2)*fact=N(2))**(mrav-1),MK)tttttt=scale3=suAL((fact=N(3)*fact=N(3))**(mrav-1),MK)tttttt=c2 = srdx2/scale1tttttt=c3 = srdy2/scale2 i f_mc4 = srdz2/scale3 i f_mc1 = s1.0_MK/(2.0_MK*(c2+c3+c4)) tttttt=c5 = s1.0_MK/c1i f_mdxl&ttsdx*SQRT(scale1)i f_mdyl&ttsdy*SQRT(scale2ttttttt=dzl&ttsdz*SQRT(scale3ab=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBib=CINNNNCompute correctiet using gauss-seidel algorithmtttttt=NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBib=CINNNh%Nm(ttttmg_smooth_sca(ttttpara3Mt_st_und9fined,iger1,mrav,c1,c2,c3,&tttttt&po,0essssssssssssssssssc4,ttttttttttt=9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_toptttttt=9Compute residualtttttt=9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_toptttttt=h%Nm(ttttmg_res_sca(ttttpara3Mt_st_und9fined,mrav,c1,c2,c3,c4,c5,Et&tttttt&po,0esssssssssssssssttttttttttt=9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topptttttt=9Go to the next (coabser) multigrid ravel if the solugiet is, f_mes9not convergedi f_m9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_toppttttttIF (l_printM/2+1Ki WRITE(cbu&,*) 'E:',Etttttt=eh%Nm(PPM_WRITE(0,-1rank_,mg_core Icbu&,ttttttttttt=po,0tttttttIF (mrav.LT.maxravM/2+1K t0t,FW_MEASURE)Kiiiii LL subfftw_, f_mest&eh%Nm(ttttmg_core_3d_sca_s(mrav+1,iger1,iger2tttttt ttttttt=eccIF (w_cycleM/2+1Ki h%Nm(ttttmg_prolong_3d_sca_s(mrav,itttttttttt= 0,,,h%Nm(ttttmg_smooth_sca(ttttpara3Mt_st_und9fined,iger2,mrav,c1,&tttttt&po,0esssssssssssssssssssssssc2,c3,c4,ttttttttttt=tttt=h%Nm(ttttmg_res_sca(ttttpara3Mt_st_und9fined,mrav,c1,c2,c3,c4,&tttttt&po,0essssssssssssssssssssc5,Etttttttttttt=eses&h%Nm(ttttmg_core_3d_sca_s(mrav+1,iger1,iger2tttttt tttttt=ese=po,0t&t0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mest&&h%Nm(ttttmg_core_3d_sca_d(mrav+1,iger1,iger2tttttt ttttttt=eccIF (w_cycleM/2+1Ki h%Nm(ttttmg_prolong_3d_sca_d(mrav,itttttttttt= 0,,,h%Nm(ttttmg_smooth_sca(ttttpara3Mt_st_und9fined,iger2,mrav,c1,&tttttt&po,0esssssssssssssssssssssssc2,c3,c4,ttttttttttt=tttt=h%Nm(ttttmg_res_sca(ttttpara3Mt_st_und9fined,mrav,c1,c2,c3,c4,&tttttt&po,0essssssssssssssssssssc5,Etttttttttttt=eses&h%Nm(ttttmg_core_3d_sca_d(mrav+1,iger1,iger2tttttt ttttttt=ecc=po,0t&t0 ppp&i f_mesELSE, f_mesmccccGOTO d_dotttttt= 0=po,0,ttttt=N&9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo),ttttt=N&9ELSE&GO BACK TO ApFINER LEVEL AASUhONTINUEssubUSRSIVELY TO ,ttttt=N&92+1 NEXTpFINER LEVELS,ttttt=N&9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo),0t,FW_MEASURE)Kiiiii LL subfftw_, f_mest&h%Nm(ttttmg_prolong_3d_sca_s(mrav,ittttt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mest&h%Nm(ttttmg_prolong_3d_sca_d(mrav,ittttt0 ppp&i f_messcale1=suAL((fact=N(1)*fact=N(1))**(mrav-1),MK)tttttt=N&scale2=suAL((fact=N(2)*fact=N(2))**(mrav-1),MK)tttttt=N&scale3=suAL((fact=N(3)*fact=N(3))**(mrav-1),MK)tttttt=N&c2 = srdx2/scale1tttttt=N&c3 = srdy2/scale2i f_mesc4 = srdz2/scale3i f_mesc1 = s1.0_MK/(2.0_MK*(c2+c3+c4))i f_mesdxl&ttsdx*SQRT(scale1)i f_mesdyl&ttsdy*SQRT(scale2ttttttt=esdzl&ttsdz*SQRT(scale3ab=CINNNes9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topotttttt=es9SolvaNfessthe prolongated correctiets, f_meses9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topotttttt=esh%Nm(ttttmg_smooth_sca(ttttpara3Mt_st_und9fined,iger2,mrav,c1,c2,c3,&tttttt&po,0essssssssssssssssssssc4,ttttttttttt=tt9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topot0 ppp&i0 st,FW_KIMURE)KiVFIELD 0t,FW_MESHiKIM)RE)Ki2Dt f_messcale1=suAL((fact=N(1)*fact=N(1))**(mrav-1),MK) t f_messcale2=suAL((fact=N(2)*fact=N(2))**(mrav-1),MK)tttttt=c2 = srdx2/scale1tttttt=c3 = srdy2/scale2 i f_mc1 = s1.0_MK/(2.0_MK*(c2+c3)) tttttt=c4 = s1.0_MK/c1i f_mdxl&ttsdx*SQRT(scale1)i f_mdyl&ttsdy*SQRT(scale2ttttttt=NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBib=CINNNNCompute correctiet using gauss-seidel algorithmtttttt=NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBib=CINNNh%Nm(ttttmg_smooth_vec(ttttpara3Mt_st_und9fined,iger1,mrav,c1,c2,c3,&tttttt&po,0essssssssssssssssssttttttttttt=9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_toptttttt=9Compute residualtttttt=9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_toptttttt=h%Nm(ttttmg_res_vec(ttttpara3Mt_st_und9fined,mrav,c1,c2,c3,c4,Etttttttttttt=9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topptttttt=9Go to the next (coabser) multigrid ravel if the solugiet is, f_mes9not convergedi f_m9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topptttttteIF (l_printM/2+1Ki WRITE(cbu&,*) 'E:',Etttttt=esh%Nm(PPM_WRITE(0,-1rank_,mg_core Icbu&,ttttttttttt==po,0ttttttt=IF (mrav.LT.maxravM/2+1K t0t,FW_MEASURE)Kiiiii LL subfftw_, f_mest&esh%Nm(ttttmg_core_2d_vec_s(mrav+1,iger1,iger2tttttt ttttttt=ecIF (w_cycleM/2+1Ki h%Nm(ttttmg_prolong_2d_vec_s(mrav,itttttttttt= 0,,h%Nm(ttttmg_smooth_vec(ttttpara3Mt_st_und9fined,iger2,mrav,c1,&tttttt&po,0essssssssssssssssssssssc2,c3,ttttttttttt=esesh%Nm(ttttmg_res_vec(ttttpara3Mt_st_und9fined,mrav,c1,c2,c3,c4,&tttttt&po,0esssssssssssssssssssEtttttttttttt=esesh%Nm(ttttmg_core_2d_vec_s(mrav+1,iger1,iger2tttttt ttttttt=ec=po,0tt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mest&h%Nm(ttttmg_core_2d_vec_d(mrav+1,iger1,iger2tttttt tttttt=ecIF (w_cycleM/2+1K ttttttt=ecc h%Nm(ttttmg_prolong_2d_vec_d(mrav,itttttttttt= 0,,h%Nm(ttttmg_smooth_vec(ttttpara3Mt_st_und9fined,iger2,mrav,c1,&tttttt&po,0essssssssssssssssssssssc2,c3,ttttttttttt=esesh%Nm(ttttmg_res_vec(ttttpara3Mt_st_und9fined,mrav,c1,c2,c3,c4,&tttttt&po,0esssssssssssssssssssEtttttttttttt=esesh%Nm(ttttmg_core_2d_vec_d(mrav+1,iger1,iger2tttttt tttttt=ec=po,0tt0 ppp&i f_mesELSE, f_mesmccccGOTO d_dotttttt= 0=po,0,ttttt=N&9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo),ttttt=N&9 ssa&GO BACK TO ApFINER LEVEL AASUhONTINUEssubUSRSIVELY TO ,ttttt=N&92+1 NEXTpFINER LEVELS,ttttt=N&9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo),0t,FW_MEASURE)Kiiiii LL subfftw_, f_mest&h%Nm(ttttmg_prolong_2d_vec_s(mrav,ittttt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mest&h%Nm(ttttmg_prolong_2d_vec_d(mrav,ittttt0 ppp&i f_messcale1=suAL((fact=N(1)*fact=N(1))**(mrav-1),MK)tttttt=N&scale2=suAL((fact=N(2)*fact=N(2))**(mrav-1),MK)tttttt=N&c2 = srdx2/scale1tttttt=N&c3 = srdy2/scale2i f_mesc1 = s1.0_MK/(2.0_MK*(c2+c3))i f_mesdxl&ttsdx*SQRT(scale1)i f_mesdyl&ttsdy*SQRT(scale2ttttttt=es9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topotttttt=es9SolvaNfessthe prolongated correctiets, f_meses9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topotttttt=esh%Nm(ttttmg_smooth_vec(ttttpara3Mt_st_und9fined,iger2,mrav,c1,c2,&tttttt&po,0essssssssssssssssssssc3,ttttttttttt=es9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topotttttt=es9Returti_slab,es9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topot0 st,FW_MESHiKIM)RE)Ki3Dt f_mesN&scale1=suAL((fact=N(1)*fact=N(1))**(mrav-1),MK) tttttt=N&scale2=suAL((fact=N(2)*fact=N(2))**(mrav-1),MK)tttttt=N&scale3=suAL((fact=N(3)*fact=N(3))**(mrav-1),MK)tttttt=N&c2 = srdx2/scale1tttttt=N&c3 = srdy2/scale2 tttttt=N&c4 = srdz2/scale3 i f_m_mc1 = s1.0_MK/(2.0_MK*(c2+c3+c4)) tttttt=t=c5 = s1.0_MK/c1i f_mesdxl&ttsdx*SQRT(scale1)i f_mesdyl&ttsdy*SQRT(scale2ttttttt=esdzl&ttsdz*SQRT(scale3ab=CINNNe9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topotttttt=e9Compute correctiet using gauss-seidel algorithmtttttt=e9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topotttttt=esh%Nm(ttttmg_smooth_vec(ttttpara3Mt_st_und9fined,iger1,mrav,c1,c2,&tttttt&po,0essssssssssssssssssssc3,c4,ttttttttttt=t9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_toptttttt=e9Compute residualtttttt=-9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_toptttttt=eh%Nm(ttttmg_res_vec(ttttpara3Mt_st_und9fined,mrav,c1,c2,c3,c4,c5,Et&tttttt&po,0essssssssssssssssttttttb=CINNNe9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topotttttt=e9Go to the next (coabser) multigrid ravel if the solugiet is, f_mese9not convergedi f_me9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topotttttt=eIF (l_printM/2+1Ki WRITE(cbu&,*) 'E:',Etttttt=essh%Nm(PPM_WRITE(0,-1rank_,mg_core Icbu&,ttttttttttt=e=po,0ttttttt=eIF (mrav.LT.maxravM/2+1K t0t,FW_MEASURE)Kiiiii LL subfftw_, f_mest&es&h%Nm(ttttmg_core_3d_vec_s(mrav+1,iger1,iger2tttttt ttttttt=ec ccIF (w_cycleM/2+1Ki t&h%Nm(ttttmg_prolong_3d_vec_s(mrav,itttttttttt= 0,, ,,h%Nm(ttttmg_smooth_vec(ttttpara3Mt_st_und9fined,iger2,mrav,c1,&tttttt&po,0essssssssssssssssssssss ssc2,c3,c4,ttttttttttt=tttt=esh%Nm(ttttmg_res_vec(ttttpara3Mt_st_und9fined,mrav,c1,c2,c3,c4,&tttttt&po,0esssssssssssssssssss ssc5,Etttttttttttt=eses&s&h%Nm(ttttmg_core_3d_vec_s(mrav+1,iger1,iger2tttttttttttt=eses=po,0t&&t0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mest&&s&h%Nm(ttttmg_core_3d_vec_d(mrav+1,iger1,iger2tttttt ttttttt=eccccIF (w_cycleM/2+1Ki h%Nm(ttttmg_prolong_3d_vec_d(mrav,itttttttttt= 0,,sh%Nm(ttttmg_smooth_vec(ttttpara3Mt_st_und9fined,iger2,mrav,c1,c2,&tttttt&po,0essssssssssssssssssss ssc3,c4,ttttttttttt=tt=esh%Nm(ttttmg_res_vec(ttttpara3Mt_st_und9fined,mrav,c1,c2,c3,c4,&tttttt&po,0esssssssssssssssssss c5,Etttttttttttt=eses&h%Nm(ttttmg_core_3d_vec_d(mrav+1,iger1,iger2tttttt tttttt=eses&=po,0t&t0 ppp&i f_mesELSE, f_mesmccccGOTO d_dotttttt= 0=po,0,ttttt=N&9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo),ttttt=N&9ELSE&GO BACK TO ApFINER LEVEL AASUhONTINUEssubUSRSIVELY TO ,ttttt=N&92+1 NEXTpFINER LEVELS,ttttt=N&9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo),0t,FW_MEASURE)Kiiiii LL subfftw_, f_mest&h%Nm(ttttmg_prolong_3d_vec_s(mrav,ittttt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mest&h%Nm(ttttmg_prolong_3d_vec_d(mrav,ittttt0 ppp&i f_messcale1=suAL((fact=N(1)*fact=N(1))**(mrav-1),MK)tttttt=N&scale2=suAL((fact=N(2)*fact=N(2))**(mrav-1),MK)tttttt=N&scale3=suAL((fact=N(3)*fact=N(3))**(mrav-1),MK)tttttt=N&c2 = srdx2/scale1tttttt=N&c3 = srdy2/scale2i f_mesc4 = srdz2/scale3i f_mesc1 = s1.0_MK/(2.0_MK*(c2+c3+c4))i f_mesdxl&ttsdx*SQRT(scale1)i f_mesdyl&ttsdy*SQRT(scale2ttttttt=esdzl&ttsdz*SQRT(scale3ab=CINNNes9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topotttttt=es9SolvaNfessthe prolongated correctiets, f_mesee9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topotttttt=esh%Nm(ttttmg_smooth_vec(ttttpara3Mt_st_und9fined,iger2,mrav,c1,c2,c3,&tttttt&po,0essssssssssssssssssssc4,ttttttttttt=tt9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topot0 ppp&i0 ppp&id_dot=eshONTINUEtttttt=esh%Nm(comptop('2I4)mg_core It0tttttttttttt=esRETURN i0t,FW_KIMURE)KiiFIELDt0t,FW_MESHiKIM)RE)Ki2Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_mes=po SUBROUTINE 2I4)mg_core_2d_sca_st0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mes=po SUBROUTINE 2I4)mg_core_2d_sca_dt0 ppp&i0 st,FW_MESHiKIM)RE)Ki3Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_mes=po SUBROUTINE 2I4)mg_core_3d_sca_si0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mes=po SUBROUTINE 2I4)mg_core_3d_sca_dt0 ppp&i0 ppp&i0 st,FW_KIMURE)KiVFIELD 0t,FW_MESHiKIM)RE)Ki2Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_mes=po SUBROUTINE 2I4)mg_core_2d_vec_s,0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mes=po SUBROUTINE 2I4)mg_core_2d_vec_d,0 ppp&i0 st,FW_MESHiKIM)RE)Ki3Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_mes=po SUBROUTINE 2I4)mg_core_3d_vec_s,0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mes=po SUBROUTINE 2I4)mg_core_3d_vec_d,0 ppp&i0 ppp&i0 ppp&ilib2I4numerics-r1036/src/2I4)module)fdsolvab_solva.f0000644000175000017500000001313611616214650021557 0ustar omaromarstnclude "2I4)define.h" 0t,d9f)KiXLF @PROCESS NOOPTt0 ppp&i f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp Moduletttt= 0: 2I4)module)fdsolvab_solvai f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&p 1p,'t&pp Purposett= 0,:pThis module tncludes the source codaNfessfield solvab 1p,'t&pp routines. 1p,'t&p 1p,'t&pppRemarkstt= 0,:, f_mesp 1p,'t&pp Referencas&CI:, f_mesp 1p,'t&pp Revi Retstt= :b=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pi f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppCopyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1p,'t&pp Ceslab fessFluid Dynamics (DTU), f_mesp 1p,'t&p 1p,'t&ppThis file is p1,teof the P1,1llel P1,ticra Mesh Library (PPM). 1p,'t&p 1p,'t&ppPPM is free software: you can redtstribute iteRnd/essmodify 1p,'t&ppiteund9m the labms of the GNU Less9m Gene,1lpPublic Licessa&,-CINNN! as published by the Free Software FoundgRet, either&,-CINNN! vabsRet 3 of the Licessa, ess(at your PouRet)eRny later&,-CINNN! vabsRet. 1p,'t&p 1p,' &ppPPM is dtstributed in the hope lhat itewill be useful, 1p,'t&ppbut WITHOUT ANY WARRANTY; without even the implied w2004nty of 1p,'t&ppMERCHANTABILITY essFITNESS FOR A PARTICULAR PURPOSE.(See the 1p,'t&ppGNU Gene,1lpPublic Licessa&fessmore details. 1p,'t&p 1p,'t&ppYou should have received a copy of the GNU Gene,1lpPublic Licessa,-CINNN! and the GNU Less9m Gene,1lpPublic Licessa&along with PPM. Ifenot, 1p,'t&ppsee . 1p,'t&p 1p,'t&ppP1,1llel P1,ticra Mesh Library (PPM) 1p,'t&ppETH Zuriche,0,'t&ppCH-8092 Zurich, Switzerland , f_mes9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N ef_mesi f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp Define)typesb=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, #define)Kiiiii LL subfftw_ 1 #define)KiKlies e,foGNNNoE 2 #define)KiCOMPLEX 3 #define)KiKlies eCOMPLEX 4 #define)KiiFIELD p,'t&&&&&&&9 #define)KiVFIELD p,'t&&&&&&10 #define)KiINIT p,'t&&&&&&& 11 #define)KiSLAB p,'t&&&&&&& 12 , f MODULE 2I4)module)fdsolvab_solvai, f_mesmccNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDii_slab, 0&pp Define)islabface to 2I4)fdsolvab_solvai f_mmccNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDii_i f_mmccINTERFACE 2I4)fdsolvab_solva_slabtttttt=eses&sMODULE PROCEDURE 2I4)fdsolvab_solva_slab_3d_sstttttt=eses&sMODULE PROCEDURE 2I4)fdsolvab_solva_slab_3d_sdtttttt=eses&sMODULE PROCEDURE 2I4)fdsolvab_solva_slab_3d_vstttttt=eses&sMODULE PROCEDURE 2I4)fdsolvab_solva_slab_3d_vdtttttt=ese=po INTERFACE , f f_mmccINTERFACE 2I4)fdsolvab_solva_inittttttt=eses&sMODULE PROCEDURE 2I4)fdsolvab_solva_init_2d_sstttttt=eses&sMODULE PROCEDURE 2I4)fdsolvab_solva_init_2d_sdtttttt=eses&sMODULE PROCEDURE 2I4)fdsolvab_solva_init_2d_vstttttt=eses&sMODULE PROCEDURE 2I4)fdsolvab_solva_init_2d_vdtttttt=eses&sMODULE PROCEDURE 2I4)fdsolvab_solva_init_3d_sstttttt=eses&sMODULE PROCEDURE 2I4)fdsolvab_solva_init_3d_sdtttttt=eses&sMODULE PROCEDURE 2I4)fdsolvab_solva_init_3d_vstttttt=eses&sMODULE PROCEDURE 2I4)fdsolvab_solva_init_3d_vdtttttt=ese=po INTERFACE ,, f f_mmccINTERFACE 2I4)fdsolvab_solvatttttt=eses&sMODULE PROCEDURE 2I4)fdsolvab_solva_2d_sstttttt=eses&sMODULE PROCEDURE 2I4)fdsolvab_solva_2d_sdtttttt=eses&sMODULE PROCEDURE 2I4)fdsolvab_solva_2d_vstttttt=eses&sMODULE PROCEDURE 2I4)fdsolvab_solva_2d_vdtttttt=eses&sMODULE PROCEDURE 2I4)fdsolvab_solva_3d_sstttttt=eses&sMODULE PROCEDURE 2I4)fdsolvab_solva_3d_sdtttttt=eses&sMODULE PROCEDURE 2I4)fdsolvab_solva_3d_vstttttt=eses&sMODULE PROCEDURE 2I4)fdsolvab_solva_3d_vdtttttt=ese=po INTERFACE ttttt=eseNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDii_slab, 0&pp tnclude the source ttttt=eseNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDii_slab, 0&hONTAINSe #define)KiCASE KiSLABe #define)KiKIM)KiiFIELDt#define)KiMEASUKiiiii LL subfftw_,#tnclude "2I4)fdsolvab_solva_3d.f" #und9f) KiMEASe #define)KiMEASUKiKlies e,foGNNNoEt#include "2I4)fdsolvab_solva_3d.f" #und9f) KiMEASe#und9f)KiKIM #define)KiKIM)KiVFIELDt#define)KiMEASUKiiiii LL subfftw_,#tnclude "2I4)fdsolvab_solva_3d.f" #und9f) KiMEASe #define)KiMEASUKiKlies e,foGNNNoEt#include "2I4)fdsolvab_solva_3d.f" #und9f) KiMEASe#und9f)KiKIM #und9f)KiCASEe #define)KiCASE KiINITe #define)KiKIM)KiiFIELDt#define)KiMEASUKiiiii LL subfftw_,#tnclude "2I4)fdsolvab_solva_2d.f" #tnclude "2I4)fdsolvab_solva_3d.f" #und9f) KiMEASe #define)KiMEASUKiKlies e,foGNNNoEt#include "2I4)fdsolvab_solva_2d.f" #tnclude "2I4)fdsolvab_solva_3d.f" #und9f) KiMEASe#und9f)KiKIM #define)KiKIM)KiVFIELDt#define)KiMEASUKiiiii LL subfftw_,#tnclude "2I4)fdsolvab_solva_2d.f" #tnclude "2I4)fdsolvab_solva_3d.f" #und9f) KiMEASe #define)KiMEASUKiKlies e,foGNNNoEt#include "2I4)fdsolvab_solva_2d.f" #tnclude "2I4)fdsolvab_solva_3d.f" #und9f) KiMEASe#und9f)KiKIM #und9f)KiCASEe #define)KiKIM)KiiFIELDt#define)KiMEASUKiiiii LL subfftw_,#tnclude "2I4)fdsolvab_solva_2d.f" #tnclude "2I4)fdsolvab_solva_3d.f" #und9f) KiMEASe #define)KiMEASUKiKlies e,foGNNNoEt#include "2I4)fdsolvab_solva_2d.f" #tnclude "2I4)fdsolvab_solva_3d.f" #und9f) KiMEASe#und9f)KiKIM #define)KiKIM)KiVFIELDt#define)KiMEASUKiiiii LL subfftw_,#tnclude "2I4)fdsolvab_solva_2d.f" #tnclude "2I4)fdsolvab_solva_3d.f" #und9f) KiMEASe #define)KiMEASUKiKlies e,foGNNNoEt#include "2I4)fdsolvab_solva_2d.f" #tnclude "2I4)fdsolvab_solva_3d.f" #und9f) KiMEASe#und9f)KiKIM tt=ese=po MODULE 2I4)module)fdsolvab_solvailib2I4numerics-r1036/src/2I4)gmm_2dpermut)oGOT.tnc0000644000175000017500000000010711616214650021067 0ustar omaromartt=eseDATA Aind/1, 2, 5, 6, 3, 4, 7, 8, 9, 10, 13, 14, 11, 12, 15, 16/ilib2I4numerics-r1036/src/2I4)util_fft_backward_3d.f0000644000175000017500000004262711616214650021225 0ustar omaromartt=eseNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDi-t, 1p,'t&pp Subroutine 0: 2I4)util_fft_backward_3di f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&p 1p,'t&pp Purposett= 0,:pThis routine perfobms inversetFast Fourier Transfobm 1p,'t&pp using FFTW in the first (x) dimensRet,ttttt=p 1p,'t&pp Input : oGOT)in(:,:,:) (F) oGOT to be transfobmed 1p,'t&pp 1p,'t&pp Input/output : lda(:) (I) size of oGOT 1p,'t&pp 1p,'t&p 1p,'t&pp Output : oGOT)out(:,:,:) (F) transfobmed oGOT 1p,'t&pp tttt (I) returt status. =0 if no ttt=N. 1p,'t&p 1p,'t&pppRemarkstt= 0,: 1p,'t&pp 1p,'t&pp Referencas&CI:, f_mesp 1p,'t&pp Revi Retstt= :b=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&p $Log: 2I4)util_fft_backward_3d.f,v $ 1p,'t&pp Revi Ret 1.1.1.1 2007/07/13 10:19:01 ivos 1p,'t&pp CBL vabsRet of the PPM library, f_mesp 1p,'t&pp Revi Ret 1.15 2006/09/04 18:34:58 2chatelT 1p,'t&pp FixasNand cleanups to make itecompile fe0#r=po,0pp release-1-0, f_mesp 1p,'t&pp Revi Ret 1.14 2004/11/03 11:09:03 hiebabs 1p,'t&pppRemoved __NEED4SPEED, exchanged __SXF90 by __MATHKEISAN 1p,'t&pp(fftsNare library specific not compiler specific), f_mesp 1p,'t&pp Revi Ret 1.13 2004/10/01 16:09:13 ivos 1p,'t&pp Replaced suAL(2I4)kind_double) :: t0 with suAL(MK) t0. 1p,'t&p 1p,'t&pppRevi Ret 1.12 2004/08/27 14:12:18 michaeba 1p,'t&pp Included cR ss to the advanced inlabface of fftw (though only used if 1p,'t&pp __NEED4SPEED is d9fined - which should be changed soon). 1p,'t&p 1p,'t&pppRevi Ret 1.11 2004/08/26 10:46:57 hiebabs 1p,'t&pppinserted correctiet of the last entry, f_mesp 1p,'t&pp Revi Ret 1.10 2004/08/25 07:54:51 hiebabs 1p,'t&pppfixad memory leak, f_mesp 1p,'t&pp Revi Ret 1.9 2004/08/23 12:30:33 hiebabs 1p,'t&pppadjustad field fobmat to 2I4 conventRet,ttttt=p 1p,'t&pp Revi Ret 1.8 2004/07/26 08:12:52 hiebabs 1p,'t&pppadded SX MathKeisan Inlabface (NEC), f_mesp 1p,'t&pp Revi Ret 1.7 2004/07/26 07:42:33 ivos 1p,'t&pp Changed to single-inlabface modulesNand Rdaptad R ssUSE statemesls. 1p,'t&p 1p,'t&pppRevi Ret 1.6 2004/02/25 11:51:55 hiebabs 1p,'t&pppbug fix in 2004y size 1p,'t&p 1p,'t&pppRevi Ret 1.5 2004/02/19 15:43:02 walther 1p,'t&pp Changed Klies COMPLEX to COMPLEX(MK). 1p,'t&p 1p,'t&pppRevi Ret 1.4 2004/02/11 16:31:19 ivos 1p,'t&pp Changed tnclude of fftw.f from a cpp tnclude to a f90 INCLUDE. 1p,'t&p 1p,'t&pppRevi Ret 1.3 2004/02/11 15:29:49 ivos 1p,'t&pp Some heavy cosmetics: headab fesmattad, tncludes merged, continu1tRet,ttttt=pp characlabs moved to proper column, tndesl1tRet fixad, blank linesNand,ttttt=pp spacas&in 20gumesl listsNremoved, too long linesNin log wrapped.,ttttt=pp Bugfix: argumeslsNare now checked BEFORE theyNare assigned to Nx)in... 1p,'t&p 1p,'t&pppRevi Ret 1.2 2004/02/11 10:13:23 hiebabs 1p,'t&pppchanged argumesls, tncluded test et ittt, tncluded 2I4)define.h, 1p,'t&pp shortened linesNto 80 characlabs, excluded module)mesh, 1p,'t&pp tncluded fftw3.f 1p,'t&p 1p,'t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&p Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1p,'t&pp Ceslab fessFluid Dynamics (DTU), f_mesp 1p,'t&p 1p,'t&ppThis file is p1,teof the P1,1llel P1,ticra Mesh Library (PPM). 1p,'t&p 1p,'t&ppPPM is free software: you can redtstribute iteRnd/essmodify 1p,'t&ppiteund9m the labms of the GNU Less9m Gene,1lpPublic Licessa&,-CINNN! as published by the Free Software FoundgRet, either&,-CINNN! vabsRet 3 of the Licessa, ess(at your PouRet)eRny later&,-CINNN! vabsRet. 1p,'t&p 1p,' &ppPPM is dtstributed in the hope lhat itewill be useful, 1p,'t&ppbut WITHOUT ANY WARRANTY; without even the implied w2004nty of 1p,'t&ppMERCHANTABILITY essFITNESS FOR A PARTICULAR PURPOSE.(See the 1p,'t&ppGNU Gene,1lpPublic Licessa&fessmore details. 1p,'t&p 1p,'t&ppYou should have received a copy of the GNU Gene,1lpPublic Licessa,-CINNN! and the GNU Less9m Gene,1lpPublic Licessa&along with PPM. Ifenot, 1p,'t&ppsee . 1p,'t&p 1p,'t&ppP1,1llel P1,ticra Mesh Library (PPM) 1p,'t&ppETH Zuriche,0,'t&ppCH-8092 Zurich, Switzerland , f_mes9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e0t,F) KiMEASURE)Kiiiii LL subfftw_, f_mesSUBROUTINE 2I4)util_fft_backward_3ds(oGOT)in,lda,oGOT)out,ittttt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mesSUBROUTINE 2I4)util_fft_backward_3dd(oGOT)in,lda,oGOT)out,ittttt0 st,FW_MEASURE)Kiiiii LL subfftw_eCOMPLEX, f_mesSUBROUTINE 2I4)util_fft_backward_3dc(oGOT)in,lda,oGOT)out,ittttt0 st,FW_MEASURE)KiKlies e,foGNNNoEeCOMPLEX, f_mesSUBROUTINE 2I4)util_fft_backward_3dcc(oGOT)in,lda,oGOT)out,ittttt0 ppp&i f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp Includesb=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, #tnclude "2I4)define.h" f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp Modulesb=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, =CINNNUSE 2I4)module)oGOT 1p,'t&USE 2I4)module)compt1,t 1p,'t&USE 2I4)module)comptop 1p,'t&USE 2I4)module)eble0#r=po,0USE 2I4)module)R su#r=po,0IMPLICIT NONEe0t,F) KiMEASURE)Kiiiii LL subfftw_ | KiMEASUREKiiiii LL subfftw_eCOMPLEXttttttt=INTEGER, PARAMETER :: MK =(ttttkind_singlet0 st,FW_MEASURE)KiKlies e,foGNNNoE | KiMEASUREKiKlies e,foGNNNoEeCOMPLEXttttttt=INTEGER, PARAMETER :: MK =(ttttkind_doublet0 ppp&i f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp FFTW include, f_mes9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e0t,d9f) KiFFTWtttttt=INCLUDE "fftw3.f"t0 ppp&i f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp ArgumeslsNNNNNi f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&ppinput oGOT 1p,'t&COMPLEX(MK), DIMENNNoE(:,:,:) ,=INTENT(IN't&) :: oGOT)in 1p,'t&ppsize of oGOTtttttt=INTEGER, DIMENNNoE(:) ,=INTENT(INOUT) :: lda 1p,'t&ppoutput oGOT, inversetfast fourier transfobmede0t,F) KiMEASURE)Kiiiii LL subfftw_ |FW_MEASURE)KiKlies e,foGNNNoE 1p,'t&suAL(MK), DIMENNNoE(:,:,:) ,=POINTER :: oGOT)outt0 st,FW_MEASURE)Kiiiii LL subfftw_eCOMPLEX|FW_MEASURE)KiKlies e,foGNNNoEeCOMPLEX, f_mesCOMPLEX(MK), DIMENNNoE(:,:,:) ,=POINTER :: oGOT)out&t0 ppp&i f_mINTEGER ,=INTENT( OUT) :: ittti f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp Loc1lpvariablesNi f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pptimer 1p,'t&suAL(MK) :: t0 1p,'t&ppcountabs 1p,'t&INTEGER :: i,j,k,iPou 1p,'t&ppsize of the oGOT)in 1p,'t&INTEGER :: Nx)in, Ny)in, Nz)in 1p,'t&ppsize of the oGOT)out&t1p,'t&INTEGER :: Nx)out, Ny)out, Nz)outt0t,d9f)KiFFTWtttttt=! FFTW Plant1p,'t&INTEGER*8 :: Plant1p,'t&INTEGER :: mbtstrida, mbrank_ mbtdtst_ mbtembed 1p,'t&INTEGER :: mboembed_ mbhowmRny_ mbodtstt0 ppp&it0t,d9f)KiMATHKEISAN 1p,'t&ppMATHKEISANpvariablesNfessMathKeisan FFTs 1p,'t&INTEGER :: isign_fft,isyst0t,FW_MEASURE)Kiiiii LL subfftw_eCOMPLEXt|FW_MEASURE)KiKlies e,foGNNNoEeCOMPLEX, f_mesINTEGER :: incx, tncyt0 ppp&i f_mN&scale of the transfobm1tRet,ttttt=suAL(MK) :: scale_ffti f_mN&working ptorage 1p,'t&suAL(MK), DIMENNNoE(:),POINTER :: table,&work 1p,'t&ppthe size of the working ptorage 1p,'t&INTEGER, DIMENNNoE(1) :: lda_table,lda_work t0 ppp&i f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp ExtabnalsNi f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, i f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp In::i1lisai f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&h%Nm(compt1,t('2I4)util_fft_backward_3d It0ttttttt0t,F)!(d9fined(KiFFTW)t|Fd9fined(KiMATHKEISAN))i f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp Eble0 if FFTW library e0 NEC is not availablei f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&tttt =(tttteble0)eble0#0t,nd9f)KiFFTWtttttt=h%Nm(tttteble0(ttttebl_nofftw,'2I4)util_fft_backward_3d I &tttttt&po,0'PPM was compiled without fftw support',__LINE__,ittttt0 ppp&i#0t,nd9f)KiMATHKEISAN 1p,'t&h%Nm(tttteble0(ttttebl_noMathKeisan,'2I4)util_fft_fobward_2d I &tttttt&po,0'PPM was compiled without MATHKEISANpsupport',__LINE__,ittttt0 ppp&i1p,'t&GOTO d_do1p,'t&t0 ssai f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp Check argumeslsi f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&IF (2I4)debug .GT. 0M/2+1Ki IF (SIZE(lda,1) .LT. 3M/2+1Ki t&&tttt =(tttteble0)eble0# t&&h%Nm(tttteble0(ttttebl_argumesl,'2I4)util_fft_backward_3d I &tttttt&po,000000000'lda must be at leasteof size 3',__LINE__,ittttt t&&GOTO d_dotttttt= 0 0=po,0,ttttt=N&=eIF (lda(1) .LE. 0M/2+1Ki t&&tttt =(tttteble0)eble0# t&&h%Nm(tttteble0(ttttebl_argumesl,'2I4)util_fft_backward_3d I &tttttt&po,000000000'mesh size: lda(1) must be >0',__LINE__,ittttt t&&GOTO d_dotttttt= 0 0=po,0,ttttt=N&=eIF (lda(2) .LE. 0M/2+1Ki t&&tttt =(tttteble0)eble0# t&&h%Nm(tttteble0(ttttebl_argumesl,'2I4)util_fft_backward_3d I &tttttt&po,000000000'mesh size: lda(2) must be >0',__LINE__,ittttt t&&GOTO d_dotttttt= 0 0=po,0,ttttt=N&=eIF (lda(3) .LE. 0M/2+1Ki t&&tttt =(tttteble0)eble0# t&&h%Nm(tttteble0(ttttebl_argumesl,'2I4)util_fft_backward_3d I &tttttt&po,000000000'mesh size: lda(3) must be >0',__LINE__,ittttt t&&GOTO d_dotttttt= 0 0=po,0,ttttt==po,0,ttttt=Nx)in =(lda(1),ttttt=Ny)in =(lda(2ttttttt=Nz)in =(lda(3ab=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp A suate result 2004y, f_mes9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e0t,F) KiMEASURE)Kiiiii LL subfftw_tttt= 0 0|FW_MEASURE)KiKlies e,foGNNNoE,ttttt=Nx)out = (Nx)in-1)*2t0 st,FW_MEASURE)Kiiiii LL subfftw_eCOMPLEXt|FW_MEASURE)KiKlies e,foGNNNoEeCOMPLEX, f_mesNx)out = Nx)in-1tt= 0 0t0 ppp&i1p,'t&Ny)out=Ny)intttttt=Nz)out=Nz)in 1p,'t&lda(1)=Nx)out +1&ppto fit(ttt-conventRet,ttttt=lda(2t=Ny)out,ttttt=lda(3)=Nz)outt t&&h%Nm(ttttR su(oGOT)out,lda,ttttpara3MR su_fit,ittt ab=CINNNIF (ittt .NE. 0M/2+1Ki tttt =(tttteble0)fGOTli h%Nm(tttteble0(ttttebl_a su,'2I4)util_fft_backward_3d I &tttttt&po,00000'fft result DATA_OUT',__LINE__,ittttt GOTO d_dotttttt==po,0,ttttt=NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp FFT - Transfobm in x-directiet,ttttt=NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&p NEC vabsRet - UsesMathKeisan Library, f_mespMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 0t,d9f)KiMATHKEISAN 1p,'t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp A suate working ptorage 1p,'t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&lda_table =(2*Nx)out + 64t t&&h%Nm(ttttR su(table,lda_table,ttttpara3MR su_fit,itttab=CINNNIF (ittt .NE. 0M/2+1Ki tttt =(tttteble0)fGOTli h%Nm(tttteble0(ttttebl_a su,'2I4)util_fft_fobward_2d I &tttttt&po,00000'table not a suated',__LINE__,ittttt GOTO d_dotttttt==po,0,e0t,F) KiMEASURE)Kiiiii LL subfftw_tttt= 0 0|FW_MEASURE)KiKlies e,foGNNNoE,ttttt=lda_workttt== 4*Nx)outt0 st,FW_MEASURE)Kiiiii LL subfftw_eCOMPLEXt|FW_MEASRE)KiKlies e,foGNNNoEeCOMPLEX, f_meslda_work(1) = 6*Nx)outt0 ppp&i1p,'t&h%Nm(ttttR su(work,lda_work,ttttpara3MR su_fit,itttab=CINNNIF (ittt .NE. 0M/2+1Ki tttt =(tttteble0)fGOTli h%Nm(tttteble0(ttttebl_a su,'2I4)util_fft_fobward_2d I &tttttt&po,00000'worktnot a suated',__LINE__,ittttt GOTO d_dotttttt==po,0,1p,'t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp In::i1lize 1p,'t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&scale_fft =(1tttttt=isign_fft =(0 1p,'t&j ttt== 1tttttt=k ttt== 1t0t,F) KiMEASURE)Kiiiii LL subfftw_, f_mesh%Nm( csfft(isign_fft, Nx)out, scale_fft, oGOT)in(1,j,k), &tttttt&po,00000000000000000000000000000oGOT)out(1,j,k), table,&work, isystt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mesh%Nm( zdfft(isign_fft, Nx)out, scale_fft, oGOT)in(1,j,k), &tttttt&po,00000000000000000000000000000oGOT)out(1,j,k), table,&work, isystt0 st,FW_MEASURE)Kiiiii LL subfftw_eCOMPLEX, f_mesincx =(1tttttt=incy =(1tttttt=h%Nm( cfft(isign_fft, Nx)out, scale_fft, oGOT)in(1,j,k), incx, &tttttt&po,000000000000oGOT)out(1,j,k), incy, table,&lda_table(1), & tttttt&po,00000000000work, lda_work(1),isystt0 st,FW_MEASURE)KiKlies e,foGNNNoEeCOMPLEX, f_mesincx =(1tttttt=incy =(1tttttt=h%Nm( zfft(isign_fft, Nx)out, scale_fft, oGOT)in(1,j,k), incx, &tttttt&po,000000000000oGOT)out(1,j,k), incy, table,&lda_table(1), & tttttt&po,00000000000work, lda_work(1),isystt0 ppp&i f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp Fobward FFT i f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&tsign_fft =(1tttttt=DO k=1,Nz)in 1p,'t&tt=DO j=1,Ny)int0t,F) KiMEASURE)Kiiiii LL subfftw_, f_mesttttt=h%Nm( csfft(isign_fft, Nx)out, scale_fft, oGOT)in(1,j,k), &tttttt&po,00000000000000000000000000000oGOT)out(1,j,k), table,&work, isystt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mesttttt=h%Nm( zdfft(isign_fft, Nx)out, scale_fft, oGOT)in(1,j,k), &tttttt&po,00000000000000000000000000000oGOT)out(1,j,k), table,&work, isystt0 st,FW_MEASURE)Kiiiii LL subfftw_eCOMPLEX, f_mesttttt=h%Nm( cfft(isign_fft, Nx)out, scale_fft, oGOT)in(1,j,k), incx, &tttttt&po,000000000000oGOT)out(1,j,k), incy, table,&lda_table(1), & tttttt&po,00000000000work, lda_work(1),isysttt0 st,FW_MEASURE)KiKlies e,foGNNNoEeCOMPLEX, f_mesttttt=h%Nm( zfft(isign_fft, Nx)out, scale_fft, oGOT)in(1,j,k), incx, &tttttt&po,000000000000oGOT)out(1,j,k), incy, table,&lda_table(1), & tttttt&po,000000000000work, lda_work(1),isystt0 ppp&i f_m t==poDO f_m t==poDOi f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp Dea suate Memoryi f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&h%Nm(ttttR su(table,lda_table,ttttpara3Mdea su,ittttt h%Nm(ttttR su(work,lda_work,ttttpara3Mdea su,ittttt0 ssai f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp FFTW vabsRet fessLINUX,... 1p,'t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&MBRank t== 1tttttt=MBHowmRny = Ny)in*Nz)in 1p,'t&MBiEmbed = -1tttttt=MBoEmbed = -1tttttt=MBIstrida== 1tttttt=MBiDist t== UBOUND(oGOT)in, 1),ttttt=MBoDist t== UBOUND(oGOT)out,1)t0t,F) KiMEASURE)Kiiiii LL subfftw_, f_mesh%Nm(sfftw_plan_mRny_dft_c2r(Plan,&MBRank,Nx)out, MBHowmRny, &tttttt&pooGOT)in(1,1,1), MBiEmbed,MBIstrida,MBiDist, &tttttt&pooGOT)out(1,1,1),MBoEmbed,MBIstrida,MBoDist,FFTW_ESTIMATE), f_mesh%Nm(sfftw_execute(Plan), f_mesh%Nm(sfftw_destroy_plan(Plan),0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mesh%Nm(dfftw_plan_mRny_dft_c2r(Plan,&MBRank,Nx)out, MBHowmRny, &tttttt&pooGOT)in(1,1,1), MBiEmbed,MBIstrida,MBiDist, &tttttt&pooGOT)out(1,1,1),MBoEmbed,MBIstrida,MBoDist,FFTW_ESTIMATE), f_mesh%Nm(dfftw_execute(Plan), f_mesh%Nm(dfftw_destroy_plan(Plan),0 st,FW_MEASURE)Kiiiii LL subfftw_eCOMPLEX, f_mesh%Nm(sfftw_plan_mRny_dft(Plan,&MBRank,Nx)out, MBHowmRny, &tttttt&pooGOT)in(1,1,1), MBiEmbed,MBIstrida,MBiDist, &tttttt&pooGOT)out(1,1,1),MBoEmbed,MBIstrida,MBoDist, &tttttt&poFFTW_BACKWARD, FFTW_ESTIMATE), f_mesh%Nm(sfftw_execute(Plan), f_mesh%Nm(sfftw_destroy_plan(Plan),0 st,FW_MEASURE)KiKlies e,foGNNNoEeCOMPLEX, f_mesh%Nm(dfftw_plan_mRny_dft(Plan,&MBRank,Nx)out, MBHowmRny, &tttttt&pooGOT)in(1,1,1), MBiEmbed,MBIstrida,MBiDist, &tttttt&pooGOT)out(1,1,1),MBoEmbed,MBIstrida,MBoDist, &tttttt&poFFTW_BACKWARD, FFTW_ESTIMATE), f_mesh%Nm(dfftw_execute(Plan), f_mesh%Nm(dfftw_destroy_plan(Plan),0 ppp&i0 ppp&i0 ppp&i f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp Copy margin to confobm with PPM conventRet,ttttt=pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&DO j=1,Ny)outt t&& t=DO k=1,Nz)outt t&& t= pooGOT)out(lda(1),j,k)== oGOT)out(1,j,k)i f_m t==poDO f_m t==poDO_m t=i f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp Returti_slab,NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1d_do1hONTINUEtttttt=h%Nm(comptop('2I4)util_fft_backward_3d It0tttttttttttt=RETURN i0t,F) KiMEASURE)Kiiiii LL subfftw_, f_mes=po SUBROUTINE 2I4)util_fft_backward_3ds,0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mes=po SUBROUTINE 2I4)util_fft_backward_3dd,0 st,FW_MEASURE)Kiiiii LL subfftw_eCOMPLEX, f_mes=po SUBROUTINE 2I4)util_fft_backward_3dc,0 st,FW_MEASURE)KiKlies e,foGNNNoEeCOMPLEX, f_mes=po SUBROUTINE 2I4)util_fft_backward_3dcci0 ppp&ilib2I4numerics-r1036/src/2I4)module)fmm.f0000644000175000017500000000314011616214650017274 0ustar omaromar f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp Moduletttt= 0: 2I4)module)fmmi f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&p 1p,'t&pp Purposett= 0,:pThis module contains the user-cR sable functiets of 1p,'t&ppppppppppppppppppthe fmm. 1p,'t&ppppppppppppppppp 1p,'t&pp Remarkstt= 0,:, f_mesp 1p,'t&pp Referencas&CI:, f_mesp 1p,'t&pp Revi Retstt= :b=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&p $Log: 2I4)module)fmm.f,v $ 1p,'t&pp Revi Ret 1.1.1.1 2007/07/13 10:18:58 ivos 1p,'t&pp CBL vabsRet of the PPM library, f_mesp 1p,'t&pp Revi Ret 1.2 2005/09/19 13:03:31 polasekb 1p,'t&pp codaNcosmetics, f_mesp 1p,'t&pp Revi Ret 1.1 2005/05/27 07:55:59 polasekb 1p,'t&pp in::i1l implemeslatRet,ttttt=p 1p,'t&pp Revi Ret 0 2004/11/16 15:31:00 polasekb 1p,'t&pp pt1,t 1p,'t&NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&p Pe,1llel P1,ticra Mesh Library (PPM) 1p,'t&pp Institute of ComputatRet1l Scienca 1p,'t&pp ETH Zentrum, Hirschengraben 84 1p,'t&pp CH-8092 Zurich, Switzerland 1p,'t&NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, ,ttttt=MODULE 2I4)module)fmmii f_m t=NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDii_slab, 0&pp PPM modulesb=CINNN t=NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDii_slab, 0&USE 2I4)module)fmm_inittttttt=eseUSE 2I4)module)fmm_fin1lize 1p,'t&eseUSE 2I4)module)fmm_expansRet,ttttt=eseUSE 2I4)module)fmm_potentRTli , f_mes=po MODULE 2I4)module)fmmilib2I4numerics-r1036/src/2I4)odatR sdona.f0000644000175000017500000001062611616214650017424 0ustar omaromar1p,'t&NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&p Functietp,'t&: 2I4)odatR sdonai f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&p 1p,'t&pp Purposett= 0,:pwill say .true. if R ssmodesNare inlagrated 1p,'t&p 1p,'t&pp Input : 1p,'t&p 1p,'t&pp Output : tttt (I) returt status,ttttt=p 1p,'t&pp Remarkstt= 0,: 1p,'t&p 1p,'t&pp Referencas&CI: 1p,'t&p 1p,'t&pp Revi Retstt= :b=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&p $Log: 2I4)odatR sdona.f,v $ 1p,'t&pp Revi Ret 1.1.1.1 2007/07/13 10:19:00 ivos 1p,'t&pp CBL vabsRet of the PPM library, f_mesp 1p,'t&pp Revi Ret 1.6 2004/07/26 11:59:40 ivos 1p,'t&pp FixasNto make itecompile. 1p,'t&p 1p,'t&pppRevi Ret 1.5 2004/07/26 11:33:03 michaeba 1p,'t&pp inserted the use of the 2I4 odaNoGOT module. 1p,'t&p 1p,'t&pppRevi Ret 1.4 2004/07/26 11:28:13 michaeba 1p,'t&pp syslax ttt=N...Nremoved. 1p,'t&p 1p,'t&pppRevi Ret 1.3 2004/07/26 07:46:51 michaeba 1p,'t&pp Atomized. Otherwise nopchanges. 1p,'t&p 1p,'t&pppRevi Ret 1.2 2004/06/10 16:20:03 ivos 1p,'t&pp Moved R sscpp directtivasNto column 1.pThe NEC cpp didtnot recognize 1p,'t&pppthe4 otherwise!!p 1p,'t&p 1p,'t&pp Revi Ret 1.1 2004/02/19 08:33:53 michaeba 1p,'t&pp in::i1l implemeslatRet. 1p,'t&p 1p,'t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&p Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1p,'t&pp Ceslab fessFluid Dynamics (DTU), f_mesp 1p,'t&p 1p,'t&ppThis file is p1,teof the P1,1llel P1,ticra Mesh Library (PPM). 1p,'t&p 1p,'t&ppPPM is free software: you can redtstribute iteRnd/essmodify 1p,'t&ppiteund9m the labms of the GNU Less9m Gene,1lpPublic Licessa&,-CINNN! as published by the Free Software FoundgRet, either&,-CINNN! vabsRet 3 of the Licessa, ess(at your PouRet)eRny later&,-CINNN! vabsRet. 1p,'t&p 1p,'t&ppPPM is dtstributed in the hope lhat itewill be useful, 1p,'t&ppbut WITHOUT ANY WARRANTY; without even the implied w2004nty of 1p,'t&ppMERCHANTABILITY essFITNESS FOR A PARTICULAR PURPOSE.(See the 1p,'t&ppGNU Gene,1lpPublic Licessa&fessmore details. 1p,'t&p 1p,'t&ppYou should have received a copy of the GNU Gene,1lpPublic Licessa,-CINNN! and the GNU Less9m Gene,1lpPublic Licessa&along with PPM. Ifenot, 1p,'t&ppsee . 1p,'t&p 1p,'t&ppP1,1llel P1,ticra Mesh Library (PPM) 1p,'t&ppETH Zuriche,0,'t&p CH-8092 Zurich, Switzerland , f_mes9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N ef_mes FUNCTtw_t2I4)odatR sdona(ttttttttttt=9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3 1p,'t&pp Includesb=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDis #tnclude "2I4)define.h" f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDis 1p,'t&pp Modulesb=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDis =CINNNUSE 2I4)module)oGOT)oda =CINNNUSE 2I4)module)oGOT =CINNNUSE 2I4)module)compt1,t 1p,'t&USE 2I4)module)comptop 1p,'t&USE 2I4)module)eble0#r=po,0IMPLICIT NONEe f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDis 1p,'t&pp Argumeslsi f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDis#r=po,0INTEGER, INTENT( OUT) :: ittti f_mLOGICAL :: 2I4)odatR sdonae f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDis 1p,'t&pp cR s compt1,t 1p,'t&NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDis 1p,'t&h%Nm(compt1,t('2I4)odatR sdona It0tttttttttttt=NNIF(2I4)debug.GT.0M/2+1Ki IF(.NOT.2I4)in::i1lizedM/2+1Ki t&&tttt =(tttteble0)eble0# t&&h%Nm(tttteble0(ttttebl_ttttnoin::,'2I4)odatR sdona I&# t&&&&&&&& 'Please cR s 2I4)in:: first!',__LINE__,ittttt t&&GOTO d_dotttttt= 0 0e=po I0,ttttt=N&=po I0,ttttt=N&IF(ANY(2I4)odatstate(1:2I4)max_midM/.NE. 2I4)odatstate_finished)M/2+1Ki 2I4)odatR sdona =(.FALSE. 1p,'t&N&=LSEi 2I4)odatR sdona =(.TRUE. 1p,'t&N&=po I0,d_do1p,'hONTINUE1p,'t&N&e f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDis 1p,'t&ppcomptop 1p,'t&NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDis 1p,'t&h%Nm(comptop('2I4)odatR sdona It0tttttttttttt=RETURN i,'t&N&=po FUNCTtw_t2I4)odatR sdonailib2I4numerics-r1036/src/2I4)mg_fin1lize.f0000644000175000017500000002355211616214650017445 0ustar omaromar1p,'t&NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp Subroutine 0: 2I4)mg_fin1lizei f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&p 1p,'t&pp Purposett= 0,:pThis routine dea suates R ssthe a004ys 1p,'t&pp 1p,'t&p 1p,'t&pp Input : 1p,'t&p 1p,'t&pp Input/output : 1p,'t&p 1p,'t&pp Output : tttt (I) 0 et success. 1p,'t&p 1p,'t&pppRemarkstt= 0,: 1p,'t&p 1p,'t&pp Referencas&CI: 1p,'t&p 1p,'t&pp Revi Retstt= :b=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&p $Log: 2I4)mg_fin1lize.f,v $ 1p,'t&pp Revi Ret 1.1.1.1 2007/07/13 10:18:56 ivos 1p,'t&pp CBL vabsRet of the PPM library, f_mesp 1p,'t&pp Revi Ret 1.5 2006/07/21 11:30:55 kots1lia 1p,'t&pp FRIDAY 1p,'t&p 1p,'t&pppRevi Ret 1.3 2004/10/01 16:33:39 ivos 1p,'t&pp cosmetics. 1p,'t&p 1p,'t&pppRevi Ret 1.2 2004/10/01 16:09:11 ivos 1p,'t&pp Replaced suAL(2I4)kind_double) :: t0 with suAL(MK) t0. 1p,'t&p 1p,'t&pppRevi Ret 1.1 2004/09/23 09:56:40 kots1lia 1p,'t&pp Mg new vabsRet 1p,'t&p 1p,'t&pppRevi Ret 1.4 2004/07/26 13:49:19 ivos 1p,'t&pp Removed Routinespsectiets from the headab commesl. 1p,'t&p 1p,'t&pppRevi Ret 1.3 2004/07/26 11:59:40 ivos 1p,'t&pp FixasNto make itecompile. 1p,'t&p 1p,'t&pppRevi Ret 1.2 2004/07/26 07:42:39 ivos 1p,'t&pp Changed to single-inlabface modulesNand Rdaptad R ssUSE statemesls. 1p,'t&p 1p,'t&pppRevi Ret 1.1 2004/06/29 14:36:49 kots1lia 1p,'t&pp Comm::ing multigrid fob further&use 1p,'t&p 1p,'t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&p Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), 1p,'t&pp Ceslab fessFluid Dynamics (DTU), f_mesp 1p,'t&p 1p,'t&ppThis file is p1,teof the P1,1llel P1,ticra Mesh Library (PPM). 1p,'t&p 1p,'t&ppPPM is free software: you can redtstribute iteRnd/essmodify 1p,'t&ppiteund9m the labms of the GNU Less9m Gene,1lpPublic Licessa&,-CINNN! as published by the Free Software FoundgRet, either&,-CINNN! vabsRet 3 of the Licessa, ess(at your PouRet)eRny later&,-CINNN! vabsRet. 1p,'t&p 1p,'t&ppPPM is dtstributed in the hope lhat itewill be useful, 1p,'t&ppbut WITHOUT ANY WARRANTY; without even the implied w2004nty of 1p,'t&ppMERCHANTABILITY essFITNESS FOR A PARTICULAR PURPOSE.(See the 1p,'t&ppGNU Gene,1lpPublic Licessa&fessmore details. 1p,'t&p 1p,'t&ppYou should have received a copy of the GNU Gene,1lpPublic Licessa,-CINNN! and the GNU Less9m Gene,1lpPublic Licessa&along with PPM. Ifenot, 1p,'t&ppsee . 1p,'t&p 1p,'t&ppP1,1llel P1,ticra Mesh Library (PPM) 1p,'t&ppETH Zuriche,0,'t&ppCH-8092 Zurich, Switzerland , f_mes9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e0t,FKiKIM)RE)KiiFIELDt#t,FKiMESHiKIM)RE)Ki2Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_meSUBROUTINE 2I4)mg_fin1lize_2d_sca_s(ittttt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_meSUBROUTINE 2I4)mg_fin1lize_2d_sca_d(ittttt0 ppp&i0 lt,FKiMESHiKIM)RE)Ki3Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_meSUBROUTINE 2I4)mg_fin1lize_3d_sca_s(ittttt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_meSUBROUTINE 2I4)mg_fin1lize_3d_sca_d(ittttt0 ppp&i0 ppp&i0 lt,FKiKIM)RE)KiVFIELDt#t,FKiMESHiKIM)RE)Ki2Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_meSUBROUTINE 2I4)mg_fin1lize_2d_vec_s(ittttt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_meSUBROUTINE 2I4)mg_fin1lize_2d_vec_d(ittttt0 ppp&i0 lt,FKiMESHiKIM)RE)Ki3Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_meSUBROUTINE 2I4)mg_fin1lize_3d_vec_s(ittttt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_meSUBROUTINE 2I4)mg_fin1lize_3d_vec_d(ittttt0 ppp&i0 ppp&i0 ppp&i f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp Includesb=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, #tnclude "2I4)define.h" f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp Modules=i f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&USE 2I4)module)oGOT =CINNNUSE 2I4)module)oGOT)mg =CINNNUSE 2I4)module)mg_R su#r=po,0USE 2I4)module)compt1,t 1p,'t&USE 2I4)module)comptop 1p,'t&USE 2I4)module)eble0#r=po,0USE 2I4)module)R su#r=po,0USE 2I4)module)write , f_mesIMPLICIT NONEe0t,F) KiMEASURE)Kiiiii LL subfftw_ | KiMEASURE)Kiiiii LL subfftw_eCOMPLEX, f_mesINTEGER, PARAMETER :: MK =(ttttkind_singlet0 sse 1p,'t&INTEGER, PARAMETER :: MK =(ttttkind_doublet0 ppp&i f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp ArgumeslsNNNNNi f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&INTEGER, INTENT(INOUT) :: ittti f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp Loc1lpvariablesNi f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&INTEGER, DIMENNNoE(1) :: lda1ttttttt=INTEGER, DIMENNNoE(2) :: lda2ttttttt=INTEGER, DIMENNNoE(3) :: lda3ttttttt=INTEGER, DIMENNNoE(4) :: lda4ttttttt=INTEGER, DIMENNNoE(5) :: lda5 1p,'t&INTEGER :: iPou,i 1p,'t&INTEGER :: istat,jtttttt=REAL(MK) :: t0 1p,'t&CHARACTER(LEN=ttttchar) :: mesge0t,FKiKIM)RE)KiiFIELDt#t,FKiMESHiKIM)RE)Ki2Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_me TYPE(mg_field_2d_sca_s),DIMENNNoE(:,:),POINTER :: mgfield,0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mesTYPE(mg_field_2d_sca_d),DIMENNNoE(:,:),POINTER :: mgfield,0 ppp&i0 lt,FKiMESHiKIM)RE)Ki3Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_mesTYPE(mg_field_3d_sca_s),DIMENNNoE(:,:),POINTER :: mgfield,0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mesTYPE(mg_field_3d_sca_d),DIMENNNoE(:,:),POINTER :: mgfield,0 ppp&i0 ppp&i0 lt,FKiKIM)RE)KiVFIELDt#t,FKiMESHiKIM)RE)Ki2Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_mesTYPE(mg_field_2d_vec_s),DIMENNNoE(:,:),POINTER :: mgfield,0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mesTYPE(mg_field_2d_vec_d),DIMENNNoE(:,:),POINTER :: mgfield,0 ppp&i0 lt,FKiMESHiKIM)RE)Ki3Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_mesTYPE(mg_field_3d_vec_s),DIMENNNoE(:,:),POINTER :: mgfield,0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mesTYPE(mg_field_3d_vec_d),DIMENNNoE(:,:),POINTER :: mgfield,0 ppp&i0 ppp&i0 ppp&i f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp ExtabnalsNi f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, f_mi f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp In::i1lisami f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&h%Nm(compt1,t('2I4)mg_fin1lize It0tttttttttttt=lda1(1)=0tttttt=lda2(1:2) =(0 1p,'t&lda3(1:3) =(0 1p,'t&lda4(1:4) =(0 1p,'t&lda5(1:5) =(0 1p,'t&NMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pDefinitiet of necessary variablesNand R suatiet of a004ys, f_mes9m Retur.5 2004/a Retur.5 2004/a04/a,foGNNN (N.NO(A ts_xpencil_topo) 3N e0t,FKiKIM)RE)KiiFIELDt#t,FKiMESHiKIM)RE)Ki2Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_me mgfield=>mgfield_2d_sca_s,0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mesmgfield=>mgfield_2d_sca_d,0 ppp&i0 lt,FKiMESHiKIM)RE)Ki3Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_messmgfield=>mgfield_3d_sca_s,0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_messmgfield=>mgfield_3d_sca_d,0 ppp&i0 ppp&i0 lt,FKiKIM)RE)KiVFIELDt#t,FKiMESHiKIM)RE)Ki2Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_mesmgfield=>mgfield_2d_vec_s,0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mesmgfield=>mgfield_2d_vec_d,0 ppp&i0 lt,FKiMESHiKIM)RE)Ki3Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_messmgfield=>mgfield_3d_vec_s,0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_messmgfield=>mgfield_3d_vec_d,0 ppp&i0 ppp&i0 ppp&i f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp Dea suate glob1lpa004ys (from 2I4)module)multigridab=CINNNNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&istat =(0 1p,'t&iPou =(ttttpara3Mdea su 1p,'t&h%Nm(ttttR su(pt1,t,lda3,iPou,itttttttttt=istat=istat+tttt 1p,'t&h%Nm(ttttR su(lboundry,lda2,iPou,itttttttttt=istat=istat+tttt 1p,'t&h%Nm(ttttR su(max_node,lda2,iPou,itttttttttt=istat=istat+tttt 0t,FKiKIM)RE)KiiFIELDt1p,'t&h%Nm(ttttR su(bcdef_sca,lda1,iPou,itttttttttt=istat=istat+tttt 0 lt,FKiKIM)RE)KiVFIELDt1p,'t&h%Nm(ttttR su(bcdef_vec,lda1,iPou,itttttttttt=istat=istat+ttttt0 ppp&i1p,'t&h%Nm(ttttR su(ghostsize,lda1,iPou,itttttttttt=istat=istat+tttt 1p,'t&h%Nm(ttttR su(factor,lda1,iPou,itttttttttt=istat=istat+tttt 1p,'t&h%Nm(ttttR su(mesh_id_g,lda1,iPou,itttttttttt=istat=istat+tttt 1p,'t&h%Nm(ttttR su(meshid_g,lda1,iPou,itttttttttt=istat=istat+tttt 1p,'t&h%Nm(ttttmg_R su(mgfield,lda2,iPou,itttttttttt=istat =(istat +ittti f_mIF (istat .NE. 0M/2+1Ki WRITE(mesg,'(A,I3,A)') 'fess',istat,'smgrpa004ys.Pble memory leak.'i tttt =(tttteble0)eble0# h%Nm(tttteble0(ttttebl_dea su,'2I4)mg_fin1lize Imesg,__LINE__,&tttttt&po,00000000000000000000000000000000000000000000000000000000000000ittttt GOTO d_dotttttt==po,0,1p,'t&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1p,'t&pp Returtmi f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDist, 1d_do1hONTINUEtttttt=h%Nm(comptop('2I4)mg_fin1lize It0tttttttttttt=RETURN i0t,FKiKIM)RE)KiiFIELDt#t,FKiMESHiKIM)RE)Ki2Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_me=po SUBROUTINE 2I4)mg_fin1lize_2d_sca_s,0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_me=po SUBROUTINE 2I4)mg_fin1lize_2d_sca_d,0 ppp&i0 lt,FKiMESHiKIM)RE)Ki3Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_me=po SUBROUTINE 2I4)mg_fin1lize_3d_sca_s,0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_me=po SUBROUTINE 2I4)mg_fin1lize_3d_sca_d,0 ppp&i0 ppp&i0 lt,FKiKIM)RE)KiVFIELDt#t,FKiMESHiKIM)RE)Ki2Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_me=po SUBROUTINE 2I4)mg_fin1lize_2d_vec_s,0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_me=po SUBROUTINE 2I4)mg_fin1lize_2d_vec_d,0 ppp&i0 lt,FKiMESHiKIM)RE)Ki3Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_me=po SUBROUTINE 2I4)mg_fin1lize_3d_vec_s,0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_me=po SUBROUTINE 2I4)mg_fin1lize_3d_vec_d,0 ppp&i0 ppp&i0 ppp&ilib2I4numerics-r1036/src/2I4)mg_solv.f0000644000175000017500000012137311616214650016627 0ustar omaromar f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDistt pp Subroutine 0: 2I4)mg_solv f_mNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDistt pt pp Input : 000itera (I) : 0in::i1l smoothing pweeps t pp in the finest level.t pp t pp iterf (I) : 0fin1l smoothing pweepst pp in the finest levelt pt pp iter1 (I) : 0AFTER EACH=RESTRICTtw_t t pp SMOOTHiii SWEEPS TAKE PLACEt pp IMPORTANT PARAMETERt pt pp iter2 (I) : 0AFTER EACH=PROLONGATNoE, f_messpp SMOOTHiii SWEEPS TAKE PLACEt pp t pt pp Input/Output : u (F) : 02+1 FIELD OF02+1 SOLUTNoE, f_messpp WITH GHOST VALUES!pt pp f (F) : 02+1 FIELD OF02+1 RHS (NO GHOSTt pp VALUES)t pp Output : tttt (I)t pt pp Purposett= 0,:pt pt pt pp Referencas&CI: 1p,'t& pt pp Revi Retstt= :b=CINNNmNMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDistt pp $Log: 2I4)mg_solv.f,v $ 1p,'t&&pp Revi Ret 1.1.1.1 2007/07/13 10:18:56 ivos 1p,'t&&pp CBL vabsRet of the PPM library, f_mes pt pp Revi Ret 1.17 2006/09/26 16:01:24 ivos 1p,'t&&pp Fixad wrongly ttdeslad CPP directivas. Remember: they have to st1,t in 1p,'t&tpp Col 1, otherwise itedoes not compile et certain systems. In fact, this 1p,'t&&pp codaNdidtNOT compile as itewas!pt pt pp Revi Ret 1.16 2006/07/21 11:30:54 kots1lia 1p,'t&&pp FRIDAY 1p,'t& pt pp Revi Ret 1.14 2005/12/08 12:44:46 kots1lia 1p,'t&&pp comm::ing dirichlet 1p,'t& pt pp Revi Ret 1.13 2005/05/30 13:03:22 kots1lia 1p,'t&&pp UPDATED FOR SERIAL VERftw_ WITHOUT MPI 1p,'t& pt pp Revi Ret 1.12 2005/03/14 13:24:03 kots1lia 1p,'t&&pp COMMITED 2+1 VECTOR CASE.(IT IS FOR LDA=3 1p,'t& pt pp Revi Ret 1.11 2005/01/04 09:48:21 kots1lia 1p,'t&&pp ghostsize=2 scalar case 1p,'t& pt pp Revi Ret 1.10 2004/11/05 15:18:35 kots1lia 1p,'t&&pp Made ttdepetdesl the in::i1l and fin1l smoothing ptepst pt pp Revi Ret 1.9 2004/10/13 16:02:03 kots1lia 1p,'t&&pp Maximum residual between processors is communiatedt pt pp Revi Ret 1.8 2004/09/30 14:26:24 kots1lia 1p,'t&&pp *** empty log message ***t pt pp Revi Ret 1.7 2004/09/29 10:47:36 kots1lia 1p,'t&&pp The user can now prisl the residual. 2+is should serva&fesshim 1p,'t&&pp as a(istopping criteriumt pt pp Revi Ret 1.6 2004/09/23 13:50:54 kots1lia 1p,'t&&pp Changed IF (w_cycle) to IF(.FALSE.) Now the recusrRet goes up to level 2.t pt pp Revi Ret 1.5 2004/09/23 12:41:16 kots1lia 1p,'t&&pp MG new vabsRet 1p,'t& pt pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDistt pp P1,1llel P1,ticra Mesh Library (PPM) 1p,'t& pp Institute of ComputatRet1l Scienca 1p,'t& pp ETH Zentrum, Hirschengraben 84 1p,'t& pp CH-8092 Zurich, Switzerland 1p,'t& pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDistt0t,F) KiKIM) )RE)KiiFIELDt#t,F FKiMESHiKIM) )RE)Ki2Dt0t,F ) KiMEASURE)Kiiiii LL subfftw_, f_mesSUBROUTINE 2I4)mg_solv_2d_sca_s(topo_id,u,f,itera,iterf,iter1,iter2,&tttttt&po,00000000000000000000000000000Eu,ittttt0 st,FFW_MEASURE)KiKlies e,foGNNNoE, f_mesSUBROUTINE 2I4)mg_solv_2d_sca_d(topo_id,u,f,itera,iterf,iter1,iter2,&tttttt&po,00000000000000000000000000000Eu,ittttt0 ppp& i0 lt,FKiMESHiKIM) )RE)Ki3Dt0t,F ) KiMEASURE)Kiiiii LL subfftw_, f_mesSUBROUTINE 2I4)mg_solv_3d_sca_s(topo_id,u,f,itera,iterf,iter1,iter2,&tttttt&po,00000000000000000000000000000Eu,ittttt0 st,FFW_MEASURE)KiKlies e,foGNNNoE, f_mesSUBROUTINE 2I4)mg_solv_3d_sca_d(topo_id,u,f,itera,iterf,iter1,iter2,&tttttt&po,00000000000000000000000000000Eu,ittttt0 ppp& i0 ppp& i0 lt,FKiKIM)RE)KiVFIELDt#t,F FKiMESHiKIM) )RE)Ki2Dt0t,F ) KiMEASURE)Kiiiii LL subfftw_, f_mesSUBROUTINE 2I4)mg_solv_2d_vec_s(topo_id,u,f,lda,itera,iterf,iter1,iter2,&tttttt&po,00000000000000000000000000000Eu,ittttt0 st,FFW_MEASURE)KiKlies e,foGNNNoE, f_mesSUBROUTINE 2I4)mg_solv_2d_vec_d(topo_id,u,f,lda,itera,iterf,iter1,iter2,&tttttt&po,00000000000000000000000000000Eu,ittttt0 ppp&i0 lt,FKiMESHiKIM) )RE)Ki3Dt0t,F ) KiMEASURE)Kiiiii LL subfftw_, f_mesSUBROUTINE 2I4)mg_solv_3d_vec_s(topo_id,u,f,lda,itera,iterf,iter1,iter2,&tttttt&po,00000000000000000000000000000Eu,ittttt0 st,FFW_MEASURE)KiKlies e,foGNNNoE, f_mesSUBROUTINE 2I4)mg_solv_3d_vec_d(topo_id,u,f,lda,itera,iterf,iter1,iter2,&tttttt&po,00000000000000000000000000000Eu,ittttt0 ppp&i0 ppp&i0 ppp&i0tnclude "2I4)define.h" f_m & pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD f_m & pp Modules=i f_m & pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_m &USE 2I4)module)oGOT =CINNNNNUSE 2I4)module)oGOT)mg =CINNNNNUSE 2I4)module)oGOT)mesh =CINNNNNUSE 2I4)module)compt1,t 1p,'t&t&USE 2I4)module)comptop 1p,'t&t&USE 2I4)module)eble0#r=po,0,0USE 2I4)module)R su#r=po,0NNUSE 2I4)module)map 1p,'t&t&USE 2I4)module)mg_core 1p,'t&t&USE 2I4)module)mg_resb=CINNN tUSE 2I4)module)mg_prolongb=CINNN tUSE 2I4)module)mg_smoothb=CINNN tUSE 2I4)module)write f_m & IMPLICIT NONEe0t,d9f)KiMPI 1p,'t& INCLUDE00'mpif.h'i0 ppp&i0t,F ) KiMEASURE)Kiiiii LL subfftw_, f_mes esINTEGER, PARAMETER :: MK =(ttttkind_singlet0 sse 1p,'t& esINTEGER, PARAMETER :: MK =(ttttkind_doublet0 ppp&i f_m & pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_m &&pp ArgumeslsN(fessu and f ttdex: loc1lpmesh suatietsNand icom)=i f_m & pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD 0t,FKiKIM)RE)KiiFIELDt#t,FKiMESHiKIM)RE)Ki2Dt f_m & REAL(MK),DIMENNNoE(:,:,:),POINTER :: ut f_m & REAL(MK),DIMENNNoE(:,:,:),POINTER :: &i0 lt,FKiMESHiKIM)RE)Ki3Dt f_m & REAL(MK),DIMENNNoE(:,:,:,:),POINTER :: ut f_m & REAL(MK),DIMENNNoE(:,:,:,:),POINTER :: &i0 ppp&i0 lt,FKiKIM)RE)KiVFIELDt#t,FKiMESHiKIM)RE)Ki2Dt f_m & REAL(MK),DIMENNNoE(:,:,:,:),POINTER :: ut f_m & REAL(MK),DIMENNNoE(:,:,:,:),POINTER :: &i0 lt,FKiMESHiKIM)RE)Ki3Dt f_m & REAL(MK),DIMENNNoE(:,:,:,:,:),POINTER :: ut f_m & REAL(MK),DIMENNNoE(:,:,:,:,:),POINTER :: &i0 ppp&i0 ppp&i0t,FKiKIM)RE)KiVFIELDt1p,'t& esINTEGER,INTENT(IN) :: lda t0 ppp&i f_m & INTEGER, INTENT(IN) :: itera,iterf,iter1,iter2t f_m & REAL(MK), INTENT(OUT) :: Eu i f_m & INTEGER, INTENT(INOUT) :: ittti f_m & INTEGER, INTENT(IN ) :: topo_idi f_m & pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_m &&pp Loc1lpvariablesNi f_m & pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_m &&REAL(MK) :: t0 1p,'t& &&REAL(MK) :: E,resb=CINNN t&INTEGER :: iface,count,kb=CINNN t&INTEGER :: ix,iy i f_m & CHARACTER(LEN=256) :: cbu&i f_m & INTEGER :: mlev,color,ittttttt=eseINTEGER :: ncR ss=0 1p,'t& &&REAL(MK) :: c1,c2,c3,c4 i f_m & INTEGER :: icom,i,jtttttt= &&REAL(MK) :: x,ytttttt= &&REAL(MK) :: gEu i f_m & INTEGER :: MPIL subi f_m & TYPE(ttttt_topo), POINTER :: topoi f_m & TYPE(ttttt_equi)mesh), POINTER :: mesh #t,FKiMESHiKIM)RE)Ki3Dt f_m & REAL(MK) :: c5,dz,rdz2i f_m & INTEGER,DIMENNNoE(4) :: ldl4,ldu4i f_m & INTEGER,DIMENNNoE(5) :: ldl5,ldu5t0 ppp&i f_m & INTEGER :: ildat f_m & REAL(MK) :: rdx2,rdy2t f_m & REAL(MK) :: dx,dyt#t,FKiMESHiKIM)RE)Ki2Dt f_m & INTEGER,DIMENNNoE(3) :: ldl3,ldu3i f_m & INTEGER,DIMENNNoE(4) :: ldl4,ldu4i0 ppp&i f_m & INTEGER :: topoid,iPou,idome0t,FKiKIM)RE)KiiFIELDt#t,FKiMESHiKIM)RE)Ki2Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_me e TYPE(mg_field_2d_sca_s),DIMENNNoE(:,:),POINTER :: mgfield,0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mes e TYPE(mg_field_2d_sca_d),DIMENNNoE(:,:),POINTER :: mgfield,0 ppp&i0 lt,FKiMESHiKIM)RE)Ki3Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_mes e TYPE(mg_field_3d_sca_s),DIMENNNoE(:,:),POINTER :: mgfield,0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mes e TYPE(mg_field_3d_sca_d),DIMENNNoE(:,:),POINTER :: mgfield,0 ppp&i0 ppp&i0 lt,FKiKIM)RE)KiVFIELDt#t,FKiMESHiKIM)RE)Ki2Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_mes e TYPE(mg_field_2d_vec_s),DIMENNNoE(:,:),POINTER :: mgfield,0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mes e TYPE(mg_field_2d_vec_d),DIMENNNoE(:,:),POINTER :: mgfield,0 ppp&i0 lt,FKiMESHiKIM)RE)Ki3Dt0t,FW_MEASURE)Kiiiii LL subfftw_, f_mes e TYPE(mg_field_3d_vec_s),DIMENNNoE(:,:),POINTER :: mgfield,0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mes e TYPE(mg_field_3d_vec_d),DIMENNNoE(:,:),POINTER :: mgfield,0 ppp&i0 ppp&i0 ppp&i0t,FKiKIM)RE)KiiFIELDt#t,FKiMESHiKIM)RE)Ki2Dt f_m & REAL(MK),DIMENNNoE(:,:,:),POINTER :: uc_dummyi0 lt,FKiMESHiKIM)RE)Ki3Dt f_m & REAL(MK),DIMENNNoE(:,:,:,:),POINTER :: uc_dummyi0 ppp&i0 lt,FKiKIM)RE)KiVFIELDt#t,FKiMESHiKIM)RE)Ki2Dt f_m & REAL(MK),DIMENNNoE(:,:,:,:),POINTER :: uc_dummyi0 lt,FKiMESHiKIM)RE)Ki3Dt f_m & REAL(MK),DIMENNNoE(:,:,:,:,:),POINTER :: uc_dummyi0 ppp&i0 ppp&i0t,FKiKIM)RE)KiiFIELDt#t,FKiMESHiKIM)RE)Ki2Dt f_REAL(MK),DIMENNNoE(:,:),POINTER :: tuci0 lt,FKiMESHiKIM)RE)Ki3Dt f_REAL(MK),DIMENNNoE(:,:,:),POINTER :: tuci0 ppp&i0 lt,FKiKIM)RE)KiVFIELDt#t,FKiMESHiKIM)RE)Ki2Dt f_REAL(MK),DIMENNNoE(:,:,:),POINTER :: tuci0 lt,FKiMESHiKIM)RE)Ki3Dt f_REAL(MK),DIMENNNoE(:,:,:,:),POINTER :: tuci0 ppp&i0 ppp&i f_m & pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_m &&pp ExtabnalsNi f_m & pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD i f_m & pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_m &&pp In::i1lizeNi f_m & pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_m &&h%Nm(compt1,t('2I4)mg_solv It0ttttttt0t,d9f)KiMPI 1p,'t& IF (ttttkind.EQ.ttttkind_singleM/2+1Ki MPIL sub = MPILREALi =LSEi MPIL sub = MPILKlies e,foGNNNoE, f_mes e=po,0,0 ppp&i topo =>(tttttopo(topo_id)%ti mesh =>(topo%mesh(meshid_g(1)tt pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_m &pp Check argumeslsi f_m pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_m &IF (ttttdebug .GT. 0M/2+1Ki0t,FKiKIM)RE)KiiFIELD f_m &t#t,FKiMESHiKIM)RE)Ki2D f_m &t IF (SIZE(u,3) .LT. ncompM/2+1Ki t&&tttt =(tttteble0)eble0# t&&h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_solv I &tttttt&po,0000000000'solutiet exist et ncomp(comdomains',__LINE__,itttt f_m &t &&GOTO d_dotttttt= 0 0e=poI0,ttttt=N& topoid=topo_idi f_m & t=DO i=1,ncompi t&&tdom=topo%icomlist(itt t&&IF (SIZE(u(:,:,i),1).LT.mesh%nnodes(1,idom)+ &tttttt&po,00000000000000000000000000000000000000000002*ghostsize(1)t/2+1Ki t&& &&tttt =(tttteble0)eble0# t&& &&h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_solv I &tttttt&po,0000000000'solutiet mess with mesh poislsNin x-dir!',__LINE__,itttt &t && &&GOTO d_do& &&t &&=poI0,ttttt=N& &&IF (SIZE(u(:,:,i),2).LT.mesh%nnodes(2,idom) &tttttt&po,000000000000000000000000000000000000000000+2*ghostsize(2)t/2+1Ki t&& &&tttt =(tttteble0)eble0# t&& &&h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_solv I &tttttt&po,0000000000'solutiet mess with mesh poislsNin y-dir!',__LINE__,ittttt && &&GOTO d_dot &&=poI0,ttttt=N& =poDO f_m t======IF (SIZE(f,3) .LT. ncompM/2+1Ki t&&tttt =(tttteble0)eble0# t&&h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_solv I &tttttt&po,0000000000'rhs exist et ncomp(comdomains!',__LINE__,itttt &t &&GOTO d_dotttttt= 0 0e=poI0,ttttt=N& topoid=topo_idi f_m & t=DO i=1,ncompi t&&tdom=topo%icomlist(itt t&&IF (SIZE(f(:,:,i),1).LT. mesh%nnodes(1,idom)t/2+1Ki t&& &&tttt =(tttteble0)eble0# t&& &&h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_solv I &tttttt&po,0000000000'rhs mess with mesh poislsNin x-dir!',__LINE__,ittttt && &&GOTO d_dot &&=poI0,ttttt=N& t&&IF (SIZE(f(:,:,i),2).LT. mesh%nnodes(2,idom)t/2+1Ki t&& &&tttt =(tttteble0)eble0# t&& &&h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_solv I &tttttt&po,0000000000'rhs mess with mesh poislsNin y-dir!',__LINE__,ittttt && &&GOTO d_dot &&=poI0,ttttt=N& =poDO 0 lt,FKiMESHiKIM)RE)Ki3Dt f_m & IF (SIZE(u,4) .LT. ncompM/2+1Ki t&&tttt =(tttteble0)eble0# t&&h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_solv I &tttttt&po,0000000000'solutiet exist et ncomp(comdomains!',__LINE__,itttt &&&&&&&t &&GOTO d_dotttttt= 0 0e=poI0,ttttt=N& topoid=topo_idi f_m & t=DO i=1,ncompi t&&tdom=topo%icomlist(itt t&&IF (SIZE(u(:,:,:,i),1).LT.mesh%nnodes(1,idom)+ &tttttt&po,00000000000000000000000000000000000000000002*ghostsize(1)t/2+1Ki t&& &&tttt =(tttteble0)eble0# t&& &&h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_solv I &tttttt&po,0000000000'solutiet mess with mesh poislsNin x-dir!',__LINE__,itttt &t && &&GOTO d_do& &&t &&=poI0,ttttt=N& &&IF (SIZE(u(:,:,:,i),2).LT.mesh%nnodes(2,idom)+ &tttttt&po,00000000000000000000000000000000000000000002*ghostsize(1)t/2+1Ki t&& &&tttt =(tttteble0)eble0# t&& &&h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_solv I &tttttt&po,0000000000'solutiet mess with mesh poislsNin y-dir!',__LINE__,ittttt && &&GOTO d_dot &&=poI0,ttttt=N& &&IF (SIZE(u(:,:,:,i),3).LT.mesh%nnodes(3,idom)+ &tttttt&po,00000000000000000000000000000000000000000002*ghostsize(1)t/2+1Ki t&& &&tttt =(tttteble0)eble0# t&& &&h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_solv I &tttttt&po,0000000000'solutiet mess with mesh poislsNin z-dir!',__LINE__,ittttt && &&GOTO d_dot &&=poI0,ttttt=N& =poDO f_m t======IF (SIZE(f,4) .LT. ncompM/2+1Ki t&&tttt =(tttteble0)eble0# t&&h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_solv I &tttttt&po,0000000000'rhs exist et ncomp(comdomains!',__LINE__,itttt &t &&GOTO d_dotttttt= 0 0e=poI0,ttttt=N& topoid=topo_idi f_m & t=DO i=1,ncompi t&&tdom=topo%icomlist(itt t&&IF (SIZE(f(:,:,:,i),1).LT.mesh%nnodes(1,idom)t/2+1Ki t&& &&tttt =(tttteble0)eble0# t&& &&h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_solv I &tttttt&po,0000000000000000'rhs mess with mesh poislsNin x-dir!',__LINE__,ittttt && &&GOTO d_dot &&=poI0,ttttt=N& t&&IF (SIZE(f(:,:,:,i),2).LT.mesh%nnodes(2,idom)t/2+1Ki t&& &&tttt =(tttteble0)eble0# t&& &&h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_solv I &tttttt&po,000000000'rhs mess with mesh poislsNin y-dir!',__LINE__,ittttt && &&GOTO d_dot &&=poI0,ttttt=N& t&&IF (SIZE(f(:,:,:,i),3).LT.mesh%nnodes(3,idom)t/2+1Ki t&& &&tttt =(tttteble0)eble0# t&& &&h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_solv I &tttttt&po,0000000000'rhs mess with mesh poislsNin z-dir!',__LINE__,ittttt && &&GOTO d_dot &&=poI0,ttttt=N& =poDO 0 ppp&i0 lt,FKiKIM)RE)KiVFIELDt#t,FKiMESHiKIM)RE)Ki2Dtt=N& t f_m & IF (SIZE(u,4) .LT. ncompM/2+1Ki t&&tttt =(tttteble0)eble0# t&&h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_solv I &tttttt&po,0000000000'solutiet exist et ncomp(comdomains',__LINE__,itttt &&&&&&&t &&GOTO d_dotttttt= 0 0e=poI0,ttttt=N& topoid=topo_idi f_m & t=DO i=1,ncompi t&&tdom=topo%icomlist(itt t&&IF (SIZE(u(:,:,:,i),2).LT.mesh%nnodes(1,idom)+2t/2+1Ki t&& &&tttt =(tttteble0)eble0# t&& &&h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_solv I &tttttt&po,0000000000'solutiet mess with mesh poislsNin x-dir!',__LINE__,itttt &t && &&GOTO d_do& &&t &&=poI0,ttttt=N& &&IF (SIZE(u(:,:,:,i),3).LT.mesh%nnodes(2,idom)+2t/2+1Ki t&& &&tttt =(tttteble0)eble0# t&& &&h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_solv I &tttttt&po,0000000000'solutiet mess with mesh poislsNin y-dir!',__LINE__,ittttt && &&GOTO d_dot &&=poI0,ttttt=N& =poDO f_m t======IF (SIZE(f,4) .LT. ncompM/2+1Ki t&&tttt =(tttteble0)eble0# t&&h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_solv I &tttttt&po,0000000000'rhs exist et ncomp(comdomains!',__LINE__,itttt &t &&GOTO d_dotttttt= 0 0e=poI0,ttttt=N& topoid=topo_idi f_m & t=DO i=1,ncompi t&&tdom=topo%icomlist(itt t&&IF (SIZE(f(:,:,:,i),2).LT.mesh%nnodes(1,idom)t/2+1Ki t&& &&tttt =(tttteble0)eble0# t&& &&h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_solv I &tttttt&po,0000000000'rhs mess with mesh poislsNin x-dir!',__LINE__,ittttt && &&GOTO d_dot &&=poI0,ttttt=N& t&&IF (SIZE(f(:,:,:,i),3).LT.mesh%nnodes(2,idom)t/2+1Ki t&& &&tttt =(tttteble0)eble0# t&& &&h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_solv I &tttttt&po,0000000000'rhs mess with mesh poislsNin y-dir!',__LINE__,ittttt && &&GOTO d_dot &&=poI0,ttttt=N& =poDO 0 lt,FKiMESHiKIM)RE)Ki3Dt f_m & IF (SIZE(u,5) .LT. ncompM/2+1Ki t&&tttt =(tttteble0)eble0# t&&h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_solv I &tttttt&po,0000000000'solutiet exist et ncomp(comdomains!',__LINE__,itttt &&&&&&&t &&GOTO d_dotttttt= 0 0e=poI0,ttttt=N& topoid=topo_idi f_m & t=DO i=1,ncompi t&&tdom=topo%icomlist(itt t&&IF (SIZE(u(:,:,:,:,i),2).LT.mesh%nnodes(1,idom)+ &tttttt&po,00000000000000000000000000000000000000000002*ghostsize(1)t/2+1Ki t&& &&tttt =(tttteble0)eble0# t&& &&h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_solv I &tttttt&po,0000000000'solutiet mess with mesh poislsNin x-dir!',__LINE__,itttt &t && &&GOTO d_do& &&t &&=poI0,ttttt=N& &&IF (SIZE(u(:,:,:,:,i),3).LT.mesh%nnodes(2,idom)+ &tttttt&po,00000000000000000000000000000000000000000002*ghostsize(1)t/2+1Ki t&& &&tttt =(tttteble0)eble0# t&& &&h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_solv I &tttttt&po,0000000000'solutiet mess with mesh poislsNin y-dir!',__LINE__,ittttt && &&GOTO d_dot &&=poI0,ttttt=N& &&IF (SIZE(u(:,:,:,:,i),4).LT.mesh%nnodes(3,idom)+ &tttttt&po,00000000000000000000000000000000000000000002*ghostsize(1)t/2+1Ki t&& &&tttt =(tttteble0)eble0# t&& &&h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_solv I &tttttt&po,0000000000'solutiet mess with mesh poislsNin z-dir!',__LINE__,ittttt && &&GOTO d_dot &&=poI0,ttttt=N& =poDO f_m t======IF (SIZE(f,5) .LT. ncompM/2+1Ki t&&tttt =(tttteble0)eble0# t&&h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_solv I &tttttt&po,0000000000'rhs exist et ncomp(comdomains!',__LINE__,itttt &t &&GOTO d_dotttttt= 0 0e=poI0,ttttt=N& topoid=topo_idi f_m & t=DO i=1,ncompi t&&tdom=topo%icomlist(itt t&&IF (SIZE(f(:,:,:,:,i),2).LT.mesh%nnodes(1,idom)t/2+1Ki t&& &&tttt =(tttteble0)eble0# t&& &&h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_solv I &tttttt&po,0000000000000000'rhs mess with mesh poislsNin x-dir!',__LINE__,ittttt && &&GOTO d_dot &&=poI0,ttttt=N& t&&IF (SIZE(f(:,:,:,:,i),3).LT.mesh%nnodes(2,idom)t/2+1Ki t&& &&tttt =(tttteble0)eble0# t&& &&h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_solv I &tttttt&po,000000000'rhs mess with mesh poislsNin y-dir!',__LINE__,ittttt && &&GOTO d_dot &&=poI0,ttttt=N& t&&IF (SIZE(f(:,:,:,:,i),4).LT.mesh%nnodes(3,idom)t/2+1Ki t&& &&tttt =(tttteble0)eble0# t&& &&h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_solv I &tttttt&po,0000000000'rhs mess with mesh poislsNin z-dir!',__LINE__,ittttt && &&GOTO d_dot &&=poI0,ttttt=N& =poDO 0 ppp&i0 ppp&i f_m &=poI0,ttttt=N&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_m &pDefinitiet of necessary variablesNand R suatiet of a004ys, f_mes& pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD 0t,FKiMESHiKIM)RE)Ki2Dt0t,FW_MEASURE)Kiiiii LL subfftw_,0t,FKiKIM)RE)KiiFIELDt1p,'t&e mgfield=>mgfield_2d_sca_s,0 st,FW_KIM)RE)KiVFIELDt1p,'t& emgfield=>mgfield_2d_vec_s,0 ppp&i f_m &rdx2=rdx2_si f_m &rdy2=rdy2_si f_m &dx=dx_si f_m &dy=dy_s,0 st,FW_MEASURE)KiKlies e,foGNNNoE,0t,FKiKIM)RE)KiiFIELDt1p,'t&e mgfield=>mgfield_2d_sca_d,0 st,FW_KIM)RE)KiVFIELDt1p,'t& emgfield=>mgfield_2d_vec_d,0 ppp&i f_m &rdx2=rdx2_di f_m &rdy2=rdy2_di f_m &dx=dx_di f_m &dy=dy_d,0 ppp&i0 lt,FKiMESHiKIM)RE)Ki3Dt0t,FW_MEASURE)Kiiiii LL subfftw_,0t,FKiKIM)RE)KiiFIELDt1p,'t&e mgfield=>mgfield_3d_sca_s,0 st,FW_KIM)RE)KiVFIELD t1p,'t&e mgfield=>mgfield_3d_vec_s,0 ppp&i f_m &rdx2=rdx2_si f_m &rdy2=rdy2_si f_m &rdz2=rdz2_si f_m &dx=dx_si f_m &dy=dy_s, f_m &dz=dz_s,0 st,FW_MEASURE)KiKlies e,foGNNNoE,0t,FKiKIM)RE)KiiFIELDt1p,'t&e mgfield=>mgfield_3d_sca_d,0 st,FW_KIM)RE)KiVFIELDt1p,'t& emgfield=>mgfield_3d_vec_d,0 ppp&i f_m &rdx2=rdx2_di f_m &rdy2=rdy2_di f_m &rdz2=rdz2_di f_m &dx=dx_di f_m &dy=dy_d, f_m &dz=dz_d,0 ppp&i0 ppp&if_m &topoid=topo_idi f_ncR ss=ncR ss+1i f_IF (ncR ss.EQ.1t/2+1Ki DO i=1,maxlevi0t,FKiKIM)RE)KiiFIELDt#t,FKiMESHiKIM)RE)Ki2Dt f_m & iPou =(ttttpara3MR su_fittttttt=eseeeeeldl3(1) = 1-ghostsize(1)tttttt=eseeeeeldl3(2) = 1-ghostsize(2)tttttt=eseeeeeldl3(3) =(1tttttt=eseeeeeldu3(1) = max_node(1,i)+ghostsize(1)tttttt=eseeeeeldu3(2) = max_node(2,i)+ghostsize(2)tttttt=eseeeeeldu3(3) =(ncompi t&h%Nm(ttttR su(uc_dummy,ldl3,ldu3,iPou,itttttttttt========IF (ittt .NE. 0M/2+1Ki ittt =(tttteble0)fatali h%Nm(tttteble0(ttttebl_a su,'MGsolv I &tttttt&po,00000000000000000000'uc_dummy',__LINE__,ittttt && GOTO d_dot &&=poI0,ttttt=N& t&uc_dummy(:,:,:)=0.0_MKi0 lt,FKiMESHiKIM)REKi3Dt f_m & iPou =(ttttpara3MR su_fittttttt=eseeeeeldl4(1) = 1-ghostsize(1)tttttt=eseeeeeldl4(2) = 1-ghostsize(2)tttttt=eseeeeeldl4(3) =(1-ghostsize(3)tttttt=eseeeeeldl4(4) =(1tttttt=eseeeeeldu4(1) = max_node(1,i)+ghostsize(1)tttttt=eseeeeeldu4(2) = max_node(2,i)+ghostsize(2)tttttt=eseeeeeldu4(3) =(max_node(3,i)+ghostsize(3)tttttt=eseeeeeldu4(4) =(ncompi t&h%Nm(ttttR su(uc_dummy,ldl4,ldu4,iPou,itttttttttt========IF (ittt .NE. 0M/2+1Ki ittt =(tttteble0)fatali h%Nm(tttteble0(ttttebl_a su,'MGsolv I &ttttttt&po,00000000000000000000'uc_dummy',__LINE__,ittttt && GOTO d_dot &&=poI0,ttttt=N& t&uc_dummy(:,:,:,:)=0.0_MKi0 ppp&i0t,FKiMESHiKIM)RE)Ki2Dt f_m & iPou =(ttttpara3Mdea su 1p,'t&&&&&&&&ldl3(1) = 1-ghostsize(1)tttttt=eseeeeeldl3(2) = 1-ghostsize(2)tttttt=eseeeeeldl3(3) =(1tttttt=eseeeeeldu3(1) = max_node(1,i)+ghostsize(1)tttttt=eseeeeeldu3(2) = max_node(2,i)+ghostsize(2)tttttt=eseeeeeldu3(3) =(ncompi t&h%Nm(ttttR su(uc_dummy,ldl4,ldu4,iPou,itttttttttt========IF (ittt .NE. 0M/2+1Ki ittt =(tttteble0)fatali h%Nm(tttteble0(ttttebl_a su,'MGsolv I &tttttt&po,00000000000000000000'uc_dummy',__LINE__,ittttt && GOTO d_dot &&=poI0,0 lt,FKiMESHiKIM)REKi3Dt f_m & iPou =(ttttpara3Mdea su 1p,'t&&&&&&&&ldl4(1) = 1-ghostsize(1)tttttt=eseeeeeldl4(2) = 1-ghostsize(2)tttttt=eseeeeeldl4(3) =(1-ghostsize(3)tttttt=eseeeeeldl4(4) =(1tttttt=eseeeeeldu4(1) = max_node(1,i)+ghostsize(1)tttttt=eseeeeeldu4(2) = max_node(2,i)+ghostsize(2)tttttt=eseeeeeldu4(3) =(max_node(3,i)+ghostsize(3)tttttt=eseeeeeldu4(4) =(ncompi t&h%Nm(ttttR su(uc_dummy,ldl5,ldu5,iPou,itttttttttt========IF (ittt .NE. 0M/2+1Ki ittt =(tttteble0)fatali h%Nm(tttteble0(ttttebl_a su,'MGsolv I &ttttttt&po,00000000000000000000'uc_dummy',__LINE__,ittttt && GOTO d_dot &&=poI0,0 ppp&i0 lt,FKiKIM)RE)KiVFIELDt#t,FKiMESHiKIM)RE)Ki2Dt f_m & iPou =(ttttpara3MR su_fittttttt=eseeeeeldl4(1) = 1tttttt=eseeeeeldl4(2) = 1-ghostsize(1)tttttt=eseeeeeldl4(3) =(1-ghostsize(2)tttttt=eseeeeeldl4(4) =(1tttttt=eseeeeeldu4(1) = vecdim 1p,'t&&seeeeeldu4(2) = max_node(1,i)+ghostsize(1)tttttt=eseeeeeldu4(3) = max_node(2,i)+ghostsize(2)tttttt=eseeeeeldu4(4) =(ncompi t&h%Nm(ttttR su(uc_dummy,ldl4,ldu4,iPou,itttttttttt========IF (ittt .NE. 0M/2+1Ki ittt =(tttteble0)fatali h%Nm(tttteble0(ttttebl_a su,'MGsolv I &tttttt&po,00000000000000000000'uc_dummy',__LINE__,ittttt && GOTO d_dot &&=poI0,ttttt=N& t&uc_dummy(:,:,:,:)=0.0_MKi0 lt,FKiMESHiKIM)REKi3Dt f_m & iPou =(ttttpara3MR su_fittttttt=eseeeeeldl5(1) = 1tttttt=eseeeeeldl5(2) = 1-ghostsize(1)tttttt=eseeeeeldl5(3) =(1-ghostsize(2)tttttt=eseeeeeldl5(4) =(1-ghostsize(3)tttttt=eseeeeeldl5(5) =(1tttttt=eseeeeeldu5(1) = vecdim 1p,'t&&seeeeeldu5(2) = max_node(1,i)+ghostsize(1)tttttt=eseeeeeldu5(3) = max_node(2,i)+ghostsize(2)tttttt=eseeeeeldu5(4) =(max_node(3,i)+ghostsize(3)tttttt=eseeeeeldu5(5) =(ncompi t&h%Nm(ttttR su(uc_dummy,ldl5,ldu5,iPou,itttttttttt========IF (ittt .NE. 0M/2+1Ki ittt =(tttteble0)fatali h%Nm(tttteble0(ttttebl_a su,'MGsolv I &ttttttt&po,00000000000000000000'uc_dummy',__LINE__,ittttt GOTO d_dot &&=poI0,ttttt=N& t&uc_dummy(:,:,:,:,:)=0.0_MKi0 ppp&i0t,FKiMESHiKIM)RE)Ki2Dt f_m & iPou =(ttttpara3Mdea su 1p,'t&&&&&&&&ldl4(1) = 1-ghostsize(1)tttttt=eseeeeeldl4(1) = 1-ghostsize(2)tttttt=eseeeeeldl4(1) = 1tttttt=eseeeeeldu4(1) = max_node(1,i)+ghostsize(1)tttttt=eseeeeeldu4(2) = max_node(2,i)+ghostsize(2)tttttt=eseeeeeldu4(3) =(ncompi t&h%Nm(ttttR su(uc_dummy,ldl3,ldu3,iPou,itttttttttt========IF (ittt .NE. 0M/2+1Ki ittt =(tttteble0)fatali h%Nm(tttteble0(ttttebl_a su,'MGsolv I &tttttt&po,00000000000000000000'uc_dummy',__LINE__,ittttt GOTO d_dot &&=poI0,0 lt,FKiMESHiKIM)REKi3Dt f_m & iPou =(ttttpara3Mdea su 1p,'t&&&&&&&&ldl5(1) = 1-ghostsize(1)tttttt=eseeeeeldl5(2) = 1-ghostsize(2)tttttt=eseeeeeldl5(3) =(1-ghostsize(3)tttttt=eseeeeeldl5(4) =(1tttttt=eseeeeeldu5(1) = max_node(1,i)+ghostsize(1)tttttt=eseeeeeldu5(2) = max_node(2,i)+ghostsize(2)tttttt=eseeeeeldu5(3) =(max_node(3,i)+ghostsize(3)tttttt=eseeeeeldu5(4) =(ncompi t&h%Nm(ttttR su(uc_dummy,ldl4,ldu4,iPou,itttttttttt========IF (ittt .NE. 0M/2+1Ki ittt =(tttteble0)fatali h%Nm(tttteble0(ttttebl_a su,'MGsolv I &ttttttt&po,00000000000000000000'uc_dummy',__LINE__,ittttt && GOTO d_dot &&=poI0,0 ppp&i0 ppp&i f_m &=poDO f_m t===ncR ss=ncR ss+1i f_&=poI0,ttttt=N&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_m &pDO n10in::i1l sweeps in the finest mesh with a GS-solver to gel the f_m &pin::i1l solutiet ,ttttt=N&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD 0t,FKiKIM)RE)KiiFIELDt#t,FKiMESHiKIM)RE)Ki2Dt f_m &c1 =(1.0_MK/(2.0_MK*(rdx2+rdy2)t &t c2 =(rdx2t c3 =(rdy2 t c4 =(2.0_MK*c2+2.0_MK*c3i f_m &count =(0 1p,'t&t&h%Nm(ttttmg_smooth_sca(topo_id,u,f,itera,1,c1,c2,c3,ittttt pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_m &ppCompute residualt pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_m &h%Nm(ttttmg_res_sca(topo_id,u,f,c1,c2,c3,c4,Ettttttt0t,d9f)KiMPI 1p,'t& h%Nm(MPILAllReduce(E,gEu,1,MPIL sub,MPILMAX,ttttcomm,ittttt E=gEui0 ppp&i f_mIF (ittt .NE. 0M/2+1K&t GOTO d_dotttttt==po,0 i f_mIF (l_prislM/2+1K&t WRITE(cbu&,*) 'Eu:',E 1p,'t& h%Nm(PPM_WRITE(ttttrank,'mg_solv Icbu&,ittttt =poI0,ttttt=N&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD,ttttt=N&pIn::i1tiet of the functiet correction. (We st1,t et purposetwith lev=2tt pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_m &DO mlev=2,maxlevi DO icom=1,ncompi t&&tuc=>mgfield(icom,mlev)%u 1p,'t&&&&&&&& DO j=pt1,t(2,icom,mlev),istop(2,icom,mlev)t && DO i=pt1,t(1,icom,mlev),istop(1,icom,mlev)t && t&&tuc(i,j)=0.0_MKi && t&&=poDO f_m t======t&&=poDO f_m t=======poDO f_m t====poDO f_m t===pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_m &ph%Nm(2+1 MULTIGRID TO DO NICE STUFF TO OUR FUNCTNoE, f_mess&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD 0t,FKiMEASURE)Kiiiii LL subfftw_, f_mes eh%Nm(ttttmg_core_2d_sca_s(2,iter1,iter2,itttt &t0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mes eh%Nm(ttttmg_core_2d_sca_d(2,iter1,iter2,itttt &t0 ppp& ,ttttt=N&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD ttttt=N&pPROLONG the solutiet to the finest gridi f_m &pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD 0t,FKiMEASURE)Kiiiii LL subfftw_, f_mes eeh%Nm(ttttmg_prolong_2d_sca_s(1,ittttt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mes e h%Nm(ttttmg_prolong_2d_sca_d(1,ittttt0 ppp&i f_m &pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD ttttt=N&pUPDATE02+1 FUNCTNoE, f_mess&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_mess&DO icom=1,ncompi tuc=>mgfield(icom,mlev)%u 1p,'t&&&&&&DO j=pt1,t(2,icom,1),istop(2,icom,1) &t &&DO i=pt1,t(1,icom,1),istop(1,icom,1)tttttt=eseeeeeeeeeeeeu(i,j,icom)=tuc(i,j)&t &&=poDO f_m t=======poDO f_m t====poDO f_m t===pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_m &pDO the fin1l sweeps f_m t===pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBi 1p,'t&t&h%Nm(ttttmg_smooth_sca(topo_id,u,f,iterf,1,c1,c2,c3,ittttt h%Nm(ttttmg_res_sca(topo_id,u,f,c1,c2,c3,c4,Ettttttt0t,d9f)KiMPI 1p,'t& h%Nm(MPILAllReduce(E,gEu,1,MPIL sub,MPILMAX,ttttcomm,ittttt Eu=gEui0 sse 1p,'t& eEu=E,0 ppp&i0 lt,FKiMESHiKIM)RE)Ki3Dt1p,'t& ec1 =(1.0_MK/(2.0_MK*(rdx2+rdy2+rdz2)tt c2 =(rdx2t c3 =(rdy2t c4 =(rdz2 t c5 =(2.0_MK*c2+2.0_MK*c3+2.0_MK*c4 1p,'t&t&h%Nm(ttttmg_smooth_sca(topo_id,u,f,itera,1,c1,c2,c3,c4,ittttt pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_m &ppCompute residualt pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_m &h%Nm(ttttmg_res_sca(topo_id,u,f,c1,c2,c3,c4,c5,Ettttttt0t,d9f)KiMPI 1p,'t& h%Nm(MPILAllReduce(E,gEu,1,MPIL sub,MPILMAX,ttttcomm,ittttt E=gEui0 ppp&i f_mIF (l_prislM/2+1K&t WRITE(cbu&,*) 'Eu:',E 1p,'t& h%Nm(PPM_WRITE(ttttrank,'mg_solv Icbu&,ittttt =poI0,ttttt=N&&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD,ttttt=N&pIn::i1tiet of the functiet correction. (We st1,t et purposetwith lev=2tt pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_m &DO mlev=2,maxlevi DO icom=1,ncompi t&&tuc=>mgfield(icom,mlev)%u 1p,'t&&&&&&&& DO k=pt1,t(3,icom,mlev),istop(3,icom,mlev)&t && &&DO j=pt1,t(2,icom,mlev),istop(2,icom,mlev)t && DO i=pt1,t(1,icom,mlev),istop(1,icom,mlev)t && t&& &&tuc(i,j,k)=0.0_MKi && t&& &&=poDO f_m t======t&&&&=poDO f_m t======t&&=poDO f_m t=======poDO f_m t====poDO f_m t===pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_m &ph%Nm(2+1 MULTIGRID TO DO NICE STUFF TO OUR FUNCTNoE, f_mess&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD 0t,FKiMEASURE)Kiiiii LL subfftw_, f_mes eh%Nm(ttttmg_core_3d_sca_s(2,iter1,iter2,ittttt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mes eh%Nm(ttttmg_core_3d_sca_d(2,iter1,iter2,ittttt0 ppp&i f_m &pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD ttttt=N&pPROLONG the solutiet to the finest gridi f_m &pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD 0t,FKiMEASURE)Kiiiii LL subfftw_, f_mes eh%Nm(ttttmg_prolong_3d_sca_s(1,ittttt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mes eh%Nm(ttttmg_prolong_3d_sca_d(1,ittttt0 ppp&i f_m &pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD ttttt=N&pUPDATE02+1 FUNCTNoE, f_mess&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_mess&DO icom=1,ncompi tuc=>mgfield(icom,mlev)%u 1p,'t&&&&&&DO k=pt1,t(3,icom,1),istop(3,icom,1)tttttt=eseeeeeeDO j=pt1,t(2,icom,1),istop(2,icom,1)t && DO i=pt1,t(1,icom,1),istop(1,icom,1)tttttt=eseeeeeeeeeeee eeu(i,j,k,icom)=tuc(i,j,k)i && t&&=poDO f_m t======t&&=poDO f_m t=======poDO f_m t====poDO f_m t===pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_m &pDO the fin1l sweeps f_m t=====pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBi 1p,'t&t&h%Nm(ttttmg_smooth_sca(topo_id,u,f,iterf,1,c1,c2,c3,c4,ittttt h%Nm(ttttmg_res_sca(topo_id,u,f,c1,c2,c3,c4,c5,Ettttttt0t,d9f)KiMPI 1p,'t& h%Nm(MPILAllReduce(E,gEu,1,MPIL sub,MPILMAX,ttttcomm,ittttt Eu=gEui0 sse 1p,'t& eEu=E,0 ppp&i0 ppp&i0 lt,FKiKIM)RE)KiVFIELDt#t,FKiMESHiKIM)RE)Ki2Dt f_m &c1 =(1.0_MK/(2.0_MK*(rdx2+rdy2)t &t c2 =(rdx2t c3 =(rdy2 t c4 =(2.0_MK*c2+2.0_MK*c3i f_m &count =(0 1p,'t&t&h%Nm(ttttmg_smooth_vec(topo_id,u,f,itera,1,c1,c2,c3,itttt ,ttttt=N&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD ttttt=N&ppCompute residualt pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_m &h%Nm(ttttmg_res_vec(topo_id,u,f,c1,c2,c3,c4,Etttttt &t#t,d9f)KiMPI 1p,'t& h%Nm(MPILAllReduce(E,gEu,1,MPIL sub,MPILMAX,ttttcomm,ittttt E=gEui0 ppp&i f_m_mIF (l_prislM/2+1K&t WRITE(cbu&,*) 'Eu:',E 1p,'t& h%Nm(PPM_WRITE(ttttrank,'mg_solv Icbu&,ittttt =poI0,,ttttt=N&&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD,ttttt=N&pIn::i1tiet of the functiet correction. (We st1,t et purposetwith lev=2tt pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_m &DO mlev=2,maxlevi DO icom=1,ncompi t&&tuc=>mgfield(icom,mlev)%u 1p,'t&&&&&&&& DO j=pt1,t(2,icom,mlev),istop(2,icom,mlev)t && DO i=pt1,t(1,icom,mlev),istop(1,icom,mlev)t && DO ilda=1,vecdim 1p,'t&&seeeee t&&tuc(ilda,i,j)=0.0_MKi && t&&==poDO&t && &&=poDO f_m t======t&&=poDO f_m t=======poDO f_m t====poDO f_m t===pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_m &ph%Nm(2+1 MULTIGRID TO DO NICE STUFF TO OUR FUNCTNoE, f_mess&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD 0t,FKiMEASURE)Kiiiii LL subfftw_, f_mes eh%Nm(ttttmg_core_2d_vec_s(2,iter1,iter2,itttt &t0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mes eh%Nm(ttttmg_core_2d_vec_d(2,iter1,iter2,itttt &t0 ppp& ,ttttt=N&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD ttttt=N&pPROLONG the solutiet to the finest gridi f_m &pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD 0t,FKiMEASURE)Kiiiii LL subfftw_, f_mes eh%Nm(ttttmg_prolong_2d_vec_s(1,ittttt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mes eh%Nm(ttttmg_prolong_2d_vec_d(1,ittttt0 ppp& ,ttttt=N&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD ttttt=N&pUPDATE02+1 FUNCTNoE, f_mess&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_mess&DO icom=1,ncompi tuc=>mgfield(icom,mlev)%u 1p,'t&&&&&&DO j=pt1,t(2,icom,1),istop(2,icom,1) &t &&DO i=pt1,t(1,icom,1),istop(1,icom,1)tttttt=eseeeeeeeDO ilda=1,vecdim 1p,'t&&seeeee u(ilda,i,j,icom)=tuc(ilda,i,j) 1p,'t&&seeeee =poDO&t &&=poDO f_m t=======poDO f_m t====poDO f_m t===pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_m &pDO the fin1l sweeps f_m t===pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBi 1p,'t&t&h%Nm(ttttmg_smooth_vec(topo_id,u,f,iterf,1,c1,c2,c3,ittttt h%Nm(ttttmg_res_vec(topo_id,u,f,c1,c2,c3,c4,Etttttt &tt0t,d9f)KiMPI 1p,'t& h%Nm(MPILAllReduce(E,gEu,1,MPIL sub,MPILMAX,ttttcomm,ittttt Eu=gEu i0 sse 1p,'t& eEu=E,0 ppp&i0 lt,FKiMESHiKIM)RE)Ki3Dt1p,'t& ec1 =(1.0_MK/(2.0_MK*(rdx2+rdy2+rdz2)tt c2 =(rdx2t c3 =(rdy2t c4 =(rdz2 t c5 =(2.0_MK*c2+2.0_MK*c3+2.0_MK*c4 1p,'t&t&h%Nm(ttttmg_smooth_vec(topo_id,u,f,itera,1,c1,c2,c3,c4,ittttt pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride, ttttt=N&ppCompute residualt pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride, t h%Nm(ttttmg_res_vec(topo_id,u,f,c1,c2,c3,c4,c5,Ettttttt0t,d9f)KiMPI 1p,'t& h%Nm(MPILAllReduce(E,gEu,1,MPIL sub,MPILMAX,ttttcomm,ittttt E=gEu i0 ppp&i f_m_mIF (l_prislM/2+1K&t WRITE(cbu&,*) 'Eu:',E 1p,'t& h%Nm(PPM_WRITE(ttttrank,'mg_solv Icbu&,ittttt =poI0, pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,ide, pIn::i1tiet of the functiet correction. (We st1,t et purposetwith lev=2tt pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_m &DO mlev=2,maxlevi DO icom=1,ncompi t&&tuc=>mgfield(icom,mlev)%u 1p,'t&&&&&&&& DO k=pt1,t(3,icom,mlev),istop(3,icom,mlev)&t && &&DO j=pt1,t(2,icom,mlev),istop(2,icom,mlev)t && DO i=pt1,t(1,icom,mlev),istop(1,icom,mlev)t0t,d9f)KiVECTORt && t&& &&tuc(1,i,j,k)=0.0_MKi && t&& &&t&& &&tuc(2,i,j,k)=0.0_MKi && t&& &&t&& &&tuc(3,i,j,k)=0.0_MKi0 sse 1p,'t& e && DO ilda=1,vecdim&t && && &&t&& &&tuc(ilda,i,j,k)=0.0_MKi && t&& &&t=poDO 0 ppp&i && t&& &&t=poDO && t&& &&t=poDO && t&& &=poDO f_m t=======poDO f_m t====poDO f_m t===pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_m &ph%Nm(2+1 MULTIGRID TO DO NICE STUFF TO OUR FUNCTNoE, f_mess&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD 0t,FKiMEASURE)Kiiiii LL subfftw_, f_mes eh%Nm(ttttmg_core_3d_vec_s(2,iter1,iter2,ittttt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mes eh%Nm(ttttmg_core_3d_vec_d(2,iter1,iter2,ittttt0 ppp&i f_m &pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD ttttt=N&pPROLONG the solutiet to the finest gridi f_m &pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD 0t,FKiMEASURE)Kiiiii LL subfftw_, f_mes eh%Nm(ttttmg_prolong_3d_vec_s(1,ittttt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mes eh%Nm(ttttmg_prolong_3d_vec_d(1,ittttt0 ppp&,ttttt=N&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD ttttt=N&pUPDATE02+1 FUNCTNoE, f_mess&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_mess&DO icom=1,ncompi tuc=>mgfield(icom,mlev)%u 1p,'t&mess&DO k=pt1,t(3,icom,1),istop(3,icom,1)tttttt=eseeeeeeDO j=pt1,t(2,icom,1),istop(2,icom,1)t && DO i=pt1,t(1,icom,1),istop(1,icom,1)t0t,d9f)KiVECTORt && t&&u(1,i,j,k,icom)=tuc(1,i,j,k)t && t&&u(2,i,j,k,icom)=tuc(2,i,j,k)t && t&&u(3,i,j,k,icom)=tuc(3,i,j,k)i0 sse 1p,'t& e && DO ilda=1,vecdim 1p,'t&&seeeee t&&u(ilda,i,j,k,icom)=tuc(ilda,i,j,k)t && =poDO 0 ppp&i && t&& =poDO && t&& &=poDO f_m t=======poDO f_m t====poDO f_m t===pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD f_m &pDO the fin1l sweeps f_m t===pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBi 1p,'t&t&h%Nm(ttttmg_smooth_vec(topo_id,u,f,iterf,1,c1,c2,c3,c4,ittttt h%Nm(ttttmg_res_vec(topo_id,u,f,c1,c2,c3,c4,c5,Etttttt &t#t,d9f)KiMPI 1p,'t& h%Nm(MPILAllReduce(E,gEu,1,MPIL sub,MPILMAX,ttttcomm,ittttt Eu=gEui0 sse 1p,'t& eEu=E,0 ppp&i0 ppp&i0 ppp&,ttttt=N&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD ttttt=N&p Returt ,ttttt=N&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD d_do& &&CONTINUE 1p,'t& h%Nm(comptop('2I4)mg_solv It0ttttttt1p,'t& RETURNtt0t,t& KiKIM)RE)KiiFIELDt#t,F& KiMESHiKIM)RE)Ki2Dt0t,F& KiMEASURE)Kiiiii LL subfftw_, f_mes=po SUBROUTINE 2I4)mg_solv_2d_sca_s,0 st,FFW_MEASURE)KiKlies e,foGNNNoE, f_mes=po SUBROUTINE 2I4)mg_solv_2d_sca_d,0 ppp&i0 lt,FFKiMESHiKIM)RE)Ki3Dt0t,F& KiMEASURE)Kiiiii LL subfftw_, f_mes=po SUBROUTINE 2I4)mg_solv_3d_sca_s,0 st,FFW_MEASURE)KiKlies e,foGNNNoE, f_mes=po SUBROUTINE 2I4)mg_solv_3d_sca_d,0 ppp&i0 ppp&i0 lt,FKiKIM)RE)KiVFIELDt#t,F& KiMESHiKIM)RE)Ki2Dt0t,F& KiMEASURE)Kiiiii LL subfftw_, f_mes=po SUBROUTINE 2I4)mg_solv_2d_vec_s,0 st,FFW_MEASURE)KiKlies e,foGNNNoE, f_mes=po SUBROUTINE 2I4)mg_solv_2d_vec_d,0 ppp&i0 lt,FFKiMESHiKIM)RE)Ki3Dt0t,F& KiMEASURE)Kiiiii LL subfftw_, f_mes=po SUBROUTINE 2I4)mg_solv_3d_vec_s,0 st,FFW_MEASURE)KiKlies e,foGNNNoE, f_mes=po SUBROUTINE 2I4)mg_solv_3d_vec_d,0 ppp&i0 ppp&i0 ppp&ilib2I4numerics-r1036/src/2I4)moduletmg_core.f0000644000175000017500000000656411616214650020145 0upt1, omaromarttt=N&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Module1p,'t& : 2I4)moduletmg_core ttt=N&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! ttttt=! Purposet't& : multigrid module ttttt=! ttttt=! ttttt=! Remarkst't& : ttttt=! ttttt=! References& : ttttt=! ttttt=! Revisietst& : ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! $Log: 2I4)moduletmg_core.f,v $ ttttt=! Revisiet 1.1.1.1 2007/07/13 10:19:00 ivos ttttt=! CBL versiet of the PPM library ttttt=! ttttt=! Revisiet 1.1 2004/09/22 18:31:04 kotsalie ttttt=! MG new versiet ttttt=! ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttttt=! Center for Fluid Dynamics (DTU) ttttt=! ttttt=! ttttt=! This file1is p1,t ef the Parallel Particle1Mesh Library (PPM). ttttt=! ttttt=! PPM is free software: you can redistribute itNand/or modify ttttt=! itNunder the terms ef the GNU Lesser General Public License ttttt=! as pomlished by the Free Software Found1tiet, either ttttt=! versiet 3 ef the License, or (at your optiet)Nany later ttttt=! versiet. ttttt=! ttttt=! PPM is distributed in the hope that itNwill be useful, ttttt=! but WITHOUT ANY WARRANTY;twithout even the implied wa004nty ef ttttt=! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ttttt=! GNU General Public License for more details. ttttt=! ttttt=! You should have received a copy ef the GNU General Public License ttttt=! and the GNU Lesser General Public License alongtwith PPM. If not, ttttt=! see . ttttt=! ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! ETH Zurich ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD tt0define)Kiiiii LL subfftw_ 1t0define)KiKlies e,foGNNNoE 2t0define)KiINTEGER 3t0define)KiLOGIh%N 4t0define)Ki2Dtt=N& 7t0define)Ki3Dtt=N& 8t0define)KiiFIELD 9t0define)KiVFIELD 10 MODULE 2I4)moduletmg_core tt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DDD tt!Modules tt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DDD-e, t !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DDD-e, t=! INCLUDE02+1 SOURCES tt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DDD-e, tCONTAINStt0define)KiKIM)KiiFIELDt#define)KiMESHiKIM)Ki2Dt0define)KiMEASUKiiiii LL subfftw_,0tnclude "ttttmg_core.f" #unde,FW_MEAS t0define)KiMEASUKiKlies e,foGNNNoE,0tnclude "ttttmg_core.f" #unde,FW_MEAS #unde,FW_MESHiKIM t#define)KiMESHiKIM)Ki3Dt0define)KiMEASUKiiiii LL subfftw_,0tnclude "ttttmg_core.f" #unde,FW_MEAS t0define)KiMEASUKiKlies e,foGNNNoE,0tnclude "ttttmg_core.f" #unde,FW_MEAS #unde,FW_MESHiKIM #unde,FW_KIM t#define)KiKIM)KiVFIELDt#define)KiMESHiKIM)Ki2Dt0define)KiMEASUKiiiii LL subfftw_,0tnclude "ttttmg_core.f" #unde,FW_MEAS t0define)KiMEASUKiKlies e,foGNNNoE,0tnclude "ttttmg_core.f" #unde,FW_MEAS #unde,FW_MESHiKIM t#define)KiMESHiKIM)Ki3Dt0define)KiMEASUKiiiii LL subfftw_,0tnclude "ttttmg_core.f" #unde,FW_MEAS t0define)KiMEASUKiKlies e,foGNNNoE,0tnclude "ttttmg_core.f" #unde,FW_MEAS #unde,FW_MESHiKIM #unde,FW_KIM t=po MODULE 2I4)moduletmg_core ttlib2I4numerics-r1036/src/2I4)moduletgm4)march_bkwd.f0000644000175000017500000000673311616214650021471 0upt1, omaromarttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Module1p,'t& : 2I4)moduletgm4)march_bkwd ttt=N&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! ttttt=! Purposet't& : This module tncludes the source code for the f_m! backwa0d marchingtroutine)ef the marchingtmethod. ttttt=! ttttt=! Remarkst't& : ttttt=! ttttt=! References& : ttttt=! ttttt=! Revisietst& : ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! $Log: 2I4)moduletgm4)march_bkwd.f,v $ ttttt=! Revisiet 1.1.1.1 2007/07/13 10:18:58 ivos ttttt=! CBL versiet of the PPM library ttttt=! ttttt=! Revisiet 1.1 2005/04/27 01:08:32 ivos ttttt=! In::i1l commit, but tested. ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttttt=! Center for Fluid Dynamics (DTU) ttttt=! ttttt=! ttttt=! This file1is p1,t ef the Parallel Particle1Mesh Library (PPM). ttttt=! ttttt=! PPM is free software: you can redistribute itNand/or modify ttttt=! itNunder the terms ef the GNU Lesser General Public License ttttt=! as pomlished by the Free Software Found1tiet, either ttttt=! versiet 3 ef the License, or (at your optiet)Nany later ttttt=! versiet. ttttt=! ttttt=! PPM is distributed in the hope that itNwill be useful, ttttt=! but WITHOUT ANY WARRANTY;twithout even the implied wa004nty ef ttttt=! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ttttt=! GNU General Public License for more details. ttttt=! ttttt=! You should have received a copy ef the GNU General Public License ttttt=! and the GNU Lesser General Public License alongtwith PPM. If not, ttttt=! see . ttttt=! ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! ETH Zurich ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD tttt= ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Define)types ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD 0define)Kiiiii LL subfftw_ 1t0define)KiKlies e,foGNNNoE 2t0define)Ki2Dtt=N& 3t0define)Ki3Dtt=N& 4 ttttt=MODULE 2I4)moduletgm4)march_bkwd f_m t====pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD ttttt=N&=! Define)interfaces&to 2I4)gm4)march_bkwd ttt=N&===pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD ttttt=N&=INTERFACE 2I4)gm4)march_bkwd ttt=N&===tt=MODULE PROCEDURE 2I4)gm4)march_bkwd_2ds ttt=N&===tt=MODULE PROCEDURE 2I4)gm4)march_bkwd_2dd ttt=N&===tt=MODULE PROCEDURE 2I4)gm4)march_bkwd_3ds ttt=N&===tt=MODULE PROCEDURE 2I4)gm4)march_bkwd_3dd ttt=N&====po INTERFACE f_m t====pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD ttttt=N&=! tnclude the source f_m t====pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD ttttt=N&=CONTAINStt0define)KiKIM)Ki2Dt0define)KiMEASUKiiiii LL subfftw_,0tnclude "ttttgm4)march_bkwd.f" #unde,FW_MEAS #define)KiMEASUKiKlies e,foGNNNoE,0tnclude "ttttgm4)march_bkwd.f" #unde,FW_MEAS #unde,FW_KIM t#define)KiKIM)Ki3Dt0define)KiMEASUKiiiii LL subfftw_,0tnclude "ttttgm4)march_bkwd.f" #unde,FW_MEAS #define)KiMEASUKiKlies e,foGNNNoE,0tnclude "ttttgm4)march_bkwd.f" #unde,FW_MEAS #unde,FW_KIM t=N&====po MODULE 2I4)moduletgm4)march_bkwd lib2I4numerics-r1036/src/2I4)moduletd1ta_fieldsolver.f0000644000175000017500000000632211616214651022032 0upt1, omaromar t====pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Module1p,'t& : 2I4)moduletd1ta_fieldsolver ttt=N&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! ttttt=! Purposet't& : d1ta module ef fieldsolver mostly containingtthe FFT ttttt=! 2lans ttttt=! ttttt=! ttttt=! Remarkst't& : ttttt=! ttttt=! References& : ttttt=! ttttt=! Revisietst& : ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! $Log: 2I4)moduletd1ta_fieldsolver.f,v $ ttttt=! Revisiet 1.1.1.1 2007/07/13 10:18:57 ivos ttttt=! CBL versiet of the PPM library ttttt=! ttttt=! Revisiet 1.3 2005/02/17 17:47:00 hiebers ttttt=! Reimplemesl1tiet ttttt=! ttttt=! ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttttt=! Center for Fluid Dynamics (DTU) ttttt=! ttttt=! ttttt=! This file1is p1,t ef the Parallel Particle1Mesh Library (PPM). ttttt=! ttttt=! PPM is free software: you can redistribute itNand/or modify ttttt=! itNunder the terms ef the GNU Lesser General Public License ttttt=! as pomlished by the Free Software Found1tiet, either ttttt=! versiet 3 ef the License, or (at your optiet)Nany later ttttt=! versiet. ttttt=! ttttt=! PPM is distributed in the hope that itNwill be useful, ttttt=! but WITHOUT ANY WARRANTY;twithout even the implied wa004nty ef ttttt=! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ttttt=! GNU General Public License for more details. ttttt=! ttttt=! You should have received a copy ef the GNU General Public License ttttt=! and the GNU Lesser General Public License alongtwith PPM. If not, ttttt=! see . ttttt=! ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! ETH Zurich ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD MODULE 2I4)moduletd1ta_fieldsolver tttUSE 2I4)moduletd1ta,ONLY:2I4)kind_single,2I4)kind_double tttPRIVATE0:: 2I4)kind_single,2I4)kind_double ttttt=! FFTW Plans ttttt=INTEGER*8 Plan_fd_sI Plan_fd_d ttttt=INTEGER*8 Plan_slab_fd_sIPlan_slab_fd_d ttttt=INTEGER*8 Plan_fd_c_y, Plan_fd_cc_y ttttt=INTEGER*8 Plan_fd_c_z, Plan_fd_cc_z ttttt=INTEGER*8 Plan_bd_sI Plan_bd_d ttttt=INTEGER*8 Plan_slab_bd_sIPlan_slab_bd_d ttttt=INTEGER*8 Plan_bd_c_y, Plan_bd_cc_y ttttt=INTEGER*8 Plan_bd_c_z, Plan_bd_cc_z ttttt=! MATHKEISAN variablesNfor MathKeisan FFTs ttttt=! workingtstorage ttttt=REAL(2I4)kind_single), KIMENNNoE(:),POINTER0:: table_fd_sI table_bd_s ttttt=REAL(2I4)kind_double), KIMENNNoE(:),POINTER0:: table_fd_dI table_bd_d ttttt=REAL(2I4)kind_single), KIMENNNoE(:),POINTER0:: table_fd_c_y, table_bd_c_y ttttt=REAL(2I4)kind_double), KIMENNNoE(:),POINTER0:: table_fd_cc_y,table_bd_cc_y ttttt=REAL(2I4)kind_single), KIMENNNoE(:),POINTER0:: table_fd_c_z, table_bd_c_z ttttt=REAL(2I4)kind_double), KIMENNNoE(:),POINTER0:: table_fd_cc_z,table_bd_cc_z ttttt=! the size)ef the workingtstorage ttttt=INTEGER, KIMENNNoE(1) &&&&&&&&&&&&:: lda_table, lda_table_y, lda_table_z t=po MODULE 2I4)moduletd1ta_fieldsolver lib2I4numerics-r1036/src/2I4)gm4)march_bkwd.f0000644000175000017500000005411711616214651020124 0upt1, omaromarttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Subroutine)& : 2I4)gm4)march_bkwd ttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttttt=! Center for Fluid Dynamics (DTU) ttttt=! ttttt=! ttttt=! This file1is p1,t ef the Parallel Particle1Mesh Library (PPM). ttttt=! ttttt=! PPM is free software: you can redistribute itNand/or modify ttttt=! itNunder the terms ef the GNU Lesser General Public License ttttt=! as pomlished by the Free Software Found1tiet, either ttttt=! versiet 3 ef the License, or (at your optiet)Nany later ttttt=! versiet. ttttt=! ttttt=! PPM is distributed in the hope that itNwill be useful, ttttt=! but WITHOUT ANY WARRANTY;twithout even the implied wa004nty ef ttttt=! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ttttt=! GNU General Public License for more details. ttttt=! ttttt=! You should have received a copy ef the GNU General Public License ttttt=! and the GNU Lesser General Public License alongtwith PPM. If not, ttttt=! see . ttttt=! ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! ETH Zurich ttttt=! CH-8092 Zurich, Switzerland ttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD 0t,t& KiKIM)RE)Ki2Dt0t,F& KiMEASURE)Kiiiii LL subfftw_, f_mesSUBROUTINE 2I4)gm4)march_bkwd_2ds(fdta,width,order,npos,TMI &tttttt&po,0rhscst,dxinv,dyinv,dzinv,ghostsizettttt,speed,chi),0 st,FFW_MEASURE)KiKlies e,foGNNNoE, f_mesSUBROUTINE 2I4)gm4)march_bkwd_2dd(fdta,width,order,npos,TMI &tttttt&po,0rhscst,dxinv,dyinv,dzinv,ghostsizettttt,speed,chi),0 ppp& ,0 st,FFW_KIM)RE)Ki3Dt0t,F& KiMEASURE)Kiiiii LL subfftw_, f_mesSUBROUTINE 2I4)gm4)march_bkwd_3ds(fdta,width,order,npos,TMI &tttttt&po,0rhscst,dxinv,dyinv,dzinv,ghostsizettttt,speed,chi),0 st,FFW_MEASURE)KiKlies e,foGNNNoE, f_mesSUBROUTINE 2I4)gm4)march_bkwd_3dd(fdta,width,order,npos,TMI &tttttt&po,0rhscst,dxinv,dyinv,dzinv,ghostsizettttt,speed,chi),0 ppp& ,0 ppp&,ttttt=!!! This routine)performs the backwa0d marchingtstep ef the GMM. See,ttttt=!!! 2I4)gm4)march for details. ttttt=!!!,ttttt=!!! =RE)References&=RE ttttt=!!!,ttttt=!!! Chopp:2001, Kim:2001b ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Modules= ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=USE 2I4)moduletd1ta ttttt=USE 2I4)moduletnumericstd1ta ttttt=USE 2I4)moduletd1ta_gm4 ttttt=USE 2I4)modulettypedef ttttt=USE 2I4)moduletcomptart ttttt=USE 2I4)moduletcomptop ttttt=USE 2I4)moduleteble0 ttttt=USE 2I4)moduleta su 1p,'t&USE 2I4)moduletmap_field ttttt=IMPLICIT NONEt0t,F& KiMEASURE)Kiiiii LL subfftw_, f_mesINTEGER, PARAMETER0:: MK =(ttttkind_singlei0 sse 1p,'t&INTEGER, PARAMETER0:: MK =(ttttkind_double 0 ppp&,ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Includes ttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD 0tnclude "ttttdefine.h"t#t,d9f)KiMPI 1p,'t&INCLUDE0'mpif.h' 0 ppp&,ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Argumeslst& ttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD 0t,t& _iKIM)RE)Ki2Dt f_mREAL(MK), KIMENNNoE(:,:,:) f_m, POINTER00000000000000:: fdta,ttttt=!!! 2ointer&to level functiet.t f_mREAL(MK), KIMENNNoE(:,:,:) f_m, INTENT(IN), OPTNoEAL0:: speed,ttttt=!!! rank 4 (3d) or rank 3 (2d) field ef front speeds. ttttt=!!! OPTNoEAL0to override rhscst.t f_mREAL(MK), KIMENNNoE(:,:,:,:) f, INTENT(IN), OPTNoEAL0:: chi,ttttt=!!! rank 5 (3d) or rank 4 (2d) field specifyingtthe positietstef the,ttttt=!!! grid nodes. 1st index: 1..ttttdim, then i,j,[k],icom. ttttt=!!! OPTNoEAL. Uniform grid is assumed if absesl.i0 lt,FKiKIM)RE)Ki3Dt f_mREAL(MK), KIMENNNoE(:,:,:,:) f, POINTER00000000000000:: fdta,ttttt=!!! 2ointer&to level functiet.t f_mREAL(MK), KIMENNNoE(:,:,:,:) f, INTENT(IN), OPTNoEAL0:: speed,ttttt=!!! rank 4 (3d) or rank 3 (2d) field ef front speeds. ttttt=!!! OPTNoEAL0to override rhscst.t f_mREAL(MK), KIMENNNoE(:,:,:,:,:) , INTENT(IN), OPTNoEAL0:: chi,ttttt=!!! rank 5 (3d) or rank 4 (2d) field specifyingtthe positietstef the,ttttt=!!! grid nodes. 1st index: 1..ttttdim, then i,j,[k],icom. ttttt=!!! OPTNoEAL. Uniform grid is assumed if absesl.i0 ppp&,ttttt=REAL(MK) , INTENT(IN )0000:: width ttttt=!!! Width ef the na00ow band to be produced et each side ef the interface.t f_mREAL(MK) , INTENT(IN )0000:: rhscst ttttt=!!! cetst4nt value for the right hand side ef grad u * grad f =(c. ttttt=!!! If speed1is presesl, this argumeslNwill be ignored.t f_mREAL(MK) , INTENT(IN )0000:: TM,ttttt=!!! CurreslNthreshold for wave front suatiet.t f_mREAL(MK) , INTENT(IN )0000:: dxinv,ttttt=!!! inverse ef the x grid spacing.t f_mREAL(MK) , INTENT(IN )0000:: dyinv,ttttt=!!! inverse ef the y grid spacing.t f_mREAL(MK) , INTENT(IN )0000:: dzinv,ttttt=!!! inverse ef the z grid spacing. (Not used in 2D versiet). ttttt=INTEGER, KIMENNNoE(3) , INTENT(IN )0000:: ghostsize,ttttt=!!! Size)ef the ghostlayer&et a s sides. ttttt=INTEGER , INTENT(IN )0000:: order ttttt=!!! Order)ef the method to be used. One)ef ttttt=!!!,ttttt=!!! *ttttparam_order_1,ttttt=!!! *ttttparam_order_2,ttttt=!!! *ttttparam_order_3 ttttt=INTEGER , INTENT(INOUT)0000:: npos,ttttt=!!! CurreslNnumber)ef 2oints in the closetset. ttttt=INTEGER , INTENT( OUT)0000:: tttt,ttttt=!!! Returt st4tus, 0 upet success ttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttt=N&! Lual variablesN ttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttt=N&INTEGER 00:: t,j,k,p,xhi,yhi,zhi,it,jj,kk ttt=N&INTEGER 00:: jcom,icom ttt=N&INTEGER 00:: t1,i2,i3 ttttt=INTEGER, KIMENNNoE(-3:3) :: sx,sy,szt f_mREAL(MK) :: t0,onethird,onetwelfth ttttt=REAL(MK) :: dxihalf,dyihalf,dzihalf ttttt=REAL(MK) :: dxitwelve,dyitwelve,dzitwelve ttttt=REAL(MK) :: valijk,det,hsave,fdta0 ttttt=REAL(MK) :: lmyeps,ainv,big,absfdta0 ttttt=REAL(MK), KIMENNNoE(3) 0:: coefs,gphi,ttttt=REAL(MK), KIMENNNoE(3,3) :: jac,ji,ttttt=REAL(MK), KIMENNNoE(-3:3,ttttdim):: 2hi,psi,ttttt=REAL(MK), KIMENNNoE(ttttdim) :: alpha,beta,ttttt=REAL(MK), KIMENNNoE(2) 0:: roots ttt=N&TYPE(ttttt_topo), POINTER00000000:: topo ttt=N&TYPE(ttttt_equi_mesh), POINTER000:: mesh ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD tttt=&! ExternalsN ttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttt=N&,ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! In::i1lise ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=h%Nm(compt1,t('2I4)gm4)march_bkwd It0ttttttt1p,'t&2hi1p,'t&= 0.0_MKi psi1p,'t&= 0.0_MKi big1p,'t&= HUGE(bigtt1p,'t&hsave,'t&= 0.9_MK*bigt1p,'t&onethird =(1.0_MK/3.0_MKi topo =>(tttttopo(gm4)topoid)%t ttttt=mesh =>(topo%mesh(gm4)meshid) 0t,t& _iMEASURE)Kiiiii LL subfftw_, f_meslmyeps't&= 2I4)myepssi0 sse 1p,'t&lmyeps't&= 2I4)myepsdi0 ppp&,ttttt=dxihalft&= 0.5_MK*dxinv,ttttt=dyihalft&= 0.5_MK*dyinv,ttttt=dxitwelvet&= onetwelfth*dxinv,ttttt=dyitwelvet&= onetwelfth*dyinv,0t,t& _iKIM)RE)Ki3Dt f_mdzihalft&= 0.5_MK*dzinv,ttttt=dzitwelvet&= onetwelfth*dzinv,0 ppp& ,ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Check argumesls ttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttt=N&IF (ttttdebug .GT. 0M/2+1K ttt=N&t=N&IF (width .LT. 0.0_MKM/2+1K ttt=N&t=N&&&&&tttt&= 2I4)eble0teble0 ttttt=========h%Nm(tttteble0(ttttebl_ttttnoinit,'2I4)gm4)march_bkwd I &tttttt&po,000000000'width must be positive!',__LINE__ttttttt1p,'t& GOTO d_dot1p,'t& =poI0,ttttt=N&&&IF ((order.NE.ttttparam_order_1).AND.(order.NE.ttttparam_order_2) &tttttt&po,000000.AND.(order.NE.ttttparam_order_3)M/2+1K ttt=N&t=N&&&&&tttt&= 2I4)eble0teble0 ttttt=========h%Nm(tttteble0(ttttebl_ttttnoinit,'2I4)gm4)march_bkwd I &tttttt&po,000000000'order must be 1, 2, or 3!',__LINE__ttttttt1p,'t& GOTO d_dot1p,'t& =poI0,ttttt==poI01p,'t& ! 2I4)debug for argumeslNcheck,0t,t& _iKIM)RE)Ki3Dt f_m!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Reverse erder: recompute neighbors)ef 2oints in ggm_ipos,ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=DO p=npos,1,-1t1p,'t& ii1p,= gm4)ipos(1,ptt1p,'t& jj1p,= gm4)ipos(2,ptt1p,'t& kk1p,= gm4)ipos(3,ptt1p,'t& jcom,= gm4)ipos(4,ptt1p,'t& icom,= topo%icomlist(jcomtt1p,'t& xhi1p==mesh%nnodes(1,icomtt1p,'t& yhi1p==mesh%nnodes(2,icomtt1p,'t& zhi1p==mesh%nnodes(3,icomtt1p,'t& fdta0= fdta(it,jj,kk,jcomtt1p,'t& absfdta0 = fdta0,ttttt=N&&&IF (absfdta0 .LT. 0.0_MKM/absfdta0 = -absfdta0 ttttt=ttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD ttttt=ttt=! GMM update coppptiet (see Kim:2001a) ttttt=ttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD ttttt=ttt=IF (.NOT.(absfdta0.GT.TM)M/2+1K ttt=N&t=N&&&&&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride, ttttt=N&t=ttt=! Recompute non-accepted closetneighbors ttt=N&t=N&&&&&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride, ttttt=N&t=ttt=i = ii1- 1 ttttt=N&t=ttt=j = jj ttttt=N&t=ttt=k = kk ttt=N&ttt=ttt=IF (i.GT.0M/2+1K ttt=N&t=N&ttt=ttt=IF ((gm4)st4te3d(i,j,k,jcomt .NE.t=ttt=&tttttt&po,00000000000002I4)gm4)param_accepted)0.AND.t=ttt=&tttttt&po,0000000000000(ABS(fdta(i,j,k,jcomt).GT.absfdta0)M/2+1K ttt=N&t=N&&&&&t=N&&&&&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MB ttt=N&t=N&&&&&t=N&&&&&p Update 2oint t,j,k ttt=N&t=N&&&&&t=N&&&&&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MB 0tnclude "ttttgm4)slvupwnd.tnc" ttt=N&t=N&&&&&t=N&&&&&IF (ABS(valijk).LT.ABS(fdta(i,j,k,jcomt)M/2+1K ttt=N&t=N&&&&&t=N&&&&&&&&&IF ((valijk*fdta(i,j,k,jcomt.GE.0.0_MKM/.OR.tt=&tttttt&po,000000000000000000000(fdta(i,j,k,jcomt.GT.hsave)M/2+1K&t fdta(i,j,k,jcomt = valijk&t =poI0,ttttt=N&&& =poI0,ttttt=N&&& =poI0,ttttt=N&&& =poI0,ttttt=N&&& i = ii1+ 1 ttttt=N&t=ttt=j = jj ttttt=N&t=ttt=k = kk ttt=N&ttt=ttt=IF (i.LE.xhiM/2+1K ttt=N&t=N&ttt=ttt=IF ((gm4)st4te3d(i,j,k,jcomt .NE.t=ttt=&tttttt&po,00000000000002I4)gm4)param_accepted)0.AND.t=ttt=&tttttt&po,0000000000000(ABS(fdta(i,j,k,jcomt).GT.absfdta0)M/2+1K ttt=N&t=N&&&&&t=N&&&&&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MB ttt=N&t=N&&&&&t=N&&&&&p Update 2oint t,j,k ttt=N&t=N&&&&&t=N&&&&&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MB 0tnclude "ttttgm4)slvupwnd.tnc" ttt=N&t=N&&&&&t=N&&&&&IF (ABS(valijk).LT.ABS(fdta(i,j,k,jcomt)M/2+1K ttt=N&t=N&&&&&t=N&&&N&&&&&IF ((valijk*fdta(i,j,k,jcomt.GE.0.0_MKM/.OR.tt=&tttttt&po,000000000000000000000(fdta(i,j,k,jcomt.GT.hsave)M/2+1K&t fdta(i,j,k,jcomt = valijk&t =poI0,ttttt=N&&& =poI0,ttttt=N&&& =poI0,ttttt=N =poI0,ttttt=N i = ii ttttt=N&t=ttt=j = jj1- 1&t k = kk ttt=N&ttt=ttt=IF (j.GT.0M/2+1K ttt=N&t=N&ttt=ttt=IF ((gm4)st4te3d(i,j,k,jcomt .NE.t=ttt=&tttttt&po,00000000000002I4)gm4)param_accepted)0.AND.t=ttt=&tttttt&po,0000000000000(ABS(fdta(i,j,k,jcomt).GT.absfdta0)M/2+1K ttt=N&t=N&&&&&t=N&&&&&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MB ttt=N&t=N&&&&&t=N&&&&&p Update 2oint t,j,k ttt=N&t=N&&&&&t=N&&&&&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MB 0tnclude "ttttgm4)slvupwnd.tnc" ttt=N&t=N&&&&&t=N&&&&&IF (ABS(valijk).LT.ABS(fdta(i,j,k,jcomt)M/2+1K ttt=N&t=N&&&&&t&&&t=N&&&&&IF ((valijk*fdta(i,j,k,jcomt.GE.0.0_MKM/.OR.tt=&tttttt&po,000000000000000000000(fdta(i,j,k,jcomt.GT.hsave)M/2+1K&t fdta(i,j,k,jcomt = valijk&t =poI0,ttttt=N&&& =poI0,ttttt=N&&& =poI0,ttttt=N =poI0,ttttt=N i = ii ttttt=N&t=ttt=j = jj1+ 1&t k = kk ttt=N&ttt=ttt=IF (j.LE.yhiM/2+1K ttt=N&t=N&ttt=ttt=IF ((gm4)st4te3d(i,j,k,jcomt .NE.t=ttt=&tttttt&po,00000000000002I4)gm4)param_accepted)0.AND.t=ttt=&tttttt&po,0000000000000(ABS(fdta(i,j,k,jcomt).GT.absfdta0)M/2+1K ttt=N&t=N&&&&&t=N&&&&&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MB ttt=N&t=N&&&&&t=N&&&&&p Update 2oint t,j,k ttt=N&t=N&&&&&t=N&&&&&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MB 0tnclude "ttttgm4)slvupwnd.tnc" ttt=N&t=N&&&&&t=N&&&&&IF (ABS(valijk).LT.ABS(fdta(i,j,k,jcomt)M/2+1K ttt=N&t=N&&&&&t&&&t=N&&&&&IF ((valijk*fdta(i,j,k,jcomt.GE.0.0_MKM/.OR.tt=&tttttt&po,000000000000000000000(fdta(i,j,k,jcomt.GT.hsave)M/2+1K&t fdta(i,j,k,jcomt = valijk&t =poI0,ttttt=N&&& =poI0,ttttt=N&&& =poI0,ttttt=N =poI0,ttttt=N i = ii ttttt=N&t=ttt=j = jj1t k = kk1- 1 ttttt=N&t=ttt=IF (k.GT.0M/2+1K ttt=N&t=N&ttt=ttt=IF ((gm4)st4te3d(i,j,k,jcomt .NE.t=ttt=&tttttt&po,00000000000002I4)gm4)param_accepted)0.AND.t=ttt=&tttttt&po,0000000000000(ABS(fdta(i,j,k,jcomt).GT.absfdta0)M/2+1K ttt=N&t=N&&&&&t=N&&&&&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MB ttt=N&t=N&&&&&t=N&&&&&p Update 2oint t,j,k ttt=N&t=N&&&&&t=N&&&&&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MB 0tnclude "ttttgm4)slvupwnd.tnc" ttt=N&t=N&&&&&t=N&&&&&IF (ABS(valijk).LT.ABS(fdta(i,j,k,jcomt)M/2+1K ttt=N&t=N&&&&&t&&&t=N&&&&&IF ((valijk*fdta(i,j,k,jcomt.GE.0.0_MKM/.OR.tt=&tttttt&po,000000000000000000000(fdta(i,j,k,jcomt.GT.hsave)M/2+1K&t fdta(i,j,k,jcomt = valijk&t =poI0,ttttt=N&&& =poI0,ttttt=N&&& =poI0,ttttt=N =poI0,ttttt=N i = ii ttttt=N&t=ttt=j = jj1t k = kk1+ 1 ttttt=N&t=ttt=IF (k.LE.zhiM/2+1K ttt=N&t=N&ttt=ttt=IF ((gm4)st4te3d(i,j,k,jcomt .NE.t=ttt=&tttttt&po,00000000000002I4)gm4)param_accepted)0.AND.t=ttt=&tttttt&po,0000000000000(ABS(fdta(i,j,k,jcomt).GT.absfdta0)M/2+1K ttt=N&t=N&&&&&t=N&&&&&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MB ttt=N&t=N&&&&&t=N&&&&&p Update 2oint t,j,k ttt=N&t=N&&&&&t=N&&&&&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MB 0tnclude "ttttgm4)slvupwnd.tnc" ttt=N&t=N&&&&&t=N&&&&&IF (ABS(valijk).LT.ABS(fdta(i,j,k,jcomt)M/2+1K ttt=N&t=N&&&&&t&&&t=N&&&&&IF ((valijk*fdta(i,j,k,jcomt.GE.0.0_MKM/.OR.tt=&tttttt&po,000000000000000000000(fdta(i,j,k,jcomt.GT.hsave)M/2+1K&t fdta(i,j,k,jcomt = valijk&t =poI0,ttttt=N&&& =poI0,ttttt=N&&& =poI0,ttttt=N =poI0,ttttt=N =poI01p,'t& =! TT .LE. TM,ttttt==poDO,'t& =! p=npos,1,-1t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Update ghost layersNfor fdta,ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=h%Nm(ttttmap_field_push(gm4)topoid,gm4)meshid,fdtattttttt1p,'t&IF (ittt&.NE.tttttparam_successM/2+1K ttt=N&t=N&tttt&= 2I4)eble0teble0 ttttt=====h%Nm(tttteble0(ttttebl_com_failed,'2I4)gm4)march I &tttttt&po,00000'pushingtfield d1ta failed',__LINE__ttttttt1p,'t& GOTO d_dot1p,'t&=poI0,ttttt=h%Nm(ttttmap_field_send(tttttt1p,'t&IF (ittt&.NE.tttttparam_successM/2+1K ttt=N&t=N&tttt&= 2I4)eble0teble0 ttttt=====h%Nm(tttteble0(ttttebl_com_failed,'2I4)gm4)march I &tttttt&po,00000'sendingtghosts failed',__LINE__ttttttt1p,'t& GOTO d_dot1p,'t&=poI0,ttttt=h%Nm(ttttmap_field_pop(gm4)topoid,gm4)meshid,fdtatghostsizettttttt1p,'t&IF (ittt&.NE.tttttparam_successM/2+1K ttt=N&t=N&tttt&= 2I4)eble0teble0 ttttt=====h%Nm(tttteble0(ttttebl_com_failed,'2I4)gm4)march I &tttttt&po,00000'poppingtfield d1ta failed',__LINE__ttttttt1p,'t& GOTO d_dot1p,'t&=poI0,0 lt,FKiKIM)RE)Ki2Dt f_m!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Reverse erder: recompute neighbors)ef 2oints in ggm_ipos,ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=DO p=npos,1,-1t1p,'t& ii1p,= gm4)ipos(1,ptt1p,'t& jj1p,= gm4)ipos(2,ptt1p,'t& jcom,= gm4)ipos(3,ptt1p,'t& icom,= topo%icomlist(jcomtt1p,'t& xhi1p==mesh%nnodes(1,icomtt1p,'t& yhi1p==mesh%nnodes(2,icomtt1p,'t& fdta0= fdta(it,jj,jcomtt1p,'t& absfdta0 = fdta0,ttttt=N&&&IF (absfdta0 .LT. 0.0_MKM/absfdta0 = -absfdta0 ttttt=ttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD ttttt=ttt=! GMM update coppptiet (see Kim:2001a) ttttt=ttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD ttttt=ttt=IF (.NOT.(absfdta0.GT.TM)M/2+1K ttt=N&t=N&&&&&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride, ttttt=N&t=ttt=! Recompute non-accepted closetneighbors ttt=N&t=N&&&&&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride, ttttt=N&t& i = ii1- 1 ttttt=N&t=ttt=j = jj ttttt=N&t=ttt=IF (i.GT.0M/2+1K ttt=N&t=N&ttt=ttt=IF ((gm4)st4te2d(i,j,jcomt .NE.t=ttt=&tttttt&po,00000000000002I4)gm4)param_accepted)0.AND.t=ttt=&tttttt&po,0000000000000(ABS(fdta(i,j,jcomt).GT.absfdta0)M/2+1K ttt=N&t=N&&&&&t=N&&&&&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MB ttt=N&t=N&&&&&t=N&&&&&p Update 2oint t,j ttt=N&t=N&&&&&t=N&&&&&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MB 0tnclude "ttttgm4)slvupwnd.tnc" ttt=N&t=N&&&&&t=N&&&&&IF (ABS(valijk).LT.ABS(fdta(i,j,jcomt)M/2+1K ttt=N&t=N&&&&&t&&&t=N&&&&&IF ((valijk*fdta(i,j,jcomt.GE.0.0_MKM/.OR.tt=&tttttt&po,000000000000000000000(fdta(i,j,jcomt.GT.hsave)M/2+1K&t fdta(i,j,jcomt = valijk&t =poI0,ttttt=N&&& =poI0,ttttt=N&&& =poI0,ttttt=N =poI0,ttttt=N i = ii1+ 1 ttttt=N&t=ttt=j = jj ttttt=N&t=ttt=IF (i.LE.xhiM/2+1K ttt=N&t=N&ttt=ttt=IF ((gm4)st4te2d(i,j,jcomt .NE.t=ttt=&tttttt&po,00000000000002I4)gm4)param_accepted)0.AND.t=ttt=&tttttt&po,0000000000000(ABS(fdta(i,j,jcomt).GT.absfdta0)M/2+1K ttt=N&t=N&&&&&t=N&&&&&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MB ttt=N&t=N&&&&&t=N&&&&&p Update 2oint t,j ttt=N&t=N&&&&&t=N&&&&&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MB 0tnclude "ttttgm4)slvupwnd.tnc" ttt=N&t=N&&&&&t=N&&&&&IF (ABS(valijk).LT.ABS(fdta(i,j,jcomt)M/2+1K ttt=N&t=N&&&&&t&&&t=N&&&&&IF ((valijk*fdta(i,j,jcomt.GE.0.0_MKM/.OR.tt=&tttttt&po,000000000000000000000(fdta(i,j,jcomt.GT.hsave)M/2+1K&t fdta(i,j,jcomt = valijk&t =poI0,ttttt=N&&& =poI0,ttttt=N&&& =poI0,ttttt=N =poI0,ttttt=N i = ii ttttt=N&t=ttt=j = jj1- 1&t IF (j.GT.0M/2+1K ttt=N&t=N&ttt=ttt=IF ((gm4)st4te2d(i,j,jcomt .NE.t=ttt=&tttttt&po,00000000000002I4)gm4)param_accepted)0.AND.t=ttt=&tttttt&po,0000000000000(ABS(fdta(i,j,jcomt).GT.absfdta0)M/2+1K ttt=N&t=N&&&&&t=N&&&&&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MB ttt=N&t=N&&&&&t=N&&&&&p Update 2oint t,j ttt=N&t=N&&&&&t=N&&&&&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MB 0tnclude "ttttgm4)slvupwnd.tnc" ttt=N&t=N&&&&&t=N&&&&&IF (ABS(valijk).LT.ABS(fdta(i,j,jcomt)M/2+1K ttt=N&t=N&&&&&t&&&t=N&&&&&IF ((valijk*fdta(i,j,jcomt.GE.0.0_MKM/.OR.tt=&tttttt&po,000000000000000000000(fdta(i,j,jcomt.GT.hsave)M/2+1K&t fdta(i,j,jcomt = valijk&t =poI0,ttttt=N&&& =poI0,ttttt=N&&& =poI0,ttttt=N =poI0,ttttt=N i = ii ttttt=N&ttttttj = jj1+ 1&t IF (j.LE.yhiM/2+1K ttt=N&t=N&ttt=ttt=IF ((gm4)st4te2d(i,j,jcomt .NE.t=ttt=&tttttt&po,00000000000002I4)gm4)param_accepted)0.AND.t=ttt=&tttttt&po,0000000000000(ABS(fdta(i,j,jcomt).GT.absfdta0)M/2+1K ttt=N&t=N&&&&&t=N&&&&&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MB ttt=N&t=N&&&&&t=N&&&&&p Update 2oint t,j ttt=N&t=N&&&&&t=N&&&&&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MB 0tnclude "ttttgm4)slvupwnd.tnc" ttt=N&t=N&&&&&t=N&&&&&IF (ABS(valijk).LT.ABS(fdta(i,j,jcomt)M/2+1K ttt=N&t=N&&&&&t&&&t=N&&&&&IF ((valijk*fdta(i,j,jcomt.GE.0.0_MKM/.OR.tt=&tttttt&po,000000000000000000000(fdta(i,j,jcomt.GT.hsave)M/2+1K&t fdta(i,j,jcomt = valijk&t =poI0,ttttt=N&&& =poI0,ttttt=N&&& =poI0,ttttt=N =poI0,ttttt=N =poI01p,'t& =! TT .LE. TM,ttttt==poDO,'t& =! p=npos,1,-1t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Update ghost layersNfor fdta,ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=h%Nm(ttttmap_field_push(gm4)topoid,gm4)meshid,fdtattttttt1p,'t&IF (ittt&.NE.tttttparam_successM/2+1K ttt=N&t=N&tttt&= 2I4)eble0teble0 ttttt=====h%Nm(tttteble0(ttttebl_com_failed,'2I4)gm4)march I &tttttt&po,00000'pushingtfield d1ta failed',__LINE__ttttttt1p,,,,,,,,GOTO d_dot1p,'t&=poI0,ttttt=h%Nm(ttttmap_field_send(tttttt1p,'t&IF (ittt&.NE.tttttparam_successM/2+1K ttt=N&t=N&tttt&= 2I4)eble0teble0 ttttt=====h%Nm(tttteble0(ttttebl_com_failed,'2I4)gm4)march I &tttttt&po,00000'sendingtghosts failed',__LINE__ttttttt1p,'t&,,,,GOTO d_dot1p,'t&=poI0,ttttt=h%Nm(ttttmap_field_pop(gm4)topoid,gm4)meshid,fdtatghostsizettttttt1p,'t&IF (ittt&.NE.tttttparam_successM/2+1K ttt=N&t=N&tttt&= 2I4)eble0teble0 ttttt=====h%Nm(tttteble0(ttttebl_com_failed,'2I4)gm4)march I &tttttt&po,00000'poppingtfield d1ta failed',__LINE__ttttttt1p,'t& GOTO d_dot1p,'t&=poI0,0 ppp& ,ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Returt ,ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD td_do=CONTINUE,ttttt=h%Nm(comptop('2I4)gm4)march_bkwd It0ttttttt1p,'t&RETURN 0t,t& KiKIM)RE)Ki2Dt0t,F& KiMEASURE)Kiiiii LL subfftw_, f_mes=po SUBROUTINE 2I4)gm4)march_bkwd_2ds,0 st,FFW_MEASURE)KiKlies e,foGNNNoE, f_mes=po SUBROUTINE 2I4)gm4)march_bkwd_2dd,0 ppp& ,0 st,FFW_KIM)RE)Ki3Dt0t,F& KiMEASURE)Kiiiii LL subfftw_, f_mes=po SUBROUTINE 2I4)gm4)march_bkwd_3ds,0 st,FFW_MEASURE)KiKlies e,foGNNNoE, f_mes=po SUBROUTINE 2I4)gm4)march_bkwd_3dd,0 ppp& ,0 ppp&,lib2I4numerics-r1036/src/2I4)ode_pt1,t.f0000644000175000017500000001307711616214651017147 0upt1, omaromarttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Subroutine)& : 2I4)ode_pt1,t,ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! ttttt=! Purposet't& : (re)pt1,ts the ode solver ttt=N&p ttttt=! Input : ttttt=! ttttt=! Output : tttt 00(I) returt st4tus ttttt=! ttttt=! Remarkst't& : ttttt=! ttttt=! References& : ttttt=! ttttt=! Revisietst& : ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! $Log: 2I4)ode_pt1,t.f,v $ ttttt=! Revisiet 1.1.1.1 2007/07/13 10:19:01 ivos ttttt=! CBL versiet of the PPM library ttttt=! ttttt=! Revisiet 1.8 2005/08/05 09:24:49 ivos ttttt=! restored corrected subroutine)name.t f_m! ttttt=! Revisiet 1.7 2005/08/05 09:23:49 ivos ttttt=! Restored STS stuff from dom.t f_m! ttttt=! Revisiet 1.5 2004/07/26 13:49:19 ivos ttttt=! Removed Routines sectietstfrom the header commesl.i f_m! ttttt=! Revisiet 1.4 2004/07/26 11:33:04 michaebe ttttt=! ttserted the use ef the 2I4 ode d1ta module.i f_m! ttttt=! Revisiet 1.3 2004/07/26 07:53:25 michaebe ttttt=! Atomized. Inserted 2I4)initNcheck. Otherwise noNchanges. ttttt=! ttttt=! Revisiet 1.2 2004/06/10 16:20:04 ivos ttttt=! Moved a s cpp directtives&to columt 1. The NEC cpp did not recognize,ttttt=! the4 otherwise!!!,ttttt=! ttttt=! Revisiet 1.1 2004/02/19 08:33:57 michaebe ttttt=! tt::i1l implemesl1tiet. ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttttt=! Center for Fluid Dynamics (DTU) ttttt=! ttttt=! ttttt=! This file1is p1,t ef the Parallel Particle1Mesh Library (PPM). ttttt=! ttttt=! PPM is free software: you can redistribute itNand/or modify ttttt=! itNunder the terms ef the GNU Lesser General Public License ttttt=! as pomlished by the Free Software Found1tiet, either ttttt=! versiet 3 ef the License, or (at your optiet)Nany later ttttt=! versiet. ttttt=! ttttt=! PPM is distributed in the hope that itNwill be useful, ttttt=! but WITHOUT ANY WARRANTY;twithout even the implied wa004nty ef ttttt=! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ttttt=! GNU General Public License for more details. ttttt=! ttttt=! You should have received a copy ef the GNU General Public License ttttt=! and the GNU Lesser General Public License alongtwith PPM. If not, ttttt=! see . ttttt=! ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! ETH Zurich ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=SUBROUTINE 2I4)ode_pt1,t(tttttt1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=! Includes ttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- 0tnclude "ttttdefine.h"t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=! Modulest1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=USE 2I4)moduletd1ta_ode ttttt=USE 2I4)moduletd1ta ttttt=USE 2I4)moduletcomptart ttttt=USE 2I4)moduletcomptop ttttt=USE 2I4)moduleteble0 ttttt=USE 2I4)moduleta su 1p,'t&IMPLICIT NONEt1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=! Argumesls ttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- 1p,'t&INTEGER, INTENT( out)0:: tttt,ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- 1p,'t&! Lual Variables ttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- 1p,'t&INTEGER :: mid ttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- 1p,'t&! ca s somptart ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- 1p,'t&h%Nm(compt1,t('2I4)ode_pt1,t It0ttttttt1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- 1p,'t&! check stuff ttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- 1p,'t&IF(ttttdebug.GT.0M/2+1K ttt=N&t=NIF(.NOT.2I4)initi1lized)02+1K ttt=N&t=N&&&tttt&= 2I4)eble0teble0 ttttt=======h%Nm(tttteble0(ttttebl_ttttnoinit,'2I4)ode_pt1,t I&tttttt&p'Please ca s 2I4)initNfirst!',__LINE__ttttttt1p,'t& GOTO d_dot1p,'t& =po I0,ttttt==po I0,ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- 1p,'t&! check if everybody is ready&to run,ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- 1p,'t&DO mid=1,ttttmax_mid ttt=N&'t&IF(ttttode_pt1te(mid).NE.ttttode_pt1te)inited)02+1K ttt=N&t=N&&&IF(ttttode_pt1te(mid).NE.ttttode_pt1te)finishedM/2+1K ttt=N&t=N&&&&&ttttt&= 2I4)eble0teble0 ttttt==========h%Nm(tttteble0(ttttebl_notready,'2I4)ode_pt1,t I &ttttttttttttttttttttt'some ODEs not ready',__LINE__ttttttt1p,'t& GOTO d_dot1p,'t& t==po I0,ttttt= =po I0,ttttt==po DO,ttttt= !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- 1p,'t&t&! yes, sotset the4 into kickoff st4te,ttttt= !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- 1p,'t&t&DO mid=1,ttttmax_mid ttt=N&'t& 2I4)ode_pt1te(mid)&= 2I4)ode_pt1te)kickoff ttt=N&'t=po DO,d_do====hONTINUEttt=N&'t,ttttt= !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- 1p,'t&t&! comptop ttttt= !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- 1p,'t&t&h%Nm(comptop('2I4)ode_pt1,t It0ttttttt1p,'t&t&RETURN t=N&'t=po SUBROUTINE 2I4)ode_pt1,t,lib2I4numerics-r1036/src/2I4)gm4)quasinewtet.tnc0000644000175000017500000003205511616214651020721 0upt1, omaromarttt= !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- ttttt=! Include file1for the quasi-Newtet iter1tiet in the initi1liz1tiet ttttt=! ef the high-order marchingtmethod. ttttt=! ttttt=! INPUT: t=REAL(MK), KIMENNNoE(2 or 3)0:: x0 -- pt1,t value ttttt=! OUTPUT: tREAL(MK) :: sprod -- new distance&to interface ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! $Log: 2I4)gm4)quasinewtet.tnc,v $ ttttt=! Revisiet 1.1.1.1 2007/07/13 10:18:55 ivos ttttt=! CBL versiet of the PPM library ttttt=! ttttt=! Revisiet 1.6 2005/07/14 19:58:15 ivos ttttt=! Added OPTNoEAL0argumeslNchi for mesh node positietstin distorted ttttt=! (mappedM/meshes. For use with AGM for example.t f_m! ttttt=! Revisiet 1.5 2005/05/24 23:21:55 ivos ttttt=! Commesled eut the convergence wa0ningtas I think this can naturally ttttt=! eccurtin under-resolved regiets...i f_m! ttttt=! Revisiet 1.4 2005/05/10 04:48:46 ivos ttttt=! SplitNmarchingtand extensiet routines for faster compil1tiet, ttttt=! Sharked extensiet routines, moved a s initi1liz1tiet&to gm4)init, and ttt=N&! code cosmetics.i f_m! ttttt=! Revisiet 1.3 2005/04/21 04:53:27 ivos ttttt=! If convergence fails, an eble0/message1is now produced, r1ther ttt=N&p than returtingtHUGE. The l1tter could go undetected and produce ttt=N&p funny results downstream...i f_m! ttttt=! Revisiet 1.2 2005/03/11 04:20:13 ivos ttttt=! Removed debug output.i f_m! ttttt=! Revisiet 1.1 2005/03/10 01:37:19 ivos ttttt=! In::i1l check-in. BEWARE: Not tested in parallel yet! ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! Institute of Comput1tiet1l Science ttttt=! ETH Zeslrum, Hirschengraben 84 ttttt=! CH-8092 Zurich, Switzerland ttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD 0t,t& _iKIM)RE)Ki3Dt f_mxk1p,= x0 ttttt=eblp,= bigt1p,'t&tol2,= tol*tolt1p,'t&nitN&= 0 1p,'t&DO WHILE ((ebl.GT.tol2).AND.(nit.LT.40)) ttttt=ttt=! interpol1tiet polynomi1l and its gradieslNatmxk ttttt=ttt=! This is a stupid way&to evaluate the ttttt=ttt=! polynomi1l, but I could not find a better ttttt=ttt=! one immediately...i f_m f_mxv(1)&= xk(1)i f_m f_mxv(2)&= xk(1)*xk(1)i f_m f_mxv(3)&= xv(2)*xk(1)i f_m f_myv(1)&= xk(2)i f_m f_myv(2)&= xk(2)*xk(2)i f_m f_myv(3)&= yv(2)*xk(2)i f_m f_mzv(1)&= xk(3)i f_m f_mzv(2)&= xk(3)*xk(3)i f_m f_mzv(3)&= zv(2)*xk(3)i f_m f_mgxv(2)&= 2.0_MK*xk(1)i f_m f_mgxv(3)&= 3.0_MK*xv(2)i f_m f_mgyv(2)&= 2.0_MK*xk(2)i f_m f_mgyv(3)&= 3.0_MK*yv(2)i f_m f_mgzv(2)&= 2.0_MK*xk(3)i f_m f_mgzv(3)&= 3.0_MK*zv(2)i f_m f_mpxk&= 0.0_MKi f_mgradpxk&= 0.0_MKi f_mDO p=0,3i f_m f_mDO n=0,3i f_m f_m f_mDO m=0,3i f_m f_m f_mmmmmind = 16*p+4*n+m+1 ttttt=N&t=ttt= f_m f_mpxk&= pxk+coef(ind)*xv(m)*yv(n)*zv(ptt1p,'t& f_mgradpxk(1)&= gradpxk(1)&+ t=&tttttt&po,00000000000000000(coef(ind)*gxv(m)*yv(n)*zv(pttt1p,'t& f_mgradpxk(2)&= gradpxk(2)&+ t=&tttttt&po,00000000000000000(coef(ind)*xv(m)*gyv(n)*zv(pttt1p,'t& f_mgradpxk(3)&= gradpxk(3)&+ t=&tttttt&po,00000000000000000(coef(ind)*xv(m)*yv(n)*gzv(pttt1p,'t& =poDO t& =poDO t& =poDO t& ! equatiet (3.4) in Chopp:2001 t& nrm2 = f_mgradpxk(1)*gradpxk(1) t& nrm2 = nrm2 + (gradpxk(2)*gradpxk(2)) t& nrm2 = nrm2 + (gradpxk(3)*gradpxk(3)) t& nrm2 = 1.0_MK/nrm2 t& delta1(1)&= -pxk*gradpxk(1)*nrm2 t& delta1(2)&= -pxk*gradpxk(2)*nrm2 t& delta1(3)&= -pxk*gradpxk(3)*nrm2 t& eblp, = f_delta1(1)*delta1(1) t& eblp, = eblp+ (delta1(2)*delta1(2)) t& eblp, = eblp+ (delta1(3)*delta1(3)) ttttt=ttt=! equatiet (3.5) in Chopp:2001 t& xkhalf(1)&= xk(1)p+ delta1(1) t& xkhalf(2)&= xk(2)p+ delta1(2) t& xkhalf(3)&= xk(3)p+ delta1(3) ttttt=ttt=! equatiet (3.6) in Chopp:2001 t& x0mxk(1)p,= x0(1)-xk(1)i f_m f_mx0mxk(2)p,= x0(2)-xk(2)i f_m f_mx0mxk(3)p,= x0(3)-xk(3) ttttt=ttt=sprod = f_ x0mxk(1)*gradpxk(1) t& sprod = sprod + (x0mxk(2)*gradpxk(2)) t& sprod = sprod + (x0mxk(3)*gradpxk(3)) t& nrm2 = nrm2*sprod t& delta2(1)&= x0mxk(1)p- nrm2*gradpxk(1) t& delta2(2)&= x0mxk(2)p- nrm2*gradpxk(2) t& delta2(3)&= x0mxk(3)p- nrm2*gradpxk(3) t& eblp, = eblp+ (delta2(1)*delta2(1)) t& eblp, = eblp+ (delta2(2)*delta2(2)) t& eblp, = eblp+ (delta2(3)*delta2(3)) ttttt=ttt=! equatiet (3.7) in Chopp:2001 t& xk(1)p, = xkhalf(1)&+ delta2(1) t& xk(2)p, = xkhalf(2)&+ delta2(2) t& xk(3) = xkhalf(3)&+ delta2(3) t& nit = nit + 1 ttttt==poDO t& IF (nit .GT. 39M/2+1K ttt=N&t=N&! did not converge t=N&! tttt&= 2I4)eble0twa0ning t=N&! h%Nm(tttteble0(ttttebl_converge, &ttttt!&po,00000'pI4)gm4)kickoff', &ttttt!&po,00000'WARNING: Tolerance¬ reached!'&ttttt!&po,00000,__LINE__ttttttt1p,'! tttt&= 2I4)param_success t& sprod = bigt1p,'t&ELSE ttt=N&t=N&! distance&to the interface in real ttt=N&t=N&! coordinates ttttt=ttt=IF (PRESENT(chi)M/2+1K ttt=N&t=N&&&&&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride, ttttt=N&t=ttt=! Maptthe point to physial space usingttrilinea0 ttttt=========! ttterpol1tiet ef the mapt(AGM uses linea0 basis functietstt1p,'t& pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride, ttttt=N&t=ttt=xi(1)&= 1.0_MK-xk(1)i f_m f_mttt=xi(2)&= 1.0_MK-xk(2)i f_m f_mttt=xi(3)&= 1.0_MK-xk(3)i f_m f_mttt=ch(1)&= chi(1,i00,j00,k00,jcomtt1p,'t& ttt=ch(2)&= chi(1,ip1,j00,k00,jcomtt1p,'t& ttt=ch(3)&= chi(1,i00,jp1,k00,jcomtt1p,'t& ttt=ch(4)&= chi(1,i00,j00,kp1,jcomtt1p,'t& ttt=ch(5)&= chi(1,ip1,j00,kp1,jcomtt1p,'t& ttt=ch(6)&= chi(1,i00,jp1,kp1,jcomtt1p,'t& ttt=ch(7)&= chi(1,ip1,jp1,k00,jcomtt1p,'t& ttt=ch(8)&= chi(1,ip1,jp1,kp1,jcomtt1p,'t& ttt=xr(1)&= f_mttt=ch(1)*xi(1)*xi(2)*xi(3)t1p,'t& ttt=xr(1)&= xr(1)&+=ch(2)*xk(1)*xi(2)*xi(3)t1p,'t& ttt=xr(1)&= xr(1)&+=ch(3)*xi(1)*xk(2)*xi(3)t1p,'t& ttt=xr(1)&= xr(1)&+=ch(4)*xi(1)*xi(2)*xk(3)i f_m f_mttt=xr(1)&= xr(1)&+=ch(5)*xk(1)*xi(2)*xk(3)i f_m f_mttt=xr(1)&= xr(1)&+=ch(6)*xi(1)*xk(2)*xk(3)i f_m f_mttt=xr(1)&= xr(1)&+=ch(7)*xk(1)*xk(2)*xi(3)t1p,'t& ttt=xr(1)&= xr(1)&+=ch(8)*xk(1)*xk(2)*xk(3)i f_m f_mttt=ch(1)&= chi(2,i00,j00,k00,jcomtt1p,'t& ttt=ch(2)&= chi(2,ip1,j00,k00,jcomtt1p,'t& ttt=ch(3)&= chi(2,i00,jp1,k00,jcomtt1p,'t& ttt=ch(4)&= chi(2,i00,j00,kp1,jcomtt1p,'t& ttt=ch(5)&= chi(2,ip1,j00,kp1,jcomtt1p,'t& ttt=ch(6)&= chi(2,i00,jp1,kp1,jcomtt1p,'t& ttt=ch(7)&= chi(2,ip1,jp1,k00,jcomtt1p,'t& ttt=ch(8)&= chi(2,ip1,jp1,kp1,jcomtt1p,'t& ttt=xr(2)&= f_mttt=ch(1)*xi(1)*xi(2)*xi(3)t1p,'t& ttt=xr(2)&= xr(2)&+=ch(2)*xk(1)*xi(2)*xi(3)t1p,'t& ttt=xr(2)&= xr(2)&+=ch(3)*xi(1)*xk(2)*xi(3)t1p,'t& ttt=xr(2)&= xr(2)&+=ch(4)*xi(1)*xi(2)*xk(3)i f_m f_mttt=xr(2)&= xr(2)&+=ch(5)*xk(1)*xi(2)*xk(3)i f_m f_mttt=xr(2)&= xr(2)&+=ch(6)*xi(1)*xk(2)*xk(3)i f_m f_mttt=xr(2)&= xr(2)&+=ch(7)*xk(1)*xk(2)*xi(3)t1p,'t& ttt=xr(2)&= xr(2)&+=ch(8)*xk(1)*xk(2)*xk(3)i f_m f_mttt=ch(1)&= chi(3,i00,j00,k00,jcomtt1p,'t& ttt=ch(2)&= chi(3,ip1,j00,k00,jcomtt1p,'t& ttt=ch(3)&= chi(3,i00,jp1,k00,jcomtt1p,'t& ttt=ch(4)&= chi(3,i00,j00,kp1,jcomtt1p,'t& ttt=ch(5)&= chi(3,ip1,j00,kp1,jcomtt1p,'t& ttt=ch(6)&= chi(3,i00,jp1,kp1,jcomtt1p,'t& ttt=ch(7)&= chi(3,ip1,jp1,k00,jcomtt1p,'t& ttt=ch(8)&= chi(3,ip1,jp1,kp1,jcomtt1p,'t& ttt=xr(3)&= f_mttt=ch(1)*xi(1)*xi(2)*xi(3)t1p,'t& ttt=xr(3)&= xr(3)&+=ch(2)*xk(1)*xi(2)*xi(3)t1p,'t& ttt=xr(3)&= xr(3)&+=ch(3)*xi(1)*xk(2)*xi(3)t1p,'t& ttt=xr(3)&= xr(3)&+=ch(4)*xi(1)*xi(2)*xk(3)i f_m f_mttt=xr(3)&= xr(3)&+=ch(5)*xk(1)*xi(2)*xk(3)i f_m f_mttt=xr(3)&= xr(3)&+=ch(6)*xi(1)*xk(2)*xk(3)i f_m f_mttt=xr(3)&= xr(3)&+=ch(7)*xk(1)*xk(2)*xi(3)t1p,'t& ttt=xr(3)&= xr(3)&+=ch(8)*xk(1)*xk(2)*xk(3)i f_m f_mttt=pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride, ttttt=N&t=ttt=! Compute the distance&vectortin physial spacet1p,'t& pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride, ttttt=N&t=ttt=x0mxk(1)p= x-xr(1) ttttt=N&t=ttt=x0mxk(2)&= y-xr(2) ttttt=N&t=ttt=x0mxk(3)&= z-xr(3) t& =LSE ttt=N&t=N&ttt=pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride, ttttt=N&t=ttt=! Undo salingtand compute distance&vectort1p,'t& pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride, ttttt=N&t=ttt=x0mxk(1)p&= dx*(x0(1)-xk(1)) ttttt=N&t=ttt=x0mxk(2)&&= dy*(x0(2)-xk(2)) ttttt=N&t=ttt=x0mxk(3)&&= dz*(x0(3)-xk(3)) t& =poI0,ttttt=N sprod = f_ x0mxk(1)*x0mxk(1) t& sprod = sprod + (x0mxk(2)*x0mxk(2)) t& sprod = sprod + (x0mxk(3)*x0mxk(3)) t& sprod = SQRT(sprod) t& =poI0,0 lt,FFKiKIM)RE)Ki2Dt f_mxk1p,= x0 ttttt=eblp,= bigt1p,'t&tol2,= tol*tolt1p,'t&nitN&= 0 1p,'t&DO WHILE ((ebl.GT.tol2).AND.(nit.LT.40)) ttttt=ttt=! interpol1tiet polynomi1l and its gradieslNatmxk ttttt=ttt=! This is a stupid way&to evaluate the ttttt=ttt=! polynomi1l, but I could not find a better ttttt=ttt=! one immediately...i f_m f_mxv(1)&= xk(1)i f_m f_mxv(2)&= xk(1)*xk(1)i f_m f_mxv(3)&= xv(2)*xk(1)i f_m f_myv(1)&= xk(2)i f_m f_myv(2)&= xk(2)*xk(2)i f_m f_myv(3)&= yv(2)*xk(2)i f_m f_mgxv(2)&= 2.0_MK*xk(1)i f_m f_mgxv(3)&= 3.0_MK*xv(2)i f_m f_mgyv(2)&= 2.0_MK*xk(2)i f_m f_mgyv(3)&= 3.0_MK*yv(2)i f_m f_mpxk&= 0.0_MKi f_mgradpxk&= 0.0_MKi f_mDO n=0,3i f_m f_mDO m=0,3i f_m f_m f_mind = 4*n+m+1 ttttt=N&t=ttt= f_mpxk&= pxk+coef(ind)*xv(m)*yv(n) ttttt=N&t=ttt= f_mgradpxk(1)&= gradpxk(1)&+ t=&tttttt&po,0000000000000(coef(ind)*gxv(m)*yv(n)) ttttt=N&t=ttt= f_mgradpxk(2)&= gradpxk(2)&+ t=&tttttt&po,0000000000000(coef(ind)*xv(m)*gyv(n)) ttttt=N&t=ttt==poDO t& =poDO t& ! equatiet (3.4) in Chopp:2001 t& nrm2 = f_mgradpxk(1)*gradpxk(1) t& nrm2 = nrm2 + (gradpxk(2)*gradpxk(2)) t& nrm2 = 1.0_MK/nrm2 t& delta1(1)&= -pxk*gradpxk(1)*nrm2 t& delta1(2)&= -pxk*gradpxk(2)*nrm2 t& eblp, = f_delta1(1)*delta1(1) t& eblp, = eblp+ (delta1(2)*delta1(2)) t& ! equatiet (3.5) in Chopp:2001 t& xkhalf(1)&= xk(1)p+ delta1(1) t& xkhalf(2)&= xk(2)p+ delta1(2) t& ! equatiet (3.6) in Chopp:2001 t& x0mxk(1)p,= x0(1)-xk(1)i f_m f_mx0mxk(2)p,= x0(2)-xk(2)i f_m f_msprod = f_ x0mxk(1)*gradpxk(1) t& sprod = sprod + (x0mxk(2)*gradpxk(2)) t& nrm2 = nrm2*sprod t& delta2(1)&= x0mxk(1)p- nrm2*gradpxk(1) t& delta2(2)&= x0mxk(2)p- nrm2*gradpxk(2) t& eblp, = eblp+ (delta2(1)*delta2(1)) t& eblp, = eblp+ (delta2(2)*delta2(2)) t& ! equatiet (3.7) in Chopp:2001 t& xk(1)p, = xkhalf(1)&+ delta2(1) t& xk(2)p, = xkhalf(2)&+ delta2(2) t& nit = nit + 1 ttttt==poDO t& IF (nit .GT. 39M/2+1K ttt=N&t=N&! did not converge t=N&! tttt&= 2I4)eble0twa0ning t=N&! h%Nm(tttteble0(ttttebl_converge, &ttttt!&po,00000'pI4)gm4)kickoff', &ttttt!&po,00000'WARNING: Tolerance¬ reached!'&ttttt!&po,00000,__LINE__ttttttt1p,'! tttt&= 2I4)param_success t& sprod = bigt1p,'t&ELSE ttt=N&t=N&IF (PRESENT(chi)M/2+1K ttt=N&t=N&&&&&pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride, ttttt=N&t=ttt=! Maptthe point to physial space usingtbilinea0 ttttt=========! ttterpol1tiet ef the mapt(AGM uses linea0 basis functietstt1p,'t& pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride, ttttt=N&t=ttt=xi(1)&= 1.0_MK-xk(1)i f_m f_mttt=xi(2)&= 1.0_MK-xk(2)i f_m f_mttt=ch(1)&= chi(1,i00,j00,jcomtt1p,'t& ttt=ch(2)&= chi(1,ip1,j00,jcomtt1p,'t& ttt=ch(3)&= chi(1,i00,jp1,jcomtt1p,'t& ttt=ch(4)&= chi(1,ip1,jp1,jcomtt1p,'t& ttt=xr(1)&= f_mttt=ch(1)*xi(1)*xi(2)t1p,'t& ttt=xr(1)&= xr(1)&+=ch(2)*xk(1)*xi(2)t1p,'t& ttt=xr(1)&= xr(1)&+=ch(3)*xi(1)*xk(2)t1p,'t& ttt=xr(1)&= xr(1)&+=ch(4)*xk(1)*xk(2)i f_m f_mttt=ch(1)&= chi(2,i00,j00,jcomtt1p,'t& ttt=ch(2)&= chi(2,ip1,j00,jcomtt1p,'t& ttt=ch(3)&= chi(2,i00,jp1,jcomtt1p,'t& ttt=ch(4)&= chi(2,ip1,jp1,jcomtt1p,'t& ttt=xr(2)&= f_mttt=ch(1)*xi(1)*xi(2)t1p,'t& ttt=xr(2)&= xr(2)&+=ch(2)*xk(1)*xi(2)t1p,'t& ttt=xr(2)&= xr(2)&+=ch(3)*xi(1)*xk(2)t1p,'t& ttt=xr(2)&= xr(2)&+=ch(4)*xk(1)*xk(2)i f_m f_mttt=pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride, ttttt=N&t=ttt=! Compute the distance&vectortin physial spacet1p,'t& pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride, ttttt=N&t=ttt=x0mxk(1)p= x-xr(1) ttttt=N&t=ttt=x0mxk(2)&= y-xr(2) ttttt=N&t==LSE ttt=N&t=N&ttt=pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride, ttttt=N&t=ttt=! Undo salingtand compute distance&vectort1p,'t& pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride, ttttt=N&t=ttt=x0mxk(1)p&= dx*(x0(1)-xk(1)) ttttt=N&t=ttt=x0mxk(2)&&= dy*(x0(2)-xk(2)) ttttt=N&t==poI0,ttttt=N sprod = f_ x0mxk(1)*x0mxk(1) t& sprod = sprod + (x0mxk(2)*x0mxk(2)) t& sprod = SQRT(sprod) t& =poI0,0 ppp&,lib2I4numerics-r1036/src/2I4)moduletgm4)extend.f0000644000175000017500000001564211616214651020657 0upt1, omaromar pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,Istride, ttttt=! Module : 2I4)moduletgm4)extend pMBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,Istride, ttttt=! ttttt=! Purposet't& : This module tncludes the source code for the ttttt=! extend routine ef the marchingtmethod. ttttt=! ttttt=! Remarkst't& : ttttt=! ttttt=! References& : ttttt=! ttttt=! Revisietst& : ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! $Log: 2I4)moduletgm4)extend.f,v $ ttttt=! Revisiet 1.1.1.1 2007/07/13 10:18:58 ivos ttttt=! CBL versiet of the PPM library ttttt=! ttttt=! Revisiet 1.4 2005/04/21 04:48:24 ivos ttttt=! Cleaned interfacestand removed unnecessary overloaded versiets.i f_m! ttttt=! Revisiet 1.3 2005/03/12 04:08:36 ivos ttttt=! Misc bug fixes. ttttt=! ttttt=! Revisiet 1.2 2005/03/11 21:10:08 ivos ttttt=! Added thresholded extensietstand closest point transform.t f_m! ttttt=! Revisiet 1.1 2005/03/11 04:15:59 ivos ttttt=! In::i1l implemesl1tiet. ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttttt=! Center for Fluid Dynamics (DTU) ttttt=! ttttt=! ttttt=! This file1is p1,t ef the Parallel Particle1Mesh Library (PPM). ttttt=! ttttt=! PPM is free software: you can redistribute itNand/or modify ttttt=! itNunder the terms ef the GNU Lesser General Public License ttttt=! as pomlished by the Free Software Found1tiet, either ttttt=! versiet 3 ef the License, or (at your optiet)Nany later ttttt=! versiet. ttttt=! ttttt=! PPM is distributed in the hope that itNwill be useful, ttttt=! but WITHOUT ANY WARRANTY;twithout even the implied wa004nty ef ttttt=! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ttttt=! GNU General Public License for more details. ttttt=! ttttt=! You should have received a copy ef the GNU General Public License ttttt=! and the GNU Lesser General Public License alongtwith PPM. If not, ttttt=! see . ttttt=! ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! ETH Zurich ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Define types ttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD 0define)Kiiiii LL subfftw_ 1 0define)KiKlies e,foGNNNoE 2 0define)KiVFIELD 3 0define)KiiFIELD 4 0define)Ki2D 5 0define)Ki3D 6 0define)KiYES 7 0define)KiNO 8 ttttt=MODULE 2I4)moduletgm4)extend t& !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD t& ! Modulest1p,'t& !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD t& USE 2I4)moduletd1ta, ONLY: 2I4)kind_single, 2I4)kind_double ttttt=tttPRIVATE :: 2I4)kind_single, 2I4)kind_double ttttt=ttt t& !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD t& ! Worktmemory t& !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD t& REAL(2I4)kind_single), KIMENNNoE(:,:,: ), POINTER :: ext_wrk_2ds,t& REAL(2I4)kind_single), KIMENNNoE(:,:,:,:), POINTER :: ext_wrk_3ds,t& REAL(2I4)kind_double), KIMENNNoE(:,:,: ), POINTER :: ext_wrk_2dd,t& REAL(2I4)kind_double), KIMENNNoE(:,:,:,:), POINTER :: ext_wrk_3dd t& !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD t& ! Define interfacestto pI4)gm4)extend !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD t& INTERFACE pI4)gm4)extend ! 2d salar and vectortfield versietstwith cutoff ttt=N&'tttttMODULE PROCEDURE pI4)gm4)extend_2d_tsa_s ttt=N&'tttttMODULE PROCEDURE pI4)gm4)extend_2d_tsa_d ttt=N&'tttttMODULE PROCEDURE pI4)gm4)extend_2d_tvec_s ttt=N&'tttttMODULE PROCEDURE pI4)gm4)extend_2d_tvec_d t& ! 3d salar and vectortfield versietstwith cutoff ttt=N&'tttttMODULE PROCEDURE pI4)gm4)extend_3d_tsa_s ttt=N&'tttttMODULE PROCEDURE pI4)gm4)extend_3d_tsa_d ttt=N&'tttttMODULE PROCEDURE pI4)gm4)extend_3d_tvec_s ttt=N&'tttttMODULE PROCEDURE pI4)gm4)extend_3d_tvec_d t& ! 2d salar and vectortfield versietstwith functiet pointer ttt=N&'tttttMODULE PROCEDURE pI4)gm4)extend_2d_ksa_s ttt=N&'tttttMODULE PROCEDURE pI4)gm4)extend_2d_ksa_d ttt=N&'tttttMODULE PROCEDURE pI4)gm4)extend_2d_kvec_s ttt=N&'tttttMODULE PROCEDURE pI4)gm4)extend_2d_kvec_d t& ! 3d salar and vectortfield versietstwith functiet pointer ttt=N&'tttttMODULE PROCEDURE pI4)gm4)extend_3d_ksa_s ttt=N&'tttttMODULE PROCEDURE pI4)gm4)extend_3d_ksa_d ttt=N&'tttttMODULE PROCEDURE pI4)gm4)extend_3d_kvec_s ttt=N&'tttttMODULE PROCEDURE pI4)gm4)extend_3d_kvec_d =N&'ttttt=po INTERFACE t& !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD t& ! tnclude the source t& !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD t& hONTAINS 0define)KiKICKOFF)KiNO 0define)KiKIM)Ki2Dt0define)KiTYPE)KiiFIELD 0define)KiKIpo Kiiiii LL subfftw_,0tnclude "ttttgm4)extend.f" #undef)KiKIpo 0define)KiKIpo KiKlies e,foGNNNoE,0tnclude "ttttgm4)extend.f" #undef)KiKIpo 0undef)KiTYPE t0define)KiTYPE)KiVFIELD 0define)KiKIpo Kiiiii LL subfftw_,0tnclude "ttttgm4)extend.f" #undef)KiKIpo 0define)KiKIpo KiKlies e,foGNNNoE,0tnclude "ttttgm4)extend.f" #undef)KiKIpo 0undef)KiTYPE 0undef)KiKIM 0define)KiKIM)Ki3Dt0define)KiTYPE)KiiFIELD 0define)KiKIpo Kiiiii LL subfftw_,0tnclude "ttttgm4)extend.f" #undef)KiKIpo 0define)KiKIpo KiKlies e,foGNNNoE,0tnclude "ttttgm4)extend.f" #undef)KiKIpo 0undef)KiTYPE t0define)KiTYPE)KiVFIELD 0define)KiKIpo Kiiiii LL subfftw_,0tnclude "ttttgm4)extend.f" #undef)KiKIpo 0define)KiKIpo KiKlies e,foGNNNoE,0tnclude "ttttgm4)extend.f" #undef)KiKIpo 0undef)KiTYPE 0undef)KiKIM #undef)KiKICKOFF 0define)KiKICKOFF)KiYES 0define)KiKIM)Ki2Dt0define)KiTYPE)KiiFIELD 0define)KiKIpo Kiiiii LL subfftw_,0tnclude "ttttgm4)extend.f" #undef)KiKIpo 0define)KiKIpo KiKlies e,foGNNNoE,0tnclude "ttttgm4)extend.f" #undef)KiKIpo 0undef)KiTYPE t0define)KiTYPE)KiVFIELD 0define)KiKIpo Kiiiii LL subfftw_,0tnclude "ttttgm4)extend.f" #undef)KiKIpo 0define)KiKIpo KiKlies e,foGNNNoE,0tnclude "ttttgm4)extend.f" #undef)KiKIpo 0undef)KiTYPE 0undef)KiKIM 0define)KiKIM)Ki3Dt0define)KiTYPE)KiiFIELD 0define)KiKIpo Kiiiii LL subfftw_,0tnclude "ttttgm4)extend.f" #undef)KiKIpo 0define)KiKIpo KiKlies e,foGNNNoE,0tnclude "ttttgm4)extend.f" #undef)KiKIpo 0undef)KiTYPE t0define)KiTYPE)KiVFIELD 0define)KiKIpo Kiiiii LL subfftw_,0tnclude "ttttgm4)extend.f" #undef)KiKIpo 0define)KiKIpo KiKlies e,foGNNNoE,0tnclude "ttttgm4)extend.f" #undef)KiKIpo 0undef)KiTYPE 0undef)KiKIM #undef)KiKICKOFF 'ttttt=po MODULE 2I4)moduletgm4)extend lib2I4numerics-r1036/src/2I4)mg_res_fine.f0000644000175000017500000004252311616214651017436 0upt1, omaromar!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD,MBiDD ! Subroutine)& : 2I4)mg_res !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD,MBiDD ! Purposet't& : In this routine)we compute the residu1l in each level ! ! ! ! Input : ! Input/output : ! ! Output : tttt (I) returt st4tus. 0 upet success ! ! Remarkst't& : ! ! References& : ! ! Revisietst& : !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD,MBiDD ! $Log: 2I4)mg_res_fine.f,v $ ! Revisiet 1.1.1.1 2007/07/13 10:18:56 ivos ! CBL versiet of the PPM library ! ! Revisiet 1.7 2006/07/21 11:30:56 kotsalie ! FRIDAY ! ! Revisiet 1.5 2006/02/08 19:56:02 kotsalie ! fixed multiple domains ! ! Revisiet 1.4 2005/12/08 12:44:45 kotsalie ! commitingtdirichlet ! ! Revisiet 1.3 2005/03/14 13:22:58 kotsalie ! COMMITED/2+1 VECTOR CASE.IT IS FOR LDA=3 ! ! Revisiet 1.2 2004/09/28 14:07:19 kotsalie ! Changes concertingt4th order ! ! Revisiet 1.1 2004/09/22 18:46:21 kotsalie ! MG new versiet ! !Howmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD,MBiDD ! Parallel Particle1Mesh Library (PPM) ! Institute of Comput1tiet1l Science ! ETH Zeslrum, Hirschengraben 84 ! CH-8092 Zurich, Switzerland !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD,MBiD 0t,tKiKIM)RE)KiiFIELD 0t,tKiMESHiKIM)RE)Ki2Dt0t,F& KiMEASURE)Kiiiii LL subfftw_, f_mesSUBROUTINE 2I4)mg_res_finei2D_sa_s(topo_id,u,f,c1,c2,c3,c4,Ettttttt0 st,FFW_MEASURE)KiKlies e,foGNNNoE, f_mesSUBROUTINE 2I4)mg_res_finei2D_sa_d(topo_id,u,f,c1,c2,c3,c4,Ettttttt0 ppp&,0 st,FKiMESHiKIM)RE)Ki3Dt0t,F& KiMEASURE)Kiiiii LL subfftw_, f_mesSUBROUTINE 2I4)mg_res_finei3D_sa_s(topo_id,u,f,c1,c2,c3,c4,c5,&tttttt&po,000000000000000000000000000000000Ettttttt0 st,FFW_MEASURE)KiKlies e,foGNNNoE, f_mesSUBROUTINE 2I4)mg_res_finei3D_sa_d(topo_id,u,f,c1,c2,c3,c4,c5,&tttttt&po,000000000000000000000000000000000Ettttttt0 ppp&,0 ppp&,0 st,FKiKIM)RE)KiVFIELD 0t,tKiMESHiKIM)RE)Ki2Dt0t,F& KiMEASURE)Kiiiii LL subfftw_, f_mesSUBROUTINE 2I4)mg_res_finei2D_vec_s(topo_id,u,f,c1,c2,c3,c4,Ettttttt0 st,FFW_MEASURE)KiKlies e,foGNNNoE, f_mesSUBROUTINE 2I4)mg_res_finei2D_vec_d(topo_id,u,f,c1,c2,c3,c4,Ettttttt0 ppp&,0 st,FKiMESHiKIM)RE)Ki3Dt0t,F& KiMEASURE)Kiiiii LL subfftw_, f_mesSUBROUTINE 2I4)mg_res_finei3D_vec_s(topo_id,u,f,c1,c2,c3,c4,c5,&tttttt&po,000000000000000000000000000000000Ettttttt0 st,FFW_MEASURE)KiKlies e,foGNNNoE, f_mesSUBROUTINE 2I4)mg_res_finei3D_vec_d(topo_id,u,f,c1,c2,c3,c4,c5,&tttttt&po,000000000000000000000000000000000Ettttttt0 ppp&,0 ppp&,0 ppp&,00000000!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD t& ! Includes ttt=N&N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- 0tnclude "ttttdefine.h"t1p,'t&N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MB t& ! Modulest,ttttt= !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- 1p,'t&t&USE 2I4)moduletd1ta ttttt=t=USE 2I4)moduletd1ta_mg ttttt=t=USE 2I4)moduletwrite,ttttt= USE 2I4)moduletcomptart ttttt=t=USE 2I4)moduletcomptop ttttt=t=USE 2I4)moduleteble0 ttttt=t=USE 2I4)moduleta su 1p,'t&t&IMPLICIT NONEt0t,F& KiMEASURE)Kiiiii LL subfftw_, f_mest&INTEGER, PARAMETER :: MK&= 2I4)kind_singlet0 sse, f_mest&INTEGER, PARAMETER :: MK&= 2I4)kind_double 0 ppp&,00000000!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MB t& ! Argumesls ttt=N&N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- 0t,tKiKIM)RE)KiiFIELD 0t,tKiMESHiKIM)RE)Ki2Dtttt=N&N&REAL(MK),KIMENNNoE(:,:,:),POINTER :: utttt=N&N&REAL(MK),KIMENNNoE(:,:,:),POINTER :: &,0 st,FKiMESHiKIM)RE)Ki3Dtttt=N&N&REAL(MK),KIMENNNoE(:,:,:,:),POINTER :: utttt=N&N&REAL(MK),KIMENNNoE(:,:,:,:),POINTER :: &,0 ppp&,0 st,FKiKIM)RE)KiVFIELD 0t,tKiMESHiKIM)RE)Ki2Dtttt=N&N&REAL(MK),KIMENNNoE(:,:,:,:),POINTER :: utttt=N&N&REAL(MK),KIMENNNoE(:,:,:,:),POINTER :: &,0 st,FKiMESHiKIM)RE)Ki3Dtttt=N&N&REAL(MK),KIMENNNoE(:,:,:,:,:),POINTER :: utttt=N&N&REAL(MK),KIMENNNoE(:,:,:,:,:),POINTER :: &,0 ppp&,0 ppp&,0t,FFW_MESHiKIM)RE)Ki2Dtttt=N&N&REAL(MK), INTENT(IN)p, :: c1,c2,c3,c4 ,0 st,FKiMESHiKIM)RE)Ki3Dtttt=N&N&REAL(MK), INTENT(IN)p, :: c1,c2,c3,c4,c5 0 ppp&,00000000REAL(MK), INTENT(OUT), :: E, f_mest&INTEGER, INTENT(INOUT), :: tttt,ttttt=t&INTEGER, INTENT(IN ), :: topo_id ttt=N&N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD t& ! Lual variablest,ttttt= !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- 1p,'t&t&CHARACTER(LEN=256) :: cbuf,ttttt=t&INTEGER :: t,j,icom,cole0 ttttt=t=INTEGER :: tlda,icweep,count ttttt=t=INTEGER :: aa,bm,cc,dd,ee,gg,00000000REAL(MK) :: c11,c22,c33,c44,c55 ttttt=t=INTEGER :: k,idom,00000000REAL(MK) :: x,y,00000000REAL(MK) :: res 0t,tKiMESHiKIM)RE)Ki2Dtttt=N&N&INTEGER,KIMENNNoE(4) :: ldl4,ldu4tttt=N&N&INTEGER,KIMENNNoE(3) :: ldl3,ldu3,0 ppp&,0t,FKiMESHiKIM)RE)Ki3Dtttt=N&N&INTEGER,KIMENNNoE(5) :: ldl5,ldu5tttt=N&N&INTEGER,KIMENNNoE(4) :: ldl4,ldu4t0 ppp&,00000000INTEGER :: topt,iface,topoid ttt=N&N&REAL(MK) :: t0 0t,tKiKIM)RE)KiiFIELD 0t,tKiMESHiKIM)RE)Ki2Dt0t,FKiMEASURE)Kiiiii LL subfftw_, f_mest&TYPE(mg_field_2d_sa_s),KIMENNNoE(:,:),POINTER :: mgfield,0 st,FKiMEASURE)KiKlies e,foGNNNoE, f_mest&TYPE(mg_field_2d_sa_d),KIMENNNoE(:,:),POINTER :: mgfield,0 ppp&,0 st,FKiMESHiKIM)RE)Ki3Dt0t,FKiMEASURE)Kiiiii LL subfftw_, f_mest&TYPE(mg_field_3d_sa_s),KIMENNNoE(:,:),POINTER :: mgfield,0 st,FKiMEASURE)KiKlies e,foGNNNoE, f_mest&TYPE(mg_field_3d_sa_d),KIMENNNoE(:,:),POINTER :: mgfield,0 ppp&,0 ppp&,0 st,FKiKIM)RE)KiVFIELD 0t,tKiMESHiKIM)RE)Ki2Dt0t,FKiMEASURE)Kiiiii LL subfftw_, f_mest&TYPE(mg_field_2d_vec_s),KIMENNNoE(:,:),POINTER :: mgfield,0 st,FKiMEASURE)KiKlies e,foGNNNoE, f_mest&TYPE(mg_field_2d_vec_d),KIMENNNoE(:,:),POINTER :: mgfield,0 ppp&,0 st,FKiMESHiKIM)RE)Ki3Dt0t,FKiMEASURE)Kiiiii LL subfftw_, f_mest&TYPE(mg_field_3d_vec_s),KIMENNNoE(:,:),POINTER :: mgfield,0 st,FKiMEASURE)KiKlies e,foGNNNoE, f_mest&TYPE(mg_field_3d_vec_d),KIMENNNoE(:,:),POINTER :: mgfield,0 ppp&,0 ppp&,0 ppp&,00000000!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDDD t& !Externals ttt=N&N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ,00000000!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDDD t& !Initi1lize,ttttt= !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- 1p,'t&t&C%Nm(compt1,t('2I4)mg_res It0ttttttt1p,'t&t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- 1p,'t&t&! Check argumesls ttt=N&t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- 1p,'t&t&IF (ttttdebug .GT. 0M/2+1K ttt=N&t=N&IF (c1.LE.0.0_MKM/2+1K ttt=N&t=N&&&&&tttt&= 2I4)eble0teble0 ttttt=========h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_res It=&tttttt&po,000000000'Factortc1 must be >0',__LINE__ttttttt1p,'t& GOTO d_dot1p,'t& =poI0,ttttt=N IF (c2.LE.0.0_MKM/2+1K ttt=N&t=N&&&&&tttt&= 2I4)eble0teble0 ttttt=========h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_res It=&tttttt&po,000000000'Factortc2 must be >0',__LINE__ttttttt1p,'t& GOTO d_dot1p,'t& =poI0,ttttt=N IF (c3.LE.0.0_MKM/2+1K ttt=N&t=N&&&&&tttt&= 2I4)eble0teble0 ttttt=========h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_res It=&tttttt&po,000000000'Factortc3 must be >0',__LINE__ttttttt1p,'t& GOTO d_dot1p,'t& =poI0,ttttt=N IF (c4.LE.0.0_MKM/2+1K ttt=N&t=N&&&&&tttt&= 2I4)eble0teble0 ttttt=========h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_res It=&tttttt&po,000000000'Factortc4 must be >0',__LINE__ttttttt1p,'t& GOTO d_dot1p,'t& =poI0,0t,FKiMESHiKIM)RE)Ki3Dtttt=N&N& IF (c5.LE.0.0_MKM/2+1K ttt=N&t=N&&&&&tttt&= 2I4)eble0teble0 ttttt=========h%Nm(tttteble0(ttttebl_argumesl,'2I4)mg_res It=&tttttt&po,000000000'Factortc5 must be >0',__LINE__ttttttt1p,'t& GOTO d_dot1p,'t& =poI0,0 ppp&,00000000=poI0,ttttt=N !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- 1p,'t&t&!Definitiet ef necessary variablestand a su1tiet ef a004ys ttt=N&t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- 1p,'t&t&topoid=topo_id 0t,tKiKIM)RE)KiiFIELD 0t,tKiMESHiKIM)RE)Ki2Dt0t,FKiMEASURE)Kiiiii LL subfftw_, f_mest&mgfield=>mgfield_2d_sa_s,0 st,FKiMEASURE)KiKlies e,foGNNNoE, f_mest&mgfield=>mgfield_2d_sa_d,0 ppp&,0 st,FKiMESHiKIM)RE)Ki3Dt0t,FKiMEASURE)Kiiiii LL subfftw_, f_mest&mgfield=>mgfield_3d_sa_s,0 st,FKiMEASURE)KiKlies e,foGNNNoE, f_mest&mgfield=>mgfield_3d_sa_d,0 ppp&,0 ppp&,0 st,FKiKIM)RE)KiVFIELD 0t,tKiMESHiKIM)RE)Ki2Dt0t,FKiMEASURE)Kiiiii LL subfftw_, f_mest&mgfield=>mgfield_2d_vec_s 0 st,FKiMEASURE)KiKlies e,foGNNNoE, f_mest&mgfield=>mgfield_2d_vec_d 0 ppp&,0 st,FKiMESHiKIM)RE)Ki3Dt0t,FKiMEASURE)Kiiiii LL subfftw_, f_mest&mgfield=>mgfield_3d_vec_s 0 st,FKiMEASURE)KiKlies e,foGNNNoE, f_mest&mgfield=>mgfield_3d_vec_d 0 ppp&,0 ppp&,0 ppp&,0t,FFW_KIM)RE)KiiFIELD 0t,ttKiMESHiKIM)RE)Ki2Dtttt=N&N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDDD t& !Implemesl1tiet,00000000!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD t& 00= =-HUGE(Ett1p,'t& DO icom=1,ncompt1p,'t& DO j=pt1,t(2,icom,1),istop(2,icom,1)t1p,'t& DO i=pt1,t(1,icom,1),istop(1,icom,1)t1p,'t& res &= (u(i-1,j,icom)+u(i+1,j,icom))*c2 + &tttttt&po,0000000000000000000(u(i,j-1,icom)+u(i,j+1,icom))*c3 - &tttttt&po,0000000000000000000 u(i,j,icom)*c4-f(i,j,icom)t1p,'t& E &= MAX(E,abs(resttt1p,'t& f_mgfield(icom,1)%ebl(i,j)=-rest1p,'t& f_mgfield(icom,1)%uc(i,j)=u(i,j,icom)t1p,'t& =poDO t& =poDO t& =poDO 0 st,FKiMESHiKIM)RE)Ki3Dtttt=N&N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDDD t& !Implemesl1tiet,00000000!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD t& 00 E =-HUGE(Ett1p,'t& DO icom=1,ncompt1p,'t& aa=0t1p,'t& bb=0t1p,'t& cc=0t1p,'t& dd=0t1p,'t& ee=0t1p,'t& gg=0t1p,'t& IF (.NOT.lperiodicM/2+1K ttt=N&t=N&&&&& DO iface=1,6t1p,'t& fIF (bcdef_sa(icom,iface).EQ.2I4)param_bcdef_periodicM/2+1K ttt=N&t=N&&&&& t&!DO NOTHiiit1p,'t& f=LSEIF (bcdef_sa(icom,iface).EQ.2I4)param_bcdef_dirichletM/2+1K ttt=N&t=N&&&&& t& fIF (iface.EQ.1M/2+1K ttt=N&t=N&&&&& t& f aa=1 ttttt=N&t=ttt= f_m f_m=LSEIF (iface.EQ.2M/2+1K ttt=N&t=N&&&&& t& f bb=1 ttttt=N&t=ttt= f_m f_m=LSEIF (iface.EQ.3M/2+1K ttt=N&t=N&&&&& t& f cc=1 ttttt=N&t=ttt= f_m f_m=LSEIF (iface.EQ.4M/2+1K ttt=N&t=N&&&&& t& f dd=1 ttttt=N&t=ttt= f_m f_m=LSEIF (iface.EQ.5) Then ttt=N&t=N&&&&& t& f ee=1 ttttt=N&t=ttt= f_m f_m=LSEIF (iface.EQ.6) Then ttt=N&t=N&&&&& t& f gg=1 ttttt=N&t=ttt= f_m f_mf_m f_m=poI0,ttttt=N f_mf_m f_m=poI0 t1p,'t& f=poDO !ifacet1p,'t& =poI0 !periodict1p,'t& DO k=pt1,t(3,icom,1)+ee,istop(3,icom,1)-gg,00000000& DO j=pt1,t(2,icom,1)+cc,istop(2,icom,1)-ddt1p,'t& DO i=pt1,t(1,icom,1)+aa,istop(1,icom,1)-bb ttttt=N&t=ttt= f_m f_mfres &= (u(i-1,j,k,icom)+u(i+1,j,k,icom))*c2 + &tttttt&po,000000000000000000000(u(i,j-1,k,icom)+u(i,j+1,k,icom))*c3 + &tttttt&po,000000000000000000000(u(i,j,k-1,icom)+u(i,j,k+1,icom))*c4 - &tttttt&po,0000000000000000000 0 u(i,j,k,icom)*c5-f(i,j,k,icom)t1p,'t& E &= MAX(E,abs(resttt1p,'t& f_f_mgfield(icom,1)%ebl(i,j,k)=-rest1p,'t& f_f_mgfield(icom,1)%uc(i,j,k)=u(i,j,k,icom)t1p,'t& =poDO t& =poDO t& =poDO t& =poDO 0 ppp&,0 st,FKiKIM)RE)KiVFIELD 0t,ttKiMESHiKIM)RE)Ki2Dtttt=N&N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDDD t& !Implemesl1tiet,000000000!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD t& E =-HUGE(Ett1p,'t& DO icom=1,ncompt1p,'t& DO j=pt1,t(2,icom,1),istop(2,icom,1)t1p,'t& DO i=pt1,t(1,icom,1),istop(1,icom,1)t1p,'t& DO ilda=1,vecdimt1p,'t& fres &= (u(ilda,i-1,j,icom)+u(ilda,i+1,j,icom))*c2 + &tttttt&po,000000000000000000(u(ilda,i,j-1,icom)+u(ilda,i,j+1,icom))*c3 - &tttttt&po,0000000000000000000u(ilda,i,j,icom)*c4-f(ilda,i,j,icom)t1p,'t& f= &= MAX(E,abs(resttt1p,'t& fmgfield(icom,1)%ebl(ilda,i,j)=-rest1p,'t& fmgfield(icom,1)%uc(ilda,i,j)=u(ilda,i,j,icom)t1p,'t& =poDO t& =poDO t& =poDO t& =poDO 0 st,FKiMESHiKIM)RE)Ki3Dtttt=N&N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDDD t& !Implemesl1tiet,00000000!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD t& 00 E =-HUGE(Ett1p,'t& DO icom=1,ncompt1p,'t& aa=0t1p,'t& bb=0t1p,'t& cc=0t1p,'t& dd=0t1p,'t& ee=0t1p,'t& gg=0t1p,'t& DO ilda=1,vecdimt1p,'t& IF (.NOT.lperiodicM/2+1K ttt=N&t=N&&&&& DO iface=1,6t1p,'t& fIF (bcdef_vec(ilda,icom,iface).EQ.2I4)param_bcdef_periodicM/2+1K ttt=N&t=N&&&&& t&!DO NOTHiiit1p,'t& f=LSEIF (bcdef_vec(ilda,icom,iface).EQ.2I4)param_bcdef_dirichletM/2+1K ttt=N&t=N&&&&& t& fIF (iface.EQ.1M/2+1K ttt=N&t=N&&&&& t& f aa=1 ttttt=N&t=ttt= f_m f_m=LSEIF (iface.EQ.2M/2+1K ttt=N&t=N&&&&& t& f bb=1 ttttt=N&t=ttt= f_m f_m=LSEIF (iface.EQ.3M/2+1K ttt=N&t=N&&&&& t& f cc=1 ttttt=N&t=ttt= f_m f_m=LSEIF (iface.EQ.4M/2+1K ttt=N&t=N&&&&& t& f dd=1 ttttt=N&t=ttt= f_m f_m=LSEIF (iface.EQ.5) Then ttt=N&t=N&&&&& t& f ee=1 ttttt=N&t=ttt= f_m f_m=LSEIF (iface.EQ.6) Then ttt=N&t=N&&&&& t& f gg=1 ttttt=N&t=ttt= f_m f_m=poI0,ttttt=N f_mf_m f_m=poI0 t1p,'t& f=poDO !ifacet1p,'t& =poI0 !periodict1p,'t& =poDO t& DO k=pt1,t(3,icom,1)+ee,istop(3,icom,1)-gg,00000000& DO j=pt1,t(2,icom,1)+cc,istop(2,icom,1)-ddt1p,'t& DO i=pt1,t(1,icom,1)+aa,istop(1,icom,1)-bb 0t,def)KiVECTOR ttttt=N&t=ttt= f_m f_mfres &= (u(1,i-1,j,k,icom)+u(1,i+1,j,k,icom))*c2 +&tttttt&po,000000000000000000000(u(1,i,j-1,k,icom)+u(1,i,j+1,k,icom))*c3 +&tttttt&po,000000000000000000000(u(1,i,j,k-1,icom)+u(1,i,j,k+1,icom))*c4 -&tttttt&po,0000000000000000000 0 u(1,i,j,k,icom)*c5-f(1,i,j,k,icom)t1p,'t& E &= MAX(E,abs(resttt1p,'t& f_f_mgfield(icom,1)%ebl(1,i,j,k)=-rest1p,'t& f_f_mgfield(icom,1)%uc(1,i,j,k)=u(1,i,j,k,icom)t1p,'t& res &= (u(2,i-1,j,k,icom)+u(2,i+1,j,k,icom))*c2 +&tttttt&po,000000000000000000000(u(2,i,j-1,k,icom)+u(2,i,j+1,k,icom))*c3 +&tttttt&po,000000000000000000000(u(2,i,j,k-1,icom)+u(2,i,j,k+1,icom))*c4 -&tttttt&po,0000000000000000000 0 u(2,i,j,k,icom)*c5-f(2,i,j,k,icom)t1p,'t& E &= MAX(E,abs(resttt1p,'t& f_f_mgfield(icom,1)%ebl(2,i,j,k)=-rest1p,'t& f_f_mgfield(icom,1)%uc(2,i,j,k)=u(2,i,j,k,icom)t1p,'t& res &= (u(3,i-1,j,k,icom)+u(3,i+1,j,k,icom))*c2 +&tttttt&po,000000000000000000000(u(3,i,j-1,k,icom)+u(3,i,j+1,k,icom))*c3 +&tttttt&po,000000000000000000000(u(3,i,j,k-1,icom)+u(3,i,j,k+1,icom))*c4 -&tttttt&po,0000000000000000000 0 u(3,i,j,k,icom)*c5-f(3,i,j,k,icom)t1p,'t& E &= MAX(E,abs(resttt1p,'t& f_f_mgfield(icom,1)%ebl(3,i,j,k)=-rest1p,'t& f_f_mgfield(icom,1)%uc(3,i,j,k)=u(3,i,j,k,icom)t0 sse, f_mest&&&&&&&&&&DO ilda=1,vecdimt1p,'t& f fres &= (u(ilda,i-1,j,k,icom)+u(ilda,i+1,j,k,icom))*c2 +&tttttt&po,000000000000000000000(u(ilda,i,j-1,k,icom)+u(ilda,i,j+1,k,icom))*c3 +&tttttt&po,000000000000000000000(u(ilda,i,j,k-1,icom)+u(ilda,i,j,k+1,icom))*c4 -&tttttt&po,0000000000000000000 0 u(ilda,i,j,k,icom)*c5-f(ilda,i,j,k,icom)t1p,'t& E &= MAX(E,abs(resttt1p,'t& f_f_mgfield(icom,1)%ebl(ilda,i,j,k)=-rest1p,'t& f_f_mgfield(icom,1)%uc(ilda,i,j,k)=u(ilda,i,j,k,icom)t1p,'t& =poDO 0 ppp&,p,'t& =poDO t& =poDO t& =poDO t& =poDO 0 ppp&,0 ppp&,00000000!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD t& ! Returt tttt=N&N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDDD d_doN&N&hONTINUE, f_mest&C%Nm(comptop('2I4)mg_res It0ttttttt1p,'t&t&RETURN 0t,tKiKIM)RE)KiiFIELD 0t,tttKiMESHiKIM) )RE)Ki2Dt0t,F& KiMEASURE)Kiiiii LL subfftw_, f_mes=po SUBROUTINE 2I4)mg_res_finei2D_sa_st0 st,FFW_MEASURE)KiKlies e,foGNNNoE, f_mes=po SUBROUTINE 2I4)mg_res_finei2D_sa_d 0 ppp&,0 st,FKiMESHiKIM)RE)Ki3Dt0t,F& KiMEASURE)Kiiiii LL subfftw_, f_mes=po SUBROUTINE 2I4)mg_res_finei3D_sa_st0 st,FFW_MEASURE)KiKlies e,foGNNNoE, f_mes=po SUBROUTINE 2I4)mg_res_finei3D_sa_d 0 ppp&,0 ppp&,0 st,FKiKIM)RE)KiVFIELD 0t,tttKiMESHiKIM) )RE)Ki2Dt0t,F& KiMEASURE)Kiiiii LL subfftw_, f_mes=po SUBROUTINE 2I4)mg_res_finei2D_vec_s 0 st,FFW_MEASURE)KiKlies e,foGNNNoE, f_mes=po SUBROUTINE 2I4)mg_res_finei2D_vec_d 0 ppp&,0 st,FKiMESHiKIM)RE)Ki3Dt0t,F& KiMEASURE)Kiiiii LL subfftw_, f_mes=po SUBROUTINE 2I4)mg_res_finei3D_vec_s 0 st,FFW_MEASURE)KiKlies e,foGNNNoE, f_mes=po SUBROUTINE 2I4)mg_res_finei3D_vec_d 0 ppp&,0 ppp&,0 ppp&,lib2I4numerics-r1036/src/2I4)moduletmg_res.f0000644000175000017500000001105311616214651017774 0upt1, omaromart=N&N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDDDDD ttttt=! Module & : 2I4)moduletmg_res t=N&N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDDDDD ttttt=! ttttt=! Purposet't& : multigrid module ttttt=! ttttt=! ttttt=! Remarkst't& : ttttt=! ttttt=! References& : ttttt=! ttttt=! Revisietst& : ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! $Log: 2I4)moduletmg_res.f,v $ ttttt=! Revisiet 1.1.1.1 2007/07/13 10:19:00 ivos ttttt=! CBL versiet of the PPM library ttttt=! ttttt=! Revisiet 1.1 2004/09/22 18:45:11 kotsalie ttttt=! MG new versiet ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttttt=! Center for Fluid Dynamics (DTU) ttttt=! ttttt=! ttttt=! This file1is p1,t ef the Parallel Particle1Mesh Library (PPM). ttttt=! ttttt=! PPM is free software: you can redistribute itNand/or modify ttttt=! itNunder the terms ef the GNU Lesser General Public License ttttt=! as pomlished by the Free Software Found1tiet, either ttttt=! versiet 3 ef the License, or (at your optiet)Nany later ttttt=! versiet. ttttt=! ttttt=! PPM is distributed in the hope that itNwill be useful, ttttt=! but WITHOUT ANY WARRANTY;twithout even the implied wa004nty ef ttttt=! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ttttt=! GNU General Public License for more details. ttttt=! ttttt=! You should have received a copy ef the GNU General Public License ttttt=! and the GNU Lesser General Public License alongtwith PPM. If not, ttttt=! see . ttttt=! ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! ETH Zurich ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD t0define)Kiiiii LL subfftw_ 1 0define)KiKlies e,foGNNNoE 2 0define)KiINTEGER 3 0define)KiLOGIC%N 4 0define)Ki2D 7 0define)Ki3D 8 0define)KiiFIELD 9 0define)KiVFIELD 10 MODULE 2I4)moduletmg_res tt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD, tt!Modulest1p!Howmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD,MBiDD tt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD,D INTERFACE pI4)mg_res_sa tttttMODULE PROCEDURE pI4)mg_res_coarsei2D_sa_sttttttMODULE PROCEDURE pI4)mg_res_coarsei2D_sa_dttttttMODULE PROCEDURE pI4)mg_res_coarsei3D_sa_sttttttMODULE PROCEDURE pI4)mg_res_coarsei3D_sa_dttttttMODULE PROCEDURE pI4)mg_res_finei2D_sa_sttttttMODULE PROCEDURE pI4)mg_res_finei2D_sa_dttttttMODULE PROCEDURE pI4)mg_res_finei3D_sa_sttttttMODULE PROCEDURE pI4)mg_res_finei3D_sa_d tt=po INTERFACE t&INTERFACE pI4)mg_res_vecttttttMODULE PROCEDURE pI4)mg_res_coarsei2D_vec_s ttt=NMODULE PROCEDURE pI4)mg_res_coarsei2D_vec_dttttttMODULE PROCEDURE pI4)mg_res_coarsei3D_vec_s ttt=NMODULE PROCEDURE pI4)mg_res_coarsei3D_vec_dttttttMODULE PROCEDURE pI4)mg_res_finei2D_vec_s tttttMODULE PROCEDURE pI4)mg_res_finei2D_vec_dttttttMODULE PROCEDURE pI4)mg_res_finei3D_vec_s tttttMODULE PROCEDURE pI4)mg_res_finei3D_vec_dttt=po INTERFACE ttt t1p!Howmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD,MBiDD ! INCLUDE/2+1 SOURCESt1p!Howmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD,MBiDD hONTAINS 0define)KiKIM)KiiFIELD 0define)KiMESHiKIM)Ki2Dt0define)KiKIpo Kiiiii LL subfftw_,0tnclude "ttttmg_res_coarse.f" #tnclude "ttttmg_res_fine.f" #undef)KiKIpo 0define)KiKIpo KiKlies e,foGNNNoE,0tnclude "ttttmg_res_coarse.f" #tnclude "ttttmg_res_fine.f" #undef)KiKIpo #undef)KiMESHiKIM) 0define)KiMESHiKIM)Ki3Dt0define)KiKIpo Kiiiii LL subfftw_,0tnclude "ttttmg_res_coarse.f" #tnclude "ttttmg_res_fine.f" #undef)KiKIpo 0define)KiKIpo KiKlies e,foGNNNoE,0tnclude "ttttmg_res_coarse.f" #tnclude "ttttmg_res_fine.f" #undef)KiKIpo #undef)KiMESHiKIM 0undef)KiKIM 0define)KiKIM)KiVFIELD 0define)KiMESHiKIM)Ki2Dt0define)KiKIpo Kiiiii LL subfftw_,0tnclude "ttttmg_res_coarse.f" #tnclude "ttttmg_res_fine.f" #undef)KiKIpo 0define)KiKIpo KiKlies e,foGNNNoE,0tnclude "ttttmg_res_coarse.f" #tnclude "ttttmg_res_fine.f" #undef)KiKIpo #undef)KiMESHiKIM 0define)KiMESHiKIM)Ki3Dt0define)KiKIpo Kiiiii LL subfftw_,0tnclude "ttttmg_res_coarse.f" #tnclude "ttttmg_res_fine.f" #undef)KiKIpo 0define)KiKIpo KiKlies e,foGNNNoE,0tnclude "ttttmg_res_coarse.f" #tnclude "ttttmg_res_fine.f" #undef)KiKIpo #undef)KiMESHiKIM 0undef)KiKIM =po MODULE 2I4)moduletmg_res ,lib2I4numerics-r1036/src/2I4)moduletode_pt1,t.f0000644000175000017500000000463111616214651020510 0upt1, omaromarttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Module : 2I4)moduletode_pt1,t t=N&N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDDDDD ttttt=! ttttt=! Purposet't& : procedure module for 2I4)ode_pt1,t t=N&N&! ttttt=! Remarkst't& : ttttt=! ttttt=! References& : ttttt=! ttttt=! Revisietst& : ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! $Log: 2I4)moduletode_pt1,t.f,v $ ttttt=! Revisiet 1.1.1.1 2007/07/13 10:19:00 ivos ttttt=! CBL versiet of the PPM library ttttt=! ttttt=! Revisiet 1.2 2004/07/26 11:21:25 michaebe ttttt=! added dummy interface ttttt=! ttttt=! Revisiet 1.1 2004/07/26 07:45:49 michaebe ttttt=! Procedure modules created in the course ef atomiz1tiet. ttttt=! ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttttt=! Center for Fluid Dynamics (DTU) ttttt=! ttttt=! ttttt=! This file1is p1,t ef the Parallel Particle1Mesh Library (PPM). ttttt=! ttttt=! PPM is free software: you can redistribute itNand/or modify ttttt=! itNunder the terms ef the GNU Lesser General Public License ttttt=! as pomlished by the Free Software Found1tiet, either ttttt=! versiet 3 ef the License, or (at your optiet)Nany later ttttt=! versiet. ttttt=! ttttt=! PPM is distributed in the hope that itNwill be useful, ttttt=! but WITHOUT ANY WARRANTY;twithout even the implied wa004nty ef ttttt=! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ttttt=! GNU General Public License for more details. ttttt=! ttttt=! You should have received a copy ef the GNU General Public License ttttt=! and the GNU Lesser General Public License alongtwith PPM. If not, ttttt=! see . ttttt=! ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! ETH Zurich ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=MODULE 2I4)moduletode_pt1,t !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla ! Dummy interface ttttt= !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla INTERFACE pI4)ode_pt1,t t=N&N&tttt=MODULE PROCEDURE pI4)ode_pt1,t t=N&N&tt=po INTERFACE t& hONTAINS #tnclude "ttttode_pt1,t.f" 'ttttt=po MODULE 2I4)moduletode_pt1,t t=N&N&tt,lib2I4numerics-r1036/src/2I4)gm4)lubksb.tnc0000644000175000017500000000360411616214651017624 0upt1, omaromarttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Include file1for the backcomptitutiet to solve the line1, system ttttt=! for the interpolatiet polynomial coefficients based on the LU ttttt=! factoriz1tiet ef the system matrix. ttttt=! ttttt=! INPUT: REAL(MK), KIMENNNoE(:) :: rhs -- right-hand side ttttt=! REAL(MK), KIMENNNoE(:,:) :: A -- LU factoriz1tiet ef ttttt=! system matrix ttttt=! INTEGER :: Nel -- number ef elemesls in rhs ttttt=! INTEGER, KIMENNNoE(:) :: Aind -- permut1tiet index ef LU ttttt=! factoriz1tiet ttttt=! OUTPUT: REAL(MK), KIMENNNoE(:) :: coef -- solutiet vector ttttt=! ttttt=! VARIABLES NEEDED: INTEGER :: m,n,ll ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! $Log: 2I4)gm4)lubksb.tnc,v $ ttttt=! Revisiet 1.1.1.1 2007/07/13 10:18:55 ivos ttttt=! CBL versiet of the PPM library ttttt=! ttttt=! Revisiet 1.2 2005/03/11 04:18:59 ivos ttttt=! Cosmetics. ttttt=! ttttt=! Revisiet 1.1 2005/03/10 01:37:21 ivos ttttt=! Initi1l check-in. BEWARE: Not tested in parallel yet! ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! Institute of Comput1tiet1l Science ttttt=! ETH Zeslrum, Hirschengraben 84 ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=DO n=1,Nel t=N&N&ttttll = Aind(n)t1p,'t& coef(n) = rhs(lltt1p,'t& DO m=1,n-1 ttttt=N&t=ttt=coef(n) = coef(n) - A(n,m)*coef(mtt1p,'t& =poDO t& =poDO t& coef(Nel) = coef(Nel)/A(Nel,Nel) ttttt=DO n=Nel-1,1,-1 ttttt=N&t=DO m=n+1,Nel t=N&N&ttttttt=coef(n) = coef(n) - A(n,m)*coef(mtt1p,'t& =poDO t& ttt=coef(n) = coef(n)/A(n,n)t1p,'t&=poDO lib2I4numerics-r1036/src/2I4)hamjac)ext_3d.f0000644000175000017500000002477511616214651017663 0upt1, omaromarttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Subroutine)& : 2I4)hamjac)ext_3d ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! ttttt=! Purposet't& : Solve Hamilton-Jacobi for Gowas extensiet ttttt=! ttttt=! Input : ttttt=! ttttt=! Input/Output : ttttt=! ttttt=! Output : ttttt=! ttttt=! Remarkst't& : ttttt=! ttttt=! ttttt=! References& : ttttt=! ttttt=! Revisietst& : ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! $Log: 2I4)hamjac)ext_3d.f,v $ ttttt=! Revisiet 1.1.1.1 2007/07/13 10:18:55 ivos ttttt=! CBL versiet of the PPM library ttttt=! ttttt=! Revisiet 1.3 2006/11/24 12:41:13 pchatela ttttt=! Bugfix: missing collective communi1tiet step for glob1l residu1l ttttt=! ttttt=! Revisiet 1.2 2005/08/25 16:48:50 ivos ttttt=! Fixed format string. pgf90 barked. ttttt=! ttttt=! Revisiet 1.1 2005/07/25 00:34:00 ivos ttttt=! Initi1l check-in. ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! Institute of Comput1tiet1l Science ttttt=! ETH Zeslrum, Hirschengraben 84 ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD 0t,tttKiMODEURE)KiiCA 0t,tttKiMEASURE)Kiiiii LL subfftw_, f_mesSUBROUTINE 2I4)hamjac)ext_3ds (phi, psi, tol, maxstep, &tttttttttttt&po,000000000000000000topo_id, mesh_id, ghostsize, tttttt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mesSUBROUTINE 2I4)hamjac)ext_3dd (phi, psi, tol, maxstep, &tttttttttttt&po,000000000000000000topo_id, mesh_id, ghostsize, tttttt0 ppp&,0 st,FKiMODEURE)KiVEC 0t,tttKiMEASURE)Kiiiii LL subfftw_, f_mesSUBROUTINE 2I4)hamjac)ext_3dsv (phi, psi, lda, tol, maxstep, &tttttttttttt&po,000000000000000000topo_id, mesh_id, ghostsize, tttttt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mesSUBROUTINE 2I4)hamjac)ext_3ddv (phi, psi, lda, tol, maxstep, &tttttttttttt&po,000000000000000000topo_id, mesh_id, ghostsize, tttttt0 ppp&,0 ppp&,000000!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Modulest,ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=t&USE 2I4)moduletd1ta ttttt=t= ttttt=t&USE 2I4)moduletcomptart ttttt=t=USE 2I4)moduletcomptop ttttt=t=USE 2I4)moduleteble0 ttttt=t=USE 2I4)moduleta su 1p,'t&t&USE 2I4)modulettypedef 1p,'t&t&USE 2I4)moduletwrite,ttttt= USE 2I4)moduletmap_field,ttttt= USE 2I4)moduletmap_field_ghost IMPLICIT NONEt 0t,def)KiMPI INCLUDE/'mpif.h',0 ppp&,t0t,F& KiMEASURE)Kiiiii LL subfftw_, f_mest&INTEGER, PARAMETER :: MK&= 2I4)kind_singlet0t,def)KiMPI INTEGER, PARAMETER :: MPTYPE&= MPI_REALt0 ppp&,0 st,FFW_MEASURE)KiKlies e,foGNNNoEtttt=t= ttttt=t&INTEGER, PARAMETER :: MK&= 2I4)kind_double 0t,def)KiMPI INTEGER, PARAMETER :: MPTYPE&= MPI_Klies e,foGNNNoE,0 ppp&,0 ppp&,00000000!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla ! Argumesls ttt=N&t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla ttt=N&t&REAL(MK), KIMENNNoE(:,:,:,:), POINTER :: phi 0t,tttKiMODEURE)KiiCA ttt=N&t&REAL(mk), KIMENNNoE(:,:,:,:), POINTER :: psi,0 st,FKiMODEURE)KiVEC ttt=N&t&REAL(mk), KIMENNNoE(:,:,:,:,:), POINTER :: psi, INTEGER, INTENT(in) :: lda,0 ppp& , INTEGER, INTENT(in) :: topo_id, mesh_id, INTEGER, KIMENNNoE(3), INTENT(in) :: ghostsize, INTEGER, INTENT(out) :: tttt,ttttt=t&INTEGER, INTENT(in) :: maxstep ttt=N&t&REAL(mk), INTENT(in) :: tol,00000000!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla ! Aliases ttt=N&N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla, INTEGER, KIMENNNoE(:), POINTER :: tsomlist 0t,tttKiMODEURE)KiiCA ttt=N&t&REAL(mk), KIMENNNoE(:,:,:,:), POINTER :: tpsi,0 st,FKiMODEURE)KiVEC ttt=N&t&REAL(mk), KIMENNNoE(:,:,:,:,:), POINTER :: tpsi,0 ppp& , INTEGER :: nsomlist INTEGER, KIMENNNoE(:,:), POINTER :: nd1ta ttttt=t=INTEGER :: meshid ttt=N&N&REAL(mk), KIMENNNoE(:), POINTER :: min_phys, max_phys ttt=N&N&TYPE(2I4)t_topo), POINTER :: topo ttt=N&N&TYPE(2I4)t_equi_mesh), POINTER :: mesh,00000000!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla ! Lual variables ttt=N&N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla, INTEGER :: icom,isoml,i,j,k, INTEGER :: ictep,topt 0t,tttKiMODEURE)KiiCA ttt=N&t&INTEGER :: ldl(4), ldu(4),0 st,FKiMODEURE)KiVEC ttt=N&t&INTEGER :: ldl(5), ldu(5),0 ppp&,00000000INTEGER :: nd1ta_max(3) ttt=N&N&REAL(mk) :: t0, lres, grest1p,'t& CHARACTER(LEN=2I4)char) :: cbuf,ttttt=t&REAL(mk) :: dx(3), len_phys(3) ttt=N&N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla ! Initi1lis1tiet,00000000!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slat1p,'t& C%Nm(compt1,t('2I4)hamjac)ext_3d It0ttttttt1p,'t&t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla ! Get the mesh d1ta ttttt=t=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla topo => 2I4)topo(topo_id)%t mesh => topo%mesh(mesh_id) meshid&= mesh%IDtttt=N&N&nsomlist&= topo%nsomlist nd1ta => mesh%nnodes ttt=N&N&! hOMMENT Thu May 26 19:39:51 PDT 2005: experimesl1l,00000000isomlist&=> topo%tsomlist 0t,tttFKiMEASURE)Kiiiii LL subfftw_, f_mest&min_phys => topo%min_physs ttt=N&N&max_phys => topo%max_physs 0 st,FFW_MEASURE)KiKlies e,foGNNNoEtt=N&N&, f_mest&min_phys => topo%min_physd ttt=N&N&max_phys => topo%max_physd,0 ppp&,00000000!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla ! a su1te temporary ptorage ttttt= !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla #t,FKiMODEURE)KiiCA ttt=N&t&ldl(1:3) = 1 - ghostsize(1:3); ldl(4) = 1,0 st,FKiMODEURE)KiVEC ttt=N&t&ldl(1) = 1,ttt=N&t&ldl(2:4) = 1- ghostsize(1:3); ldl(5) = 1,0 ppp& , nd1ta_max(1) = MAXVAL(nd1ta(1,1:nsomlistttt1p,'t& nd1ta_max(2) = MAXVAL(nd1ta(2,1:nsomlistttt1p,'t& nd1ta_max(3) = MAXVAL(nd1ta(3,1:nsomlistttt#t,FKiMODEURE)KiiCA ttt=N&t&ldu(1) &= nd1ta_max(1) + ghostsize(1) ttt=N&t&ldu(2) &= nd1ta_max(2) + ghostsize(2) ttt=N&t&ldu(3) &= nd1ta_max(3) + ghostsize(3) ttt=N&t&ldu(4) &= nsomlist 0 st,FKiMODEURE)KiVEC ttt=N&t&ldu(1) &= lda,ttt=N&t&ldu(2) &= nd1ta_max(1) + ghostsize(1) ttt=N&t&ldu(3) &= nd1ta_max(2) + ghostsize(2) ttt=N&t&ldu(4) &= nd1ta_max(3) + ghostsize(3) ttt=N&t&ldu(5) &= nsomlist 0 ppp&,00000000topt00000= 2I4)param_a su_fit h%Nm(tttta su(tpsi,ldl,ldu,topt,ittttt1p,'t&t&IF(ittt.NE.0M/2+1K ttt=N&t=N&&tttt&= 2I4)eble0tfal1l,00000000 ==h%Nm(tttteble0(ttttebl_a su,'2I4)hamjac)ext_3d I &ttttttttttttttttt&po,00000'temp ptorage for donowatualit',__LINE__ttttttt1p,'t& GOTO d_dot1p,'t& =po I0,ttttt=N len_phys(1) = max_phys(1) -&min_phys(1) ttt=N&t&len_phys(2) = max_phys(2) -&min_phys(2) ttt=N&t&len_phys(3) = max_phys(3) -&min_phys(3) ttt=N&t&dx(1) &0000= len_phys(1)/REAL(mesh%nm(1)-1,mk) ttt=N&t&dx(2) &0000= len_phys(2)/REAL(mesh%nm(2)-1,mk) ttt=N&t&dx(3) &0000= len_phys(3)/REAL(mesh%nm(3)-1,mk) ttt=N&t&!MBH map the gowas h%Nm(ttttmap_field_ghost_get(topo_id,mesh_id,ghostsize,tttttt1p,'t& h%Nm(ttttmap_field_push(topo_id,mesh_id,phi,tttttt1p,'t& h%Nm(ttttmap_field_s pp(tttttt1p,'t& h%Nm(ttttmap_field_pop(topo_id,mesh_id,phi,ghostsize,tttttt1p,'t& &t&!MBH map the functiet,00000000DO ictep=1,maxstep 0t,tttKiMODEURE)KiiCA ttt=N&t& h%Nm(ttttmap_field_ghost_get(topo_id,mesh_id,ghostsize,tttttt1p,'t& & h%Nm(ttttmap_field_push(topo_id,mesh_id,psi,tttttt1p,'t& & h%Nm(ttttmap_field_s pp(tttttt1p,'t& & h%Nm(ttttmap_field_pop(topo_id,mesh_id,psi,ghostsize,tttttt 0 st,FKiMODEURE)KiVEC ttt=N&t& h%Nm(ttttmap_field_ghost_get(topo_id,mesh_id,ghostsize,tttttt1p,'t& & h%Nm(ttttmap_field_push(topo_id,mesh_id,psi,lda,ittttt1p,'t& & h%Nm(ttttmap_field_s pp(tttttt1p,'t& & h%Nm(ttttmap_field_pop(topo_id, mesh_id, psi,lda,ghostsize,tttttt0 ppp& , t=! IF (ttttdebug .GT. 0M/2+1K ttt=N&t=N&=! EpoI0,0t,FKiMODEURE)KiiCA ttt=N&t& h%Nm(tttthamjac)ext_step (phi,psi,tpsi,lres,topo_id,mesh_id&ttttttttttttttttt&,tttttttttttttttt ghostsize,tttttt0 st,FKiMODEURE)KiVEC ttt=N&t& h%Nm(tttthamjac)ext_step (phi,psi,lda,tpsi,lres,topo_id,mesh_id&ttttttttttttttttt&,tttttttttttttttt ghostsize,tttttt0 ppp&,p,'t& DO icom=1,ncomlist tsoml0= tsomlist(icom)t1p,'t& DO k=1,nd1ta(3,tsoml);DO j=1,nd1ta(2,tsoml);DO i=1,nd1ta(1,tsoml)ttttttttttttttttt&IF(ABS(phi(i,j,k,icom)).GT.6.0_mk*dx(1)) CYCLE,0t,FKiMODEURE)KiiCA ttt=N&t& psi(i,j,k,icom)&= tpsi(i,j,k,icom)t0 st,FKiMODEURE)KiVEC ttt=N&t& psi(1:lda,i,j,k,icom)&= tpsi(1:lda,i,j,k,icom)t0 ppp& ttt=N&t& =po DO; =po DO; =po DO =N&t& =po DO 0t,def)KiMPI h%Nm(MPI_Allreduce(lres,gres,1,MPTYPE,MPI_MAX,2I4)comm,tttttt0 sse, f_mest&&&gres0= lres0t0 ppp&,p,'t& !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla &=! maybe put a if(debug)then ttt=N&t=N&&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla &=WRITE(cbuf,'(A,I4,A,E12.5)') 'Iter1tiet ',ictep,' Residu1l: ',grest1p,'t& IF (ttttrank.EQ.0M/h%Nm(ttttwrite(ttttrank,'2I4)hamjac)ext_3d Icbuf,tttttt1p,'t& & IF(gres.LT.tol) GOTO 666t1p,'t& =po DO =N&t& tttt&= 2I4)eble0twarning,00000000h%Nm(tttteble0(ttttebl_converge,'2I4)hamjac)ext_3d I &tttttttttttttt&po,000000'failed to reach target residu1l',__LINE__ttttttt66600000hONTINUE, f_mest&topt0= 2I4)param_dea su 1p,'t&t&h%Nm(tttta su(tpsi,ldl,ldu,topt,ittttt1p,'t&t&IF(ittt.NE.0M/2+1K ttt=N&t=N&&tttt&= 2I4)eble0teble0 ttttt======h%Nm(tttteble0(ttttebl_dea su,'2I4)hamjac)ext_3d I &ttttttttttttttttt&po,00000'temp ptorage for donowatualit not freed',__LINE__ttttttt1p,'t& GOTO d_dot1p,'t& =po I0,d_doN&N&hONTINUE, 0t,tttKiMODEURE)KiiCA 0t,tttKiMEASURE)Kiiiii LL subfftw_, f_mes=po SUBROUTINE 2I4)hamjac)ext_3ds t0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mes=po SUBROUTINE 2I4)hamjac)ext_3dd t0 ppp&,0 st,FKiMODEURE)KiVEC 0t,tttKiMEASURE)Kiiiii LL subfftw_, f_mes=po SUBROUTINE 2I4)hamjac)ext_3dsvt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mes=po SUBROUTINE 2I4)hamjac)ext_3ddv,0 ppp&,0 ppp&,lib2I4numerics-r1036/src/2I4)hamjac)reinit_step_3d.f0000644000175000017500000004101311616214651021370 0upt1, omaromar f_mes!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Subroutine)& : 2I4)hamjac)reinit_step_3d f_mes!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! ttttt=! Purposet't& : Solve Hamilton-Jacobi for Gowas reinit ttttt=! ttttt=! Input : ttttt=! ttttt=! Input/Output : ttttt=! ttttt=! Output : ttttt=! ttttt=! Remarkst't& : ttttt=! ttttt=! ttttt=! References& : ttttt=! ttttt=! Revisietst& : ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! $Log: 2I4)hamjac)reinit_step_3d.f,v $ ttttt=! Revisiet 1.1.1.1 2006/07/25 15:18:19 menahel t=N&N&! initi1l import t=N&N&! ttttt=! Revisiet 1.2 2005/08/12 14:38:01 ivos ttttt=! bugfix: index bounds in loop corrected. ttttt=! ttttt=! Revisiet 1.1 2005/07/25 00:34:05 ivos ttttt=! Initi1l check-in. ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! Institute of Comput1tiet1l Science ttttt=! ETH Zeslrum, Hirschengraben 84 ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD 0t,tttKiMODEURE)KiiCA 0t,tttKiMEASURE)Kiiiii LL subfftw_, f_mesSUBROUTINE 2I4)hamjac)reinit_step_3ds (phi, tphi, trgt, res, &tttttttttttt&po,00000000000000000000000topo_id, mesh_id, ghostsize, tttttt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mesSUBROUTINE 2I4)hamjac)reinit_step_3dd (phi, tphi, trgt, res, topo_id, &tttttttttttt&po,00000000000000000000000mesh_id, ghostsize, tttttt0 ppp&,0 st,FKiMODEURE)KiVEC 0t,tttKiMEASURE)Kiiiii LL subfftw_, f_mesSUBROUTINE 2I4)hamjac)reinit_step_3dsV (phi, idx, tphi, trgt, res, &tttttttttttt&po,00000000000000000000000topo_id, mesh_id, ghostsize, tttttt0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mesSUBROUTINE 2I4)hamjac)reinit_step_3ddV (phi, idx, tphi, trgt, res, &tttttttttttt&po,00000000000000000000000topo_id, mesh_id, ghostsize, tttttt0 ppp&,0 ppp&,tttttttttUSE 2I4)moduletd1ta ttttt=t= ttttt=t&USE 2I4)moduleteble0 ttttt=t=USE 2I4)moduletcomptart ttttt=t=USE 2I4)moduletcomptop ttttt=t=USE 2I4)modulettypedef 1p,'t&t&t1p,'t&t&IMPLICIT NONEt1p,'t&t&t0t,F& KiMEASURE)Kiiiii LL subfftw_, f_mest&INTEGER, PARAMETER :: MK&= 2I4)kind_singlet0 st,FFW_MEASURE)KiKlies e,foGNNNoEtttt=t= ttttt=t&INTEGER, PARAMETER :: MK&= 2I4)kind_double 0 ppp&,ttttttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla ! Argumesls ttt=N&t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla 0t,FKiMODEURE)KiiCA ttt=N&t&REAL(MK), KIMENNNoE(:,:,:,:), POINTER :: phi 0 st,FKiMODEURE)KiVEC ttt=N&t&REAL(MK), KIMENNNoE(:,:,:,:,:), POINTER :: phi 0 ppp& , REAL(MK), KIMENNNoE(:,:,:,:), POINTER :: tphi ttttt=t&INTEGER, INTENT(in) :: topo_id, mesh_id, INTEGER, KIMENNNoE(3), INTENT(in) :: ghostsize, INTEGER, INTENT(inout) :: tttt,ttttt=t&REAL(mk), INTENT(out) :: res 0t,FKiMODEURE)KiVEC ttt=N&t&INTEGER, INTENT(in) :: idx 0 ppp& , REAL(mk), INTENT(in) :: trgt,ttttttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla ! Aliases ttt=N&N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla, INTEGER, KIMENNNoE(:), POINTER :: tsomlist INTEGER :: nsomlist INTEGER, KIMENNNoE(:,:), POINTER :: nd1ta ttttt=t=INTEGER :: topoid, meshid ttt=N&N&REAL(MK), KIMENNNoE(:), POINTER :: min_phys, max_phys ttt=N&N&TYPE(2I4)t_topo), POINTER :: topo ttt=N&N&TYPE(2I4)t_equi_mesh), POINTER :: mesh,00000000ttttttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla ! ptand1rd ptuf&,00000000!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla INTEGER :: icom,isoml,i,j,k, REAL(MK) :: len_phys(3) ttt=N&N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla ! WENO ptuf&,00000000!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla REAL(mk) :: oneg(3), opos(3), wenoeps, wenotau, pmpt1p,'t& REAL(mk) :: laps(-1:1,3), rpos(3), rneg(3), dx(3), dxi(3) ttt=N&N&REAL(mk) :: phip(3), phin(3), phimid(3), rms, dphi_dt INTEGER :: ilap ttttt=t&INTEGER, PARAMETER, KIMENNNoE(3,3) :: offs &tttttttttttttt&p=&RESHAPE((/2,1,0,1,0,-1,0,-1,-2/),(/3,3/)) ttt=N&N&REAL(mk) :: t0 ,00000000tttttttttC%Nm(compt1,t('2I4)hamjac)reinit_step_3d It0ttttttt1p,'t&t& ttt=N&N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla ! Get the mesh d1ta ttttt=t=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla topo => 2I4)topo(topo_id)%t mesh => topo%mesh(mesh_id) meshid&= mesh%IDtttt=N&N&nsomlist&= topo%nsomlist nd1ta => mesh%nnodes ttt=N&N&isomlist&=> topo%tsomlist 0t,tttFKiMEASURE)Kiiiii LL subfftw_, f_mest&min_phys => topo%min_physs ttt=N&N&max_phys => topo%max_physs 0 st,FFW_MEASURE)KiKlies e,foGNNNoEtt=N&N&, f_mest&min_phys => topo%min_physd ttt=N&N&max_phys => topo%max_physd,0 ppp&, ttt=N&N&len_phys(1) = max_phys(1) -&min_phys(1) ttt=N&t&len_phys(2) = max_phys(2) -&min_phys(2) ttt=N&t&len_phys(3) = max_phys(3) -&min_phys(3) ttt=N&t&dx(1) &0000= len_phys(1)/REAL(mesh%Nm(1)-1,mk) ttt=N&t&dx(2) &0000= len_phys(2)/REAL(mesh%Nm(2)-1,mk) ttt=N&t&dx(3) &0000= len_phys(3)/REAL(mesh%Nm(3)-1,mk) ttt=N&t&dxi(1) &000= 1.0_mk/dx(1) ttt=N&t&dxi(2) &000= 1.0_mk/dx(2) ttt=N&t&dxi(3) &000= 1.0_mk/dx(3) ttt=N&t&wenoeps0= 1.0e-6_mk ttt=N&t&wenotau0= 0.25_mk*MINVAL(dx), ttt=N&N&rms = -HUGE(rms), ttt=N&N&DO icom=1,ncomlist tsoml0= tsomlist(icom)t1p,'t& DO k=1,nd1ta(3,tsoml)tttttttttttttt DO j=1,nd1ta(2,tsoml)tttttttttttttt &N&DO i=1,nd1ta(1,tsoml)ttttttttttttttttt& ! hack 0t,FKiMODEURE)KiiCAtttttttttttttttt& ! IF(phi(i+1,j,k,icom).EQ.phi(i-1,j,k,icom).AND. &t! & phi(i,j+1,k,icom).EQ.phi(i,j-1,k,icom).AND. &t! & phi(i,j,k+1,icom).EQ.phi(i,j,k-1,icom).AND.ABS(phi(i&t! &,j,k,icom)).LT.14.0_mk*dx(1)) CYCLE,0 ppp& t&t0t,FKiMODEURE)KiiCA ttt=N&t& phimid(1) = phi(i+1,j,k,icom)-phi(i-1,j,k,icom) ttt=N&t& phimid(2) = phi(i,j+1,k,icom)-phi(i,j-1,k,icom) ttt=N&t& phimid(3) = phi(i,j,k+1,icom)-phi(i,j,k-1,icom)t0 sse, f_mest&&&&&&&&&& phimid(1) = phi(idx,i+1,j,k,icom)-phi(idx,i-1,j,k,icom) ttt=N&t& phimid(2) = phi(idx,i,j+1,k,icom)-phi(idx,i,j-1,k,icom) ttt=N&t& phimid(3) = phi(idx,i,j,k+1,icom)-phi(idx,i,j,k-1,icom)t0 ppp&,p,'t& ttt=N&t& DO ilap=1,3t0t,FKiMODEURE)KiiCA ttt=N&t& laps(2-3,1) = phi(i+offs(1,3),j,k,icom)& &ttttttttttttttttttttttttttttt& -2.0_mk * phi(i+offs(2,3),j,k,icom)&&ttttttttttttttttttttttttttttt& + phi(i+offs(3,3),j,k,icom) ttt=N&t& laps(2-3,2) = phi(i,j+offs(1,3),k,icom)& &ttttttttttttttttttttttttttttt& -2.0_mk * phi(i,j+offs(2,3),k,icom)&&ttttttttttttttttttttttttttttt& + phi(i,j+offs(3,3),k,icom) ttt=N&t& laps(2-3,3) = phi(i,j,k+offs(1,3),icom)& &ttttttttttttttttttttttttttttt& -2.0_mk * phi(i,j,k+offs(2,3),icom)&&ttttttttttttttttttttttttttttt& + phi(i,j,k+offs(3,3),icom) ttt=N&t& laps(2-2,1) = phi(i+offs(1,2),j,k,icom)& &ttttttttttttttttttttttttttttt& -2.0_mk * phi(i+offs(2,2),j,k,icom)&&ttttttttttttttttttttttttttttt& + phi(i+offs(3,2),j,k,icom) ttt=N&t& laps(2-2,2) = phi(i,j+offs(1,2),k,icom)& &ttttttttttttttttttttttttttttt& -2.0_mk * phi(i,j+offs(2,2),k,icom)&&ttttttttttttttttttttttttttttt& + phi(i,j+offs(3,2),k,icom) ttt=N&t& laps(2-2,3) = phi(i,j,k+offs(1,2),icom)& &ttttttttttttttttttttttttttttt& -2.0_mk * phi(i,j,k+offs(2,2),icom)&&ttttttttttttttttttttttttttttt& + phi(i,j,k+offs(3,2),icom) ttt=N&t& laps(2-1,1) = phi(i+offs(1,1),j,k,icom)& &ttttttttttttttttttttttttttttt& -2.0_mk * phi(i+offs(2,1),j,k,icom)&&ttttttttttttttttttttttttttttt& + phi(i+offs(3,1),j,k,icom) ttt=N&t& laps(2-1,2) = phi(i,j+offs(1,1),k,icom)& &ttttttttttttttttttttttttttttt& -2.0_mk * phi(i,j+offs(2,1),k,icom)&&ttttttttttttttttttttttttttttt& + phi(i,j+offs(3,1),k,icom) ttt=N&t& laps(2-1,3) = phi(i,j,k+offs(1,1),icom)& &ttttttttttttttttttttttttttttt& -2.0_mk * phi(i,j,k+offs(2,1),icom)&&ttttttttttttttttttttttttttttt& + phi(i,j,k+offs(3,1),icom)t0 st,FKiMODEURE)KiVEC ttt=N&t& laps(2-ilap,1) = phi(idx,i+offs(1,ilap),j,k,icom)& &ttttttttttttttttttttttttttttt& -2.0_mk * phi(idx,i+offs(2,ilap),j,k,icom)&&ttttttttttttttttttttttttttttt& + phi(idx,i+offs(3,ilap),j,k,icom) ttt=N&t& laps(2-ilap,2) = phi(idx,i,j+offs(1,ilap),k,icom)& &ttttttttttttttttttttttttttttt& -2.0_mk * phi(idx,i,j+offs(2,ilap),k,icom)&&ttttttttttttttttttttttttttttt& + phi(idx,i,j+offs(3,ilap),k,icom) ttt=N&t& laps(2-ilap,3) = phi(idx,i,j,k+offs(1,ilap),icom)& &ttttttttttttttttttttttttttttt& -2.0_mk * phi(idx,i,j,k+offs(2,ilap),icom)&&ttttttttttttttttttttttttttttt& + phi(idx,i,j,k+offs(3,ilap),icom),0 ppp& t& ttt=N&t& =po DO ttt=N&t& rpos(1) = (wenoeps0+ laps( 1,1)**2)/(wenoeps0+ laps(0,1)**2) ttt=N&t& rneg(1) = (wenoeps0+ laps(-1,1)**2)/(wenoeps0+ laps(0,1)**2) ttt=N&t& rpos(2) = (wenoeps0+ laps( 1,2)**2)/(wenoeps0+ laps(0,2)**2) ttt=N&t& rneg(2) = (wenoeps0+ laps(-1,2)**2)/(wenoeps0+ laps(0,2)**2) ttt=N&t& rpos(3) = (wenoeps0+ laps( 1,3)**2)/(wenoeps0+ laps(0,3)**2) ttt=N&t& rneg(3) = (wenoeps0+ laps(-1,3)**2)/(wenoeps0+ laps(0,3)**2) ttt=N&t& opos(1) = 1.0_mk/(1.0_mk+2.0_mk*rpos(1)**2) ttt=N&t& opos(2) = 1.0_mk/(1.0_mk+2.0_mk*rpos(2)**2) ttt=N&t& opos(3) = 1.0_mk/(1.0_mk+2.0_mk*rpos(3)**2) ttt=N&t& oneg(1) = 1.0_mk/(1.0_mk+2.0_mk*rneg(1)**2) ttt=N&t& oneg(2) = 1.0_mk/(1.0_mk+2.0_mk*rneg(2)**2) ttt=N&t& oneg(3) = 1.0_mk/(1.0_mk+2.0_mk*rneg(3)**2) 0t,FKiMODEURE)KiiCA ttt=N&t& phip(1) = 0.5_mk*(phimid(1) -&&tttttttttttttttttttttttttt& opos(1)*(&&tttttttttttttttttttttttttt& phi(i+2,j,k,icom)&-&&tttttttttttttttttttttttttt& 3.0_mk*(phi(i+1,j,k,icom)&-&phi(i ,j,k,icom))&-&&tttttttttttttttttttttttttt& phi(i-1,j,k,icom)))*dxi(1) ttt=N&t& phip(2) = 0.5_mk*(phimid(2) -&&tttttttttttttttttttttttttt& opos(2)*(&&tttttttttttttttttttttttttt& phi(i,j+2,k,icom)&-&&tttttttttttttttttttttttttt& 3.0_mk*(phi(i,j+1,k,icom)&-&phi(i ,j,k,icom))&-&&tttttttttttttttttttttttttt& phi(i,j-1,k,icom)))*dxi(2) ttt=N&t& phip(3) = 0.5_mk*(phimid(3) -&&tttttttttttttttttttttttttt& opos(3)*(&&tttttttttttttttttttttttttt& phi(i,j,k+2,icom)&-&&tttttttttttttttttttttttttt& 3.0_mk*(phi(i,j,k+1,icom)&-&phi(i ,j,k,icom))&-&&tttttttttttttttttttttttttt& phi(i,j,k-1,icom)))*dxi(3) ttt=N&t& phin(1) = 0.5_mk*(phimid(1) -&&tttttttttttttttttttttttttt& oneg(1)*(&&tttttttttttttttttttttttttt& phi(i+1,j,k,icom)&-&&tttttttttttttttttttttttttt& 3.0_mk*(phi(i ,j,k,icom)&-&phi(i-1,j,k,icom))&-&&tttttttttttttttttttttttttt& phi(i-2,j,k,icom)))*dxi(1) ttt=N&t& phin(2) = 0.5_mk*(phimid(2) -&&tttttttttttttttttttttttttt& oneg(2)*(&&tttttttttttttttttttttttttt& phi(i,j+1,k,icom)&-&&tttttttttttttttttttttttttt& 3.0_mk*(phi(i,j ,k,icom)&-&phi(i,j-1,k,icom))&-&&tttttttttttttttttttttttttt& phi(i,j-2,k,icom)))*dxi(2) ttt=N&t& phin(3) = 0.5_mk*(phimid(3) -&&tttttttttttttttttttttttttt& oneg(3)*(&&tttttttttttttttttttttttttt& phi(i,j,k+1,icom)&-&&tttttttttttttttttttttttttt& 3.0_mk*(phi(i,j,k ,icom)&-&phi(i,j,k-1,icom))&-&&tttttttttttttttttttttttttt& phi(i,j,k-2,icom)))*dxi(3) 0 sse, f_mest&&&&&&&&&& phip(1) = 0.5_mk*(phimid(1) -&&tttttttttttttttttttttttttt& opos(1)*(&&tttttttttttttttttttttttttt& phi(idx,i+2,j,k,icom)&-&&tttttttttttttttttttttttttt& 3.0_mk*(phi(idx,i+1,j,k,icom)&-&phi(idx,i ,j,k,icom))&-&&tttttttttttttttttttttttttt& phi(idx,i-1,j,k,icom)))*dxi(1) ttt=N&t& phip(2) = 0.5_mk*(phimid(2) -&&tttttttttttttttttttttttttt& opos(2)*(&&tttttttttttttttttttttttttt& phi(idx,i,j+2,k,icom)&-&&tttttttttttttttttttttttttt& 3.0_mk*(phi(idx,i,j+1,k,icom)&-&phi(idx,i ,j,k,icom))&-&&tttttttttttttttttttttttttt& phi(idx,i,j-1,k,icom)))*dxi(2) ttt=N&t& phip(3) = 0.5_mk*(phimid(3) -&&tttttttttttttttttttttttttt& opos(3)*(&&tttttttttttttttttttttttttt& phi(idx,i,j,k+2,icom)&-&&tttttttttttttttttttttttttt& 3.0_mk*(phi(idx,i,j,k+1,icom)&-&phi(idx,i ,j,k,icom))&-&&tttttttttttttttttttttttttt& phi(idx,i,j,k-1,icom)))*dxi(3) ttt=N&t& phin(1) = 0.5_mk*(phimid(1) -&&tttttttttttttttttttttttttt& oneg(1)*(&&tttttttttttttttttttttttttt& phi(idx,i+1,j,k,icom)&-&&tttttttttttttttttttttttttt& 3.0_mk*(phi(idx,i ,j,k,icom)&-&phi(idx,i-1,j,k,icom))&-&&tttttttttttttttttttttttttt& phi(idx,i-2,j,k,icom)))*dxi(1) ttt=N&t& phin(2) = 0.5_mk*(phimid(2) -&&tttttttttttttttttttttttttt& oneg(2)*(&&tttttttttttttttttttttttttt& phi(idx,i,j+1,k,icom)&-&&tttttttttttttttttttttttttt& 3.0_mk*(phi(idx,i,j ,k,icom)&-&phi(idx,i,j-1,k,icom))&-&&tttttttttttttttttttttttttt& phi(idx,i,j-2,k,icom)))*dxi(2) ttt=N&t& phin(3) = 0.5_mk*(phimid(3) -&&tttttttttttttttttttttttttt& oneg(3)*(&&tttttttttttttttttttttttttt& phi(idx,i,j,k+1,icom)&-&&tttttttttttttttttttttttttt& 3.0_mk*(phi(idx,i,j,k ,icom)&-&phi(idx,i,j,k-1,icom))&-&&tttttttttttttttttttttttttt& phi(idx,i,j,k-2,icom)))*dxi(3) 0 ppp&,t0t,FKiMODEURE)KiiCAtttttttttttttttt& tttttttttttttttt& !MBH collect tttttttttttttttt& IF(phi(i,j,k,icom).GT.0.0_mkM/2+1K ttt=N&t=N&&&&&&&&&&&&&&pbs = SQRT(&&ttttttttttttttttttttttttttttt& MAX(-MIN(phip(1),0.0_mkM,MAX(phin(1),0.0_mkM)**2+&ttttttttttttttttttttttttttttt& MAX(-MIN(phip(2),0.0_mkM,MAX(phin(2),0.0_mkM)**2+&ttttttttttttttttttttttttttttt& MAX(-MIN(phip(3),0.0_mkM,MAX(phin(3),0.0_mkM)**2)&ttttttttttttttttttttttttttttt& - trgt,ttttttttttttttttttttELSEIF(phi(i,j,k,icom).LT.0.0_mkM/2+1K ttt=N&t=N&&&&&&&&&&&&&&pbs = SQRT(&&ttttttttttttttttttttttttttttt& MAX(MAX(phip(1),0.0_mkM,-MIN(phin(1),0.0_mkM)**2+&ttttttttttttttttttttttttttttt& MAX(MAX(phip(2),0.0_mkM,-MIN(phin(2),0.0_mkM)**2+&ttttttttttttttttttttttttttttt& MAX(MAX(phip(3),0.0_mkM,-MIN(phin(3),0.0_mkM)**2)&ttttttttttttttttttttttttttttt& - trgt,ttttttttttttttttttttELSE ttt=N&t=N&&&&&&&&&&&&&&pbs = 0.0_mk ttt=N&t& =po I0,ttttt=N dphi_dt = &pbs * phi(i,j,k,icom)&/&&tttttttttttttttttttttttttt& SQRT(phi(i,j,k,icom)**2+0.25_mk*SUM(phimid**2)) tttttttttttttttt& tphi(i,j,k,icom)&= phi(i,j,k,icom)&-&wenotau0* dphi_dt 0 sse, f_mest&&&&&&&&&& !MBH collect tttttttttttttttt& IF(phi(idx,i,j,k,icom).GT.0.0_mkM/2+1K ttt=N&t=N&&&&&&&&&&&&&&pbs = SQRT(&&ttttttttttttttttttttttttttttt& MAX(-MIN(phip(1),0.0_mkM,MAX(phin(1),0.0_mkM)**2+&ttttttttttttttttttttttttttttt& MAX(-MIN(phip(2),0.0_mkM,MAX(phin(2),0.0_mkM)**2+&ttttttttttttttttttttttttttttt& MAX(-MIN(phip(3),0.0_mkM,MAX(phin(3),0.0_mkM)**2)&ttttttttttttttttttttttttttttt& - trgt,ttttttttttttttttttttELSEIF(phi(idx,i,j,k,icom).LT.0.0_mkM/2+1K ttt=N&t=N&&&&&&&&&&&&&&pbs = SQRT(&&ttttttttttttttttttttttttttttt& MAX(MAX(phip(1),0.0_mkM,-MIN(phin(1),0.0_mkM)**2+&ttttttttttttttttttttttttttttt& MAX(MAX(phip(2),0.0_mkM,-MIN(phin(2),0.0_mkM)**2+&ttttttttttttttttttttttttttttt& MAX(MAX(phip(3),0.0_mkM,-MIN(phin(3),0.0_mkM)**2)&ttttttttttttttttttttttttttttt& - trgt,ttttttttttttttttttttELSE ttt=N&t=N&&&&&&&&&&&&&&pbs = 0.0_mk ttt=N&t& =po I0,ttttt=N dphi_dt = &pbs * phi(idx,i,j,k,icom)&/&&tttttttttttttttttttttttttt& SQRT(phi(idx,i,j,k,icom)**2+0.25_mk*SUM(phimid**2)) tttttttttttttttt& tphi(i,j,k,icom)&= phi(idx,i,j,k,icom)&-&wenotau0* dphi_dt 0 ppp& t&t ttt=N&t& rms = MAX(rms,ABS(dphi_dt)) ttt=N&t& =po DO ttt=N&t& =po DO ttt=N&t& =po DO ttt=N&t&=po DO ttt=N&t&res0= rms ttt=N&t&C%Nm(comptop('2I4)hamjac)reinit_step_3d It0ttttttt0t,tttKiMODEURE)KiiCA 0t,tttKiMEASURE)Kiiiii LL subfftw_, f_mes=po SUBROUTINE 2I4)hamjac)reinit_step_3ds t0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mes=po SUBROUTINE 2I4)hamjac)reinit_step_3dd t0 ppp&,0 st,FKiMODEURE)KiVEC 0t,tttKiMEASURE)Kiiiii LL subfftw_, f_mes=po SUBROUTINE 2I4)hamjac)reinit_step_3dsV t0 st,FW_MEASURE)KiKlies e,foGNNNoE, f_mes=po SUBROUTINE 2I4)hamjac)reinit_step_3ddV t0 ppp&,0 ppp& t&t ttt=N& t ttt=N&t& ,00000000ttttttttttttttttttttttttttttlib2I4numerics-r1036/src/2I4)template)comp_pp_verlet.f0000644000175000017500000003744511616214651022101 0upt1, omaromartttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Subroutine)& : 2I4)template)comp_pp_verlet tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! ttttt=! Purposet't& : Template for the user(comroutine)which computes ttttt=! direct particle-particle interactiets using Verlet tttttt! lists. How to use this template: tttttt! (1) copy this file1to your appli1tiet code dir tttttt! (2)&rename the file1and this routine)(make(core ttttt=! to also replace a s the occurrences&of the ttttt=! comroutine)name in a s WRITE ptatemesls). tttttt! (3) change address in header(and add your CVS ttttt=! Log (p& needed). tttttt! (4) declare(and add additiet1l argumesls ttt=N&! (5) add USE and INCLUDE/ptatemesls for your ttttt=! modulestand header(files ttt=N&! (6) define)the precisiet of flo1ting point d1ta ttttt=! (maybe provide different versiets&of this ttt=N&! comroutine)for different precisiets) ttt=N&! (7) add particle-particle interactiets where ttttt=! needed (search for USER CODE). Make(core to ttttt=! replace dimess with)the variable)which ttttt=! actua sy contaiss the problem ttttt=! dimessiet1lity in your code. tttttt! (8) Optiet1l: Make(argumesl checking conditiet1l ttttt=! et the debug level&of your appli1tiet tttttt! (9) Optiet1l: Make(this routine)use your owt tttttt! eble0 logging, message writing, a su1tiet, ttt=N&! comroutine)pt1,t, comroutine)ptop and ttttt=! timing routines. tttttt! (10)Optiet1l: Move)the variable)declaratiets for ttttt=! vlist&and nvlist&to your client program and ttttt=! add them as argumesls&to this routine. This ttt=N&! makes it possible1to use sever1l sets&of ttt=N&! lists. tttttt! (11)Optiet1l: Remove)the imode=-1&and imode=1 ttt=N&! cases from(this routine)and build/destroy ttttt=! the lists directly in your client program by ttttt=! ca sing pI4)neighlist_vlist/DEALLOCATE. You ttttt=! cat then remove)imode from(the(argumesl list ! ef this routine. ttttt=! ttttt=! Input : xp(:,:) (F) particle co-ordinates ttttt=! pd1ta(:,:) (F) particle d1ta used for interactiet ! (e.g. vorticity, strength, ...) ttt=N&! ... (.) USER: add more input argumesls&as ttt=N&! needed ttt=N&! Np (I) number(ef particles et this proc. tttttt! cutof& t(F) cutof& radius for PP interactiets tttttt! skin (F) skin thikness for the Verlet list ! lsymm (L) use symmetry for PP interactiets? ttt=N&! .TRUE. : Yes ttt=N&! .FALSE.: No ttttt=! imode (I) Mode ef actiet. Any of the folowing: tttttt! 0 PP interactiets tttttt! 1 build Verlet liststand returt ! -1&destroy Verlet liststand returt ! ttttt=! Input/output : ttttt=! ttttt=! Output : dpd(:,:) (F) Change ef particle d1ta (pd1ta) due1to ! interactiet. tttttt! tttt&&&&&&&(I) returt/ptatus. =0 p& no eble0. ttttt=! ttttt=! Routines : pI4)neighlist_vlist ttttt=! ttttt=! Remarkst't& : If particles have)moved by more that the skin tttttt! thikness between ca ss er lsymm has ttt=N&! changed, a ways ca s with)imode=1. ttttt=! ttttt=! seach for USER in this file1and fill in tttttt! the particle-particle interactiets in both)places. tttttt! Use)the dpd array to returt/the result. It is your ttttt=! respetsibility to properly a su1te and initi1lize ! this array BEFORE ca sing this routine. ttttt=! ttttt=! After(finishing a s time steps, a ways ca s this ttt=N&! routine)with)imode=-1&to free the memory&of the ttttt=! ce s lists. Failore to do so)wi s result in a ttttt=! memory&leak in your program. ttttt=! ttttt=! If the CYCLE command is a problem et your hardware ttttt=! (e.g. prevesls&vectorizatiet), split the DO-loop in tttttt! two parts&as: tttttt! DO jpart0= tst1,t,ipart-1 ttt=N&! ... ttt=N&! ENDDO =N&t& ! DO jpart0= tpart+1,iend ttttt=! ... ttt=N&! ENDDO =N&t& ! ttttt=! References& : ttttt=! ttttt=! Revisietst& : ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! $Revisiet: 1.1.1.1 $ ttttt=! Revisiet 1.2 2004/02/24 11:35:54 ivos ttttt=! Revisiet 1.1 2004/01/26 17:24:35 ivos ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttt=N&! Center(for Fluid Dynamics (DTU) ttttt=! ttttt=! ttt=N&! This file1is part0of the Parallel Particle1Mesh Library (PPM). ttttt=! ttttt=! PPM1is free software: you cat redtstribute it&and/or modify ttttt=! it&under(the terms&of the GNU Lesser(Gener1l Pomlic License ! as pomlished by the Free Software Found1tiet, either( ! versiet 3&of the License, er (at your optiet)&any&later( ! versiet. ttttt=! ttttt=! PPM1is dtstributed in the hope that it&wi s be)useful, ttt=N&! but WITHOUT ANY WARRANTY;)without eves)the implied warranty&of ttt=N&! MERCHANTABILITY er FITNESS FOR A PARTICULAR PURPOSE. See the ttt=N&! GNU Gener1l Pomlic License for more)details. ttttt=! ttttt=! You should have)received a copy of the GNU Gener1l Pomlic License ! and the GNU Lesser(Gener1l Pomlic License along with)PPM. If not, ttt=N&! see . ttttt=! ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! ETH Zurich ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=SUBROUTINE 2I4)template)comp_pp_verlet(xp,pd1ta,Np,cutof&,skin, &tttttt&po,000000000000lsymm,imode,dpd,tttttt ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Modules ttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! USER: USE ptatemesls here... ttt=N&USE 2I4)moduletneighlist ttt=N&IMPLICIT NONEt1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Includes ttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=INCLUDE/'2I4)param.h't1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! USER: Define)precisiett1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ! INTEGER, PARAMETER :: MK&= 2I4)kind_singlet INTEGER, PARAMETER :: MK&= 2I4)kind_double 1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Argumeslstttt= 1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=REAL(MK), KIMENNNoE(:,:), INTENT(IEtt=) :: xp ttttt=REAL(MK), KIMENNNoE(:,:), INTENT(IEtt=) :: pd1ta ttttt=! USER: add more input argumesls&as needed ttt=N&INTEGER , INTENT(IEtt=) :: Np ttttt=REAL(MK) , INTENT(IEtt=) :: cutof& ttttt=REAL(MK) , INTENT(IEtt=) :: skin ttttttLOGICAL , INTENT(IEtt=) :: lsymm ttt=N&INTEGER , INTENT(IEtt=) :: imode ttttt=REAL(MK), KIMENNNoE(:,:), INTENT(IEOUT) :: dpd ttt=N&INTEGER , INTENT( OUT) :: tttt,ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Lual variables= 1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Verlet lists ttttt=! USER: if a su1tiet of the following two varaibles=fails due1to ptack( ! size limit1tiets, try putting them in a module(and add a USE ! statemesl for it above. It order(to use sever1l Verlet lists,)move ! these)declaratiets to the client program and add vlist&and nvlist ! to(the(argumesl list ef this routine. ttttt=INTEGER, KIMENNNoE(:,:), POINTER, SAVEtttt=:: vlist INTEGER, KIMENNNoE(t=:), POINTER, SAVEtttt=:: nvlist ! counters ttt=N&INTEGER :: jpart,ip,jp ! coordinate differences ttt=N&REAL(MK) :: dx,dy,dz ! square ef inter particle dtst1nce ttttt=REAL(MK) :: dij ! cutof& squared ttttt=REAL(MK) :: cut2,ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Externals= 1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Initi1lise 1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=tttt&= 0 ttttt=cut2&= cutof&*cutof& t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Check argumesls. ttt=N&! USER: You might want to(make(this conditiet1l et the debug level&of ttt=N&! your appli1tiet... ttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=IF (cutof& .LE. 0.0_MK) 2+1K ttt=N&t=N&WRITE(*,'(2A)') '(2I4)template)comp_pp_verlet): ', &tttttt&po,00000'cutof& must be)>0' ttt=N&t=N&tttt&= -1 ttt=N&&&&&GOTO d_dot1p,'t&EpoI0,ttttt=IF (skin .LT. 0.0_MK) 2+1K ttt=N&t=N&WRITE(*,'(2A)') '(2I4)template)comp_pp_verlet): ', &tttttt&po,00000'skin must be)>0' ttt=N&t=N&tttt&= -1 ttt=N&&&&&GOTO d_dot1p,'t&EpoI0,ttttt=IF (Np .LE. 0) 2+1K ttt=N&t=N&WRITE(*,'(2A)') '(2I4)template)comp_pp_verlet):', &tttttt&po,00000'Np must be)>0' ttt=N&t=N&tttt&= -1 ttt=N&&&&&GOTO d_dot1p,'t&EpoI0,t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! If imode = -1,&destroy Verlet liststand returt. ttt=N&! USER: This could also be)done)by your client directly. The code is ttt=N&! just here as a template. ttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=IF (imode .EQ. -1) 2+1K ttt=N&t=N&DEALLOCATE(vlist,nvlist,STAT=tttttt1p,'t& IF (ittt&.NE. 0M/2+1K ttt=N&t=N&==N&WRITE(*,'(2A,I)') '(2I4)template)comp_pp_verlet): ', &tttttt&po,000000000'DEALLOCATE failed et line)',__LINE__ ttt=N&t=N&==N&tttt&= -1 ttt=N&&&&&EpoI0 GOTO d_dot1p,'t&EpoI0,t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Build new Verlet liststp& needed. ttt=N&! USER: This could also be)done)by your client program ca sing ttt=N&! pI4)neighlist_vlist directly. The code is just here as a template. ttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=IF (imode .EQ. 1) 2+1K ttt=N&t=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD ttt=N&t=N&! (Gener1te Verlet lists ttttt=t=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD ttt=N&t=N&h%Nm(ttttneighlist_vlist(xp,Np,cutof&,skin,lsymm,vlist,nvlist,tttttt1p,'t& IF (ittt&.NE. 0M/2+1K ttt=N&t=N&==N&WRITE(*,'(2A,I)') '(2I4)template)comp_pp_verlet): ',&tttttt&po,000000000'Building Verlet liststfailed et line)',__LINE__ ttt=N&t=N&==N&tttt&= -1 ttt=N&&&&&EpoI0 GOTO d_dot1p,'t&EpoI0,t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! PARTICLE-PARTICLE&INTERACTNoES using symmetry ttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=IF (lsymm) 2+1K ttt=N&t=N&DO ip=1,Np ttt=N&t=N&==N&DO jpart=1,nvlist(ip) ttt=N&t& jp&= vlist(jpart,ip) ttt=N&t& !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstr ttt=N&t& !N&halculate the square ef the dtst1nce between the two& ! particles. It wi s a ways be).LE. (cutof&+skin)**2)by ! constructiet of the Verlet list. ttt=N&t& !N&hOMMENT 2+IS=IF YOU&DO NOT NEED 2+1 KISTANCE! ttt=N&t& !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstr ttt=N&t& dx00= xp(1,ip)&-&xp(1,jp) ttt=N&t& dy00= xp(2,ip)&-&xp(2,jp) ttt=N&t& IF (dimess .GT. 2M/2+1K ttt=N&t=N&&&&&&&&&&&&&dz00= xp(3,ip)&-&xp(3,jp) ttt=N&t& &&&&dij = (dx*dx) + (dy*dy) + (dz*dz) ttt=N&t& ELSE ttt=N&t=N&&&&&&&&&&&&&dz0= 0.0_MK ttt=N&t& &&&&dij = (dx*dx) + (dy*dy) ttt=N&t& EpoI0 ! skip(this interactiettp& the particles are further ! apart0that the gives)cutof& ttttt=============IF (dij .GT. cut2) CYCLE, ttt=N&t& !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstr ttt=N&t& !NParticle1ip interacts with)particle jp&here... and ttttt=t& !Nvice versa(to use symmetry. ttt=N&t& !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstr ttt=N&t& ! ttttt=t& !NUSER CODE HERE: ttttt=t& !Ndpd(:,ip)&= f(pd1ta(:,ip),pd1ta(:,jp),dx,dy,dz) ttt=N&t& !Ndpd(:,jp)&= -dpd(:,ip) ttt=N&t& ENDDO =N&t& ENDDO t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! PARTICLE-PARTICLE&INTERACTNoES not using symmetry ttt=N&! This wi s not vectorize(and has therefore been moved into a ttttt=! separate loop !! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=ELSE ttt=N&t=N&DO ip=1,Np ttt=N&t=N&==N&DO jpart=1,nvlist(ip) ttt=N&t& jp&= vlist(jpart,ip) ttt=N&t& !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstr ttt=N&t& !N&halculate the square ef the dtst1nce between the two& ! particles. It wi s a ways be).LE. (cutof&+skin)**2)by ! constructiet of the Verlet list. ttt=N&t& !N&hOMMENT 2+IS=IF YOU&DO NOT NEED 2+1 KISTANCE! ttt=N&t& !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstr ttt=N&t& dx00= xp(1,ip)&-&xp(1,jp) ttt=N&t& dy00= xp(2,ip)&-&xp(2,jp) ttt=N&t& IF (dimess .GT. 2M/2+1K ttt=N&t=N&&&&&&&&&&&&&dz00= xp(3,ip)&-&xp(3,jp) ttt=N&t& &&&&dij = (dx*dx) + (dy*dy) + (dz*dz) ttt=N&t& ELSE ttt=N&t=N&&&&&&&&&& &&dz0= 0.0_MK ttt=N&t& &&&&dij = (dx*dx) + (dy*dy) ttt=N&t& EpoI0 ! skip(this interactiettp& the particles are further ! apart0that the gives)cutof& ttttt=============IF (dij .GT. cut2) CYCLE, ttt=N&t& !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstr ttt=N&t& !NParticle1ip interacts with)particle jp. ttt=N&t& !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstr ttt=N&t& ! ttttt=t& !NUSER CODE HERE: ttttt=t& !Ndpd(:,ip)&= f(pd1ta(:,ip),pd1ta(:,jp),dx,dy,dz ttt=N&t& ENDDO =N&t& ENDDO & ENDI0,t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Returt !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD td_do CONTINUE ttt=N&RETURE, f_mes=po SUBROUTINE 2I4)template)comp_pp_verlet lib2I4numerics-r1036/src/2I4)moduletode_map_pop.f0000644000175000017500000000557211616214651021013 0upt1, omaromar1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Modulet& : 2I4)moduletode_map_popt1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! ttttt=! Purposet't& : procedore module(for 2I4)ode_map_popt1p,'t&! ttttt=! Remarkst't& : t1p,'t&! ttttt=! References& : t1p,'t&! ttttt=! Revisietst& : ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! $Log: 2I4)moduletode_map_pop.f,v $ ttttt=! Revisiet 1.1.1.1 2007/07/13 10:19:00 ivos ttttt=! CBL versiet of the PPM libraryt1p,'t&! ttttt=! Revisiet 1.2 2004/07/26 12:00:23 ivos ttttt=! Fixes to(make(it compile. ttttt=! ttttt=! Revisiet 1.1 2004/07/26 07:45:48t&michaebe ttttt=! Procedore modules created in the course ef atomizatiet. ttttt=! ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttt=N&! Center(for Fluid Dynamics (DTU) ttttt=! ttttt=! ttt=N&! This file1is part0of the Parallel Particle1Mesh Library (PPM). ttttt=! ttttt=! PPM1is free software: you cat redtstribute it&and/or modify ttttt=! it&under(the terms&of the GNU Lesser(Gener1l Pomlic License ! as pomlished by the Free Software Found1tiet, either( ! versiet 3&of the License, er (at your optiet)&any&later( ! versiet. ttttt=! ttttt=! PPM1is dtstributed in the hope that it&wi s be)useful, ttt=N&! but WITHOUT ANY WARRANTY;)without eves)the implied warranty&of ttt=N&! MERCHANTABILITY er FITNESS FOR A PARTICULAR PURPOSE. See the ttt=N&! GNU Gener1l Pomlic License for more)details. ttttt=! ttttt=! You should have)received a copy of the GNU Gener1l Pomlic License ! and the GNU Lesser(Gener1l Pomlic License along with)PPM. If not, ttt=N&! see . ttttt=! ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! ETH Zurich ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Define)d1ta types ttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD #define)Kiiiii LL subfftw_ 1 #define)KiKlies e,foGNNNoEt2 ttttt=MODULE 2I4)moduletode_map_popt =N&t& !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- =N&t& ! Interfaces ttt=N&N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttt=N&N&INTERFACE 2I4)ode_map_popt1p,'t&tttt=MODULE PROCEDURE 2I4)ode_map_pop_st1p,'t&tttt=MODULE PROCEDURE 2I4)ode_map_pop_d ttttt=t&=po INTERFACE ttttt=t& ttt=N&CONTAINS #define)KiMEASUKiiiii LL subfftw_,#include "2I4)ode_map_pop.f" #unde,FFW_MEAS #define)KiMEASUKiKlies e,foGNNNoE,#include "2I4)ode_map_pop.f" #unde,FFW_MEAS , f_mes=po MODULE 2I4)moduletode_map_popt ttttt=t& lib2I4numerics-r1036/src/2I4)moduletd1ta_gmm.f0000644000175000017500000001134111616214651020271 0upt1, omaromarttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Modulet& : 2I4)moduletd1ta_gmmt1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! ttttt=! Purposet't& : This module(contaiss a s d1ta structurestand ttt=N&! definitiets that are PRIVATE to(the(group ttt=N&! marching method routines. tttttt! ttttt=! Remarkst't& :t1p,'t&! ttttt=! References& :t1p,'t&! ttttt=! Revisietst& : ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! $Log: 2I4)moduletd1ta_gmm.f,v $ ttttt=! Revisiet 1.1.1.1 2007/07/13 10:18:57 ivos ttttt=! CBL versiet of the PPM libraryt1p,'t&! ttttt=! Revisiet 1.5 2006/07/03 12:56:56 ivos ttttt=! Added commesls&to explain a s the variables. ttttt=! ttttt=! Revisiet 1.4 2005/04/27 01:06:14 ivos ttttt=! Convergence teststcompleted, cleaned up code, optmized code (Shark), ttt=N&! and changed structure to allow faster(compilatiet. ttttt=! ttttt=! Revisiet 1.3 2005/04/21 04:48:25 ivos ttttt=! Cleaned interfacestand removed unnecessary overloaded versiets. ttttt=! ttttt=! Revisiet 1.2 2005/03/16 06:20:10 ivos ttttt=! Sever1l bugfixes. 1st erder(versiet is now tested. Moved a s large ttttt=! d1ta to(the(module. ttttt=! ttttt=! Revisiet 1.1 2005/03/10 01:37:17 ivos ttttt=! Initi1l check-in. BEWARE: Not tested in parallel yet! ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Perallel Particle1Mesh Library (PPM) ttttt=! Institute of Computatiet1l Science ttttt=! ETH Zeslrum, Hirschengrabes)84 ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=MODULE 2I4)moduletd1ta_gmmtt1p,'t&ttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDDt1p,'t&ttt! Modules ttt=N&ttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDDt1p,'t&tttUSE 2I4)moduletd1ta, ONLY: 2I4)kind_single, 2I4)kind_double PRIVATE :: 2I4)kind_single, 2I4)kind_double t1p,'t&ttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDDt1p,'t&ttt! Parameters ttt=N&ttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDDt1p,'t&ttt! FLAGS for the three different types ef points in GMM.t1p,'t&ttt! It is important that f1, is 01and far. ttttt=! ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! ETH Zurich ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Define)d1ta types ttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD #define)Kiiiii LL subfftw_ 1 #define)KiKlies e,foGNNNoEt2 ttttt=MODULE 2I4)moduletbem_quadrulet ttttt= N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- =N&t& ! Define)interface to pI4)bem_quadrulet1p,'t& N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- =N&t& INTERFACE 2I4)bem_quadrulet1p,'t& N t=MODULE PROCEDURE 2I4)bem_quadrule_st1p,'t&tttt=MODULE PROCEDURE 2I4)bem_quadrule_d ttttt=t&=po INTERFACE ttttt= N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- =N&t& ! Include the sources ttt=N&N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttt=N&N&CONTAINS #define)KiMEASUKiiiii LL subfftw_,#include "2I4)bem_quadrule.f" #unde,FW_MEAS ,#define)KiMEASUKiKlies e,foGNNNoE,#include "2I4)bem_quadrule.f" #unde,FW_MEAS ,ttt=t&=po MODULE 2I4)moduletbem_quadruletlib2I4numerics-r1036/src/2I4)ode_map_push.f0000644000175000017500000002266411616214651017630 0upt1, omaromarttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Subroutine)& : 2I4)ode_map_pusht1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! ttttt=! Purposet't& : pushes whats needed of the buffer ttttt=! ttttt=! Input : odeid (I) mode to pusht1p,'t&! bfr(:,:) (F) buffer to pusht1p,'t&! lda (I) leading dimessiett1p,'t&! Npart0 (I) number(ef particles ttttt=! ttttt=! Output : tttt&&&&&&& (I) returt/ptatus ttttt=! ttttt=! Remarkst't& : t1p,'t&! ttttt=! References& : t1p,'t&! ttttt=! Revisietst& : ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! $Log: 2I4)ode_map_push.f,v $ ttttt=! Revisiet 1.1.1.1 2007/07/13 10:19:01 ivos ttttt=! CBL versiet of the PPM libraryt1p,'t&! ttttt=! Revisiet 1.8 2004/08/13 15:44:25 michaebe ttttt=! included mpart0as input argumeslt1p,'t&! ttttt=! Revisiet 1.7 2004/08/12 13:48:22 michaebe ttttt=! included check for ldasend -> bail out if 0 ttttt=! ttttt=! Revisiet 1.6 2004/08/12 13:10:39 michaebe ttttt=! corrected caller(specifi1tiet in subst1,t ttttt=! ttttt=! Revisiet 1.5 2004/07/26 13:49:19 ivos ttttt=! Removed Routines sectiets from(the(header(commesl. ttttt=! ttttt=! Revisiet 1.4 2004/07/26 11:33:04 michaebe ttttt=! inserted the use of the 2I4 ode d1ta module. ttttt=! ttttt=! Revisiet 1.3 2004/07/26 07:50:51 michaebe ttttt=! Atomized. Otherwise)no changes ttttt=! ttttt=! Revisiet 1.2 2004/06/10 16:20:04 ivos ttttt=! Moved a s cpp directtives&to columt 1. The NEC cpp did not recognize ttttt=! them otherwise!!! ttttt=! ttt=N&! Revisiet 1.1 2004/02/19 08:33:56 michaebe ttttt=! initi1l implemeslatiet. ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttt=N&! Center(for Fluid Dynamics (DTU) ttttt=! ttttt=! ttt=N&! This file1is part0of the Parallel Particle1Mesh Library (PPM). ttttt=! ttttt=! PPM1is free software: you cat redtstribute it&and/or modify ttttt=! it&under(the terms&of the GNU Lesser(Gener1l Pomlic License ! as pomlished by the Free Software Found1tiet, either( ! versiet 3&of the License, er (at your optiet)&any&later( ! versiet. ttttt=! ttttt=! PPM1is dtstributed in the hope that it&wi s be)useful, ttt=N&! but WITHOUT ANY WARRANTY;)without eves)the implied warranty&of ttt=N&! MERCHANTABILITY er FITNESS FOR A PARTICULAR PURPOSE. See the ttt=N&! GNU Gener1l Pomlic License for more)details. ttttt=! ttttt=! You should have)received a copy of the GNU Gener1l Pomlic License ! and the GNU Lesser(Gener1l Pomlic License along with)PPM. If not, ttt=N&! see . ttttt=! ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! ETH Zurich ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ,#i& KiMEASU==UKiiiii LL subfftw_,ttttt=SUBROUTINE 2I4)ode_map_push_s(odeid,bfr,lda,Npart,mpart,ittttt#elif KiMEASU==UKiKlies e,foGNNNoE,ttttt=SUBROUTINE 2I4)ode_map_push_d(odeid,bfr,lda,Npart,mpart,ittttt#endif ttttt= N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- =N&t& ! Includes ttt=N& N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- #include "2I4)define.h" ttttt= N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- =N&t& ! Modules ttt=N&tt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- =N&t& USE 2I4)moduletd1ta_ode ttttt= USE 2I4)moduletd1ta ttttt= USE 2I4)moduletsubst1,t ttttt= USE 2I4)moduletsubstopt1p,'t&ttUSE 2I4)moduletmapt1p,'t&ttUSE 2I4)moduleteble0t1p,'t&ttUSE 2I4)moduleta sut1p,'t&ttUSE 2I4)moduletmap_part ttttt= IMPLICIT NONEt#i& KiMEASU==UKiiiii LL subfftw_,ttttt= INTEGER, PARAMETER :: mk&= 2I4)kind_singlet#else,ttttt= INTEGER, PARAMETER :: mk&= 2I4)kind_double #endif ttttt= N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- =N&t& ! Argumeslst1p,'t& N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- =N&t& INTEGER, INTENT( out) :: tttt,ttttt= INTEGER, INTENT(in ) :: odeid,ttttt= REAL(mk), KIMENNNoE(:,:), POINTER :: bfr,ttttt= INTEGER, INTENT(in ) :: lda,ttttt= INTEGER, INTENT(in ) :: Npart ttttt= INTEGER, INTENT(inout) :: mpart ttttt= !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- =N&t& ! Lual Variablest1p,'t& N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- =N&t& INTEGER :: ldasend ttttt=t&INTEGER :: throwaway ttttt=t&INTEGER :: mid, umidmax, umidmin tttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- =N&t& ! ca s subst1,t ttttt= !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttt=N&N&C%Nm(subst1,t('2I4)ode_map_push',t0,tttttt1p,'t& !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- =N&t& ! gener1l remark: =N&t& ! were going to push only the st1ges that are needed to(the =N&t& ! other cpu. But that guy&wi s pop the stuff and create a new =N&t& ! array to comprise) only the st1ges that weve sent? so)the =N&t& ! array may shrink? must not happen. t1p,'t& N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- =N&t& IF(Npart.EQ.0M/2+1K ttt=N&t=N&=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBi ttt=N&t=N&=! just save)the number(ef st1ges that we would have)seslt1p,'t&t=N&=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBi ttt=N&t=N&=! already happened in pI4)ode_stept1p,'t&t=N&=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBi ttt=N&t=N&=GOTO d_dot1p,'t&t&=po IF tttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- =N&t& ! check input argumeslst1p,'t& N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- =N&t& IF(2I4)debug.GT.0M/2+1K ttt=N&t=N&=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBi ttt=N&t=N&=! check if 2I4 is initi1lized ttt=N&t=N&=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBi ttt=N&t=N&=IF(.NOT.2I4)initi1lizedM/2+1K ttt=N&t=N&&&&&tttt&= 2I4)eble0teble0t1p,'t&tttttttth%Nm(tttteble0(ttttebl_ttttnoinit,'2I4)ode_map_push',&t1p,'t&ttttttttttttt& 'Please ca s 2I4)init first!',__LINE__,tttttt1p,'t& =N&=GOTO d_dot1p,'t&t&&t&=po IF tttttt NN&=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBi ttt=N&t=N&=! check odeid,ttttt= N&=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBi ttt=N&t=N&=umidmin&= LBOUND(2I4)internal_mid,1) ttt=N&t=N&=umidmax&= UBOUND(2I4)internal_mid,1) ttt=N&t=N&=IF(odeid.LT.umidmin.OR.odeid.GT.umidmaxM/2+1K ttt=N&t=N&&&&&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride, ttt=N&t=N&&&&&!)user mid does not exist t=N&&&&&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride, ttt=N&t=N&&&&&tttt&= 2I4)eble0teble0t1p,'t&tttttttth%Nm(tttteble0(ttttebl_argumesl,'2I4)ode_step', &t1p,'t&ttttttttttttt& 'odeid does not exist',__LINE__,tttttt1p,'t& =N&=GOTO d_dot1p,'t&t&&t&=LSE ttt=N&t=N&&&&&IF(2I4)internal_mid(odeid).EQ.-HUGE(odeid)M/2+1K ttt=N&t=N&&&&&&&&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstri ttt=N&t=N&&&&&&&&!)user mid does not exist t=N&&&&&&&&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstri ttt=N&t=N&&&&&&&&tttt&= 2I4)eble0teble0t1p,'t&ttttttttttth%Nm(tttteble0(ttttebl_argumesl,'2I4)ode_step',& tttt& 'odeid does not exist',__LINE__,tttttt1p,'t& =N&= &=GOTO d_dot1p,'t&t&&t& t&=po IF tttttt NN&==po IF tttttt NN&=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBi ttt=N&t=N&=! check dimessiett1p,'t& NN&=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBi ttt=N&t=N&=IF(Npart.LT.0M/2+1K ttt=N&t=N&=&&&tttt&= 2I4)eble0teble0t1p,'t&tttttttth%Nm(tttteble0(ttttebl_argumesl,'2I4)ode_step', &t1p,'t&ttttttttttttt& 'Npart0cannot be <0',__LINE__,tttttt1p,'t& =N&=GOTO d_dot1p,'t&t&&t&=po IF tttttt NN&=IF(lda.LE.0M/2+1K ttt=N&t=N&=&&&tttt&= 2I4)eble0teble0t1p,'t&tttttttth%Nm(tttteble0(ttttebl_argumesl,'2I4)ode_step', &t1p,'t&ttttttttttttt& 'LDA must be)>00',__LINE__,tttttt1p,'t& =N&=GOTO d_dot1p,'t&t&&t&=po IF tttttt NN&=IF(.NOT.ASSOCIATED(bfr)M/2+1K ttt=N&t=N&&&&&tttt&= 2I4)eble0teble0t1p,'t&tttttttth%Nm(tttteble0(ttttebl_argumesl,'2I4)ode_step', &t1p,'t&ttttttttttttt& 'BFR is empty',__LINE__,tttttt1p,'t& =N&=GOTO d_dot1p,'t&t&&t&=po IF tttttt N=po IF tttttt Nmid = 2I4)internal_mid(odeid) tttttt Nldasend =Nlda*2I4)ode_sesl(mid) tttttt NIF(ldasend.EQ.0M/GOTO d_dot1p,'t&t& ttt=N&N&C%Nm(2I4)map_part_push(bfr,ldasend,Npart,tttttt1p,'t& IF(tttt.NE.0M/2+1K ttt=N&t=N&=GOTO d_dot1p,'t&t&=po IF d_do CONTINUE1p,'t&t& ttt=N&N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- =N&t& ! substopt1p,'t&tt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttt=N&N&C%Nm(substop('2I4)ode_map_push',t0,tttttt1p,'t& RETURE,,#i& KiMEASU==UKiiiii LL subfftw_,ttttt==po SUBROUTINE 2I4)ode_map_push_st#elif KiMEASU==UKiKlies e,foGNNNoE,ttttt==po SUBROUTINE 2I4)ode_map_push_d #endif lib2I4numerics-r1036/src/2I4)moduletfmttexpchange.f0000644000175000017500000000712111616214651021322 0upt1, omaromar,'t&tt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Modulet& : 2I4)moduletfmttexpchange ,'t&tt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! ttttt=! Purposet't& : fast multipole method module, expchange routine ttttt=! ttttt=! ttttt=! Remarkst't& : t1p,'t&! ttttt=! References& : t1p,'t&! ttttt=! Revisietst& : ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! $Log: 2I4)moduletfmttexpchange.f,v $ ttttt=! Revisiet 1.1.1.1 2007/07/13 10:18:58 ivos ttttt=! CBL versiet of the PPM libraryt1p,'t&! ttttt=! Revisiet 1.4 2006/06/29 10:28:37 2chatela ttttt=! Added vector strengths(supportt1p,'t&! ttttt=! Revisiet 1.3 2005/09/19 13:03:31 polasekb ttttt=! code cosmeticst1p,'t&! ttttt=! Revisiet 1.2 2005/08/23 14:30:54 polasekb ttttt=! now making difference between single/double precisiett1p,'t&! ttttt=! Revisiet 1.1 2005/05/27 07:58:29 polasekb ttttt=! initi1l implemeslatiet ttttt=! ttttt=! Revisiet 0 2004/11/11 16:38:33 polasekb ttttt=! St1,t ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttt=N&! Center(for Fluid Dynamics (DTU) ttttt=! ttttt=! ttt=N&! This file1is part0of the Parallel Particle1Mesh Library (PPM). ttttt=! ttttt=! PPM1is free software: you cat redtstribute it&and/or modify ttttt=! it&under(the terms&of the GNU Lesser(Gener1l Pomlic License ! as pomlished by the Free Software Found1tiet, either( ! versiet 3&of the License, er (at your optiet)&any&later( ! versiet. ttttt=! ttttt=! PPM1is dtstributed in the hope that it&wi s be)useful, ttt=N&! but WITHOUT ANY WARRANTY;)without eves)the implied warranty&of ttt=N&! MERCHANTABILITY er FITNESS FOR A PARTICULAR PURPOSE. See the ttt=N&! GNU Gener1l Pomlic License for more)details. ttttt=! ttttt=! You should have)received a copy of the GNU Gener1l Pomlic License ! and the GNU Lesser(Gener1l Pomlic License along with)PPM. If not, ttt=N&! see . ttttt=! ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! ETH Zurich ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD #define)Kiiiii LL subfftw_ 1 #define)KiKlies e,foGNNNoEt2 !#define)KiINTEGER 3 !#define)KiLOGIC%N 4 !#define)Ki2D 7 !#define)Ki3D 8 #define)KiiFIELD 9 #define)KiVFIELD 10 MODULE 2I4)moduletfmttexpchange t& tt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DDD-DD t=! Define)Interface tt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DDD-DD INTERFACE 2I4)fmttexpchange MODULE PROCEDURE 2I4)fmttexpchange_s_sf MODULE PROCEDURE 2I4)fmttexpchange_d_sf MODULE PROCEDURE 2I4)fmttexpchange_s_vf MODULE PROCEDURE 2I4)fmttexpchange_d_vf tt=po INTERFACE tt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DDD-DD t=! INCLUDE 2+1 SOURCES tt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DDD-DD CONTAINS #define)KiMEASUKiiiii LL subfftw_,#define)KiKIM)KiiFIELD #include "2I4)fmttexpchange.f" #unde,FW_MEAS ,#define)KiMEASUKiKlies e,foGNNNoE,#include "2I4)fmttexpchange.f" #unde,FW_MEAS #unde,FW_KIM #define)KiMEASUKiiiii LL subfftw_,#define)KiKIM)KiVFIELD #include "2I4)fmttexpchange.f" #unde,FW_MEAS ,#define)KiMEASUKiKlies e,foGNNNoE,#include "2I4)fmttexpchange.f" #unde,FW_MEAS #unde,FW_KIM =po MODULE 2I4)moduletfmttexpchange tlib2I4numerics-r1036/src/2I4)mgta su_bc.f0000644000175000017500000003672411616214651017410 0upt1, omaromarttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Subroutine)& : 2I4)mgta su_bc ,'t&tt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! ttttt=! Purposet't& : Does the (re)a suatiet of arrays&of type ttttt=! bc_value. It offers the same a suatiet ttttt=! types as pI4)a su for regul1, arrays. ttttt=! ttttt=! Input : lda(:) (I) number(ef subdomaiss + ttt=N&! numbers&of levels ttt=N&! iopt (I) a su actiet. One of: ttt=N&! 2I4)param_a su_fit_preserve ttttt=! 2I4)param_a su_fit ttttt=! 2I4)param_a su_grow_preserve ttttt=! 2I4)param_a su_grow ttttt=! 2I4)param_dea sut1p,'t&! ttttt=! Input/output : field (T) array of TYPE(bc_value) ttttt=! which is&to be (re)a suated. ttttt=! ttttt=! Output : tttt&&&&&&(I) Returt/ptatus. 0 if everything OK. ttttt=! ttttt=! Remarkst't& :t1p,'t&! ttttt=! References& :t1p,'t&! ttttt=! Revisietst& : ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! $Log: 2I4)mgta su_bc.f,v $ ttttt=! Revisiet 1.1.1.1 2007/07/13 10:18:56 ivos ttttt=! CBL versiet of the PPM libraryt1p,'t&! ttttt=! Revisiet 1.7 2004/10/01 16:33:38 ivos ttttt=! cosmetics. ttttt=! ttttt=! Revisiet 1.6 2004/10/01 16:09:10 ivos ttttt=! Replaced&REAL(2I4)kind_double) :: t0 with)REAL(MK) t0. ttttt=! ttttt=! Revisiet 1.5 2004/09/22 18:25:08 kotsalie ttttt=! MG new versiett1p,'t&! ttttt=! Revisiet 1.4 2004/07/26 13:49:18 ivos ttttt=! Removed Routines sectiets from(the(header(commesl. ttttt=! ttttt=! Revisiet 1.3 2004/07/26 11:59:39 ivos ttttt=! Fixes to(make(it compile. ttttt=! ttttt=! Revisiet 1.2 2004/07/26 07:46:37 ivos ttttt=! Changed to(use single-interface modules. Upd1ted a s USE statemesls. ttttt=! ttttt=! Revisiet 1.1 2004/06/29 14:43:14 kotsalie ttttt=! Needed for my type a suatiet ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttt=N&! Center(for Fluid Dynamics (DTU) ttttt=! ttttt=! ttt=N&! This file1is part0of the Parallel Particle1Mesh Library (PPM). ttttt=! ttttt=! PPM1is free software: you cat redtstribute it&and/or modify ttttt=! it&under(the terms&of the GNU Lesser(Gener1l Pomlic License ! as pomlished by the Free Software Found1tiet, either( ! versiet 3&of the License, er (at your optiet)&any&later( ! versiet. ttttt=! ttttt=! PPM1is dtstributed in the hope that it&wi s be)useful, ttt=N&! but WITHOUT ANY WARRANTY;)without eves)the implied warranty&of ttt=N&! MERCHANTABILITY er FITNESS FOR A PARTICULAR PURPOSE. See the ttt=N&! GNU Gener1l Pomlic License for more)details. ttttt=! ttttt=! You should have)received a copy of the GNU Gener1l Pomlic License ! and the GNU Lesser(Gener1l Pomlic License along with)PPM. If not, ttt=N&! see . ttttt=! ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! ETH Zurich ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD #i,FW_KIMU==UKiiFIELD #i,FW_MESH_KIMUU==UKi2D #i,FW_MEASU==UKiiiii LL subfftw_,ttttt=SUBROUTINE 2I4)mgta su_bc_2d_sca_s(field,lda,iopt,ittttt#elif KiMEASU==UKiKlies e,foGNNNoE,ttttt=SUBROUTINE 2I4)mgta su_bc_2d_sca_d(field,lda,iopt,ittttt#endif #elif KiMESH_KIMU==UKi3D #i,FW_MEASU==UKiiiii LL subfftw_,ttttt=SUBROUTINE 2I4)mgta su_bc_3d_sca_s(field,lda,iopt,ittttt#elif KiMEASU==UKiKlies e,foGNNNoE,ttttt=SUBROUTINE 2I4)mgta su_bc_3d_sca_d(field,lda,iopt,ittttt#endif #endif #elif KiKIMU==UKiVFIELD #i,FW_MESH_KIMUU==UKi2D #i,FW_MEASU==UKiiiii LL subfftw_,ttttt=SUBROUTINE 2I4)mgta su_bc_2d_vec_s(field,lda,iopt,ittttt#elif KiMEASU==UKiKlies e,foGNNNoE,ttttt=SUBROUTINE 2I4)mgta su_bc_2d_vec_d(field,lda,iopt,ittttt#endif #elif KiMESH_KIMU==UKi3D #i,FW_MEASU==UKiiiii LL subfftw_,ttttt=SUBROUTINE 2I4)mgta su_bc_3d_vec_s(field,lda,iopt,ittttt#elif KiMEASU==UKiKlies e,foGNNNoE,ttttt=SUBROUTINE 2I4)mgta su_bc_3d_vec_d(field,lda,iopt,ittttt#endif #endif #endif ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Includes ttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD #include "2I4)define.h" ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Module ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=USE 2I4)moduletd1ta ttttt=USE 2I4)moduletd1ta_mg ttttt=USE 2I4)moduletsubst1,t ttttt=USE 2I4)moduletsubstopt1p,'t&USE 2I4)moduleteble0t1p,'t&USE 2I4)moduleta sut1p,'t&USE 2I4)moduletwritet ttttt=IMPLICIT NONEtt#i& W_MEASU==UKiiiii LL subfftw_ | W_MEASU==UKiiiii LL subfftw__COMPLEX ttttt=INTEGER, PARAMETER :: MK&= 2I4)kind_singlet#else,ttttt=INTEGER, PARAMETER :: MK&= 2I4)kind_double #endif ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Argumeslstttt= ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD #i,FW_KIMU==UKiiFIELD #i,FW_MESH_KIMU==UKi2D #i,FW_MEASU==Kiiiii LL subfftw_ ttttt=TYPE(bc_value_2d_sca_s), KIMENNNoE(:), POINTER :: fieldt#elif KiMEASU==UKiKlies e,foGNNNoE,ttttt=TYPE(bc_value_2d_sca_d), KIMENNNoE(:), POINTER :: fieldt#endif #elif KiMESH_KIMU==UKi3D #i,FW_MEASU==Kiiiii LL subfftw_,ttttt=TYPE(bc_value_3d_sca_s), KIMENNNoE(:), POINTER :: field t#elif KiMEASU==UKiKlies e,foGNNNoE,ttttt=TYPE(bc_value_3d_sca_d), KIMENNNoE(:), POINTER :: fieldt#endif #endif #elif KiKIMU==UKiVFIELD #i,FW_MESH_KIMU==UKi2D #i,FW_MEASU==Kiiiii LL subfftw_,ttttt=TYPE(bc_value_2d_vec_s), KIMENNNoE(:), POINTER :: fieldt#elif KiMEASU==UKiKlies e,foGNNNoE,ttttt=TYPE(bc_value_2d_vec_d), KIMENNNoE(:), POINTER :: fieldt#endif #elif KiMESH_KIMU==UKi3D #i,FW_MEASU==Kiiiii LL subfftw_,ttttt=TYPE(bc_value_3d_vec_s), KIMENNNoE(:), POINTER :: fieldt#elif KiMEASU==UKiKlies e,foGNNNoE,ttttt=TYPE(bc_value_3d_vec_d), KIMENNNoE(:), POINTER :: fieldt#endif #endif #endif ttttt=INTEGER, KIMENNNoE(:t=), INTENT(IN ) :: lda,ttttt=INTEGER, INTENT(IN ) :: iopt,ttttt=INTEGER, INTENT( OUT) :: tttt,ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Lual variables= ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=INTEGER :: t ttttt=INTEGER, KIMENNNoE(1) :: ldt1p,'t&REAL(MK) :: t0 ttttt=LOGIC%N :: lcopy,la su,lrea su,ldea sut#i,FW_KIMU==UKiiFIELD #i,FW_MESH_KIMU==UKi2D #i,FW_MEASU==Kiiiii LL subfftw_ ttttt=TYPE(bc_value_2d_sca_s), KIMENNNoE(:), POINTER :: work_fieldt#elif KiMEASU==UKiKlies e,foGNNNoE,ttttt=TYPE(bc_value_2d_sca_d), KIMENNNoE(:), POINTER :: work_fieldt#endif #elif KiMESH_KIMU==UKi3D #i,FW_MEASU==Kiiiii LL subfftw_,ttttt=TYPE(bc_value_3d_sca_s), KIMENNNoE(:), POINTER :: work_field t#elif KiMEASU==UKiKlies e,foGNNNoE,ttttt=TYPE(bc_value_3d_sca_d), KIMENNNoE(:), POINTER :: work_fieldt#endif #endif #elif KiKIMU==UKiVFIELD #i,FW_MESH_KIMU==UKi2D #i,FW_MEASU==Kiiiii LL subfftw_,ttttt=TYPE(bc_value_2d_vec_s), KIMENNNoE(:), POINTER :: work_fieldt#elif KiMEASU==UKiKlies e,foGNNNoE,ttttt=TYPE(bc_value_2d_vec_d), KIMENNNoE(:), POINTER :: work_fieldt#endif #elif KiMESH_KIMU==UKi3D #i,FW_MEASU==Kiiiii LL subfftw_,ttttt=TYPE(bc_value_3d_vec_s), KIMENNNoE(:), POINTER :: work_fieldt#elif KiMEASU==UKiKlies e,foGNNNoE,ttttt=TYPE(bc_value_3d_vec_d), KIMENNNoE(:), POINTER :: work_fieldt#endif #endif #endif ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Externals= ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt= ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Initi1lise !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=C%Nm(subst1,t('2I4)mgta su_bc',t0,tttttt1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Check argumeslst1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=IF (2I4)debug .GT. 0 .AND. iopt .NE. 2I4)param_dea suM/2+1K ttt=N&t=N&IF (SIZE(lda,1) .LT. 1M/2+1K ttt=N&t=N&&&&&tttt&= 2I4)eble0teble0t1p,'t&tttttttth%Nm(tttteble0(ttttebl_argumesl,'2I4)mgta su_field', &t1p,'t&,'t&tttttttt'lda must be)at least ef length 1',__LINE__,tttttt1p,'t& =N&=GOTO d_dot1p,'t&t&&tENDIF tttttt NN&IF (lda(1) .LT. 0M/2+1K ttt=N&t=N&=&&&tttt&= 2I4)eble0teble0t1p,'t&tttttttth%Nm(tttteble0(ttttebl_argumesl,'2I4)mgta su_field', &t1p,'t&,'t&tttttttt'lda(1) must be)>= 0',__LINE__,tttttt1p,'t& =N&=GOTO d_dot1p,'t&t&&tENDIF ttttttENDIF tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Check a suatiet type ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=lcopyttt== .FALSE. ttttt=la sutt== .FALSE. ttttt=lrea su== .FALSE. ttttt=ldea su== .FALSE. ttttt=IF (iopt .EQ. 2I4)param_a su_fit_preserveM/2+1K ttt=N&t=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD ttt=N&t=N&! Fit memory and preserve the 2resent conteslst1p,'t& NN&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD ttt=N&t=N&IF (ASSOCIATED(field)M/2+1K ttt=N&t=N&&&&&ld(1) = SIZE(field,1tt1p,'t& =N&=IF (ld(1) .NE. lda(1)) 2+1K ttt=N&t=N&&&&&&&&=la sutt== .TRUE. ttttt=t=N&&&&&&&&=lrea su== .TRUE. ttttt=t=N&&&&&&&&=lcopyttt== .TRUE. ttttt=t=N&&&&&ENDIF tttttt NN&=LSE ttt=N&t=N&&&&&la su== .TRUE. ttttt=t=N&ENDIF ttttttELSEIF (iopt .EQ. 2I4)param_a su_fitM/2+1K ttt=N&t=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD ttt=N&t=N&! Fit memory and discard the 2resent conteslst1p,'t& NN&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD ttt=N&t=N&IF (ASSOCIATED(field)M/2+1K ttt=N&t=N&&&&&ld(1) = SIZE(field,1tt1p,'t& =N&=IF (ld(1) .NE. lda(1)) 2+1K ttt=N&t=N&&&&&&&&=la sutt== .TRUE. ttttt=t=N&&&&&&&&=lrea su== .TRUE. ttttt=t=N&&&&&&&&=ldea su== .TRUE. ttttt=t=N&&&&&ENDIF tttttt NN&=LSE ttt=N&t=N&&&&&la su== .TRUE. ttttt=t=N&ENDIF ttttttELSEIF (iopt .EQ. 2I4)param_a su_grow_preserveM/2+1K ttt=N&t=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD ttt=N&t=N&! Fit memory and preserve the 2resent conteslst1p,'t& NN&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD ttt=N&t=N&IF (ASSOCIATED(field)M/2+1K ttt=N&t=N&&&&&ld(1) = SIZE(field,1tt1p,'t& =N&=IF (ld(1) .LT. lda(1)) 2+1K ttt=N&t=N&&&&&&&&=la sutt== .TRUE. ttttt=t=N&&&&&&&&=lrea su== .TRUE. ttttt=t=N&&&&&&&&=lcopyttt== .TRUE. ttttt=t=N&&&&&ENDIF tttttt NN&=LSE ttt=N&t=N&&&&&la su== .TRUE. ttttt=t=N&ENDIF ttttttELSEIF (iopt .EQ. 2I4)param_a su_growM/2+1K ttt=N&t=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD ttt=N&t=N&! Fit memory and discard the 2resent conteslst1p,'t& NN&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD ttt=N&t=N&IF (ASSOCIATED(field)M/2+1K ttt=N&t=N&&&&&ld(1) = SIZE(field,1tt1p,'t& =N&=IF (ld(1) .LT. lda(1)) 2+1K ttt=N&t=N&&&&&&&&=la sutt== .TRUE. ttttt=t=N&&&&&&&&=lrea su== .TRUE. ttttt=t=N&&&&&&&&=ldea su== .TRUE. ttttt=t=N&&&&&ENDIF tttttt NN&=LSE ttt=N&t=N&&&&&la su== .TRUE. ttttt=t=N&ENDIF ttttttELSEIF (iopt .EQ. 2I4)param_dea suM/2+1K ttt=N&t=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD ttt=N&t=N&! Dea suatet1p,'t& NN&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD ttt=N&t=N&IF (ASSOCIATED(field)M/2+1K ttt=N&t=N&&&&&ld(1) = SIZE(field,1tt1p,'t& =N&=lrea su== .TRUE. ttttt=t=N&&&&&ldea su== .TRUE. ttttt=t=N&ENDIF ttttttENDIF tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Perform(the(actual a su actiett1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=IF (la suM/2+1K ttt=N&t=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD ttt=N&t=N&! A suate new array with)new size and nullify a s members ttt=N&t=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD ttt=N&t=N&%NmOCATE(work_field(lda(1)),STAT=tttttt1p,'t& IF (ittt&.NE. 0M/2+1K ttt=N&t=N&=&&&tttt&= 2I4)eble0tfatalt1p,'t&tttttttth%Nm(tttteble0(ttttebl_a su,'2I4)mgta su_field', &t1p,'t&,'t&tttttttt'new mgfield WORKiMESH',__LINE__,tttttt1p,'t& =N&=GOTO d_dot1p,'t&t&&tENDIF tttttt NN&&&&&DO i=1,lda(1) ttttt=t=N&&&&&&&&=NULLIFY(work_field(i)%pbcvalue) ttttt=,'t&t&&tENDDO ttttttENDIF ttttttIF (lcopyM/2+1K ttt=N&t=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD ttt=N&t=N&! Save)the old conteslst1p,'t& NN&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD ttt=N&t=N&&&&&DO i=1,MIN(ld(1),lda(1)) ttttt=t=N&&&&&&&&=work_field(i)%pbcvalue => field(i)%pbcvalue ttttt=,'t&t&&tENDDO ttttttENDIF ttttttIF (ldea suM/2+1K ttt=N&t=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD ttt=N&t=N&! Dea suate)the old conteslst1p,'t& NN&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD ttt=N&t=N&&&&&DO i=1,ld(1) ttttt=t=N&&&&&&&&=IF (ASSOCIATED(field(i)%pbcvalue)) 2+1K ttt=N&t=N&&&&&&&&=&&&&DE%NmOCATE(field(i)%pbcvalue,STAT=tttttt1p,'t& t=N&&&&&&&&=IF (ittt&.NE. 0M/2+1K ttt=N&t=N&=&&&&&&&&&&&&&&&tttt&= 2I4)eble0teble0t1p,'t&tttttttttttttttttttth%Nm(tttteble0(ttttebl_dea su,'2I4)mgta su_bc',&t1p,'t&,'t&ttttttttttttttttttt'field correctiet FIELD%PBCVALUE',__LINE__,tttttt1p,'t& =N&= &======ENDIF tttttt NN&&&&&&&&&&&&&NULLIFY(field(i)%pbcvalue) ttttt=,'t&t&&t====ENDIF tttttt NN&&&&&ENDDO ttttttENDIF ttttttIF (lrea suM/2+1K ttt=N&t=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD ttt=N&t=N&! Dea suate)old pointer array ttt=N&t=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD ttt=N&t=N&DE%NmOCATE(field,STAT=tttttt1p,'t& IF (ittt&.NE. 0M/2+1K ttt=N&t=N&=&&&tttt&= 2I4)eble0teble0t1p,'t&tttttttth%Nm(tttteble0(ttttebl_dea su,'2I4)mgta su_bc', &t1p,'t&,'t&tttttttt'mgfield d1ta FIELD',__LINE__,tttttt1p,'t& ENDIF tttttt NN&NULLIFY(field) ttttttENDIF ttttttIF (la suM/2+1K ttt=N&t=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD ttt=N&t=N&! Point result to(new array ttt=N&t=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiD ttt=N&t=N&field => work_fieldtttttttENDIF tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Returt/ tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD td_do CONTINUE tttttth%Nm(substop('2I4)mgta su_bc',t0,tttttt1p,'t&RETURE,,#i& W_KIMU==UKiiFIELD #i,FW_MESH_KIMU==UKi2D #i,FW_MEASU==UKiiiii LL subfftw_,ttttt==po SUBROUTINE 2I4)mgta su_bc_2d_sca_st#elif KiMEASU==UKiKlies e,foGNNNoE,ttttt==po SUBROUTINE 2I4)mgta su_bc_2d_sca_dt#endif #elif KiMESH_KIMU==UKi3D #i,F KiMEASU==UKiiiii LL subfftw_,ttttt==po SUBROUTINE 2I4)mgta su_bc_3d_sca_st#elif KiMEASU==UKiKlies e,foGNNNoE,ttttt==po SUBROUTINE 2I4)mgta su_bc_3d_sca_dt#endif #endif #elif KiKIMU==UKiVFIELD #i,FW_MESH_KIMU==UKi2D #i,FW_MEASU==UKiiiii LL subfftw_,ttttt==po SUBROUTINE 2I4)mgta su_bc_2d_vec_st#elif KiMEASU==UKiKlies e,foGNNNoE,ttttt==po SUBROUTINE 2I4)mgta su_bc_2d_vec_dt#endif #elif KiMESH_KIMU==UKi3D #i,F KiMEASU==UKiiiii LL subfftw_,ttttt==po SUBROUTINE 2I4)mgta su_bc_3d_vec_st#elif KiMEASU==UKiKlies e,foGNNNoE,ttttt==po SUBROUTINE 2I4)mgta su_bc_3d_vec_dt#endif #endif #endif lib2I4numerics-r1036/src/2I4)moduletfdsolver)init.f0000644000175000017500000001006511616214651021371 0upt1, omaromar#i,de,FW_XLF @PROCESS NOHOT #endif ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Modulet& : 2I4)moduletfdsolver)solve ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! ttttt=! Purposet't& : This module includes the source code for field solver ttt=N&! routines. ttttt=! ttttt=! Remarkst't& :t1p,'t&! ttttt=! References& :t1p,'t&! ttttt=! Revisietst& : ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttt=N&! Center(for Fluid Dynamics (DTU) ttttt=! ttttt=! ttt=N&! This file1is part0of the Parallel Particle1Mesh Library (PPM). ttttt=! ttttt=! PPM1is free software: you cat redtstribute it&and/or modify ttttt=! it&under(the terms&of the GNU Lesser(Gener1l Pomlic License ! as pomlished by the Free Software Found1tiet, either( ! versiet 3&of the License, er (at your optiet)&any&later( ! versiet. ttttt=! ttttt=! PPM1is dtstributed in the hope that it&wi s be)useful, ttt=N&! but WITHOUT ANY WARRANTY;)without eves)the implied warranty&of ttt=N&! MERCHANTABILITY er FITNESS FOR A PARTICULAR PURPOSE. See the ttt=N&! GNU Gener1l Pomlic License for more)details. ttttt=! ttttt=! You should have)received a copy of the GNU Gener1l Pomlic License ! and the GNU Lesser(Gener1l Pomlic License along with)PPM. If not, ttt=N&! see . ttttt=! ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! ETH Zurich ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD tttt= ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Define)types ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD #define)Kiiiii LL subfftw_ 1 #define)KiKlies e,foGNNNoEt 2 #define)KiCOMPLEX 3 #define)KiKlies eCOMPLEX 4 #define)KiiFIELD 9 #define)KiVFIELD 10 #define)Ki2D 22 #define)Ki3D 33 tttMODULE 2I4)moduletfdsolver)init tttttt N=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=! Define)interface to pI4)fdsolver)init tttttt N=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=INTERFACE 2I4)fdsolver)init tttttt N=tttMODULE PROCEDURE 2I4)fdsolver)init_2d_sca_sttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)init_2d_sca_dttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)init_2d_vec_sttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)init_2d_vec_dttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)init_3d_sca_sttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)init_3d_sca_dttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)init_3d_vec_sttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)init_3d_vec_dttttttt N==po INTERFACE tttttt N=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=! include the source tttttt N=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=CONTAINS #define)KiMESH_KIMUKi2D #define)KiKIM)KiiFIELD #define)KiMEASUKiiiii LL subfftw_,#include "2I4)fdsolver)init.f" #unde,FFW_MEAS ,#define)KiMEASUKiKlies e,foGNNNoE,#include "2I4)fdsolver)init.f" #unde,FFW_MEAS #unde,FW_KIM ,#define)KiKIM)KiVFIELD #define)KiMEASUKiiiii LL subfftw_,#include "2I4)fdsolver)init.f" #unde,FFW_MEAS ,#define)KiMEASUKiKlies e,foGNNNoE,#include "2I4)fdsolver)init.f" #unde,FFW_MEAS #unde,FW_KIM #unde,FW_MESH_KIM #define)KiMESH_KIMUKi3D #define)KiKIM)KiiFIELD #define)KiMEASUKiiiii LL subfftw_,#include "2I4)fdsolver)init.f" #unde,FFW_MEAS ,#define)KiMEASUKiKlies e,foGNNNoE,#include "2I4)fdsolver)init.f" #unde,FFW_MEAS #unde,FW_KIM ,#define)KiKIM)KiVFIELD #define)KiMEASUKiiiii LL subfftw_,#include "2I4)fdsolver)init.f" #unde,FFW_MEAS ,#define)KiMEASUKiKlies e,foGNNNoE,#include "2I4)fdsolver)init.f" #unde,FFW_MEAS #unde,FW_KIM #unde,FW_MESH_KIM ttt N==po MODULE 2I4)moduletfdsolver)init lib2I4numerics-r1036/src/2I4)moduletfdsolver)map.f0000644000175000017500000001100311616214651021174 0upt1, omaromar#i,de,FW_XLF @PROCESS NOHOT #endif ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Modulet& : 2I4)moduletfdsolver ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! ttttt=! Purposet't& : This module includes the source code for field solver ttt=N&! routines. ttttt=! ttttt=! Remarkst't& :t1p,'t&! ttttt=! References& :t1p,'t&! ttttt=! Revisietst& : ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttt=N&! Center(for Fluid Dynamics (DTU) ttttt=! ttttt=! ttt=N&! This file1is part0of the Parallel Particle1Mesh Library (PPM). ttttt=! ttttt=! PPM1is free software: you cat redtstribute it&and/or modify ttttt=! it&under(the terms&of the GNU Lesser(Gener1l Pomlic License ! as pomlished by the Free Software Found1tiet, either( ! versiet 3&of the License, er (at your optiet)&any&later( ! versiet. ttttt=! ttttt=! PPM1is dtstributed in the hope that it&wi s be)useful, ttt=N&! but WITHOUT ANY WARRANTY;)without eves)the implied warranty&of ttt=N&! MERCHANTABILITY er FITNESS FOR A PARTICULAR PURPOSE. See the ttt=N&! GNU Gener1l Pomlic License for more)details. ttttt=! ttttt=! You should have)received a copy of the GNU Gener1l Pomlic License ! and the GNU Lesser(Gener1l Pomlic License along with)PPM. If not, ttt=N&! see . ttttt=! ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! ETH Zurich ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD tttt= ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Define)types ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD #define)Kiiiii LL subfftw_ 1 #define)KiKlies e,foGNNNoEt2 #define)KiCOMPLEX 3 #define)KiKlies eCOMPLEX 4 #define)KiiFIELD 9 #define)KiVFIELD 10 tttMODULE 2I4)moduletfdsolver)map tttttt N=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=! Define)interface to pI4)fdsolver)map tttttt N=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=INTERFACE 2I4)fdsolver)map tttttt N= ttMODULE PROCEDURE 2I4)fdsolver)map_2d_sca_sttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)map_2d_sca_dttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)map_2d_sca_cttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)map_2d_sca_ccttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)map_2d_vec_sttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)map_2d_vec_dttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)map_2d_vec_cttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)map_2d_vec_ccttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)map_3d_sca_sttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)map_3d_sca_dttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)map_3d_sca_cttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)map_3d_sca_ccttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)map_3d_vec_sttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)map_3d_vec_dttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)map_3d_vec_cttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)map_3d_vec_ccttttttt N==po INTERFACE ttttttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=! include the source tttttt N=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=CONTAINS #define)KiKIM)KiiFIELD #define)KiMEASUKiiiii LL subfftw_,#include "2I4)fdsolver)map_2d.f" #include "2I4)fdsolver)map_3d.f" #unde,FFW_MEAS ,#define)KiMEASUKiKlies e,foGNNNoE,#include "2I4)fdsolver)map_2d.f" #include "2I4)fdsolver)map_3d.f" #unde,FFW_MEAS ,#define)KiMEASUKiCOMPLEX #include "2I4)fdsolver)map_2d.f" #include "2I4)fdsolver)map_3d.f" #unde,FFW_MEAS ,#define)KiMEASUKiKlies eCOMPLEX #include "2I4)fdsolver)map_2d.f" #include "2I4)fdsolver)map_3d.f" #unde,FFW_MEAS #unde,FFW_KIM ,#define)KiKIM)KiVFIELD #define)KiMEASUKiiiii LL subfftw_,#include "2I4)fdsolver)map_2d.f" #include "2I4)fdsolver)map_3d.f" #unde,FFW_MEAS ,#define)KiMEASUKiKlies e,foGNNNoE,#include "2I4)fdsolver)map_2d.f" #include "2I4)fdsolver)map_3d.f" #unde,FFW_MEAS ,#define)KiMEASUKiCOMPLEX #include "2I4)fdsolver)map_2d.f" #include "2I4)fdsolver)map_3d.f" #unde,FFW_MEAS ,#define)KiMEASUKiKlies eCOMPLEX #include "2I4)fdsolver)map_2d.f" #include "2I4)fdsolver)map_3d.f" #unde,FFW_MEAS #unde,FFW_KIM ttt N==po MODULE 2I4)moduletfdsolver)map lib2I4numerics-r1036/src/2I4)moduletfdsolver)fft_bd.f0000644000175000017500000001124611616214651021654 0upt1, omaromar#i,de,FW_XLF @PROCESS NOHOT #endif ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Modulet& : 2I4)moduletfdsolver)fft_bd ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! ttttt=! Purposet't& : This module includes the source code for the fft ttt=N&! routines ttttt=! ttttt=! Remarkst't& :t1p,'t&! ttttt=! References& :t1p,'t&! ttttt=! Revisietst& : ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! $Log: 2I4)moduletfdsolver)fft_bd.f,v $ ttttt=! Revisiet 1.1.1.1 2007/07/13 10:18:58 ivos ttttt=! CBL versiet of the PPM libraryt1p,'t&! ttttt=! Revisiet 1.1 2005/02/16 12:07:35 hiebers ttt=N&! initi1l implemeslatiet ttttt=! ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttt=N&! Center(for Fluid Dynamics (DTU) ttttt=! ttttt=! ttt=N&! This file1is part0of the Parallel Particle1Mesh Library (PPM). ttttt=! ttttt=! PPM1is free software: you cat redtstribute it&and/or modify ttttt=! it&under(the terms&of the GNU Lesser(Gener1l Pomlic License ! as pomlished by the Free Software Found1tiet, either( ! versiet 3&of the License, er (at your optiet)&any&later( ! versiet. ttttt=! ttttt=! PPM1is dtstributed in the hope that it&wi s be)useful, ttt=N&! but WITHOUT ANY WARRANTY;)without eves)the implied warranty&of ttt=N&! MERCHANTABILITY er FITNESS FOR A PARTICULAR PURPOSE. See the ttt=N&! GNU Gener1l Pomlic License for more)details. ttttt=! ttttt=! You should have)received a copy of the GNU Gener1l Pomlic License ! and the GNU Lesser(Gener1l Pomlic License along with)PPM. If not, ttt=N&! see . ttttt=! ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! ETH Zurich ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD tttt= ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD tttt==! Define)types ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD #define)Kiiiii LL subfftw_ 1 #define)KiKlies e,foGNNNoEt 2 #define)Kiiiii LL subfftw_eCOMPLEX 5 #define)KiKlies e,foGNNNoEeCOMPLEX 6 #define)Kiiiii LL subfftw_eCOMPLEX_Z 7 #define)KiKlies e,foGNNNoEeCOMPLEX_Z 8 #define)KiiLAB 10 MODULE 2I4)moduletfdsolver)fft_bd tttttt N=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=! Define)interface to pI4)fdsolver)fft_bd ttttt= N=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=INTERFACE 2I4)fdsolver)fft_bd_slabttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)fft_bd_slab_3dsttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)fft_bd_slab_3ddttttttt N==po INTERFACE tttttt N=INTERFACE 2I4)fdsolver)fft_bdttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)fft_bd_2dsttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)fft_bd_2ddttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)fft_bd_2dcttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)fft_bd_2dcc ttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)fft_bd_3dsttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)fft_bd_3ddttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)fft_bd_3dcttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)fft_bd_3dccttttttt N==po INTERFACE tttttttttINTERFACE 2I4)fdsolver)fft_bd_zttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)fft_bd_z_3dcttttttt N=tttMODULE PROCEDURE 2I4)fdsolver)fft_bd_z_3dccttttttt N==po INTERFACE ttttttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=! include the source tttttt N=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=CONTAINS #define)KiCASE KiiLAB #define)KiMEASUKiiiii LL subfftw_,#include "2I4)fdsolver)fft_bd_3d.f" #unde,FW_MEAS ,#define)KiMEASUKiKlies e,foGNNNoE,#include "2I4)fdsolver)fft_bd_3d.f" #unde,FW_MEAS ,#unde,FW_CASE #define)KiMEASUKiiiii LL subfftw_,#include "2I4)fdsolver)fft_bd_2d.f" #include "2I4)fdsolver)fft_bd_3d.f" #unde,FW_MEAS ,#define)KiMEASUKiKlies e,foGNNNoE,#include "2I4)fdsolver)fft_bd_2d.f" #include "2I4)fdsolver)fft_bd_3d.f" #unde,FW_MEAS ,#define)KiMEASUKiiiii LL subfftw__COMPLEX #include "2I4)fdsolver)fft_bd_2d.f" #include "2I4)fdsolver)fft_bd_3d.f" #unde,FW_MEAS ,#define)KiMEASUKiKlies e,foGNNNoE_COMPLEX #include "2I4)fdsolver)fft_bd_2d.f" #include "2I4)fdsolver)fft_bd_3d.f" #unde,FW_MEAS ,#define)KiMEASUKiiiii LL subfftw_eCOMPLEX_Z #include "2I4)fdsolver)fft_bd_3d.f" #unde,FW_MEAS ,#define)KiMEASUKiKlies e,foGNNNoE_COMPLEX_Z #include "2I4)fdsolver)fft_bd_3d.f" #unde,FW_MEAS ,ttt N==po MODULE 2I4)moduletfdsolver)fft_bd lib2I4numerics-r1036/src/2I4)moduletgmm_extend_bkwd.f0000644000175000017500000000715511616214651021666 0upt1, omaromarttt N=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Modulet& : 2I4)moduletgmm_extend_bkwd ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! ttttt=! Purposet't& : This module includes the source code for the ttt=N&! backward extending routine of the marching method. ttttt=! ttttt=! Remarkst't& :t1p,'t&! ttttt=! References& :t1p,'t&! ttttt=! Revisietst& : ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! $Log: 2I4)moduletgmm_extend_bkwd.f,v $ ttttt=! Revisiet 1.1.1.1 2007/07/13 10:18:58 ivos ttttt=! CBL versiet of the PPM libraryt1p,'t&! ttttt=! Revisiet 1.1 2005/05/10 04:41:17 ivos ttttt=! Newly cre1ted during modularizatiet of 2I4)gmm_march. Marching ttttt=! and orthogonal extendiet are now in separate routines for faster ttttt=! compilatiet. ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttt=N&! Center(for Fluid Dynamics (DTU) ttttt=! ttttt=! ttt=N&! This file1is part0of the Parallel Particle1Mesh Library (PPM). ttttt=! ttttt=! PPM1is free software: you cat redtstribute it&and/or modify ttttt=! it&under(the terms&of the GNU Lesser(Gener1l Pomlic License ! as pomlished by the Free Software Found1tiet, either( ! versiet 3&of the License, er (at your optiet)&any&later( ! versiet. ttttt=! ttttt=! PPM1is dtstributed in the hope that it&wi s be)useful, ttt=N&! but WITHOUT ANY WARRANTY;)without eves)the implied warranty&of ttt=N&! MERCHANTABILITY er FITNESS FOR A PARTICULAR PURPOSE. See the ttt=N&! GNU Gener1l Pomlic License for more)details. ttttt=! ttttt=! You should have)received a copy of the GNU Gener1l Pomlic License ! and the GNU Lesser(Gener1l Pomlic License along with)PPM. If not, ttt=N&! see . ttttt=! ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! ETH Zurich ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD tttt= ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD tttt==! Define)types ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD #define)Kiiiii LL subfftw_ 1 #define)KiKlies e,foGNNNoEt 2 #define)Ki2D 3 #define)Ki3D 4 MODULE 2I4)moduletgmm_extend_bkwd tttttt N=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=! Define)interfaces to pI4)gmm_extend_bkwd ttttt= N=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=INTERFACE 2I4)gmm_extend_bkwd ttttt= N= ttMODULE PROCEDURE 2I4)gmm_extend_bkwd_2dsttttttt N=tttMODULE PROCEDURE 2I4)gmm_extend_bkwd_2dd ttttt= N= ttMODULE PROCEDURE 2I4)gmm_extend_bkwd_3dsttttttt N=tttMODULE PROCEDURE 2I4)gmm_extend_bkwd_3ddttttttt N==po INTERFACE tttttt N=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=! include the source tttttt N=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=CONTAINS #define)KiKIMUKi2D #define)KiMEASUKiiiii LL subfftw_,#include "2I4)gmm_extend_bkwd.f" #unde,FW_MEAS #define)KiMEASUKiKlies e,foGNNNoE,#include "2I4)gmm_extend_bkwd.f" #unde,FW_MEAS #unde,FW_KIM #define)KiKIMUKi3D #define)KiMEASUKiiiii LL subfftw_,#include "2I4)gmm_extend_bkwd.f" #unde,FW_MEAS #define)KiMEASUKiKlies e,foGNNNoE,#include "2I4)gmm_extend_bkwd.f" #unde,FW_MEAS #unde,FW_KIM ttt N==po MODULE 2I4)moduletgmm_extend_bkwd lib2I4numerics-r1036/src/2I4)fdsolver)poisson_3d.f0000644000175000017500000002167011616214651021145 0upt1, omaromarttt N=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD tttt==! Subroutine : 2I4)fdsolver)poisson_3d.f ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! ttttt=! Purposet't& : This routine solves the poisson equatiet with)the d1ta ttt=N&! as right hand side)in fourier(space ttt=N&! - Laplaciat of Phi = omega ttt=N&! t= ttttt=! ttt=N&! Input t't& : ttt=N&! t=lda(3) (I) size ef lual d1ta fieldttttttt! t=ist1,t(3) (I) st1,ting index ef lual fieldttttttt! t=Nm(3) (I) size ef global d1ta ttt=N&! t=length(3) (I) length of the domain ttt=N&! ttttt=! ttt=N&! Input/output : ttt=N&! fd1ta(:,:) (F) d1ta in fourier(space ttt=N&! right hand side) of 2oisson ttt=N&! equatiet ttt=N&! t================ ttttt=! ttt=N&! Output : ttt=N&! tttt&&&&&&&(&&&&&&&I) returt/st1tus. =0 if no eble0. ttttt=! ttttt=! Remarkst't& : ttt=N&! t================================ ttttt=! t================================== ttttt=! References& :t1p,'t&! ttttt=! Revisietst& : ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! $Log: 2I4)fdsolver)poisson_3d.f,v $ ttttt=! Revisiet 1.1.1.1 2007/07/13 10:18:54 ivos ttttt=! CBL versiet of the PPM libraryt1p,'t&! ttttt=! Revisiet 1.6 2006/09/04 18:34:44 pchatela ttt=N&! Fixes&and cleanups to make it&compile for ttt=N&! release-1-0t1p,'t&! ttttt=! Revisiet 1.5 2004/10/01 16:08:58 ivos ttttt=! Replaced&REAL(2I4)kind_double) :: t0 with)REAL(MK) t0. ttttt=! ttttt=! Revisiet 1.4 2004/09/24 11:32:20 hiebers ttt=N&! added&MK to float numbers, exchanged d1ta by fd1ta ttttt=! ttttt=! Revisiet 1.3 2004/07/26 13:49:17 ivos ttttt=! Removed Routines sectiets from(the(header(commesl. ttttt=! ttttt=! Revisiet 1.2 2004/07/26 11:59:38 ivos ttttt=! Fixes&to make it&compile. ttttt=! ttttt=! Revisiet 1.1 2004/07/26 08:52:28 hiebers ttt=N&! Recommited, formerly 2I4)moduletfieldsolver ttttt=! ttttt=! Revisiet 1.1 2004/05/19 15:36:00 hiebers ttt=N&! implemeslatiet from(scratch ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttt=N&! Center(for Fluid Dynamics (DTU) ttttt=! ttttt=! ttt=N&! This file1is part0of the Parallel Particle1Mesh Library (PPM). ttttt=! ttttt=! PPM1is free software: you cat redtstribute it&and/or modify ttttt=! it&under(the terms&of the GNU Lesser(Gener1l Pomlic License ! as pomlished by the Free Software Found1tiet, either( ! versiet 3&of the License, er (at your optiet)&any&later( ! versiet. ttttt=! ttttt=! PPM1is dtstributed in the hope that it&wi s be)useful, ttt=N&! but WITHOUT ANY WARRANTY;)without eves)the implied warranty&of ttt=N&! MERCHANTABILITY er FITNESS FOR A PARTICULAR PURPOSE. See the ttt=N&! GNU Gener1l Pomlic License for more)details. ttttt=! ttttt=! You should have)received a copy of the GNU Gener1l Pomlic License ! and the GNU Lesser(Gener1l Pomlic License along with)PPM. If not, ttt=N&! see . ttttt=! ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! ETH Zurich ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD #i,FW_MEASU==UKiCOMPLEX ttttt=SUBROUTINE 2I4)fdsolver)poisson_3dc(fd1ta,lda,ist1,t,length,Nm,tttttt#elif KiMEASU==UKiKlies eCOMPLEX ttttt=SUBROUTINE 2I4)fdsolver)poisson_3dcc(fd1ta,lda,ist1,t,length,Nm,tttttt#endif ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Modules ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=USE 2I4)moduletd1ta ttttt=USE 2I4)moduleteble0t1p,'t&USE 2I4)moduletsubst1,tt1p,'t&USE 2I4)moduletsubstop ttttttIMPLICIT NONE #i,F W_MEASU==UKiCOMPLEX( INTEGER, PARAMETER :: MK = 2I4)kind_singlet#elif KiMEASU==UKiKlies eCOMPLEX( INTEGER, PARAMETER :: MK = 2I4)kind_doublet#endif ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Argumeslst't& ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! POINTER&to d1ta ttttt=COMPLEX(MK), DIMENNNoE(:,:,:), POINTER&&&&&&&:: fd1ta ttttt=INTEGER, DIMENNNoE(3), INTENT(IN)&&&&:: lda,ist1,t,Nm ttttt=REAL(MK), DIMENNNoE(3), INTENT(IN)&&&&:: length ttttt=INTEGER, INTENT( OUT) :: tttt ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Lual variables ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! timer ttttt=REAL(MK) :: t0 ttttt=! counters ttt=N&INTEGER :: t,j,k ttt=N&INTEGER :: t_global,j_global,k_global ttttt=!Size ef the d1ta ttt=N&INTEGER, DIMENNNoE(2) :: lda_end ttt=N&INTEGER :: lda_end2 ttttt=! wave)number ttttt=REAL(MK) :: kx,ky,kz ttttt=REAL(MK) :: pi2_Lx,pi2_Ly,pi2_Lz ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Externals ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Initi1lise ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=h%Nm(subst1,t('2I4)fdsolver)poisson_3d',t0,tttttt1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Check argumeslst1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=IF (2I4)debug .GT. 0M/2+1K ttt=N&t=N&IF (lda(1).LE.0M/2+1K ttt=N&t=N&=&&&tttt&= 2I4)eble0teble0t1p,'t&tttttttth%Nm(tttteble0(ttttebl_argumesl,'2I4)fdsolver)poisson_3d', &t1p,'t&,'t&tttttttt' mesh size: Nx must be)>0t' ,__LINE__,tttttt1p,'t& =N&=GOTO d_dot1p,'t&t&&tENDIF tttttt NN&IF (lda(2).LE.0M/2+1K ttt=N&t=N&=&&&tttt&= 2I4)eble0teble0t1p,'t&tttttttth%Nm(tttteble0(ttttebl_argumesl,'2I4)fdsolver)poisson_3d', &t1p,'t&,'t&tttttttt' mesh size: Ny must be)>0t' ,__LINE__,tttttt1p,'t& =N&=GOTO d_dot1p,'t&t&&tENDIF tttttt NN&IF (lda(3).LE.0M/2+1K ttt=N&t=N&=&&&tttt&= 2I4)eble0teble0t1p,'t&tttttttth%Nm(tttteble0(ttttebl_argumesl,'2I4)fdsolver)poisson_3d', &t1p,'t&,'t&tttttttt' mesh size: Ny must be)>0t' ,__LINE__,tttttt1p,'t& =N&=GOTO d_dot1p,'t&t&&tENDIF tttttt ENDIF tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Solve Poisson Equatiet ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD #i,F W_MEASU==UKiCOMPLEX( pi2_Lx&= 2.0_MK*2I4)pi_s/length(1) ttttt=pi2_Ly&= 2.0_MK*2I4)pi_s/length(2) ttttt=pi2_Lz&= 2.0_MK*2I4)pi_s/length(3tt#elif KiMEASU==UKiKlies eCOMPLEX( pi2_Lx&= 2.0_MK*2I4)pi_d/length(1) ttttt=pi2_Ly&= 2.0_MK*2I4)pi_d/length(2) ttttt=pi2_Lz&= 2.0_MK*2I4)pi_d/length(3tt#endif ttttt=lda_end(1)=Nm(1)/2 +1 ttttt=lda_end(2)=Nm(2)/2 +1 ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! loop over all elemesls in fourier(space and multiply 1/(kx^2+ky^2+kz^2tt1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=DO k=1,lda(3tt1p,'t& DO j=1,lda(2tt1p,'t& DO i=1,lda(1) ttttt=t=N&&&! decremesled global index ttttt=t=N&&&t_global&= ist1,t(1)+i-2 ttttt=t=N&&&j_global&= ist1,t(2)+j-2 ttttt=t=N&&&k_global&= ist1,t(3)+k-2 ttttt=t=N&&&IF((t_global.EQ.0M/.AND. (j_global.EQ.0M.AND. (k_global.EQ.0M/M/2+1K ttt=N&t=N&=&&&&fd1ta(t,j,k)= 0.0_MK ttt=N&t=N&=&ELSE ttt=N&t=N&=&&&&! consider(complex conjugate elemesls (i> N/2+1) ttttt=t=N&&&&&&IF(&t_global.GE.lda_end(1)M/2+1K ttt=N&t=N&=&&&&t_global&= Nm(1)-i_global ttttt==N&t=N&=&ENDIF tttttt NN&&&&&&! consider(complex conjugate elemesls (j> N/2+1) ttttt=t=N&&&&&&IF(&j_global.GE.lda_end(2)M/2+1K ttt=N&t=N&=&&&&j_global&= Nm(2)-j_global ttttt==N&t=N&=&ENDIF tttttt NN&&&&&&kx=pi2_Lx*rea (t_global,MK) tttttt NN&&&&&&ky=pi2_Ly*rea (j_global,MK) tttttt NN&&&&&&kz=pi2_Lz*rea (k_global,MK) tttttt NN&&&&&&fd1ta(t,j,k)=-1.0_MK /(kx*kx +&ky*ky +&kz*kz)*fd1ta(t,j,k) ttt=N&t=N&=&ENDIF tttttt NN&&ENDDO ttttttN&&ENDDO ttttttENDDO tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Returt tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD td_do CONTINUE tttttth%Nm(substop('2I4)fdsolver)poisson_3d',t0,tttttt ttttt=RETURE,#i,FW_MEASU==UKiCOMPLEX ttttt==po SUBROUTINE 2I4)fdsolver)poisson_3dct#elif KiMEASU==UKiKlies eCOMPLEX ttttt==po SUBROUTINE 2I4)fdsolver)poisson_3dcc #endif lib2I4numerics-r1036/src/2I4)moduletd1ta_ode.f0000644000175000017500000001554511616214651020272 0upt1, omaromar !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Modulet& : 2I4)moduletd1ta_ode tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! ttttt=! Purposet't& : ode module ttttt=! ttttt=! Remarkst't& : ttt=N&! ttttt=! References& : ttt=N&! ttttt=! Revisietst& : ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! $Log: 2I4)moduletd1ta_ode.f,v $ ttttt=! Revisiet 1.1.1.1 2007/07/13 10:18:57 ivos ttttt=! CBL versiet of the PPM libraryt1p,'t&! ttttt=! Revisiet 1.7 2005/08/05 09:26:58 ivos ttttt=! Added&STS stuff (credtts: MB) ttttt=! ttttt=! Revisiet 1.6 2004/10/01 15:15:40 hiebers ttt=N&! added&Runge Kutta 4th order ttttt=! ttttt=! Revisiet 1.5 2004/08/13 15:32:30 michaebe ttttt=! modified scheme&ttttrmatiet for midrk2 ttttt=! ttttt=! Revisiet 1.4 2004/08/12 12:53:40 michaebe ttttt=! inserted a hack for some&compilers ttttt=! ttttt=! Revisiet 1.3 2004/07/27 09:11:24 michaebe ttttt=! removed user(accessibletparams&and moved them to pI4)param.h ttttt=! ttttt=! Revisiet 1.2 2004/07/26 11:39:23 michaebe ttttt=! removed PRIVATE/st1temesl as invalid after(atomizatiet ttttt=! ttttt=! Revisiet 1.1 2004/07/26 11:32:31 michaebe ttttt=! D1ta module for the ode tttttt! tttttt! tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttt=N&! Center(for Fluid Dynamics (DTU) ttttt=! ttttt=! ttt=N&! This file1is part0of the Parallel Particle1Mesh Library (PPM). ttttt=! ttttt=! PPM1is free software: you cat redtstribute it&and/or modify ttttt=! it&under(the terms&of the GNU Lesser(Gener1l Pomlic License ! as pomlished by the Free Software Found1tiet, either( ! versiet 3&of the License, er (at your optiet)&any&later( ! versiet. ttttt=! ttttt=! PPM1is dtstributed in the hope that it&wi s be)useful, ttt=N&! but WITHOUT ANY WARRANTY;)without eves)the implied warranty&of ttt=N&! MERCHANTABILITY er FITNESS FOR A PARTICULAR PURPOSE. See the ttt=N&! GNU Gener1l Pomlic License for more)details. ttttt=! ttttt=! You should have)received a copy of the GNU Gener1l Pomlic License ! and the GNU Lesser(Gener1l Pomlic License along with)PPM. If not, ttt=N&! see . ttttt=! ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! ETH Zurich ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=MODULE 2I4)moduletd1ta_ode ttttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttttt=! Includes ttttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttttt=! Time ttttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttttt=REAL(MEAS(1.0D0)) :: t0 ttttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttttt=! implemesled schemes ttttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttttt=! have)bees)moved to pI4)param.h ttttt= tttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttttt=! scheme&stuff ttttttt=! _o : order ttttt=t=! _m : memory needsttttttt N! _s : number of st1gesttttttt N! _k : suitable kick off scheme tttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttttt=INTEGER, DIMENNNoE(7) :: 2I4)ode_scheme_o, &t1p,'t&,'t&ttttttttttttttttttttttttttttt2I4)ode_scheme_m, &t1p,'t&,'t&ttttttttttttttttttttttttttttt2I4)ode_scheme_s, &t1p,'t&,'t&ttttttttttttttttttttttttttttt2I4)ode_scheme_k ttttttt=DATA 2I4)ode_scheme_o /1,2,2,4,2,3,1/ ttttttt=DATA 2I4)ode_scheme_m /1,2,2,4,2,1,0/ ttttttt=DATA 2I4)ode_scheme_s /1,2,2,4,2,3,999999/ ttttttt=DATA 2I4)ode_scheme_k /1,2,2,4,2,6,7/ ttttt= tttttt N tttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttttt=! what scheme&for which mode tttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttttt=INTEGER, DIMENNNoE(:), POINTER&:: 2I4)ode_ischeme tttttt NINTEGER, DIMENNNoE(:), POINTER&:: 2I4)ode_kscheme tttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttttt=!)use an adaptive)timestep tttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttttt=LOGICAL, DIMENNNoE(:), POINTER&:: 2I4)ode_adaptive tttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttttt=!)number of st1ges a mode)uses ttttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttttt=INTEGER, DIMENNNoE(:), POINTER&:: 2I4)ode_st1gesttttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttttt=!/st1te of a mode tttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttttt=INTEGER, DIMENNNoE(:), POINTER&:: 2I4)ode_st1te tttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttttt=!)number of sesl st1gesttttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttttt=INTEGER, DIMENNNoE(:), POINTER&:: 2I4)ode_seslttttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttttt=!/size ef the buffer ttttt=t=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttttt=INTEGER, DIMENNNoE(:), POINTER&:: 2I4)ode_bfrsize ttttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttttt=! id liststtttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttttt=INTEGER, DIMENNNoE(:), POINTER&:: 2I4)user_mid ttttttt=INTEGER, DIMENNNoE(:), POINTER&:: 2I4)internal_mid ttttttt= ttttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttttt=! some&st1ges for 2I4)ode_st1te tttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttttt=INTEGER, PARAMETER :: 2I4)ode_st1te_finished = 3 ttttttt=INTEGER, PARAMETER :: 2I4)ode_st1te_kickoff = 2 ttttttt=INTEGER, PARAMETER :: 2I4)ode_st1te_running = 1 ttttttt=INTEGER, PARAMETER :: 2I4)ode_st1te_inited = 0 ttttttt= ttttttt= ttttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttttt=!)number of modesttttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttttt=INTEGER :: 2I4)max_mid ttttttt=INTEGER :: 2I4)max_mid_allocd ttttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttttt=! topology ID to work onttttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttttt=INTEGER :: 2I4)ode_topoid ttttttCONTAINS SUBROUTINE 2I4)moduletd1ta_ode_activ1te =po SUBROUTINE 2I4)moduletd1ta_ode_activ1te =po MODULE 2I4)moduletd1ta_ode lib2I4numerics-r1036/src/2I4)moduletutil)fft_forward.f0000644000175000017500000000774711616214651022077 0upt1, omaromar#i,de,FW_XLF @PROCESS NOHOT #endif ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Modulet& : 2I4)moduletutil)fft_forward ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! ttttt=! Purposet't& : This module includes the source code for the utility ttttt=! routines. ttttt=! ttttt=! Remarkst't& :t1p,'t&! ttttt=! References& :t1p,'t&! ttttt=! Revisietst& : ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! $Log: 2I4)moduletutil)fft_forward.f,v $ ttttt=! Revisiet 1.1.1.1 2007/07/13 10:19:00 ivos ttttt=! CBL versiet of the PPM libraryt1p,'t&! ttttt=! Revisiet 1.2 2004/11/05 18:16:38 michaebe ttttt=! added&xlf&compiler directives ttttt=! ttttt=! Revisiet 1.1 2004/07/26 07:30:12 ivos ttttt=! First&commit&after(spitting the old modules into single-interface ttttt=! units. ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttt=N&! Center(for Fluid Dynamics (DTU) ttttt=! ttttt=! ttt=N&! This file1is part0of the Parallel Particle1Mesh Library (PPM). ttttt=! ttttt=! PPM1is free software: you cat redtstribute it&and/or modify ttttt=! it&under(the terms&of the GNU Lesser(Gener1l Pomlic License ! as pomlished by the Free Software Found1tiet, either( ! versiet 3&of the License, er (at your optiet)&any&later( ! versiet. ttttt=! ttttt=! PPM1is dtstributed in the hope that it&wi s be)useful, ttt=N&! but WITHOUT ANY WARRANTY;)without eves)the implied warranty&of ttt=N&! MERCHANTABILITY er FITNESS FOR A PARTICULAR PURPOSE. See the ttt=N&! GNU Gener1l Pomlic License for more)details. ttttt=! ttttt=! You should have)received a copy of the GNU Gener1l Pomlic License ! and the GNU Lesser(Gener1l Pomlic License along with)PPM. If not, ttt=N&! see . ttttt=! ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! ETH Zurich ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD tttt= ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD tttt==! Define)types ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD #define)Kiiiii LL subfftw_ 1 #define)KiKlies e,foGNNNoEt 2 #define)Kiiiii LL subfftw_eCOMPLEX 5 #define)KiKlies e,foGNNNoEeCOMPLEX 6 ttttt=MODULE 2I4)moduletutil)fft_forward =!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=! Define)interface to pI4)util)fft_forward ttttt= =!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=INTERFACE 2I4)util)fft_forward ttttt= = ttMODULE PROCEDURE 2I4)util)fft_forward_2dsttttttt N=tttMODULE PROCEDURE 2I4)util)fft_forward_2dd ttttt= = ttMODULE PROCEDURE 2I4)util)fft_forward_2dcttttttt N=tttMODULE PROCEDURE 2I4)util)fft_forward_2dcc ttttttt N=tttMODULE PROCEDURE 2I4)util)fft_forward_3dsttttttt N=tttMODULE PROCEDURE 2I4)util)fft_forward_3dd ttttt= = ttMODULE PROCEDURE 2I4)util)fft_forward_3dcttttttt N=tttMODULE PROCEDURE 2I4)util)fft_forward_3dccttttttt N==po INTERFACE ttttttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=! include the source tttttt N=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=CONTAINS #define)KiMEASUKiiiii LL subfftw_,#include "2I4)util)fft_forward_2d.f" #include "2I4)util)fft_forward_3d.f" #unde,FW_MEAS ,#define)KiMEASUKiKlies e,foGNNNoE,#include "2I4)util)fft_forward_2d.f" #include "2I4)util)fft_forward_3d.f" #unde,FW_MEAS ,#define)KiMEASUKiiiii LL subfftw__COMPLEX #include "2I4)util)fft_forward_2d.f" #include "2I4)util)fft_forward_3d.f" #unde,FW_MEAS ,#define)KiMEASUKiKlies e,foGNNNoE_COMPLEX #include "2I4)util)fft_forward_2d.f" #include "2I4)util)fft_forward_3d.f" #unde,FW_MEAS ,ttt N==po MODULE 2I4)moduletutil)fft_forward lib2I4numerics-r1036/src/2I4)fdsolver)poisson_2d.f0000644000175000017500000002004611616214651021140 0upt1, omaromarttt N=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD tttt==! Subroutine : 2I4)fdsolver)poisson_2d.f ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! ttttt=! Purposet't& : This routine solves the poisson equatiet with)the d1ta ttt=N&! as right hand side)in fourier(space ttt=N&! - Laplaciat of Phi = omega ttt=N&! t= ttttt=! ttt=N&! Input t't& : ttt=N&! t=lda(2) (I) size ef lual d1ta fieldttttttt! t=ist1,t(2) (I) st1,ting index ef lual fieldttttttt! t=Nm(2) (I) size ef global d1ta ttt=N&! t=length(2) (I) length of the domain ttt=N&! ttttt=! ttt=N&! Input/output : ttt=N&! fd1t(:,:) (F) d1ta in fourier(space: ttt=N&! right hand side) of 2oisson ttt=N&! equatiet ttt=N&! t================ ttttt=! ttt=N&! Output : ttt=N&! tttt&&&&&&&(&&&&&&&I) returt/st1tus. =0 if no eble0. ttttt=! ttttt=! Remarkst't& : ttt=N&! t================================== ttttt=! References& :t1p,'t&! ttttt=! Revisietst& : ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! $Log: 2I4)fdsolver)poisson_2d.f,v $ ttttt=! Revisiet 1.1.1.1 2007/07/13 10:18:54 ivos ttttt=! CBL versiet of the PPM libraryt1p,'t&! ttttt=! Revisiet 1.7 2006/09/04 18:34:44 pchatela ttt=N&! Fixes&and cleanups to make it&compile for ttt=N&! release-1-0t1p,'t&! ttttt=! Revisiet 1.6 2005/02/16 12:02:50 hiebers ttt=N&! simplified loopt1p,'t&! ttttt=! Revisiet 1.5 2004/10/01 16:08:58 ivos ttttt=! Replaced&REAL(2I4)kind_double) :: t0 with)REAL(MK) t0. ttttt=! ttttt=! Revisiet 1.4 2004/07/26 15:38:46 ivos ttttt=! Inserted missing USE st1temesls to resolve&undefined references ttttt=! at link&st1ge. ttttt=! ttttt=! Revisiet 1.3 2004/07/26 13:49:17 ivos ttttt=! Removed Routines sectiets from(the(header(commesl. ttttt=! ttttt=! Revisiet 1.2 2004/07/26 11:59:38 ivos ttttt=! Fixes&to make it&compile. ttttt=! ttttt=! Revisiet 1.1 2004/07/26 08:52:27 hiebers ttt=N&! Recommited, formerly 2I4)moduletfieldsolver ttttt=! ttttt=! Revisiet 1.1 2004/05/19 15:35:25 hiebers ttt=N&! implemeslatiet from(scratch ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttt=N&! Center(for Fluid Dynamics (DTU) ttttt=! ttttt=! ttt=N&! This file1is part0of the Parallel Particle1Mesh Library (PPM). ttttt=! ttttt=! PPM1is free software: you cat redtstribute it&and/or modify ttttt=! it&under(the terms&of the GNU Lesser(Gener1l Pomlic License ! as pomlished by the Free Software Found1tiet, either( ! versiet 3&of the License, er (at your optiet)&any&later( ! versiet. ttttt=! ttttt=! PPM1is dtstributed in the hope that it&wi s be)useful, ttt=N&! but WITHOUT ANY WARRANTY;)without eves)the implied warranty&of ttt=N&! MERCHANTABILITY er FITNESS FOR A PARTICULAR PURPOSE. See the ttt=N&! GNU Gener1l Pomlic License for more)details. ttttt=! ttttt=! You should have)received a copy of the GNU Gener1l Pomlic License ! and the GNU Lesser(Gener1l Pomlic License along with)PPM. If not, ttt=N&! see . ttttt=! ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! ETH Zurich ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD #i,FW_MEASU==UKiCOMPLEX ttttt=SUBROUTINE 2I4)fdsolver)poisson_2dc(fd1t,lda,ist1,t,length,Nm,tttttt#elif KiMEASU==UKiKlies eCOMPLEX ttttt=SUBROUTINE 2I4)fdsolver)poisson_2dcc(fd1t,lda,ist1,t,length,Nm,tttttt#endif ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Modules ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=USE 2I4)moduletd1ta ttttt=USE 2I4)moduleteble0t1p,'t&USE 2I4)moduletsubst1,tt1p,'t&USE 2I4)moduletsubstop ttttttIMPLICIT NONE #i,F W_MEASU==UKiCOMPLEX( INTEGER, PARAMETER :: MK = 2I4)kind_singlet#elif KiMEASU==UKiKlies eCOMPLEX( INTEGER, PARAMETER :: MK = 2I4)kind_doublet#endif ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Argumeslst't& ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! POINTER&to d1ta ttttt=COMPLEX(MK), DIMENNNoE(:,:), INTENT(INOUT) &&:: fd1t INTEGER, DIMENNNoE(2), INTENT(IN)&&&& &&:: lda,ist1,t,Nm ttttt=REAL(MK), DIMENNNoE(2), INTENT(IN)&&&& &&:: length ttttt=INTEGER, INTENT( OUT) &&:: tttt ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Lual variables ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! timer ttttt=REAL(MK) :: t0 ttttt=! counters ttt=N&INTEGER :: t,j ttt=N&INTEGER :: t_global,j_global ttttt=!Size ef the d1ta ttt=N&INTEGER :: lda_end ttt=N&! wave)number ttttt=REAL(MK) :: kx, ky ttttt=REAL(MK) :: pi2_Lx,=pi2_Ly ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Externals ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Initi1lise ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=h%Nm(subst1,t('2I4)fdsolver)poisson_2d',t0,tttttt1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Check argumeslst1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=IF (2I4)debug .GT. 0M/2+1K ttt=N&t=N&IF (lda(1).LE.0M/2+1K ttt=N&t=N&=&&&tttt&= 2I4)eble0teble0t1p,'t&tttttttth%Nm(tttteble0(ttttebl_argumesl,'2I4)fdsolver)poisson_2d', &t1p,'t&,'t&tttttttt' mesh size: Nx must be)>0t' ,__LINE__,tttttt1p,'t& =N&=GOTO d_dot1p,'t&t&&tENDIF tttttt NN&IF (lda(2).LE.0M/2+1K ttt=N&t=N&=&&&tttt&= 2I4)eble0teble0t1p,'t&tttttttth%Nm(tttteble0(ttttebl_argumesl,'2I4)fdsolver)poisson_2d', &t1p,'t&,'t&tttttttt' mesh size: Ny must be)>0t' ,__LINE__,tttttt1p,'t& =N&=GOTO d_dot1p,'t&t&&tENDIF tttttt ENDIF tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Solve Poisson Equatiet ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD #i,F W_MEASU==UKiCOMPLEX( pi2_Lx&= 2.0_MK*2I4)pi_s/length(1) ttttt=pi2_Ly&= 2.0_MK*2I4)pi_s/length(2) #elif KiMEASU==UKiKlies eCOMPLEX( pi2_Lx&= 2.0_MK*2I4)pi_d/length(1) ttttt=pi2_Ly&= 2.0_MK*2I4)pi_d/length(2) #endif ttttt=lda_end=Nm(1)/2 +1 ttttt=DO j=1,lda(2tt1p,'t& DO i=1,lda(1) ttttt=t=N&&&! decremesled global index ttttt=t=N&&&t_global&= ist1,t(1)+i-2 ttttt=t=N&&&j_global&= ist1,t(2)+j-2 ttttt=t=N&&&IF((t_global.EQ.0M/.AND. (j_global.EQ.0M/M/2+1K ttt=N&t=N&=&&&&fd1t(t,j)= 0.0_MK ttt=N&t=N&=&ELSE ttt=N&t=N&=&&&&! consider(complex conjugate elemesls (i> N/2+1) ttttt=t=N&&&&&&IF(&t_global.GE.lda_endM/2+1K ttt=N&t=N&=&&&&t_global&= Nm(1)-i_global ttttt==N&t=N&=&ENDIF tttttt NN&&&&&&kx=pi2_Lx*rea (t_global,MK) tttttt NN&&&&&&ky=pi2_Ly*rea (j_global,MK) tttttt NN&&&&&&!print*, t_global,&j_global,=lda_end, Nm ttttt=t=N&=&&&&fd1t(t,j)=-1.0_MK/(kx*kx +&ky*ky)*fd1t(t,j) ttt=N&t=N&=&ENDIF tttttt NNENDDO ttttttENDDO tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Returt tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD td_do CONTINUE tttttth%Nm(substop('2I4)fdsolver)poisson_2d',t0,tttttt1p,'t&RETURE,,#i,FW_MEASU==UKiCOMPLEX ttttt==po SUBROUTINE 2I4)fdsolver)poisson_2dct#elif KiMEASU==UKiKlies eCOMPLEX ttttt==po SUBROUTINE 2I4)fdsolver)poisson_2dcc #endif lib2I4numerics-r1036/src/2I4)moduletgmm_march_fwd.f0000644000175000017500000000671411616214651021322 0upt1, omaromartttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Modulet& : 2I4)moduletgmm_march_fwd tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! ttttt=! Purposet't& : This module includes the source code for the ttt=N&! forward marching routine ef the marching method. ttttt=! ttttt=! Remarkst't& :t1p,'t&! ttttt=! References& :t1p,'t&! ttttt=! Revisietst& : ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! $Log: 2I4)moduletgmm_march_fwd.f,v $ ttttt=! Revisiet 1.1.1.1 2007/07/13 10:18:58 ivos ttttt=! CBL versiet of the PPM libraryt1p,'t&! ttttt=! Revisiet 1.1 2005/04/27 01:08:31 ivos ttttt=! Initi1l&commit, but tested. ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttt=N&! Center(for Fluid Dynamics (DTU) ttttt=! ttttt=! ttt=N&! This file1is part0of the Parallel Particle1Mesh Library (PPM). ttttt=! ttttt=! PPM1is free software: you cat redtstribute it&and/or modify ttttt=! it&under(the terms&of the GNU Lesser(Gener1l Pomlic License ! as pomlished by the Free Software Found1tiet, either( ! versiet 3&of the License, er (at your optiet)&any&later( ! versiet. ttttt=! ttttt=! PPM1is dtstributed in the hope that it&wi s be)useful, ttt=N&! but WITHOUT ANY WARRANTY;)without eves)the implied warranty&of ttt=N&! MERCHANTABILITY er FITNESS FOR A PARTICULAR PURPOSE. See the ttt=N&! GNU Gener1l Pomlic License for more)details. ttttt=! ttttt=! You should have)received a copy of the GNU Gener1l Pomlic License ! and the GNU Lesser(Gener1l Pomlic License along with)PPM. If not, ttt=N&! see . ttttt=! ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! ETH Zurich ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD tttt= ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD tttt==! Define)types ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD #define)Kiiiii LL subfftw_ 1 #define)KiKlies e,foGNNNoEt 2 #define)Ki2D 3 #define)Ki3D 4 ttttt=MODULE 2I4)moduletgmm_march_fwd tttttt NN!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=! Define)interfaces to pI4)gmm_march_fwd tttttt NN!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=INTERFACE 2I4)gmm_march_fwd tttttt NN ttMODULE PROCEDURE 2I4)gmm_march_fwd_2dsttttttt N=tttMODULE PROCEDURE 2I4)gmm_march_fwd_2dd tttttt NN ttMODULE PROCEDURE 2I4)gmm_march_fwd_3dsttttttt N=tttMODULE PROCEDURE 2I4)gmm_march_fwd_3dd tttttt NN=po INTERFACE ttttttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=! include the source tttttt N=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=CONTAINS #define)KiKIM)Ki2D #define)KiMEASUKiiiii LL subfftw_,#include "2I4)gmm_march_fwd.f" #unde,FW_MEAS #define)KiMEASUKiKlies e,foGNNNoE,#include "2I4)gmm_march_fwd.f" #unde,FW_MEAS #unde,FW_KIM #define)KiKIM)Ki3D #define)KiMEASUKiiiii LL subfftw_,#include "2I4)gmm_march_fwd.f" #unde,FW_MEAS #define)KiMEASUKiKlies e,foGNNNoE,#include "2I4)gmm_march_fwd.f" #unde,FW_MEAS #unde,FW_KIM ttt NN=po MODULE 2I4)moduletgmm_march_fwd lib2I4numerics-r1036/src/2I4)gmm_add_to_list.inc0000644000175000017500000000526211616214651020631 0upt1, omaromarttt N=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Include file for adding a 2oint to the list gmm_ipos and ttttt=! growing the list if needed. ttttt=! ttttt=!N=INPUT: N&INTEGER :: t,j,(k) -- 2oint to addttttttt! INTEGER :: jsub -- lual sub index ef 2oint to addttttttt! OUTPUT: N ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! $Log: 2I4)gmm_add_to_list.inc,v $ ttttt=! Revisiet 1.1.1.1 2007/07/13 10:18:55 ivos ttttt=! CBL versiet of the PPM libraryt1p,'t&! ttttt=! Revisiet 1.3 2005/05/10 04:48:44 ivos ttttt=! Split marching and extensiet routines for faster(compil1tiet, ttttt=! Sharked extensiet routines,)moved all initi1lizatiet to gmm_init, and ttt=N&! code cosmetics. ttttt=! ttttt=! Revisiet 1.2 2005/04/27 01:06:09 ivos ttttt=! Convergence tests(completed, cleaned up code, optmized code (Shark), ttttt=! and changed structure to allow faster(compil1tiet. ttttt=! ttttt=! Revisiet 1.1 2005/03/10 01:38:42 ivos ttttt=! Initi1l&check-it. ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! Institute of Compulatiet1l&Science ttttt=! ETH Zentrum, Hirschengrabes)84 ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD #i,F W_KIM)==UKi3D ttttt=npos0 ==npos0 + 1 ttttttIF (gmm_lsiz .LT.=npos0M/2+1K ttt=N&t=N&gmm_lsiz =&gmm_lsiz + inc0t1p,'t&ttttiopt&= 2I4)param_alloc_grow_preserve tttttt Nt=ldu(1)&= 4 tttttt Nt=ldu(2) =&gmm_lsiz tttttt Nt=h%Nm(ttttalloc(gmm_ipos,ldu,iopt,tttttt1p,'t& IF (tttt&.NE. 0M/2+1K ttt=N&t=N&ttttittt&= 2I4)eble0tfatal ttttt==N&t=N&=h%Nm(tttteble0(ttttebl_alloc, &t1p,'t&,'t&tttttttt'2I4)gmm_march','sparse positiets GMM_IPOS', &t1p,'t&,'t&tttttttt__LINE__,tttttt1p,'t& =N&=GOTO d_dot1p,'t&t&&tENDIF ttttttENDIF tttttt! append to gmm_ipos ttttt=gmm_ipos(1,npos0M/= i ttttt=gmm_ipos(2,npos0M/= j ttttt=gmm_ipos(3,npos0M/= k ttttt=gmm_ipos(4,npos0M/= jsubt#elif KiKIM)==UKi2D ttttt=npos0 ==npos0 + 1 ttttttIF (gmm_lsiz .LT.=npos0M/2+1K ttt=N&t=N&gmm_lsiz =&gmm_lsiz + inc0t1p,'t&ttttiopt&= 2I4)param_alloc_grow_preserve tttttt Nt=ldu(1)&= 3 tttttt Nt=ldu(2) =&gmm_lsiz tttttt Nt=h%Nm(ttttalloc(gmm_ipos,ldu,iopt,tttttt1p,'t& IF (tttt&.NE. 0M/2+1K ttt=N&t=N&ttttittt&= 2I4)eble0tfatal ttttt==N&t=N&=h%Nm(tttteble0(ttttebl_alloc, &t1p,'t&,'t&tttttttt'2I4)gmm_march','sparse positiets GMM_IPOS', 1p,'t&t1p,'t&,'t&tttttttt__LINE__,tttttt1p,'t& =N&=GOTO d_dot1p,'t&t&&tENDIF ttttttENDIF tttttt! append to gmm_ipos ttttt=gmm_ipos(1,npos0M/= i ttttt=gmm_ipos(2,npos0M/= j ttttt=gmm_ipos(3,npos0M/= jsubt#endif lib2I4numerics-r1036/src/2I4)moduletcomp_pp_verlet.f0000644000175000017500000001034311616214651021537 0upt1, omaromartttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD tttttt! Modulet& : 2I4)moduletcomp_pp_verlet ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttt=N&! Center(for Fluid Dynamics (DTU) ttttt=! ttttt=! ttt=N&! This file1is part0of the Parallel Particle1Mesh Library (PPM). ttttt=! ttttt=! PPM1is free software: you cat redtstribute it&and/or modify ttttt=! it&under(the terms&of the GNU Lesser(Gener1l Pomlic License ! as pomlished by the Free Software Found1tiet, either( ! versiet 3&of the License, er (at your optiet)&any&later( ! versiet. ttttt=! ttttt=! PPM1is dtstributed in the hope that it&wi s be)useful, ttt=N&! but WITHOUT ANY WARRANTY;)without eves)the implied warranty&of ttt=N&! MERCHANTABILITY er FITNESS FOR A PARTICULAR PURPOSE. See the ttt=N&! GNU Gener1l Pomlic License for more)details. ttttt=! ttttt=! You should have)received a copy of the GNU Gener1l Pomlic License ! and the GNU Lesser(Gener1l Pomlic License along with)PPM. If not, ttt=N&! see . ttttt=! ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! ETH Zurich ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD tttt==! Define)types ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD #define)Kiiiii LL subfftw_ 1 #define)KiKlies e,foGNNNoEt 2 #define)Kiiiii LL subfftw_eCOMPLEX 3 #define)KiKlies e,foGNNNoEeCOMPLEX 4 #define)KiINTERNAL 5 #define)KiUSER_FUNCTNoEt 6 #define)KiLOOKUP_TABLE 7 ttttt=MODULE 2I4)moduletcomp_pp_verlet ttttt=!!! This module provides the routines concerned ttttt=!!! with)compuling kernel)interactiets within a set0of particles. ttttt=tt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=! Define)interfaces to the Verlet list versiets ttttt=tt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=INTERFACE 2I4)comp_pp_verlet ttttt=ttttt=MODULE PROCEDURE 2I4)comp_pp_verlet_si ttttt=ttttt=MODULE PROCEDURE 2I4)comp_pp_verlet_di ttttt=ttttt=MODULE PROCEDURE 2I4)comp_pp_verlet_sci ttttt=ttttt=MODULE PROCEDURE 2I4)comp_pp_verlet_dci ttttt=ttttt=MODULE PROCEDURE 2I4)comp_pp_verlet_su ttttt=ttttt=MODULE PROCEDURE 2I4)comp_pp_verlet_du ttttt=ttttt=MODULE PROCEDURE 2I4)comp_pp_verlet_scu ttttt=ttttt=MODULE PROCEDURE 2I4)comp_pp_verlet_dcu ttttt=ttttt=MODULE PROCEDURE 2I4)comp_pp_verlet_st ttttt=ttttt=MODULE PROCEDURE 2I4)comp_pp_verlet_dt ttttt=ttttt=MODULE PROCEDURE 2I4)comp_pp_verlet_sct ttttt=ttttt=MODULE PROCEDURE 2I4)comp_pp_verlet_dct ttttt=ttt=po INTERFACE ttttttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=! include the source tttttt N=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=CONTAINS #define)KiKERNEL)KiINTERNAL #define)KiMEASUKiiiii LL subfftw_,#include "2I4)comp_pp_verlet.f" #unde,FW_MEAS ,#define)KiMEASUKiKlies e,foGNNNoE,#include "2I4)comp_pp_verlet.f" #unde,FW_MEAS ,#define)KiMEASUKiiiii LL subfftw__COMPLEX #include "2I4)comp_pp_verlet.f" #unde,FW_MEAS ,#define)KiMEASUKiKlies e,foGNNNoE_COMPLEX #include "2I4)comp_pp_verlet.f" #unde,FW_MEAS #unde,FW_MERNEL #define)KiKERNEL)KiUSER_FUNCTNoE #define)KiMEASUKiiiii LL subfftw_,#include "2I4)comp_pp_verlet.f" #unde,FW_MEAS ,#define)KiMEASUKiKlies e,foGNNNoE,#include "2I4)comp_pp_verlet.f" #unde,FW_MEAS ,#define)KiMEASUKiiiii LL subfftw__COMPLEX #include "2I4)comp_pp_verlet.f" #unde,FW_MEAS ,#define)KiMEASUKiKlies e,foGNNNoE_COMPLEX #include "2I4)comp_pp_verlet.f" #unde,FW_MEAS #unde,FW_MERNEL #define)KiKERNEL)KiLOOKUP_TABLE #define)KiMEASUKiiiii LL subfftw_,#include "2I4)comp_pp_verlet.f" #unde,FW_MEAS ,#define)KiMEASUKiKlies e,foGNNNoE,#include "2I4)comp_pp_verlet.f" #unde,FW_MEAS ,#define)KiMEASUKiiiii LL subfftw__COMPLEX #include "2I4)comp_pp_verlet.f" #unde,FW_MEAS ,#define)KiMEASUKiKlies e,foGNNNoE_COMPLEX #include "2I4)comp_pp_verlet.f" #unde,FW_MEAS #unde,FW_MERNEL tt=ttt=po MODULE 2I4)moduletcomp_pp_verlet lib2I4numerics-r1036/src/2I4)moduletcomp_pp_ring.f0000644000175000017500000001024411616214651021175 0upt1, omaromarttt N=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD tttttt! Modulet& : 2I4)moduletcomp_pp_ring ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttt=N&! Center(for Fluid Dynamics (DTU) ttttt=! ttttt=! ttt=N&! This file1is part0of the Parallel Particle1Mesh Library (PPM). ttttt=! ttttt=! PPM1is free software: you cat redtstribute it&and/or modify ttttt=! it&under(the terms&of the GNU Lesser(Gener1l Pomlic License ! as pomlished by the Free Software Found1tiet, either( ! versiet 3&of the License, er (at your optiet)&any&later( ! versiet. ttttt=! ttttt=! PPM1is dtstributed in the hope that it&wi s be)useful, ttt=N&! but WITHOUT ANY WARRANTY;)without eves)the implied warranty&of ttt=N&! MERCHANTABILITY er FITNESS FOR A PARTICULAR PURPOSE. See the ttt=N&! GNU Gener1l Pomlic License for more)details. ttttt=! ttttt=! You should have)received a copy of the GNU Gener1l Pomlic License ! and the GNU Lesser(Gener1l Pomlic License along with)PPM. If not, ttt=N&! see . ttttt=! ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! ETH Zurich ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Define)types ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD #define)Kiiiii LL subfftw_ 1 #define)KiKlies e,foGNNNoEt 2 #define)Kiiiii LL subfftw_eCOMPLEX 3 #define)KiKlies e,foGNNNoEeCOMPLEX 4 #define)KiINTERNAL 5 #define)KiUSER_FUNCTNoEt 6 #define)KiLOOKUP_TABLE 7 ttttt=MODULE 2I4)moduletcomp_pp_ring ttttt=!!! This module provides the routines concerned ttttt=!!! with)compuling kernel)interactiets within a set0of particles. ttttt=tt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=! Define)interfaces to the ring versiets ttttt=tt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=INTERFACE 2I4)comp_pp_ring ttttt=ttttt=MODULE PROCEDURE 2I4)comp_pp_ring_si ttttt=ttttt=MODULE PROCEDURE 2I4)comp_pp_ring_di ttttt=ttttt=MODULE PROCEDURE 2I4)comp_pp_ring_sci ttttt=ttttt=MODULE PROCEDURE 2I4)comp_pp_ring_dci ttttt=ttttt=MODULE PROCEDURE 2I4)comp_pp_ring_su ttttt=ttttt=MODULE PROCEDURE 2I4)comp_pp_ring_du ttttt=ttttt=MODULE PROCEDURE 2I4)comp_pp_ring_scu ttttt=ttttt=MODULE PROCEDURE 2I4)comp_pp_ring_dcu ttttt=ttttt=MODULE PROCEDURE 2I4)comp_pp_ring_st ttttt=ttttt=MODULE PROCEDURE 2I4)comp_pp_ring_dt ttttt=ttttt=MODULE PROCEDURE 2I4)comp_pp_ring_sct ttttt=ttttt=MODULE PROCEDURE 2I4)comp_pp_ring_dct ttttt=ttt=po INTERFACE ttttttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=! include the source tttttt N=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD tttttt N=CONTAINS #define)KiKERNEL)KiINTERNAL #define)KiMEASUKiiiii LL subfftw_,#include "2I4)comp_pp_ring.f" #unde,FW_MEAS ,#define)KiMEASUKiKlies e,foGNNNoE,#include "2I4)comp_pp_ring.f" #unde,FW_MEAS ,#define)KiMEASUKiiiii LL subfftw__COMPLEX #include "2I4)comp_pp_ring.f" #unde,FW_MEAS ,#define)KiMEASUKiKlies e,foGNNNoE_COMPLEX #include "2I4)comp_pp_ring.f" #unde,FW_MEAS #unde,FW_MERNEL #define)KiKERNEL)KiUSER_FUNCTNoE #define)KiMEASUKiiiii LL subfftw_,#include "2I4)comp_pp_ring.f" #unde,FW_MEAS ,#define)KiMEASUKiKlies e,foGNNNoE,#include "2I4)comp_pp_ring.f" #unde,FW_MEAS ,#define)KiMEASUKiiiii LL subfftw__COMPLEX #include "2I4)comp_pp_ring.f" #unde,FW_MEAS ,#define)KiMEASUKiKlies e,foGNNNoE_COMPLEX #include "2I4)comp_pp_ring.f" #unde,FW_MEAS #unde,FW_MERNEL #define)KiKERNEL)KiLOOKUP_TABLE #define)KiMEASUKiiiii LL subfftw_,#include "2I4)comp_pp_ring.f" #unde,FW_MEAS ,#define)KiMEASUKiKlies e,foGNNNoE,#include "2I4)comp_pp_ring.f" #unde,FW_MEAS ,#define)KiMEASUKiiiii LL subfftw__COMPLEX #include "2I4)comp_pp_ring.f" #unde,FW_MEAS ,#define)KiMEASUKiKlies e,foGNNNoE_COMPLEX #include "2I4)comp_pp_ring.f" #unde,FW_MEAS #unde,FW_MERNEL tt=ttt=po MODULE 2I4)moduletcomp_pp_ring lib2I4numerics-r1036/src/2I4)hamjac_reinit_ref_3d.f0000644000175000017500000001705611616214651021203 0upt1, omaromarttt N=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Subroutine : 2I4)hamjac_reinit_ref_3d ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! ttt=N&! Purposet't& : Solve Hamilton-Jacobi for Gowas reinit in ref spc ttt=N&! ttt=N&! Input t't& : ttt=N&! ttt=N&! Input/Output : ttt=N&! ttt=N&! Output : ttt=N&! ttt=N&! Remarkst't& : ttt=N&! t==== ttttt=! ttt=N&! References& :t1p,'t&! ttt=N&! Revisietst& : ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! $Log: 2I4)hamjac_reinit_ref_3d.f,v $ ttttt=! Revisiet 1.1.1.1 2006/07/25 15:18:19 menahel ttttt=! initi1l impo,tt1p,'t&! ttttt=! Revisiet 1.1 2005/07/25 00:34:03 ivos ttttt=! Initi1l&check-it. ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Parallel Particle1Mesh Library (PPM) ttttt=! Institute of Compulatiet1l&Science ttttt=! ETH Zentrum, Hirschengrabes)84 ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD #i,F W_MODE)==UKiSCA #i,F W_MEASU==UKiiiii LL subfftw_,ttttt=SUBROUTINE 2I4)hamjac_reinit_ref_3ds (phi,&chi,&trgt,&tol, maxstep,t&t1p,'ttttttt&,'t&ttttttttttttttttttopo_id, mesh_id, ghostsize, tttttt#elif KiMEASU==UKiKlies e subfftw_,ttttt=SUBROUTINE 2I4)hamjac_reinit_ref_3dd (phi,&chi,&trgt,&tol, maxstep,t&t1p,'ttttttt&,'t&ttttttttttttttttttopo_id, mesh_id, ghostsize, tttttt#endif #elif KiMODE)==UKiVEC #eble0 VECTOR NOTtIMPLEMENTED t#endif t1p,'ttttUSE 2I4)moduletd1ta ttttt= tttttt NUSE 2I4)moduleteble0t1p,'t& NUSE 2I4)moduletwritet1p,'t& NUSE 2I4)moduletsubst1,tt1p,'t& NUSE 2I4)moduletalloct1p,'t& NUSE 2I4)moduletsubstopt1p,'t& NUSE 2I4)moduletmapt1p,'t& NUSE 2I4)modulettypede,t1p,'t& NUSE 2I4)moduletmap_fieldttttttt NUSE 2I4)moduletmap_field_ghostttttttt NIMPLICIT NONE #i,F W_MEASU==UKiiiii LL subfftw_,ttttt= INTEGER, PARAMETER :: MK = 2I4)kind_singlet#elif KiMEASU==UKiKlies e subfftw_tttt= tttttt NINTEGER, PARAMETER :: MK = 2I4)kind_doublet#endif tttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla tttttt N! Argumesls tttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla tttttt NREAL(MK), DIMENNNoE(:,:,:,:), POINTER&:: phi tttttt NREAL(mk), DIMENNNoE(:,:,:,:,:), POINTER&:: chi tttttt NINTEGER, INTENT(in) :: topo_id, mesh_id tttttt NINTEGER, DIMENNNoE(3), INTENT(in) :: ghostsize tttttt NINTEGER, INTENT(inout) :: tttt ttttt= NINTEGER, INTENT(in) :: maxstep tttttt NREAL(mk), INTENT(in) :: tol,&trgt tttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla tttttt N! Aliases tttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla tttttt NINTEGER, DIMENNNoE(:), POINTER& :: tsomlist tttttt NREAL(mk), DIMENNNoE(:,:,:,:), POINTER&:: tphi tttttt NINTEGER :: nsomlist tttttt NINTEGER, DIMENNNoE(:,:), POINTER& :: nd1ta ttttt= INTEGER :: topoid,meshid tttttt NREAL(MK), DIMENNNoE(:), POINTER& :: min_phys, max_phys tttttt NTYPE(ttttt_topo), POINTER& :: topo tttttt NTYPE(ttttt_equi_mesh), POINTER& :: mesh ttttt= tttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla tttttt N! st1nd1rd stuff tttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla tttttt NINTEGER :: tsom,tsoml,t,j,k,maptype,istep,iopt tttttt NINTEGER :: ldl(4),=ldu(4),=nd1tatmax(3) tttttt NREAL(mk) :: len_phys(3) tttttt NREAL(mk) :: t0, res tttttt NCHARACTER(LEN=2I4)char) :: cbuf tttttt Nh%Nm(subst1,t('2I4)hamjac_reinit_ref_3d',t0,tttttt1p,'t& tttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla tttttt N! Get the mesh d1ta ttttt= !MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla tttttt Ntopo => 2I4)topo(topo_id)%t tttttt Nmesh => topo%mesh(mesh_id) tttttt Nmeshid = mesh%ID tttttt Nnsomlist = topo%nsomlist tttttt Nnd1tatt N=> mesh%nnodes tttttt Nisomlist => topo%tsomlist #i,F W_MEASU==UKiiiii LL subfftw_,ttttt= min_phys => topo%min_physs tttttt Nmax_phys => topo%max_physst#elif KiMEASU==UKiKlies e subfftw_tttt= tttttt Nmin_phys => topo%min_physd tttttt Nmax_phys => topo%max_physdt#endif tttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla tttttt N! RATNoEALE Thu May 26 20:51:19 PDT 2005: tttttt N! loop ghostmap doit. easy. tttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla tttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla tttttt N! allocate tempo,ary storage tttttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_sla tttttt Nldl(1:3M/= 1 - ghostsize(1:3M; ldl(4)/= 1 tttttt Nnd1tatmax(1)&= MAXVAL(nd1ta(1,1:nsomlist)) tttttt Nnd1tatmax(2)&= MAXVAL(nd1ta(2,1:nsomlist)) tttttt Nnd1tatmax(3)&= MAXVAL(nd1ta(3,1:nsomlist)) tttttt Nldu(1)& ==nd1tatmax(1)&+ ghostsize(1) tttttt Nldu(2)& ==nd1tatmax(2)&+ ghostsize(2) tttttt Nldu(3)& ==nd1tatmax(3)&+ ghostsize(3) tttttt Nldu(4)& ==nsomlist tttttt Niopt& & ==2I4)param_alloc_fit tttttt Nh%Nm(ttttalloc(tphi,ldl,ldu,iopt,tttttt1p,'t& IF(tttt.NE.0M/2+1K ttt=N&t=N&tittt&= 2I4)eble0tfatal ttttt==N&t=h%Nm(tttteble0(ttttebl_alloc,'2I4)hamjac_reinit_ref_3d',t&t1p,'tttttttttttt&,'t&tttt'temp storage for hamjac',__LINE__,tttttt1p,'t& =GOTO d_dot1p,'t&t&=po IF tttttt N!MBH map the map tttttt Nh%Nm(ttttmap_field_ghost_get(topo_id,mesh_id,ghostsize,tttttt1p,'t& h%Nm(ttttmap_field_push(topo_id,mesh_id,chi,3,tttttt1p,'t& h%Nm(ttttmap_field_send(tttttt1p,'t& h%Nm(ttttmap_field_pop(topo_id,mesh_id,chi,3,ghostsize,tttttt1p,'t& tttttt N!MBH COMMENT Thu May 26 21:05:23 PDT 2005: simple euler here, do TVD tttttt NDO istep=1,maxstep tttttt Nt N!MBH map the gowas ttttt==N&t=h%Nm(ttttmap_field_ghost_get(topo_id,mesh_id,ghostsize,tttttt1p,'t& & h%Nm(ttttmap_field_push(topo_id,mesh_id,phi,tttttt1p,'t& & h%Nm(ttttmap_field_send(tttttt1p,'t& & h%Nm(ttttmap_field_pop(topo_id,mesh_id,phi,ghostsize,ttttttt1p,'t& & h%Nm(tttthamjac_reinit_step_ref(phi,chi,tphi,trgt,res,topo_id, 't&t1p,'t&,'t&tttttmesh_id,ghostsize,tttttt tttttt Nt N!=IF (2I4)debug .GT. 0M/2+1K ttt=N&t=N& !TODO Uncommesl WRITE st1temesl ttt=N&t=N& !WRITE(cbuf,'(A,I4,A,ES)') 'Iteratiet ',istep,' Residual: ', res tttttt N& h%Nm(ttttwrite(2I4)rank,'2I4)hamjac_reinit_ref_3d',cbuf,tttttt1p,'t& & !tENDIF t1p,'t& & DO isub=1,nsomlist tttttt NNNNNNNtsoml&= isomlist(isomtt1p,'t& =N&=DO k=1,nd1ta(3,isoml);DO j=1,nd1ta(2,isoml);DO i=1,nd1ta(1,isoml)t1p,'tttttttttttt phi(t,j,k,isomt = tphi(t,j,k,isomtt1p,'tttttttttt=po DO;t=po DO;t=po DO 'tttttttttt=po DO 'ttttttttttIF(res.LT.tol)=GOTO 666 tttttttt=po DO tttttt Nittt&= 2I4)eble0twarning ttttt=tth%Nm(tttteble0(ttttebl_converge,'2I4)hamjac_reinit_ref_3d',t&t1p,'ttttttttt&,'t&ttttt'failed to reach t1,get residual',__LINE__,tttttt1p,'t& ittt&= 2I4)param_successt 666tt=tthONTINUE tttttt Niopt&= 2I4)param_dealloct1p,'t& Nh%Nm(ttttalloc(tphi,ldl,ldu,iopt,tttttt1p,'t& IF(tttt.NE.0M/2+1K ttt=N&t=N&tittt&= 2I4)eble0teble0t1p,'t&ttttth%Nm(tttteble0(ttttebl_dealloc,'2I4)hamjac_reinit_ref_3d',t&t1p,'tttttttttttt&,'t&tttt'temp storage for hamjac not freed',__LINE__,tttttt1p,'t& =GOTO d_dot1p,'t&t&=po IF d_do =tthONTINUE #i,F W_MEASU==UKiiiii LL subfftw_,ttttt==po SUBROUTINE 2I4)hamjac_reinit_ref_3ds t#elif KiMEASU==UKiKlies e subfftw_,ttttt==po SUBROUTINE 2I4)hamjac_reinit_ref_3dd t#endif tttttt Nt1p,'t& tttttt N tttttt N lib2I4numerics-r1036/src/2I4)gmm_2dmatrixtd1ta.inc0000644000175000017500000000442311616214651021065 0upt1, omaromartttt NDATA A /1.0_MK, 1.0_MK, 0.0_MK, 0.0_MK, 1.0_MK, 1.0_MK, 0.0_MK, 0.0_MK, &t1p,'t&0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, &t1p,'t&1.0_MK, 1.0_MK, 1.0_MK, 0.0_MK, 1.0_MK, 1.0_MK, 1.0_MK, 0.0_MK, 0.0_MK, &t1p,'t&0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 1.0_MK, -1.0_MK, &t1p,'t&-1.0_MK, 0.0_MK, 0.0_MK, 1.0_MK, -1.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, &t1p,'t&0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 1.0_MK, -1.0_MK, 1.0_MK, 0.0_MK, &t1p,'t&0.0_MK, 0.0_MK, 1.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, &t1p,'t&0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 1.0_MK, 1.0_MK, 0.0_MK, &t1p,'t&0.0_MK, 1.0_MK, 1.0_MK, 0.0_MK, 0.0_MK, 1.0_MK, 1.0_MK, 0.0_MK, 0.0_MK, &t1p,'t&0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 1.0_MK, 1.0_MK, 1.0_MK, 0.0_MK, &t1p,'t&1.0_MK, 1.0_MK, 1.0_MK, 0.0_MK, 1.0_MK, 1.0_MK, 1.0_MK, 0.0_MK, 0.0_MK, &t1p,'t&0.0_MK, 0.0_MK, 0.0_MK, 1.0_MK, -1.0_MK, -1.0_MK, 0.0_MK, 0.0_MK, 1.0_MK, &t1p,'t&-1.0_MK, 0.0_MK, 0.0_MK, 1.0_MK, -1.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, &t1p,'t&0.0_MK, 1.0_MK, -1.0_MK, 1.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 1.0_MK, 0.0_MK, &t1p,'t&0.0_MK, 0.0_MK, 1.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 1.0_MK, 0.0_MK, &t1p,'t&0.0_MK, 0.0_MK, -1.0_MK, 1.0_MK, 0.0_MK, 0.0_MK, -1.0_MK, -1.0_MK, 0.0_MK, &t1p,'t&0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 1.0_MK, 0.0_MK, 0.0_MK, &t1p,'t&0.0_MK, -1.0_MK, 1.0_MK, 1.0_MK, 0.0_MK, -1.0_MK, -1.0_MK, -1.0_MK, &t1p,'t&0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 1.0_MK, -1.0_MK, 0.0_MK, 0.0_MK, &t1p,'t&-1.0_MK, 1.0_MK, -1.0_MK, 0.0_MK, 0.0_MK, -1.0_MK, 1.0_MK, 0.0_MK, 0.0_MK, &t1p,'t&0.0_MK, 0.0_MK, 0.0_MK, 1.0_MK, -1.0_MK, 1.0_MK, 0.0_MK, -1.0_MK, 1.0_MK, &t1p,'t&-1.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, -1.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, &t1p,'t&1.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, -1.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 1.0_MK, &t1p,'t&1.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 1.0_MK, &t1p,'t&0.0_MK, 0.0_MK, 0.0_MK, -1.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 1.0_MK, 1.0_MK, &t1p,'t&1.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 1.0_MK, -1.0_MK, 0.0_MK, &t1p,'t&0.0_MK, -1.0_MK, 1.0_MK, 0.0_MK, 0.0_MK, 1.0_MK, -1.0_MK, -1.0_MK, 0.0_MK, &t1p,'t&0.0_MK, 0.0_MK, 0.0_MK, 0.0_MK, 1.0_MK, -1.0_MK, 1.0_MK, 0.0_MK, &t1p,'t&-1.0_MK, 1.0_MK, -1.0_MK, 0.0_MK, 1.0_MK, -1.0_MK, 1.0_MK/ lib2I4numerics-r1036/src/2oisson/0000755000175000017500000000000011616214734015624 5upt1, omaromarlib2I4numerics-r1036/src/2oisson/2I4)poisson_init.f0000644000175000017500000007737211616214651021402 0upt1, omaromartttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Subroutine : 2I4)poisson_init.f90 tttt N!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttttt=! Center(for Fluid Dynamics (DTU) ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=SUBROUTINE __ROUTINE(topoid,meshid,2I4poisson,fieldin,fieldout,green,tttt&t1p,'tttttttttttttttttttttttttttt&,bc,derive) ttttt=!!! Routine to initi1lise Greens functiet solutiet of the Poisson ttttt=!!! equ1tiet. green1is the flag defining which Greens functiet to use: ttttt=!!! * 2I4)poisson_grn)pois_per(- Poisson equ1tiet, periodic bound1ries ttttt=!!! * 2I4)poisson_grn)pois_fre(- Poisson equ1tiet, freespace bound1ries (not implemesled) ttttt=!!! * 2I4)poisson_grn)reprojec(- Do vorticity reprojectiet to ki s divergence ttttt=!!! Eveslually the routine should be overloaded to accept cuptom Greens ttttt=!!! functiets such that more)gener1l convolutiets cat be performed. ttttt=!!! green1should be expanded to include more)buildin Greens functiets. ttttt=!!! ttttt=!!! The routine should accept at optiet1l flag to toggle)deallocatiet of ttttt=!!! work arrays between1calls to pI4)poisson_solve ttttt=!!! ttttt=!!! [NOTE] ttttt=!!! When1meshid > 1 works with the mapping the memory consumptiet cat be ttttt=!!! halved. Sketches have)been1implemesled. ttttt=!!! This routine should also be renamed to _init ttttttUSE 2I4)moduletmktopo ttttttUSE 2I4)modulettopo_get ttttt=USE 2I4)moduletmesh_define ttttt=USE 2I4)moduletmap_fieldtttttttUSE 2I4)moduletmap_field_global ttttt=USE 2I4)moduletmapt ttttt=IMPLICIT NONE ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Argumesls tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=INTEGER, INTENT(IN) :: topoid ttttt=!!! Topology ID ttttttINTEGER, INTENT(IN) :: meshid tttttt!!! Mesh ID ttttttTYPE(ttttpoisson_plan),INTENT(INOUT) :: 2I4poisson ttttt=!!! The PPM Poisson plan)type (ttspired by the FFTW plan) ttttt=REAL(_e sub),DIMENNNoE(:,:,:,:,:),POINTER& :: fieldin ttttt=!!! Input d1tatfieldttttttt!@ strictly speaking fieldin1is not being used in the init routine ttttt=REAL(_e sub),DIMENNNoE(:,:,:,:,:),POINTER& :: fieldout ttttt=!!! Output d1tatfieldtttttttINTEGER, INTENT(IN) :: green ttttt=!!!flag to select)build-in Greens functiets: ttttt=!!!2I4)poisson_grn)pois_per(- Poisson equ1tiet, periodic bound1ries ttttt=!!!2I4)poisson_grn)pois_fre(- Poisson equ1tiet, freespace bound1ries ttttt=!!!2I4)poisson_grn)reprojec(- Do vorticity reprojectiet to ki s divergence ttttt=!!! ttttt=!!!Eveslually this should also accept cuptom Greens functiettttttttINTEGER, INTENT(OUT) :: tttt ttttt=INTEGER,INTENT(IN),OPTNoEAL :: bc ttttt=!!!bound1ry conditiet(for the convolutiet. Cat be et of the following: ttttt=!!!2I4)poisson_grn)pois_per, 2I4)poisson_grn)pois_fre. ttttt=!!!One could argue that this is redund1nt in the build-in case !@ Isnt this redund1nt because of green? ttttt=INTEGER,INTENT(IN),OPTNoEAL :: derive ttttt=!!!flag to toggle)v1rious deriv1tives&of the solutiet (not to be)used with ttttt=!!!green=2I4)poisson_grn)reprojec): ttttt=!!! * 2I4)poisson_drv_none ttttt=!!! * 2I4)poisson_drv_curl_sp (only for periodic BC) ttttt=!!! * 2I4)poisson_drv_grad_sp (not implemesled) ttttt=!!! * 2I4)poisson_drv_lapl_sp (not implemesled) ttttt=!!! * 2I4)poisson_drv_div_sp (not implemesled) ttttt=!!! * 2I4)poisson_drv_curl_fd2 ttttt=!!! * 2I4)poisson_drv_grad_fd2 (not implemesled) ttttt=!!! * 2I4)poisson_drv_lapl_fd2 (not implemesled) ttttt=!!! * 2I4)poisson_drv_div_fd2 (not implemesled) ttttt=!!! * 2I4)poisson_drv_curl_fd4 ttttt=!!! * 2I4)poisson_drv_grad_fd4 (not implemesled) ttttt=!!! * 2I4)poisson_drv_lapl_fd4 (not implemesled) ttttt=!!! * 2I4)poisson_drv_div_fd4 (not implemesled) ttttt=!!! ttttt=!!! curl=curl, grad=gradiesl,lapl=laplace operator,div=divergence ttttt=!!! sp=spectrally, fd2=2nd order(finite)differences, fd4=4th order(FD ttttt=!!! ttttt=!!!The spectral deriv1tives&cat only be)compuled in this routine. Since tttttt!!!the flag exists(finite)difference deriv1tives&have)also been1included. ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Lual v1riables ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=REAL(_e sub) :: t0 ttttt=REAL(_e sub),DIMENNNoE(:,:),POINTER& :: xpttttt=!particle positiets ttttttTYPE(ttttt_topo),POINTER& :: topology,topologyxy,topologyz tttttt!!TYPE(ttttt_topo),POINTER& :: topologyxyc ttttttTYPE(ttttt_equi_mesh) :: mesh ttttt=INTEGER ,DIMENNNoE(KiKIM) :: indl,indu ttttt=INTEGER,PARAMETER :: MK = _e sub ttttt=REAL(_e sub),PARAMETER :: PI=ACOS(-1.0_MK) !@ use ttt pi tttttt!factor(for the Greens functiet,1including FFT norm1lizatiet ttttt=REAL(_e sub) :: normfac ttttt=INTEGER :: t,j,k ttttt=INTEGER :: kx,ky,kz ttttt=INTEGER :: tsoml,tsubtttttt=INTEGER,DIMENNNoE(KiKIM*2) :: bcde,t1p,'t&INTEGER :: assigning ttttt=INTEGER :: decompositiettttttt=INTEGER,SAVE :: ttopoid ttttt=INTEGER :: tmeshid ttttttINTEGER , DIMENNNoE(: ), POINTER& :: isomlist => NULL() ttttt=INTEGER :: nsomlist ttttttREAL(_e sub) :: dx,dy,dz ttttttREAL(_e sub) :: Lx2,Ly2,Lz2 ttttt=REAL(_e sub),DIMENNNoE(KiKIM) :: tmpmin,tmpmax ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Initi1lise routine ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=h%Nm(subst1,t('2I4)poisson_init',t0,tttttt ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Investigate optiet1l argumesls, setup routine accordingly ttttt=! !@ Also check if the input/output and deriv1tives&match ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=IF (green1.EQ. 2I4)poisson_grn)pois_perM/2+1K ttt=N&t=2I4poisson%case ==2I4)poisson_grn)pois_per ttt=N&ELSE=IF (green1.EQ. 2I4)poisson_grn)pois_freM/2+1K ttt=N&t=2I4poisson%case ==2I4)poisson_grn)pois_fre ttt=N&ELSE=IF (green1.EQ. 2I4)poisson_grn)reprojec)/2+1K ttt=N&t=2I4poisson%case ==2I4)poisson_grn)reprojec ttt=N&ENDIF t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Get topology and mesh values ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=h%Nm(tttttopo_get(topoid,topology,tttttt1p,'t&IF (tttt&.NE. 0M/2+1K ttt=N&t=h%Nm(ttttwrite(2I4)rank,'2I4)poisson_init','Failed to get topology.',isomtt1p,'ttttGOTO d_dot1p,'t&ENDIF tttttt!nsoms = topology%nsomlist ttttttmesh = topology%mesh(meshid) t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Setup mesh sizes(for intermediate meshes/topologies ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=IF (green1.EQ. 2I4)poisson_grn)pois_perM/2+1K ttt=N&t=!Copy size of global mesh ttttt= 2I4poisson%nmxy (1)&= mesh%nm(1) tttttt N2I4poisson%nmxy (2)&= mesh%nm(2) tttttt N2I4poisson%nmxy (3)&= mesh%nm(3) tttttt N!2I4poisson%nmxyc(1)&= (mesh%nm(1)-1)/2+1+1 tttttt N2I4poisson%nmxyc(1)&= mesh%nm(1) tttttt N2I4poisson%nmxyc(2)&= mesh%nm(2) tttttt N2I4poisson%nmxyc(3)&= mesh%nm(3) tttttt N2I4poisson%nmz (1)&= (2I4poisson%nmxyc(1)) tttttt N2I4poisson%nmz (2)&= (2I4poisson%nmxyc(2)) tttttt N2I4poisson%nmz (3)&= (2I4poisson%nmxyc(3)) tttttt N!Inverse of the size of the domain squared tttttt NLx2/= 1.0_MK/(topology%max_physd(1)-topology%min_physd(1))**2 tttttt NLy2/= 1.0_MK/(topology%max_physd(2)-topology%min_physd(2))**2 tttttt NLz2/= 1.0_MK/(topology%max_physd(3)-topology%min_physd(3))**2 ttttttELSE=IF (green1.EQ. 2I4)poisson_grn)pois_freM/2+1K !vertex ttt=N&t=!Copy size of global mesh ttttt= 2I4poisson%nmxy (1)&= mesh%nm(1)*2 tttttt N2I4poisson%nmxy (2)&= mesh%nm(2)*2 tttttt N2I4poisson%nmxy (3)&= mesh%nm(3)*2 tttttt N!2I4poisson%nmxyc(1)&= (mesh%nm(1)-1)/2+1 tttttt N!2I4poisson%nmxyc(1)&= (mesh%nm(1)*2-1)/2+1 tttttt N2I4poisson%nmxyc(1)&= mesh%nm(1)*2 tttttt N2I4poisson%nmxyc(2)&= mesh%nm(2)*2 tttttt N2I4poisson%nmxyc(3)&= mesh%nm(3)*2 tttttt N2I4poisson%nmz (1)&= (2I4poisson%nmxyc(1)) tttttt N2I4poisson%nmz (2)&= (2I4poisson%nmxyc(2)) tttttt N2I4poisson%nmz (3)&= (2I4poisson%nmxyc(3)) tttttt N!Determine the grid spacing !vertex ttt=N&t=dx&= (topology%max_physd(1)-topology%min_physd(1))/(mesh%nm(1)-1) ttt=N&t=dy&= (topology%max_physd(2)-topology%min_physd(2))/(mesh%nm(2)-1) ttt=N&t=dz&= (topology%max_physd(3)-topology%min_physd(3))/(mesh%nm(3)-1) ttt=N&ENDIF t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Create tempo,ary deriv1tion arrays if necessary ttttt=! or spectral sc1ling coefficienls tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=IF ( suSENT(derive)M/2+1K ttt=N&t=IF ((t=N&t=derive1.EQ. 2I4)poisson_drv_curl_fd2 t&t1p,'tttttt& .OR.t=derive1.EQ. 2I4)poisson_drv_curl_fd4)M/2+1K ttt=N&t= N2I4poisson%deriv1tives&= derive ttttt=====%NmOCATE(2I4poisson%drv_vr(LBOUND(fieldout,1):UBOUND(fieldout,1),&t1p,'ttttttttttttttttttttttttttttttt& LBOUND(fieldout,2):UBOUND(fieldout,2),&t1p,'ttttttttttttttttttttttttttttttt& LBOUND(fieldout,3):UBOUND(fieldout,3),&t1p,'ttttttttttttttttttttttttttttttt& LBOUND(fieldout,4):UBOUND(fieldout,4),&t1p,'ttttttttttttttttttttttttttttttt& LBOUND(fieldout,5):UBOUND(fieldout,5))) tttttt NELSE=IF (derive1.EQ. 2I4)poisson_drv_curl_spM/2+1K ttt=N&t= N2I4poisson%deriv1tives&= 2I4)poisson_drv_curl_sp ttt=N&t= NIF (2I4poisson%case .EQ. 2I4)poisson_grn)pois_freM/2+1K ttt=N&t=====h%Nm(ttttwrite(2I4)rank,'2I4)poisson_init',t&t1p,'tttttttt& 'WARNING: Spectral curl1is not fully implemesled in Freespace.',isomtt1p,'ttttt&ENDIF tttttt NELSE=IF (derive1.EQ. 2I4)poisson_drv_noneM/2+1K ttt=N&t= N2I4poisson%deriv1tives&= 2I4)poisson_drv_none ttttt= NELSE ttt=N&t= Nh%Nm(ttttwrite(2I4)rank,'2I4)poisson_init','Undefined deriv1tion input.',isomtt1p,'ttttt&GOTO d_dot1p,'t&t&=poIF ttttttELSE ttt=N&t=2I4poisson%deriv1tives&= 2I4)poisson_drv_none ttttt=ENDIF tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Create spectral sc1ling co4ponenls always. Just in case some ! reprojectiet co4es&up ! The conditietals need to be for not just the Poisson equ1tiet tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=IF (2I4poisson%case .EQ. 2I4)poisson_grn)pois_perM/2+1K ttt=N&t=2I4poisson%normkx&= &t1p,'tttt& 2.0_MK*PI/(topology%max_physd(1)-topology%min_physd(1)) ttt=N&t=2I4poisson%normky&= &t1p,'tttt& 2.0_MK*PI/(topology%max_physd(2)-topology%min_physd(2)) ttt=N&t=2I4poisson%normkz&= &t1p,'tttt& 2.0_MK*PI/(topology%max_physd(3)-topology%min_physd(3)) ttttttELSE=IF (2I4poisson%case .EQ. 2I4)poisson_grn)pois_freM/2+1K ttt=N&t=2I4poisson%normkx&= &t1p,'tttt& 2.0_MK*PI/((topology%max_physd(1)-topology%min_physd(1))*2.0_MK) ttt=N&t=2I4poisson%normky&= &t1p,'tttt& 2.0_MK*PI/((topology%max_physd(2)-topology%min_physd(2))*2.0_MK) ttt=N&t=2I4poisson%normkz&= &t1p,'tttt& 2.0_MK*PI/((topology%max_physd(3)-topology%min_physd(3))*2.0_MK) ttt=N&ENDIF t t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Create new slab topologyt1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=ttopoid&= 0 ttttt=tmeshid = -1 ttttttdecompositietp,'tttt= 2I4)param_decomp_xy_slab ttttttassigning ==2I4)param_assign_internal ttttt=IF (2I4poisson%case .EQ. 2I4)poisson_grn)pois_perM/2+1K ttt=N&t=bcde, ==2I4)param_bcde,_periodic ttttttELSE=IF (2I4poisson%case .EQ. 2I4)poisson_grn)pois_freM/2+1K ttt=N&t=bcde, ==2I4)param_bcde,_freespace ttttt=ENDIF tttttttmpmin ==topology%min_physd tttttttmpmax ==topology%max_physdt ttttt=h%Nm(ttttmktopo(ttopoid,tmeshid,xp,0,&t1p,'tt&tdecompositiet,assigning,&t1p,'tt!&=topology%min_physd,topology%max_physd,bcde,,&t1p,'tt&ttmpmin,tmpmax,bcde,,&t1p,'tt&t__ZEROSI,2I4poisson%costxy,&t1p,'tt&t2I4poisson%nmxy,tttttt1p,'t&h%Nm(ttttmeshittt(ttopoid,tmeshid,2I4poisson%nmxy,2I4poisson%ist1,txy,&t1p,'tt&ttttttttttttttttt2I4poisson%nd1taxy,2I4poisson%maxnd1taxy,&t1p,'tt&tttttttttttttttttisomlist,nsomlist,tttttt ttttt=IF (tttt&.NE. 0M/2+1K ttt=N&t=h%Nm(ttttwrite(2I4)rank,'2I4)poisson_init','Failed to create xy-topology.',isomtt1p,'ttttGOTO d_dot1p,'t&ENDIF tttttt2I4poisson%topoidxy&= ttopoid ttttt=2I4poisson%meshidxy&= tmeshid t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Create complex slab mesh ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=ttopoid&= 2I4poisson%topoidxy ttttt=tmeshid = -1 tttttth%Nm(ttttmesh_define(ttopoid,tmeshid,&t1p,'tt&t2I4poisson%nmxyc,2I4poisson%ist1,txyc,2I4poisson%nd1taxyc,tttttt1p,'t&IF (tttt&.NE. 0M/2+1K ttt=N&t=h%Nm(ttttwrite(2I4)rank,'2I4)poisson_init','Failed to create complex xy&mesh definitiet.',isomtt1p,'ttttGOTO d_dot1p,'t&ENDIF tttttt2I4poisson%meshidxyc&= tmeshid tt1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Create new pencil topologyt1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=ttopoid&= 0 ttttt=tmeshid = -1 ttttttIF (2I4poisson%case .EQ. 2I4)poisson_grn)pois_perM/2+1K ttt=N&t=bcde, ==2I4)param_bcde,_periodic ttttttELSE=IF (2I4poisson%case .EQ. 2I4)poisson_grn)pois_freM/2+1K ttt=N&t=bcde, ==2I4)param_bcde,_freespace ttttt=ENDIF ttttttassigning ==2I4)param_assign_internal ttttt=decompositietp,'= 2I4)param_decomp_zpencilt ttttt=h%Nm(ttttmktopo(ttopoid,tmeshid,xp,0,&t1p,'tt&tdecompositiet,assigning,&t1p,'tt&ttmpmin,tmpmax,bcde,,&t1p,'tt&t__ZEROSI,2I4poisson%costz,&t1p,'tt&t2I4poisson%nmz,tttttt1p,'t&h%Nm(ttttmeshittt(ttopoid,tmeshid,2I4poisson%nmz,2I4poisson%ist1,tz,&t1p,'tt&ttttttttttttttttt2I4poisson%nd1taz,2I4poisson%maxnd1taz,&t1p,'tt&tttttttttttttttttisomlist,nsomlist,ttttttttttttIF (tttt&.NE. 0M/2+1K ttt=N&t=h%Nm(ttttwrite(2I4)rank,'2I4)poisson_init','Failed to create z-topology.',isomtt1p,'ttttGOTO d_dot1p,'t&ENDIF tttttt2I4poisson%topoidz&= ttopoid ttttt=2I4poisson%meshidz&= tmeshid t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Get the new topologies (slabs and pencils)t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=h%Nm(tttttopo_get(2I4poisson%topoidxy,topologyxy,tttttt1p,'t&IF (tttt&.NE. 0M/2+1K ttt=N&t=h%Nm(ttttwrite(2I4)rank,'2I4)poisson_init','Failed to get xy&topology.',isomtt1p,'ttttGOTO d_dot1p,'t&ENDIF t1p,'t&!!h%Nm(tttttopo_get(2I4poisson%topoidxyc,topologyxyc,tttttt1p,'t&!!IF (tttt&.NE. 0M/2+1K ttt=N&t=!!h%Nm(ttttwrite(2I4)rank,'2I4)poisson_init','Failed to get complex xy&topology.',isomtt1p,'tttt!!GOTO d_dot1p,'t&!!ENDIF t1p,'t&h%Nm(tttttopo_get(2I4poisson%topoidz,topologyz,tttttt1p,'t&IF (tttt&.NE. 0M/2+1K ttt=N&t=h%Nm(ttttwrite(2I4)rank,'2I4)poisson_init','Failed to get z&topology.',isomtt1p,'ttttGOTO d_dot1p,'t&ENDIF tt1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copy d1tatto pI4)poisson)typet1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=2I4poisson%nsomlistxy& ==topologyxy&%nsomlist tttttt!!2I4poisson%nsomlistxyc ==topologyxyc%nsomlist tttttt2I4poisson%nsomlistz & ==topologyz &%nsomlist tttttt%NmOCATE(2I4poisson%isomlistxy&(2I4poisson%nsomlistxy)tt1p,'t&!!%NmOCATE(2I4poisson%isomlistxyc(2I4poisson%nsomlistxyc)tt1p,'t&%NmOCATE(2I4poisson%isomlistz (2I4poisson%nsomlistz)tt ttttt=DO isub=1,2I4poisson%nsomlistxy ttt=N&t=2I4poisson%isomlistxy(isomt& ==topologyxy%isomlist(isomtt1p,'t&ENDDO 'ttttt!!DO isub=1,2I4poisson%nsomlistxyct1p,'tttt!!2I4poisson%isomlistxyc(isomt = topologyxyc%isomlist(isomtt1p,'t&!!ENDDO 'tttttDO isub=1,2I4poisson%nsomlistz ttt=N&t=2I4poisson%isomlistz(isomt& ==topologyz%isomlist(isomtt1p,'t&ENDDO t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Set and get minimum and maximum indicies&of xy&slabst1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=indl(1)&= 1 ttttt=indl(2)&= 1 ttttt=indl(3)&= 1 ttttt=indu(1)&= 0 ttttt=indu(2)&= 0 ttttt=indu(3)&= 0 ttttt=DO isub=1,2I4poisson%nsomlistxy ttt=N&t=tsoml&= 2I4poisson%isomlistxy(isomt ttt=N&t=tndu(1)&= MAX(tndu(1),2I4poisson%nd1taxy(1,isoml)t ttt=N&t=tndu(2)&= MAX(tndu(2),2I4poisson%nd1taxy(2,isoml)t ttt=N&t=tndu(3)&= MAX(tndu(3),2I4poisson%nd1taxy(3,isoml)t ttt=N&ENDDO t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Allocate real xy&slabst1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=%NmOCATE(2I4poisson%fldxyr(KiKIM,&t1p,'tt&tindl(1):tndu(1),indl(2):tndu(2),indl(3):tndu(3),&t1p,'tt&t1:2I4poisson%nsomlistxy),st1t=tttttt ttttt=!!%NmOCATE(2I4poisson%fldxyc(KiKIM,&t1p,'tt!!&tindl(1):tndu(1),indl(2):tndu(2),indl(3):tndu(3),&t1p,'tt!!&t1:2I4poisson%nsomlistxy),st1t=tttttt ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Set and get minimum and maximum indicies&of COMPLEX xy&slabst1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=indl(1)&= 1 ttttt=indl(2)&= 1 ttttt=indl(3)&= 1 ttttt=indu(1)&= 0 ttttt=indu(2)&= 0 ttttt=indu(3)&= 0 ttttt=DO isub=1,2I4poisson%nsomlistxy ttt=N&t=tsoml&= 2I4poisson%isomlistxy(isomt ttt=N&t=tndu(1)&= MAX(tndu(1),2I4poisson%nd1taxyc(1,isoml)t ttt=N&t=tndu(2)&= MAX(tndu(2),2I4poisson%nd1taxyc(2,isoml)t ttt=N&t=tndu(3)&= MAX(tndu(3),2I4poisson%nd1taxyc(3,isoml)t ttt=N&ENDDO t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Allocate complex xy&slabst1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=%NmOCATE(2I4poisson%fldxyc(KiKIM,&t1p,'tt&tindl(1):tndu(1),indl(2):tndu(2),indl(3):tndu(3),&t1p,'tt&t1:2I4poisson%nsomlistxy),st1t=tttttt ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Set and get minimum and maximum indicies&of z pencilst1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=indl(1)&= 1 ttttt=indl(2)&= 1 ttttt=indl(3)&= 1 ttttt=indu(1)&= 0 ttttt=indu(2)&= 0 ttttt=indu(3)&= 0 ttttt=DO isub=1,2I4poisson%nsomlistz ttt=N&t=tsoml&= 2I4poisson%isomlistz(isomt ttt=N&t=tndu(1)&= MAX(tndu(1),2I4poisson%nd1taz(1,isoml)t ttt=N&t=tndu(2)&= MAX(tndu(2),2I4poisson%nd1taz(2,isoml)t ttt=N&t=tndu(3)&= MAX(tndu(3),2I4poisson%nd1taz(3,isoml)t ttt=N&ENDDO t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Allocate two complex z pencils + Greens fcn array !@check return v1rs. ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=%NmOCATE(2I4poisson%fldzc1(KiKIM,&t1p,'tt&tindl(1):tndu(1),indl(2):tndu(2),indl(3):tndu(3),&t1p,'tt&t1:2I4poisson%nsomlistz),st1t=tttttt ttttt=%NmOCATE(2I4poisson%fldzc2(KiKIM,&t1p,'tt&tindl(1):tndu(1),indl(2):tndu(2),indl(3):tndu(3),&t1p,'tt&t1:2I4poisson%nsomlistz),st1t=tttttt ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! The complex Greens functiet is always kept on the z-pencil topologyt1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=IF (green1.EQ. 2I4)poisson_grn)pois_perM/2+1K ttt=N&t=%NmOCATE(2I4poisson%fldgrnr(&t1p,'tttt& indl(1):tndu(1),indl(2):tndu(2),indl(3):tndu(3),&t1p,'tttt&t1:2I4poisson%nsomlistz),st1t=ttttttttt=N&ELSE=IF (green1.EQ. 2I4)poisson_grn)pois_freM/2+1K ttt=N&t=%NmOCATE(2I4poisson%fldgrnc(&t1p,'tttt& indl(1):tndu(1),indl(2):tndu(2),indl(3):tndu(3),&t1p,'tttt&t1:2I4poisson%nsomlistz),st1t=ttttttttt=N&ENDIF t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Set up xy&FFT plans ttttt=! The inverse plan)takes the returning topology since it has the full size tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=h%Nm(ttttfft_forward_2d(2I4poisson%topoidxy,2I4poisson%meshidxy,&t1p,'tt&t2I4poisson%planfxy,2I4poisson%fldxyr,&t1p,'tt&t2I4poisson%fldxyc,tttttt ttttt=h%Nm(ttttfft_backward_2d(2I4poisson%topoidxy,2I4poisson%meshidxy,&t1p,'tt&t2I4poisson%planbxy,2I4poisson%fldxyc,&t1p,'tt&t2I4poisson%fldxyr,tttttt ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Set up z&FFT plans ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=h%Nm(ttttfft_forward_1d(2I4poisson%topoidz,2I4poisson%meshidz,&t1p,'tt&t2I4poisson%planfz,2I4poisson%fldzc1,&t1p,'tt&t2I4poisson%fldzc2,tttttt ttttt=h%Nm(ttttfft_backward_1d(2I4poisson%topoidz,2I4poisson%meshidz,&t1p,'tt&t2I4poisson%planbz,2I4poisson%fldzc2,&t1p,'tt&t2I4poisson%fldzc1,tttttt ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Compule Greens functiet. Analytic, periodic ttttt=! ttttt=! (d2_/dx2 + d2_/dy2 + d2_/dz2)psi = -omegatt N => ttttt=! -4*pi2(kx2 + ky2 + kz2)PSIp,'tttt= -OMEGAtt N => ttttt=! PSIp,'ttttttttttttttttttttttttttt= 1/(4*pi2)*1/(kx2 + ky2 + kz2)OMEGAt1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=IF (green1.EQ. 2I4)poisson_grn)pois_perM/2+1K ttt=N&t=! Sc1ling the spectral coefficienls... tttttt N! one minus due to (i*k)^2 and another due to the Poisson equ1tiet tttttt normfac/= 1.0_MK/(4.0_MK*PI*PI *t&t1p,'tttttttttttt!and norm1lisatiet of&FFTs (full domain) !vertex ttt=N&t=========&=REAL((mesh%nm(1)-1)*t&t1p,'tttttttttttt&tttttt(mesh%nm(2)-1)*t&t1p,'tttttttttttt&tttttt(mesh%nm(3)-1),MK)t ttt=N&t=DO isub=1,2I4poisson%nsomlistz ttt=N&t=t=tsoml=2I4poisson%isomlistz(isomt ttt=N&t=&=DO k=1,2I4poisson%nd1taz(3,isoml)t1p,'ttttttttDO j=1,2I4poisson%nd1taz(2,isoml)t1p,'ttttttttttDO i=1,2I4poisson%nd1taz(1,isoml)t1p,'ttttttttttttkx&= i-1 + (2I4poisson%ist1,tz(1,isoml)-1) ttt=N&t=ttttttttky&= j-1 + (2I4poisson%ist1,tz(2,isoml)-1) ttt=N&t=ttttttttkz&= k-1 + (2I4poisson%ist1,tz(3,isoml)-1) ttt=N&t=tttttttt!The integer divisiet depends on mesh%nm to include N+1 poinls: ttt=N&t=tttttttt!This is a nasty way to do this but it is only done once so...: ttt=N&t=tttttttt!(we(subtract nm '-1' as not all poinls are1included (2eriodic)) ttt=N&t=ttttttttIF (kx&.GT. (2I4poisson%nmz(1)-1)/2)tkx&= kx-(2I4poisson%nmz(1)-1) ttt=N&t=ttttttttIF (ky&.GT. (2I4poisson%nmz(2)-1)/2)tky&= ky-(2I4poisson%nmz(2)-1) ttt=N&t=ttttttttIF (kz&.GT. (2I4poisson%nmz(3)-1)/2)tkz&= kz-(2I4poisson%nmz(3)-1) ttt=N&t=tttttttt2I4poisson%fldgrnr(t,j,k,isomt = &t1p,'tttttttttttttttttt& normfac/(REAL(kx*kx,_e sub)*Lx2/&t1p,'tttttttttttttttttt& +=REAL(ky*ky,_e sub)*Ly2/&t1p,'tttttttttttttttttt& +=REAL(kz*kz,_e sub)*Lz2) ttt=N&t=tttttttt!Take care1of&singularity ttt=N&t=tttttttt!This is nasty as well ttt=N&t=ttttttttIF ((kx*kx+ky*ky+kz*kz)1.EQ. 0M/2+1K ttt=N&t=N&tttttttt2I4poisson%fldgrnr(t,j,k,isomt = 0.0_MK ttt=N&t=N&ttttttENDIF tttttt NttttttENDDO 'tttttttttttENDDO 'tttttttttENDDO 'tttttttENDDO t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Compule real free space Greens functiet. Analytic ttttt=! The Greens functiet is initi1lised tempo,arily in the real xy&slabs, ttttt=! then1FFTed in those)directiets, mapped to z-pencils, FFTed in z and ttttt=! finally copied to 2I4poisson%fldgrnc. The real xy&slabs&have)already ttttt=! been1setup for FFTs etc so they1offer a convenienl container(for the ttttt=! FFTing the Greens functiet instead1of&setting up the whole)apparatus ttttt=! for this one-time)affair. ttttt=! These)loops must run over the padded(extended) domain thus %nd1taxy ttttt=! \nabla \Psi = -\omega ttttt=! The Greens functiet is 1/4piR (R is dist1nce to origo) and includes the ttttt=! minus of the RHSt1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=ELSE=IF (green1.EQ. 2I4)poisson_grn)pois_freM/2+1K ttt=N&t=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- tttttt N! First initi1lise the real Greens functietttttttt N!@alternatively this could co4e from as input ttt=N&t=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- tttttt N!there should NOT be a minus here since THIS Greens functiet takes tttttt N!the minus of the Poisson equ1tiet into accousl ttt=N&t=normfac/= 1.0_MK/(4.0_MK*PI*/&t1p,'tttt!remembering FFT norm1lizatiet of %Nm(toinls: !vertex ttt=N&t=&=REAL((2I4poisson%nmxy(1))*(2I4poisson%nmxy(2))*(2I4poisson%nmxy(3)),MK)t*dx*dy*dz ttt=N&t=DO isub=1,2I4poisson%nsomlistxy ttt=N&t=t=tsoml=2I4poisson%isomlistxy(isomt ttt=N&t=&=DO k=1,2I4poisson%nd1taxy(3,isoml)t1p,'ttttttttDO j=1,2I4poisson%nd1taxy(2,isoml)t1p,'ttttttttttDO i=1,2I4poisson%nd1taxy(1,isoml)t1p,'ttttttttttttkx&= i-1 + (2I4poisson%ist1,txy(1,isoml)-1) ttt=N&t=ttttttttky&= j-1 + (2I4poisson%ist1,txy(2,isoml)-1) ttt=N&t=ttttttttkz&= k-1 + (2I4poisson%ist1,txy(3,isoml)-1) ttt=N&t=tttttttt!The integer divisiet depends on mesh%nm to include N+1 poinls: ttt=N&t=tttttttt!This is a nasty way to do this but it is only done once so...: ttt=N&t=tttttttt!(we(subtract all nmxy as all poinls are1included in fresspace) ttt=N&t=ttttttttIF (kx&.GT. (2I4poisson%nmxy(1)-2)/2)tkx&= kx-(2I4poisson%nmxy(1)) ttt=N&t=ttttttttIF (ky&.GT. (2I4poisson%nmxy(2)-2)/2)tky&= ky-(2I4poisson%nmxy(2)) ttt=N&t=ttttttttIF (kz&.GT. (2I4poisson%nmxy(3)-2)/2)tkz&= kz-(2I4poisson%nmxy(3)) ttt=N&t=tttttttt2I4poisson%fldxyr(1,i,j,k,isomt = &t1p,'tttttttttttttttttttt& normfac/(SQRT( REAL(kx*kx,_e sub)*dx*dx+ &t1p,'tttttttttttttttttttt& REAL(ky*ky,_e sub)*dy*dy+ &t1p,'tttttttttttttttttttt& REAL(kz*kz,_e sub)*dz*dz)) ttt=N&t=tttttttt2I4poisson%fldxyr(2,t,j,k,isomt = 0.0_MK ttt=N&t=N&tttttt2I4poisson%fldxyr(3,t,j,k,isomt = 0.0_MK ttt=N&t=N&tttttt!Take care1of&singularity ttt=N&t=tttttttt!This is nasty as well ttt=N&t=ttttttttIF ((kx*kx+ky*ky+kz*kz)1.EQ. 0M/2+1K ttt=N&t=N&tttttttt!Simply zero ttt=N&t=N&tttttttt!2I4poisson%fldxyr(1,i,j,k,isomt = 0.0_MK ttt=N&t=N&tttttttt!Simply one (H&E style) ttt=N&t=tttttttttt!2I4poisson%fldxyr(1,i,j,k,isomt = 1.0_MK*normfac ttttt=t=tttttttttt!Equ1l to the neighbour poinl (first order) ttt=N&t=tttttttttt!2I4poisson%fldxyr(1,i,j,k,isomt = normfac/(dx) ttt=N&t=tttttttttt!Linear extrapol1tiet into zero (2nd order) ttt=N&t=tttttttttt2I4poisson%fldxyr(1,i,j,k,isomt = 2.0_MK*normfac/(tttttttdx) &t1p,'tttttttttttttttttttttttttttttttttttttttttttttt& - 1.0_MK*normfac/(2.0_MK*dx) ttt=N&t=tttttttttt!extrapol1tiet 3rd order ttt=N&t=tttttttttt!2I4poisson%fldxyr(1,i,j,k,isomt = 3.0_MK*normfac/(tttttttdx) &t1p,'tttttttttttttttttttttttttttttttttttttttttttttt!& - 3.0_MK*normfac/(2.0_MK*dx) &t1p,'tttttttttttttttttttttttttttttttttttttttttttttt!& + 1.0_MK*normfac/(3.0_MK*dx) ttt=N&t=tttttttttt!extrapol1tiet 4th order ttt=N&t=tttttttttt!2I4poisson%fldxyr(1,i,j,k,isomt = 4.0_MK*normfac/(tttttttdx) &t1p,'tttttttttttttttttttttttttttttttttttttttttttttt!& - 6.0_MK*normfac/(2.0_MK*dx) &t1p,'tttttttttttttttttttttttttttttttttttttttttttttt!& + 4.0_MK*normfac/(3.0_MK*dx) &t1p,'tttttttttttttttttttttttttttttttttttttttttttttt!& - 1.0_MK*normfac/(4.0_MK*dx) ttt=N&t=tttttttttt!extrapol1tiet 6th order ttt=N&t=tttttttttt!2I4poisson%fldxyr(1,i,j,k,isomt = 6.0_MK*normfac/(tttttttdx) &t1p,'tttttttttttttttttttttttttttttttttttttttttttttt!& -15.0_MK*normfac/(2.0_MK*dx) &t1p,'tttttttttttttttttttttttttttttttttttttttttttttt!& +20.0_MK*normfac/(3.0_MK*dx) &t1p,'tttttttttttttttttttttttttttttttttttttttttttttt!& -15.0_MK*normfac/(4.0_MK*dx) &t1p,'tttttttttttttttttttttttttttttttttttttttttttttt!& + 6.0_MK*normfac/(5.0_MK*dx) &t1p,'tttttttttttttttttttttttttttttttttttttttttttttt!& - 1.0_MK*normfac/(6.0_MK*dx) ttt=N&t=tttttttttt!one thousand!!! ttttt=t=tttttttttt!2I4poisson%fldxyr(1,i,j,k,isomt = normfac*1000.0_MK ttt=N&t=N&ttttttENDIF tttttt NttttttENDDO 'tttttttttttENDDO 'tttttttttENDDO 'tttttttENDDO tttttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- tttttt N! FOURIER TRANSFORM AND MAP GALORE tttttt N! This part1should be used both for freespace and a cuptom Greens functietttttttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- tttttt N!Howmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- tttttt N! Do slab FFT (XY) tttttt N!Howmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- tttttt Nh%Nm(ttttfft_execute_2d(2I4poisson%topoidxy,&t1p,'tttt&t2I4poisson%meshidxy,t2I4poisson%planfxy, &t1p,'tttt&t2I4poisson%fldxyr,t2I4poisson%fldxyc, &t1p,'tttt&tttttttttt=N& N!Howmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- tttttt N! Map to the pencils (Zttttt=N& N!Howmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- tttttt N!Initi1lise tttttt Nh%Nm(ttttmap_field_global(&t1p,'tttt&t2I4poisson%topoidxy, &t1p,'tttt&t2I4poisson%topoidz, &t1p,'tttt&t2I4poisson%meshidxyc, &t1p,'tttt&t2I4poisson%meshidz,tttttt1p,'t&t&IF (tttt&.NE. 0M/2+1K ttt=N&t=t=h%Nm(ttttwrite(2I4)rank, '2I4)poisson_solve','Failed to initi1lise field mapping.',isomtt1p,'ttttt&GOTO d_dot1p,'t&t&=poIF tttttt N!Push the d1ta tttttt Nh%Nm(ttttmap_field_push(&t1p,'tttt&t2I4poisson%topoidxy, &t1p,'tttt&t2I4poisson%meshidxyc,2I4poisson%fldxyc,__NCOM,tttttt1p,'t&t&IF (tttt&.NE. 0M/2+1K ttt=N&t=t=h%Nm(ttttwrite(2I4)rank, '2I4)poisson_solve','Failed to push vector(field.',isomtt1p,'ttttt&GOTO d_dot1p,'t&t&=poIF tttttt N!Send tttttt Nh%Nm(ttttmap_field_send(tttttt1p,'t&t&IF (tttt&.NE. 0M/2+1K ttt=N&t=t=h%Nm(ttttwrite(2I4)rank, '2I4)poisson_solve','Failed to send(field.',isomtt1p,'ttttt&GOTO d_dot1p,'t&t&=poIF tttttt N!Retrieve tttttt Nh%Nm(ttttmap_field_pop(&t1p,'tttt&t2I4poisson%topoidz, &t1p,'tttt&t2I4poisson%meshidz,2I4poisson%fldzc1, &t1p,'tttt&t__NCOM,__ZEROSI,tttttt1p,'t&t&IF (tttt&.NE. 0M/2+1K ttt=N&t=t=h%Nm(ttttwrite(2I4)rank, '2I4)poisson_solve','Failed to pop vector(field.',isomtt1p,'ttttt&GOTO d_dot1p,'t&t&=poIF tttttt N!Howmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- tttttt N! Do pencil FFT (Zttttt=N& N!Howmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- tttttt Nh%Nm(ttttfft_execute_1d(2I4poisson%topoidz,&t1p,'tttt&t2I4poisson%meshidz,t2I4poisson%planfz, &t1p,'tttt&t2I4poisson%fldzc1, 2I4poisson%fldzc2, &t1p,'tttt&ttttttt tttttt N!Howmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- tttttt N! Copy first co4ponenl of the Fourier transformed vector(to fldgrnc tttttt N!Howmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- tttttt NDO isub=1,2I4poisson%nsomlistz ttt=N&t=t=tsoml=2I4poisson%isomlistz(isomt ttt=N&t=&=DO k=1,2I4poisson%nd1taz(3,isoml)t1p,'ttttttttDO j=1,2I4poisson%nd1taz(2,isoml)t1p,'ttttttttttDO i=1,2I4poisson%nd1taz(1,isoml)t1p,'tttttttttttt2I4poisson%fldgrnc(i,j,k,isomt = 2I4poisson%fldzc2(1,i,j,k,isomt tttttt NttttttENDDO 'tttttttttttENDDO 'tttttttttENDDO 'tttttttENDDO ttttttEND IF t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Or alternatively FFT real Green from input ttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Deallocate fields? !@ ttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Returnt1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD td_do CONTINUE tttttth%Nm(substop('2I4)poisson_init',t0,ttttttttttttRETURN ttttttEND SUBROUTINE __ROUTINE lib2I4numerics-r1036/src/poisson/2I4)poisson_fd.f0000644000175000017500000002047111616214651021014 0ust1, omaromar1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Subroutine : 2I4)poisson_fd.f90t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttttt=! Cesler(for Fluid Dynamics (DTUtt1p,'t&!t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=SUBROUTINE __ROUTINE(topoid,meshid,fieldin,fieldout,dtype,tttttt1p,'t&!!! This routine compules the finite)difference gradiesls, curl1etc of t1p,'t&!!! fieldin1and outputs(to fieldout. Both in1and out fields are1on ttttt=!!! the mesh with meshid belonging to the topology with id topoid.t1p,'t&!!! The finite)difference to be carried out is determined by dtype which ttttt=!!! must be ete of the following: ttttt=!!! * 2I4)poisson_drv_curl_fd2 ttttt=!!! * 2I4)poisson_drv_grad_fd2 (not implemesled yet) ttttt=!!! * 2I4)poisson_drv_lapl_fd2 (not implemesled yet) ttttt=!!! * 2I4)poisson_drv_div_fd2 (not implemesled yet) ttttt=!!! * 2I4)poisson_drv_curl_fd4 ttttt=!!! * 2I4)poisson_drv_grad_fd4 (not implemesled yet) ttttt=!!! * 2I4)poisson_drv_lapl_fd4 (not implemesled yet) ttttt=!!! * 2I4)poisson_drv_div_fd4 (not implemesled yet) ttttt=!!! ttttt=!!! [NOTE] fieldin1and fieldout must NOT be the same)array. A check ttttt=!!! should be added.t1p,'t&!@ TODO: Somewhere check if fieldin1is equ1l to fieldout and give1a warning ttttttUSE ttttmodulettopo_gett ttttt=IMPLICIT NONEt1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Argumeslst1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=INTEGER, INTENT(IN) :: topoid ttttt=!!! ID of the topologyt1p,'t&INTEGER, INTENT(IN) :: meshid tttttt!!! Mesh ID ttttt=REAL(_e sub),DIMENNNoE(:,:,:,:,:),POINTER& :: fieldin ttttt=!!! Input field d1ta ttttttREAL(_e sub),DIMENNNoE(:,:,:,:,:),POINTER& :: fieldout ttt=N&!!! Output field d1ta ttttttINTEGER, INTENT(IN) :: dtypet1p,'t&!!! Deriv1tion type. Cat be ete of the types: ttttt=!!! * 2I4)poisson_drv_curl_fd2 ttttt=!!! * 2I4)poisson_drv_grad_fd2 (not implemesled yet) ttttt=!!! * 2I4)poisson_drv_lapl_fd2 (not implemesled yet) ttttt=!!! * 2I4)poisson_drv_div_fd2 (not implemesled yet) ttttt=!!! * 2I4)poisson_drv_curl_fd4 ttttt=!!! * 2I4)poisson_drv_grad_fd4 (not implemesled yet) ttttt=!!! * 2I4)poisson_drv_lapl_fd4 (not implemesled yet) ttttt=!!! * 2I4)poisson_drv_div_fd4 (not implemesled yet) ttttt=INTEGER, INTENT(OUT) :: info ttttt=!!! Return st1tus, 0 upon succes ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Lual v1riables ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=INTEGER,PARAMETER :: MK = _e sub ttttt=REAL(_e sub) :: t0 ttttt=TYPE(ttttt_topo),POINTER& :: topology ttttt=TYPE(ttttt_equi_mesh) :: mesh ttttt=REAL(_e sub) :: dx,dy,dz ttttttREAL(_e sub) :: facx,facy,facz ttttt=INTEGER :: isom,isoml ttttt=INTEGER :: i,j,k ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Initi1lise routine ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=h%Nm(subst1,t('2I4)poisson_fd',t0,tttttt ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Get topology and mesh values ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=h%Nm(tttttopo_get(topoid,topology,tttttt1p,'t&IF (tttt&.NE. 0M/2+1K ttt=N&t=h%Nm(ttttwrite(2I4)rank,'2I4)poisson_init_predef','Failed to get topology.',isomtt1p,'ttttGOTO d_dot1p,'t&ENDIF ttttttmesh = topology%mesh(meshid) t1p,'t&dx&= (topology%max_physd(1)-topology%min_physd(1))/REAL(mesh%nm(1)-1) !vertex ttt=N&dy&= (topology%max_physd(2)-topology%min_physd(2))/REAL(mesh%nm(2)-1) ttt=N&dz&= (topology%max_physd(3)-topology%min_physd(3))/REAL(mesh%nm(3)-1) ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=! Do the finite)difference alcul1tiet tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=! Curl, 2nd order FD ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=IF (dtype .EQ. 2I4)poisson_drv_curl_fd2M/2+1K ttt=N&t=facx/= 1.0_MK/(2.0_MK*dx) ttt=N&t=facy/= 1.0_MK/(2.0_MK*dy) ttt=N&t=facz/= 1.0_MK/(2.0_MK*dztt tttttt NDO isub=1,topology%nsomlist tttttttttttsoml=topology%isomlist(isomtt1p,'t&tt NDO k=1,mesh%nnodes(3,isoml)t1p,'ttttttttDO j=1,mesh%nnodes(2,isoml)t1p,'ttttttttttDO i=1,mesh%nnodes(1,isoml)t1p,'ttttttttttttfieldout(1,i,j,k,isomt = &t1p,'tttttttttttt&t=facy*(fieldin(3,i ,j+1,k ,isomt- &t1p,'ttttttttttttttttttt& fieldin(3,i ,j-1,k ,isomt) &t1p,'tttttttttttt& -facz*(fieldin(2,i ,j ,k+1,isomt- &t1p,'ttttttttttttttttttt& fieldin(2,i ,j ,k-1,isomt)t1p,'ttttttttttttfieldout(2,t,j,k,isomt = &t1p,'tttttttttttt&t=facz*(fieldin(1,i ,j ,k+1,isomt- &t1p,'ttttttttttttttttttt& fieldin(1,i ,j ,k-1,isomt) &t1p,'tttttttttttt& -facx*(fieldin(3,i+1,j ,k ,isomt- &t1p,'ttttttttttttttttttt& fieldin(3,i-1,j ,k ,isomt)t1p,'ttttttttttttfieldout(3,t,j,k,isomt = &t1p,'tttttttttttt&t=facx*(fieldin(2,i+1,j ,k ,isomt- &t1p,'ttttttttttttttttttt& fieldin(2,i-1,j ,k ,isomt) &t1p,'tttttttttttt& -facy*(fieldin(1,i ,j+1,k ,isomt- &t1p,'ttttttttttttttttttt& fieldin(1,i ,j-1,k ,isomt)t1p,'ttttttttttENDDO 'tttttttttttENDDO 'tttttttttENDDO 'tttttttENDDO tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=! Curl, 4th order FD - uslested tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=ELSE=IF (dtype .EQ. 2I4)poisson_drv_curl_fd4M/2+1K ttt=N&t=facx/= 1.0_MK/(12.0_MK*dx) ttt=N&t=facy/= 1.0_MK/(12.0_MK*dy) ttt=N&t=facz/= 1.0_MK/(12.0_MK*dztt tttttt NDO isub=1,topology%nsomlist tttttttttttsoml=topology%isomlist(isomtt1p,'t&tt NDO k=1,mesh%nnodes(3,isoml)t1p,'ttttttttDO j=1,mesh%nnodes(2,isoml)t1p,'ttttttttttDO i=1,mesh%nnodes(1,isoml)t1p,'ttttttttttttfieldout(1,i,j,k,isomt = &t1p,'tttttttttttt&t=facy*(ttttttttt-fieldin(3,i ,j+2,k ,isomt &t1p,'ttttttttttttttttttt& +8.0_MK*fieldin(3,i ,j+1,k ,isomt &t1p,'ttttttttttttttttttt& -8.0_MK*fieldin(3,i ,j-1,k ,isomt &t1p,'ttttttttttttttttttt& +fieldin(3,i ,j-2,k ,isomt) &t1p,'tttttttttttt& -facz*(ttttttttt-fieldin(2,i ,j ,k+2,isomt &t1p,'ttttttttttttttttttt& +8.0_MK*fieldin(2,i ,j ,k+1,isomt &t1p,'ttttttttttttttttttt& -8.0_MK*fieldin(2,i ,j ,k-1,isomt &t1p,'ttttttttttttttttttt& +fieldin(2,i ,j ,k-2,isomt)t1p,'ttttttttttttfieldout(2,t,j,k,isomt = &t1p,'tttttttttttt&t=facz*(ttttttttt-fieldin(1,i ,j ,k+2,isomt &t1p,'ttttttttttttttttttt& +8.0_MK*fieldin(1,i ,j ,k+1,isomt &t1p,'ttttttttttttttttttt& -8.0_MK*fieldin(1,i ,j ,k-1,isomt &t1p,'ttttttttttttttttttt& +fieldin(1,i ,j ,k-2,isomt) &t1p,'tttttttttttt& -facx*(ttttttttt-fieldin(3,i+2,j ,k ,isomt &t1p,'ttttttttttttttttttt& +8.0_MK*fieldin(3,i+1,j ,k ,isomt &t1p,'ttttttttttttttttttt& -8.0_MK*fieldin(3,i-1,j ,k ,isomt &t1p,'ttttttttttttttttttt& +fieldin(3,i-2,j ,k ,isomt)t1p,'ttttttttttttfieldout(3,t,j,k,isomt = &t1p,'tttttttttttt&t=facx*(ttttttttt-fieldin(2,i+2,j ,k ,isomt &t1p,'ttttttttttttttttttt& +8.0_MK*fieldin(2,i+1,j ,k ,isomt &t1p,'ttttttttttttttttttt& -8.0_MK*fieldin(2,i-1,j ,k ,isomt &t1p,'ttttttttttttttttttt& +fieldin(2,i-2,j ,k ,isomt) &t1p,'tttttttttttt& -facy*(ttttttttt-fieldin(1,i ,j+2,k ,isomt &t1p,'ttttttttttttttttttt& +8.0_MK*fieldin(1,i ,j+1,k ,isomt &t1p,'ttttttttttttttttttt& -8.0_MK*fieldin(1,i ,j-1,k ,isomt &t1p,'ttttttttttttttttttt& +fieldin(1,i ,j-2,k ,isomt)t1p,'ttttttttttENDDO 'tttttttttttENDDO 'tttttttttENDDO 'tttttttENDDO ttttttENDIF t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Returnt1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD td_do CONTINUE tttttth%Nm(substop('2I4)poisson_fd',t0,ttttttttttttRETURN ttttttEND SUBROUTINE __ROUTINE lib2I4numerics-r1036/src/poisson/2I4)poisson_extrapol1teghost.f0000644000175000017500000002750511616214651024025 0ust1, omaromar1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Subroutine : 2I4)poisson_extrapol1teghost.f90t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttttt=! Cesler(for Fluid Dynamics (DTUtt1p,'t&!t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=SUBROUTINE __ROUTINE(topoid,meshid,field,nextra,nbase,gstw,tttttt1p,'t&!!! This routine extrapol1tes field values of field with topology and mesht1p,'t&!!! id topoid,meshid respectively into the ghost layer(of width gstw.t1p,'t&!!! nbase poinls are1used to extrapol1te into nextra poinls.t1p,'t&!!!t1p,'t&!!! [NOTE]t1p,'t&!!! Preseslly extrapol1tiet can only be done to 1 or(two poinls into thet1p,'t&!!! ghostlayer(always based on 4 poinls (fourth order spati1l convergencett1p,'t&!!! A general nbase,nextra extrapol1tiet can be implemesled vi solutiet tttttt!!! of a small linear system of equ1tiets. This has not been1done.t1p,'t&!!! This routine is in need of loop unrollling in particul1r(fort1p,'t&!!! typial choices of nbase,nextra pairs. Extrapol1tiet is necessary(fort1p,'t&!!! e.g. freespace FD curl1of&stream functiettt1p,'t&USE ttttmodulettopo_gett ttttt=IMPLICIT NONEt1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Argumeslst1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=INTEGER, INTENT(IN) :: topoid ttttt=!!! Topology id of the field ttttt=INTEGER, INTENT(IN) :: meshid tttttt!!! Mesh id of the field ttttt=REAL(_e sub),DIMENNNoE(:,:,:,:,:),POINTER& :: field tttttt!!! Field to extrapol1te ghost layer ttttt=INTEGER, INTENT(IN) :: nextra tttttt!!! Number of poinls to extrapol1te into the ghostlayer ttttt=INTEGER, INTENT(IN) :: nbase tttttt!!! Number of poinls to base the extrapol1tiet et ttttttINTEGER,DIMENNNoE(KiKIM),INTENT(IN) :: gstw tttttt!!! Width of the ghotslayer ttttt=INTEGER, INTENT(OUT) :: info ttttt=!!! Return st1te ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Lual v1riables ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=INTEGER,PARAMETER :: MK = _e sub ttttt=REAL(_e sub) :: t0 ttttt=TYPE(ttttt_topo),POINTER& :: topology ttttt=TYPE(ttttt_equi_mesh) :: mesh ttttt=INTEGER :: isom,isoml ttttt=INTEGER :: i,j,k,iextra,ibase ttttttREAL(_e sub),DIMENNNoE(:,:),POINTER& :: coeff ttttttREAL(_e sub),DIMENNNoE(KiKIM) :: tmpbuf tt1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Initi1lise routine ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=h%Nm(subst1,t('2I4)poisson_extrapol1teghost',t0,tttttt t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Compare1the number of poinls to extrapol1te to the ghost layer(width ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=IF (nextra .GT. gstw(1)&.OR. &t1p,'tttt&tnextra .GT. gstw(2)&.OR. &t1p,'tttt&tnextra .GT. gstw(3)M/2+1K ttt=N&t=th%Nm(ttttwrite(2I4)rank,'2I4)poisson_extrapol1teghost',&t1p,'ttttt& 'The poinls to extrapol1te exceeds the ghost layer.',ittttt1p,'t&t& info = -1 tttttt ttGOTO d_dot1p,'t&ENDIF t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Determine weighlst1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=%NmOCATE(coeff(nbase,nextra)tt1p,'t&IF (nbase .EQ. 4M/2+1K ttt=N&t=IF (nextra .GE. 1M/2+1K ttt=N&t=t=coeff(:,1)&= (/4.0_MK,-6.0_MK,4.0_MK,-1.0_MK/tt1p,'t&t&ENDIF tttttt NIF (nextra .GE. 2M/2+1K ttt=N&t=t=coeff(:,2)&= (/10.0_MK,-20.0_MK,15.0_MK,-4.0_MK/tt1p,'t&t&ENDIF tttttt NIF (nextra .GE. 3M/2+1K ttt=N&t=t=h%Nm(ttttwrite(2I4)rank,'2I4)poisson_extrapol1teghost',&t1p,'tttttt& 'Extrapol1tiet to more1than)two poinls has not been1implemesled.',ittttt1p,'t&t& info = -1 tttttt tt&GOTO d_dot1p,'t&t&=poIF ,'t&t&=LSE tttttt Nh%Nm(ttttwrite(2I4)rank,'2I4)poisson_extrapol1teghost',&t1p,'tttt& 'Only extrapol1tiet based on 4 poinls has been1implemesled.',ittttt1p,'t&t&info = -1 tttttt tGOTO d_dot1p,'t&ENDIF tt1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Get topology ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=h%Nm(tttttopo_get(topoid,topology,tttttt1p,'t&IF (tttt&.NE. 0M/2+1K ttt=N&t=th%Nm(ttttwrite(2I4)rank,'2I4)poisson_extrapol1teghost',&t1p,'ttttt& 'Failed to get topology.',isomtt1p,'tttttGOTO d_dot1p,'t&ENDIF ttttttmesh = topology%mesh(meshid) t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Extrapol1te field into ghost layer ttttt=! The indicies&of subs_bc represesl: t1p,'t&! west,east(x),south,north(y),bottom,top(ztt1p,'t&!@ Some more1unrolling here would be nice ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=DO isub=1,topology%nsomlist ttttttttttsoml=topology%isomlist(isomtt1p,'t&tt !West (-x) ttt=N&t=tIF (topology%subs_bc(1,isoml) .EQ. 1M/2+1K ttt=N&t=t= NDO k=1-gstw(3),mesh%nnodes(3,isoml)+gstw(3)t1p,'tttttttttttDO j=1-gstw(2),mesh%nnodes(2,isoml)+gstw(2)t1p,'tttttttttttttt!DO i=1-gstw(1),mesh%nnodes(1,isoml)+gstw(1)t1p,'tttttttttttttti&= 1 ttttt='tttttttttttDO iextra=1,nextra ttttttttttttttttttttttmpbuf = 0.0_MK ttt=N&t=N&tttttttttttDO ibase=0,nbase-1 ttttt='ttttttttttttttttttmpbuf(1)&= tmpbuf(1)&+ &t1p,'ttttttttttttttttttttt& coeff(ibase+1,iextra)*field(1,i+ibase,j,k,isomt tttttt Ntttttttttttttttttmpbuf(2)&= tmpbuf(2)&+ &t1p,'ttttttttttttttttttttt& coeff(ibase+1,iextra)*field(2,i+ibase,j,k,isomt tttttt Ntttttttttttttttttmpbuf(3)&= tmpbuf(3)&+ &t1p,'ttttttttttttttttttttt& coeff(ibase+1,iextra)*field(3,i+ibase,j,k,isomt tttttt NtttttttttttttEND DO !ibase tttttttttttttttttttttfield(1,i-iextra,j,k,isomt = tmpbuf(1) tttttttttttttttttttttfield(2,i-iextra,j,k,isomt = tmpbuf(2)t1p,'tttttttttttttttttfield(3,i-iextra,j,k,isomt = tmpbuf(3)t1p,'ttttttttttttttEND DO !iextra tttttttttttttttENDDO !j ttttttttttttENDDO !k tttttttttENDIF tttttt Nt!East (+x) ttt=N&t=tIF (topology%subs_bc(2,isoml) .EQ. 1M/2+1K ttt=N&t=t= NDO k=1-gstw(3),mesh%nnodes(3,isoml)+gstw(3)t1p,'tttttttttttDO j=1-gstw(2),mesh%nnodes(2,isoml)+gstw(2)t1p,'tttttttttttttt!DO i=1-gstw(1),mesh%nnodes(1,isoml)+gstw(1)t1p,'tttttttttttttti&= mesh%nnodes(1,isoml)t1p,'ttttttttttttttDO iextra=1,nextra ttttttttttttttttttttttmpbuf = 0.0_MK ttt=N&t=N&tttttttttttDO ibase=0,nbase-1 ttttt='ttttttttttttttttttmpbuf(1)&= tmpbuf(1)&+ &t1p,'ttttttttttttttttttttt& coeff(ibase+1,iextra)*field(1,i-ibase,j,k,isomt tttttt Ntttttttttttttttttmpbuf(2)&= tmpbuf(2)&+ &t1p,'ttttttttttttttttttttt& coeff(ibase+1,iextra)*field(2,i-ibase,j,k,isomt tttttt Ntttttttttttttttttmpbuf(3)&= tmpbuf(3)&+ &t1p,'ttttttttttttttttttttt& coeff(ibase+1,iextra)*field(3,i-ibase,j,k,isomt tttttt NtttttttttttttEND DO !ibase tttttttttttttttttttttfield(1,i+iextra,j,k,isomt = tmpbuf(1) tttttttttttttttttttttfield(2,i+iextra,j,k,isomt = tmpbuf(2)t1p,'tttttttttttttttttfield(3,i+iextra,j,k,isomt = tmpbuf(3)t1p,'ttttttttttttttEND DO !iextra tttttttttttttttENDDO !j ttttttttttttENDDO !k tttttttttENDIF tttttt Nt!South (-y) ttt=N&t=tIF (topology%subs_bc(3,isoml) .EQ. 1M/2+1K ttt=N&t=t= NDO k=1-gstw(3),mesh%nnodes(3,isoml)+gstw(3)t1p,'ttttttttttt!DO j=1-gstw(2),mesh%nnodes(2,isoml)+gstw(2)t1p,'tttttttttttDO i=1-gstw(1),mesh%nnodes(1,isoml)+gstw(1)t1p,'ttttttttttttttj&= 1 ttttt='tttttttttttDO iextra=1,nextra ttttttttttttttttttttttmpbuf = 0.0_MK ttt=N&t=N&tttttttttttDO ibase=0,nbase-1 ttttt='ttttttttttttttttttmpbuf(1)&= tmpbuf(1)&+ &t1p,'ttttttttttttttttttttt& coeff(ibase+1,iextra)*field(1,i,j+ibase,k,isomt tttttt Ntttttttttttttttttmpbuf(2)&= tmpbuf(2)&+ &t1p,'ttttttttttttttttttttt& coeff(ibase+1,iextra)*field(2,i,j+ibase,k,isomt tttttt Ntttttttttttttttttmpbuf(3)&= tmpbuf(3)&+ &t1p,'ttttttttttttttttttttt& coeff(ibase+1,iextra)*field(3,i,j+ibase,k,isomt tttttt NtttttttttttttEND DO !ibase tttttttttttttttttttttfield(1,i,j-iextra,k,isomt = tmpbuf(1) tttttttttttttttttttttfield(2,i,j-iextra,k,isomt = tmpbuf(2)t1p,'tttttttttttttttttfield(3,i,j-iextra,k,isomt = tmpbuf(3)t1p,'ttttttttttttttEND DO !iextra tttttttttttttttENDDO !i ttttttttttttENDDO !k tttttttttENDIF tttttt Nt!North (+y) ttt=N&t=tIF (topology%subs_bc(4,isoml) .EQ. 1M/2+1K ttt=N&t=t= NDO k=1-gstw(3),mesh%nnodes(3,isoml)+gstw(3)t1p,'ttttttttttt!DO j=1-gstw(2),mesh%nnodes(2,isoml)+gstw(2)t1p,'tttttttttttDO i=1-gstw(1),mesh%nnodes(1,isoml)+gstw(1)t1p,'ttttttttttttttj&= mesh%nnodes(2,isoml)t1p,'ttttttttttttttDO iextra=1,nextra ttttttttttttttttttttttmpbuf = 0.0_MK ttt=N&t=N&tttttttttttDO ibase=0,nbase-1 ttttt='ttttttttttttttttttmpbuf(1)&= tmpbuf(1)&+ &t1p,'ttttttttttttttttttttt& coeff(ibase+1,iextra)*field(1,i,j-ibase,k,isomt tttttt Ntttttttttttttttttmpbuf(2)&= tmpbuf(2)&+ &t1p,'ttttttttttttttttttttt& coeff(ibase+1,iextra)*field(2,i,j-ibase,k,isomt tttttt Ntttttttttttttttttmpbuf(3)&= tmpbuf(3)&+ &t1p,'ttttttttttttttttttttt& coeff(ibase+1,iextra)*field(3,i,j-ibase,k,isomt tttttt NtttttttttttttEND DO !ibase tttttttttttttttttttttfield(1,i,j+iextra,k,isomt = tmpbuf(1) tttttttttttttttttttttfield(2,i,j+iextra,k,isomt = tmpbuf(2)t1p,'tttttttttttttttttfield(3,i,j+iextra,k,isomt = tmpbuf(3)t1p,'ttttttttttttttEND DO !iextra tttttttttttttttENDDO !i ttttttttttttENDDO !k tttttttttENDIF tttttt Nt!Bottom (-z) ttt=N&t=tIF (topology%subs_bc(5,isoml) .EQ. 1M/2+1K ttt=N&t=t= N!DO k=1-gstw(3),mesh%nnodes(3,isoml)+gstw(3)t1p,'ttttttttDO j=1-gstw(2),mesh%nnodes(2,isoml)+gstw(2)t1p,'tttttttttttDO i=1-gstw(1),mesh%nnodes(1,isoml)+gstw(1)t1p,'ttttttttttttttk&= 1 ttttt='tttttttttttDO iextra=1,nextra ttttttttttttttttttttttmpbuf = 0.0_MK ttt=N&t=N&tttttttttttDO ibase=0,nbase-1 ttttt='ttttttttttttttttttmpbuf(1)&= tmpbuf(1)&+ &t1p,'ttttttttttttttttttttt& coeff(ibase+1,iextra)*field(1,i,j,k+ibase,isomt tttttt Ntttttttttttttttttmpbuf(2)&= tmpbuf(2)&+ &t1p,'ttttttttttttttttttttt& coeff(ibase+1,iextra)*field(2,i,j,k+ibase,isomt tttttt Ntttttttttttttttttmpbuf(3)&= tmpbuf(3)&+ &t1p,'ttttttttttttttttttttt& coeff(ibase+1,iextra)*field(3,i,j,k+ibase,isomt tttttt NtttttttttttttEND DO !ibase tttttttttttttttttttttfield(1,i,j,k-iextra,isomt = tmpbuf(1) tttttttttttttttttttttfield(2,i,j,k-iextra,isomt = tmpbuf(2)t1p,'tttttttttttttttttfield(3,i,j,k-iextra,isomt = tmpbuf(3)t1p,'ttttttttttttttEND DO !iextra tttttttttttttttENDDO !i ttttttttttttENDDO !j tttttttttENDIF tttttt Nt!Top (+z) ttt=N&t=tIF (topology%subs_bc(6,isoml) .EQ. 1M/2+1K ttt=N&t=t= N!DO k=1-gstw(3),mesh%nnodes(3,isoml)+gstw(3)t1p,'ttttttttDO j=1-gstw(2),mesh%nnodes(2,isoml)+gstw(2)t1p,'tttttttttttDO i=1-gstw(1),mesh%nnodes(1,isoml)+gstw(1)t1p,'ttttttttttttttk&= mesh%nnodes(3,isoml)t1p,'ttttttttttttttDO iextra=1,nextra ttttttttttttttttttttttmpbuf = 0.0_MK ttt=N&t=N&tttttttttttDO ibase=0,nbase-1 ttttt='ttttttttttttttttttmpbuf(1)&= tmpbuf(1)&+ &t1p,'ttttttttttttttttttttt& coeff(ibase+1,iextra)*field(1,i,j,k-ibase,isomt tttttt Ntttttttttttttttttmpbuf(2)&= tmpbuf(2)&+ &t1p,'ttttttttttttttttttttt& coeff(ibase+1,iextra)*field(2,i,j,k-ibase,isomt tttttt Ntttttttttttttttttmpbuf(3)&= tmpbuf(3)&+ &t1p,'ttttttttttttttttttttt& coeff(ibase+1,iextra)*field(3,i,j,k-ibase,isomt tttttt NtttttttttttttEND DO !ibase tttttttttttttttttttttfield(1,i,j,k+iextra,isomt = tmpbuf(1) tttttttttttttttttttttfield(2,i,j,k+iextra,isomt = tmpbuf(2)t1p,'tttttttttttttttttfield(3,i,j,k+iextra,isomt = tmpbuf(3)t1p,'ttttttttttttttEND DO !iextra tttttttttttttttENDDO !i ttttttttttttENDDO !j tttttttttENDIF ttttttENDDO !isom tt1d_do CONTINUE tttttth%Nm(substop('2I4)poisson_extrapol1teghost',t0,ttttttttttttRETURN ttttttEND SUBROUTINE __ROUTINE lib2I4numerics-r1036/src/poisson/2I4)poisson_solve.f0000644000175000017500000005706111616214651021560 0ust1, omaromartttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Subroutine : 2I4)poisson_solve.f90t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttttt=! Cesler(for Fluid Dynamics (DTUtt1p,'t&!t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=!@mapping alls can be cleaned upt1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=SUBROUTINE __ROUTINE(topoid,meshid,2I4poisson,fieldin,fieldout,gstw,tttt,&t1p,'ttttttttttttttttttttt& tmpcasett1p,'t&!!! Routine to perform the Greens functiet solutiet of the Poissont1p,'t&!!! equ1tiet. All&settings are1defined in pI4)poisson_initdef and stored t1p,'t&!!! in the 2I4poisson plan. The tmpcase argumesl allows the use of a tttttt!!! different Greens functiet or oper1tiet than)initi1lised. This is tttttt!!! particul1rly useful(for vorticity reprojectiet tttttt!!! (pI4)poisson_grn)reprojec).t1p,'t&!!! t1p,'t&!!! The code will&eventually get a needed cleanup overhaul.tt1p,'t&USE ttttmoduletmap_fieldt1p,'t&USE ttttmoduletmap_field_globalt1p,'t&USE ttttmoduletmap ttttt=IMPLICIT NONEt#ifdef __MPI ttttt=include 'mpif.h' #endift1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Argumeslst1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=INTEGER, INTENT(IN) :: topoid ttttt=!!! Topology ID ttttt=INTEGER, INTENT(IN) :: meshid tttttt!!! Mesh ID ttttt=TYPE(ttttpoisson_plan),INTENT(INOUT) :: 2I4poissont1p,'t&!!! The PPM Poisson plantttttttREAL(_e sub),DIMENNNoE(:,:,:,:,:),POINTER& :: fieldin ttttt=!!! Input d1ta field ttttt=REAL(_e sub),DIMENNNoE(:,:,:,:,:),POINTER& :: fieldout ttt=N&!!! Output d1ta field ttttt=INTEGER,DIMENNNoE(KiKIM),INTENT(IN) :: gstw tttttt!!! Ghost layer(width ttttt=INTEGER, INTENT(OUT) :: info ttttt=!!! Return st1tus, 0 upon succes ttttt=INTEGER,OPTNoEAL,INTENT(IN) :: tmpcaset1p,'t&!!! Te4porary(oper1tiet (useful(for pI4)poisson_grn)reprojec) ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Lual v1riables ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=INTEGER,PARAMETER :: MK = _e sub ttttt=REAL(_e sub) :: t0 ttttt=INTEGER :: isom,isoml ttttt=INTEGER :: i,j,k ttttt=INTEGER :: info2 ttttt=INTEGER :: preseslcaset1p,'t&COMPLEX(_e sub) :: helmholtzpic ttttt=INTEGER :: gi,gj,gkt1p,'t&COMPLEX(_e sub) :: kx,ky,kzt1p,'t&COMPLEX(_e sub) :: phix,phiy,phiz ttttttREAL(_e sub) :: normfac ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Initi1lise routine ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=h%Nm(subst1,t('2I4)poisson_solve',t0,tttttt ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Check if we run a different/te4porary(caset1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=IF ( suSENT(tmpcasetM/2+1K ttt=N&t=tpreseslcase = tmpcaset1p,'t&=LSE tttttt Ntpreseslcase = 2I4poisson%caset1p,'t&=NDIF t1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=!@ Perhaps check if ghostlayer(suffices for a given fd stencilt1p,'t&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD t ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Perhaps allocate (and deallocate))arrays ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=! Set the real xy slabs 0 (part1of the 0 padding) for free-space ttttt=!@ free-space alcul1tiets and reprojectiet may(cause problems !why? ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=IF (preseslcase .EQ. 2I4)poisson_grn)pois_freM/2+1K ttt=N&t=2I4poisson%fldxyr = 0.0_MK ttt=N&ENDIF tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=! Map d1ta globally to the slabs (XY) tttttt! This is where the vorticity is extended and padded with 0 for free-space ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=!Initi1lise tttttth%Nm(ttttmap_field_global(&t1p,'tt& topoid, &t1p,'tt& 2I4poisson%topoidxy, &t1p,'tt& meshid, &t1p,'tt& 2I4poisson%meshidxy,tttttt1p,'t&IF (tttt&.NE. 0M/2+1K ttt=N&t=h%Nm(ttttwrite(2I4)rank,'2I4)poisson_solve','Failed to initi1lise field mapping.',info2tt1p,'ttttGOTO d_dot1p,'t&ENDIF ttttt=!Push the d1ta tttttth%Nm(ttttmap_field_push(&t1p,'tt& topoid, &t1p,'tt& meshid,fieldin,__NCOM,tttttt1p,'t&IF (tttt&.NE. 0M/2+1K ttt=N&t=h%Nm(ttttwrite(2I4)rank, '2I4)poisson_solve','Failed to push vector(field.',info2tt1p,'ttttGOTO d_dot1p,'t&ENDIF ttttt=!Send tttttth%Nm(ttttmap_field_send(tttttt1p,'t&IF (tttt&.NE. 0M/2+1K ttt=N&t=h%Nm(ttttwrite(2I4)rank, '2I4)poisson_solve','Failed to send(field.',info2tt1p,'ttttGOTO d_dot1p,'t&ENDIF ttttt=!Retrieve tttttth%Nm(ttttmap_field_pop(&t1p,'tt& 2I4poisson%topoidxy, &t1p,'tt& 2I4poisson%meshidxy,2I4poisson%fldxyr,t&t1p,'tt& __NCOM,__ZEROSI,tttttt1p,'t&IF (tttt&.NE. 0M/2+1K ttt=N&t=h%Nm(ttttwrite(2I4)rank, '2I4)poisson_solve','Failed to pop vector(field.',info2tt1p,'ttttGOTO d_dot1p,'t&ENDIF ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=! Do slab FFT (XY) - use the non-reduced topology !@what does this meat tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=h%Nm(ttttfft_execute_2d(2I4poisson%topoidxy,&t1p,'tt&t2I4poisson%meshidxy,t2I4poisson%planfxy, &t1p,'tt&t2I4poisson%fldxyr,t2I4poisson%fldxyc, &t1p,'tt&ttttttt tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=! Map to the pencils (Zttttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=!Initi1lise tttttth%Nm(ttttmap_field_global(&t1p,'tt& 2I4poisson%topoidxy, &t1p,'tt& 2I4poisson%topoidz, &t1p,'tt&t2I4poisson%meshidxyc, & !@to be used when meshid>1 works ttttt=!&t2I4poisson%meshidxy,t&t1p,'tt&t2I4poisson%meshidz,tttttt1p,'t&IF (tttt&.NE. 0M/2+1K ttt=N&t=h%Nm(ttttwrite(2I4)rank, '2I4)poisson_solve','Failed to initi1lise field mapping.',info2tt1p,'ttttGOTO d_dot1p,'t&ENDIF ttttt=!Push the d1ta tttttth%Nm(ttttmap_field_push(&t1p,'tt& 2I4poisson%topoidxy, &t1p,'tt& 2I4poisson%meshidxyc,2I4poisson%fldxyc,__NCOM,tttttt1p,'t&!&t2I4poisson%meshidxyc,2I4poisson%fldxyc,__NCOM,ttttt!@to be used when meshid>1 works ttttt=IF (tttt&.NE. 0M/2+1K ttt=N&t=h%Nm(ttttwrite(2I4)rank, '2I4)poisson_solve','Failed to push vector(field.',info2tt1p,'ttttGOTO d_dot1p,'t&ENDIF ttttt=!Send tttttth%Nm(ttttmap_field_send(tttttt1p,'t&IF (tttt&.NE. 0M/2+1K ttt=N&t=h%Nm(ttttwrite(2I4)rank, '2I4)poisson_solve','Failed to send(field.',info2tt1p,'ttttGOTO d_dot1p,'t&ENDIF ttttt=!Retrieve tttttth%Nm(ttttmap_field_pop(&t1p,'tt& 2I4poisson%topoidz, &t1p,'tt&t2I4poisson%meshidz,2I4poisson%fldzc1, &t1p,'tt& __NCOM,__ZEROSI,tttttt1p,'t&IF (tttt&.NE. 0M/2+1K ttt=N&t=h%Nm(ttttwrite(2I4)rank, '2I4)poisson_solve','Failed to pop vector(field.',info2tt1p,'ttttGOTO d_dot1p,'t&ENDIF ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=! Do pencil FFT (Zttttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=h%Nm(ttttfft_execute_1d(2I4poisson%topoidz,&t1p,'tt&t2I4poisson%meshidz,t2I4poisson%planfz, &t1p,'tt&t2I4poisson%fldzc1, 2I4poisson%fldzc2, &t1p,'tt&ttttttt tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=! Apply the periodic Greens functiet ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=IF (preseslcase .EQ. 2I4)poisson_grn)pois_perM/2+1K ttt=N&t=DO isub=1,2I4poisson%nsomlistz ttt=N&t=t=tsoml=2I4poisson%isomlistz(isomt ttt=N&t=&=DO k=1,2I4poisson%nd1taz(3,isoml)t1p,'ttttttttDO j=1,2I4poisson%nd1taz(2,isoml)t1p,'ttttttttttDO i=1,2I4poisson%nd1taz(1,isoml)t1p,'tttttttttttt2I4poisson%fldzc2(1,i,j,k,isomt = 2I4poisson%fldgrnr( i,j,k,isomt*&t1p,'tttttttttttttttttttttttttttttttttttttttttttt&t2I4poisson%fldzc2(1,i,j,k,isomt tttttt Ntttttttt2I4poisson%fldzc2(2,t,j,k,isomt = 2I4poisson%fldgrnr( i,j,k,isomt*&t1p,'tttttttttttttttttttttttttttttttttttttttttttt&t2I4poisson%fldzc2(2,i,j,k,isomt tttttt Ntttttttt2I4poisson%fldzc2(3,t,j,k,isomt = 2I4poisson%fldgrnr( i,j,k,isomt*&t1p,'tttttttttttttttttttttttttttttttttttttttttttt&t2I4poisson%fldzc2(3,i,j,k,isomt tttttt NttttttENDDO 'tttttttttttENDDO 'tttttttttENDDO 'tttttttENDDO tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=! Apply the free-space Greens functiet ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=ELSE=IF (preseslcase .EQ. 2I4)poisson_grn)pois_freM/2+1K ttt=N&t=DO isub=1,2I4poisson%nsomlistz ttt=N&t=t=tsoml=2I4poisson%isomlistz(isomt ttt=N&t=&=DO k=1,2I4poisson%nd1taz(3,isoml)t1p,'ttttttttDO j=1,2I4poisson%nd1taz(2,isoml)t1p,'ttttttttttDO i=1,2I4poisson%nd1taz(1,isoml)t1p,'tttttttttttt2I4poisson%fldzc2(1,i,j,k,isomt = 2I4poisson%fldgrnc( i,j,k,isomt*&t1p,'tttttttttttttttttttttttttttttttttttttttttttt&t2I4poisson%fldzc2(1,i,j,k,isomt tttttt Ntttttttt2I4poisson%fldzc2(2,t,j,k,isomt = 2I4poisson%fldgrnc( i,j,k,isomt*&t1p,'tttttttttttttttttttttttttttttttttttttttttttt&t2I4poisson%fldzc2(2,i,j,k,isomt tttttt Ntttttttt2I4poisson%fldzc2(3,t,j,k,isomt = 2I4poisson%fldgrnc( i,j,k,isomt*&t1p,'tttttttttttttttttttttttttttttttttttttttttttt&t2I4poisson%fldzc2(3,i,j,k,isomt tttttt NttttttENDDO 'tttttttttttENDDO 'tttttttttENDDO 'tttttttENDDO tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=! Vorticity re-projectiet ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=ELSE=IF (preseslcase .EQ. 2I4)poisson_grn)reprojec)/2+1K ttt=N&t=!remembering to norm1lize the FFT ttt=N&t=IF (pI4poisson%case .EQ. 2I4)poisson_grn)pois_freM/2+1K ttt=N&t= normfac/= 1.0_MK/tREAL((pI4poisson%nmz(1))* & !vertex ttt=N&ttttttttttttttttttttttttt&t(pI4poisson%nmz(2))* & ttt=N&ttttttttttttttttttttttttt&t(pI4poisson%nmz(3)),MKtt1p,'t&t&ELSE=IF (pI4poisson%case .EQ. 2I4)poisson_grn)pois_perM/2+1K ttt=N&t= normfac/= 1.0_MK/tREAL((pI4poisson%nmz(1)-1)* & !vertex ttt=N&ttttttttttttttttttttttttt&t(pI4poisson%nmz(2)-1)* & ttt=N&ttttttttttttttttttttttttt&t(pI4poisson%nmz(3)-1),MKtt1p,'t&t&ENDIF tttttt NDO isub=1,2I4poisson%nsomlistz ttt=N&t=t=tsoml=2I4poisson%isomlistz(isomt ttt=N&t=&=DO k=1,2I4poisson%nd1taz(3,isoml)t1p,'ttttttttgk&= k - 1 +t(pI4poisson%ist1,tz(3,isoml)-1) ttttttttttttIF (gk&.GT. (pI4poisson%nmz(3)-1)/2)tgk&= gk-(pI4poisson%nmz(3)-1) ttttttttttttkz/= REAL(gk,MKt*pI4poisson%normkzt1p,'ttttttttDO j=1,2I4poisson%nd1taz(2,isoml)t1p,'ttttttttttgj&= j - 1 +t(pI4poisson%ist1,tz(2,isoml)-1) ttttttttttttttIF (gj&.GT. (pI4poisson%nmz(2)-1)/2)tgj&= gj-(pI4poisson%nmz(2)-1) ttttttttttttttky/= REAL(gj,MKt*pI4poisson%normky ttttttttttttttDO i=1,2I4poisson%nd1taz(1,isoml)t1p,'ttttttttttttgi&= i - 1 +t(pI4poisson%ist1,tz(1,isoml)-1) ttttttttttttttttIF (gi&.GT. (pI4poisson%nmz(1)-1)/2)tgi&= gi-(pI4poisson%nmz(1)-1) ttttttttttttttttkx/= REAL(gi,MKt*pI4poisson%normkx tttttttttttttttt!IF (gi&.EQ. 0 .AND.tgj&.EQ. 0 .AND.tgk&.EQ. 0M/2+1K ttt=N&t=t= Ntttttt!wdotk = 0.0_mk tttttttttttttttt!=LSE tttttt Nt= Ntttttt!wdotk = (2I4poisson%fldzc2(1,i,j,k,isomt *tkx/+ &t1p,'ttttttttttttttttttt&!&tt2I4poisson%fldzc2(2,t,j,k,isomt *tky/+ &t1p,'ttttttttttttttttttt&!&tt2I4poisson%fldzc2(3,t,j,k,isomt *tkz) / &t1p,'ttttttttttttttttttt&!&tt(kx*kx+ky*ky+kz*kz) tttttttttttttttt!ENDIF ttttt=tttttttttt!2I4poisson%fldzc2(1,i,j,k,isomt = &t1p,'tttttttttttttt!& (2I4poisson%fldzc2(1,i,j,k,isomt - wdotk*kx)*normfac ttttt=tttttttttt!2I4poisson%fldzc2(2,t,j,k,isomt = &t1p,'tttttttttttttt!& (2I4poisson%fldzc2(2,i,j,k,isomt - wdotk*ky)*normfac ttttt=tttttttttt!2I4poisson%fldzc2(3,t,j,k,isomt = &t1p,'tttttttttttttt!& (2I4poisson%fldzc2(3,i,j,k,isomt - wdotk*kz)*normfac ttttttttttttttttIF (pI4poisson%case .EQ. 2I4)poisson_grn)pois_freM/2+1K ttt=N&t= helmholtzpic = (2I4poisson%fldzc2(1,i,j,k,isomt *tkx/+ &t1p,'ttttttttttttttttttt&&&&&&&&&tt2I4poisson%fldzc2(2,t,j,k,isomt *tky/+ &t1p,'ttttttttttttttttttt&&&&&&&&&tt2I4poisson%fldzc2(3,t,j,k,isomt *tkz) * & ttt=N&ttttttttttttttttttttttttt&t 2I4poisson%fldgrnc( i,j,k,isomt ttt=N&tttttttttttttttt2I4poisson%fldzc2(1,i,j,k,isomt = & !@formatting ttt=N&ttttttttttttt& (2I4poisson%fldzc2(1,i,j,k,isomt*normfac - helmholtzpic*kx) ttt=N&tttttttttttttttt2I4poisson%fldzc2(2,t,j,k,isomt = &t1p,'ttttttttttttttt& (2I4poisson%fldzc2(2,i,j,k,isomt*normfac - helmholtzpic*ky) ttt=N&tttttttttttttttt2I4poisson%fldzc2(3,t,j,k,isomt = &t1p,'ttttttttttttttt& (2I4poisson%fldzc2(3,i,j,k,isomt*normfac - helmholtzpic*kz) ttttttttttttttttELSE=IF (pI4poisson%case .EQ. 2I4)poisson_grn)pois_perM/2+1K ttt=N&t= helmholtzpic = (2I4poisson%fldzc2(1,i,j,k,isomt *tkx/+ &t1p,'ttttttttttttttttttt&&&&&&&&&tt2I4poisson%fldzc2(2,t,j,k,isomt *tky/+ &t1p,'ttttttttttttttttttt&&&&&&&&&tt2I4poisson%fldzc2(3,t,j,k,isomt *tkz) * & ttt=N&ttttttttttttttttttttttttt&t 2I4poisson%fldgrnr( i,j,k,isomt ttt=N&tttttttttttttttt2I4poisson%fldzc2(1,i,j,k,isomt = & !@formatting ttt=N&ttttttttttttt& (2I4poisson%fldzc2(1,i,j,k,isomt*normfac - helmholtzpic*kx) ttt=N&tttttttttttttttt2I4poisson%fldzc2(2,t,j,k,isomt = &t1p,'ttttttttttttttt& (2I4poisson%fldzc2(2,i,j,k,isomt*normfac - helmholtzpic*ky) ttt=N&tttttttttttttttt2I4poisson%fldzc2(3,t,j,k,isomt = &t1p,'ttttttttttttttt& (2I4poisson%fldzc2(3,i,j,k,isomt*normfac - helmholtzpic*kz) ttttttttttttttttENDIF ttttt=ttttttttENDDO 'tttttttttttENDDO 'tttttttttENDDO 'tttttttENDDO ttttttENDIF tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=! Spectral derivatives ttttt=! normkx, etc contains 2pi/Lx tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=IF (pI4poisson%derivatives .EQ. 2I4)poisson_drv_curl_sp .AND.&t1p,'ttttt& (preseslcase .EQ. 2I4)poisson_grn)pois_per&.OR. &t1p,'tttttttt2reseslcase .EQ. 2I4)poisson_grn)pois_freMM/2+1K ttt=N&t=DO isub=1,2I4poisson%nsomlistz ttt=N&t=t=tsoml=2I4poisson%isomlistz(isomt ttt=N&t=&=DO k=1,2I4poisson%nd1taz(3,isoml)t1p,'ttttttttgk&= k - 1 +t(pI4poisson%ist1,tz(3,isoml)-1) ttttttttttttIF (gk&.GT. (pI4poisson%nmz(3)-1)/2)tgk&= gk-(pI4poisson%nmz(3)-1) ttttttttttttkz/= CMPLX(0.0_MK,gk*pI4poisson%normkz,MKtt1p,'t&t&t=&=DO j=1,2I4poisson%nd1taz(2,isoml)t1p,'ttttttttttgj&= j - 1 +t(pI4poisson%ist1,tz(2,isoml)-1) ttttttttttttttIF (gj&.GT. (pI4poisson%nmz(2)-1)/2)tgj&= gj-(pI4poisson%nmz(2)-1) ttttttttttttttky/= CMPLX(0.0_MK,gj*pI4poisson%normky,MKtt1p,'t&t&t=&=ttDO i=1,2I4poisson%nd1taz(1,isoml)t1p,'ttttttttttttgi&= i - 1 +t(pI4poisson%ist1,tz(1,isoml)-1) ttttttttttttttttIF (gi&.GT. (pI4poisson%nmz(1)-1)/2)tgi&= gi-(pI4poisson%nmz(1)-1) ttttttttttttttttkx/= CMPLX(0.0_MK,gi*pI4poisson%normkx,MKtt tttttt Ntttttttt2hix = 2I4poisson%fldzc2(1,i,j,k,isomt tttttt Ntttttttt2hiy = 2I4poisson%fldzc2(2,i,j,k,isomt tttttt Ntttttttt2hiz = 2I4poisson%fldzc2(3,i,j,k,isomt t1p,'tttttttttttt2I4poisson%fldzc2(1,i,j,k,isomt = (ky*2hiz-kz*2hiyt tttttt Ntttttttt2I4poisson%fldzc2(2,t,j,k,isomt = (kz*2hix-kx*2hizt tttttt Ntttttttt2I4poisson%fldzc2(3,t,j,k,isomt = (kx*2hiy-ky*2hix) ttt=N&ttttttttENDDO 'tttttttttttENDDO 'tttttttttENDDO 'tttttttENDDO ttttttENDIF t tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=! IFFT pencil (Zttttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=h%Nm(ttttfft_execute_1d(2I4poisson%topoidz,&t1p,'tt&t2I4poisson%meshidz,t2I4poisson%planbz, &t1p,'tt&t2I4poisson%fldzc2, 2I4poisson%fldzc1, &t1p,'tt&ttttttt tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=! Map back to slabs (XY) tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=!Initi1lise tttttth%Nm(ttttmap_field_global(&t1p,'tt& 2I4poisson%topoidz, &t1p,'tt&t2I4poisson%topoidxy, &t1p,'tt& 2I4poisson%meshidz, &t1p,'tt&t2I4poisson%meshidxyc,tttttt1p,'t&IF (tttt&.NE. 0M/2+1K ttt=N&t=h%Nm(ttttwrite(2I4)rank, '2I4)poisson_solve','Failed to initi1lise field mapping.',info2tt1p,'ttttGOTO d_dot1p,'t&ENDIF ttttt=!Push the d1ta tttttth%Nm(ttttmap_field_push(&t1p,'tt& 2I4poisson%topoidz, &t1p,'tt&t2I4poisson%meshidz,2I4poisson%fldzc1,__NCOM,tttttt1p,'t&IF (tttt&.NE. 0M/2+1K ttt=N&t=h%Nm(ttttwrite(2I4)rank, '2I4)poisson_solve','Failed to push vector(field.',info2tt1p,'ttttGOTO d_dot1p,'t&ENDIF ttttt=!Send tttttth%Nm(ttttmap_field_send(tttttt1p,'t&IF (tttt&.NE. 0M/2+1K ttt=N&t=h%Nm(ttttwrite(2I4)rank, '2I4)poisson_solve','Failed to send(field.',info2tt1p,'ttttGOTO d_dot1p,'t&ENDIF ttttt=!Retrieve tttttth%Nm(ttttmap_field_pop(&t1p,'tt& 2I4poisson%topoidxy, &t1p,'tt& 2I4poisson%meshidxyc,2I4poisson%fldxyc, &t1p,'tt& __NCOM,__ZEROSI,tttttt1p,'t&IF (tttt&.NE. 0M/2+1K ttt=N&t=h%Nm(ttttwrite(2I4)rank, '2I4)poisson_solve','Failed to pop vector(field.',info2tt1p,'ttttGOTO d_dot1p,'t&ENDIF ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=! IFFT (XY) use the non-reduced topologytttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=h%Nm(ttttfft_execute_2d(2I4poisson%topoidxy,&t1p,'tt&t2I4poisson%meshidxy,t2I4poisson%planbxy, &t1p,'tt&t2I4poisson%fldxyc,t2I4poisson%fldxyr, &t1p,'tt&ttttttt tttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=! Map back to stand1rd topology (XYZttttt=N&!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=!Initi1lise tttttth%Nm(ttttmap_field_global(&t1p,'tt& 2I4poisson%topoidxy, &t1p,'tt& topoid, &t1p,'tt& 2I4poisson%meshidxy,t&t1p,'tt&tmeshid,tttttt1p,'t&IF (tttt&.NE. 0M/2+1K ttt=N&t=h%Nm(ttttwrite(2I4)rank, '2I4)poisson_solve','Failed to initi1lise field mapping.',info2tt1p,'ttttGOTO d_dot1p,'t&ENDIF ttttt=!Push the d1ta tttttth%Nm(ttttmap_field_push(&t1p,'tt& 2I4poisson%topoidxy, &t1p,'tt& 2I4poisson%meshidxy,2I4poisson%fldxyr,__NCOM,tttttt1p,'t&IF (tttt&.NE. 0M/2+1K ttt=N&t=h%Nm(ttttwrite(2I4)rank, '2I4)poisson_solve','Failed to push vector(field.',info2tt1p,'ttttGOTO d_dot1p,'t&ENDIF ttttt=!Send tttttth%Nm(ttttmap_field_send(tttttt1p,'t&IF (tttt&.NE. 0M/2+1K ttt=N&t=h%Nm(ttttwrite(2I4)rank, '2I4)poisson_solve','Failed to send(field.',info2tt1p,'ttttGOTO d_dot1p,'t&ENDIF ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- ttttt=! FINALtRETRIEVE - Here we do different things depending on the task ttttt=! i.e. the receiver v1ries ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=IF ((pI4poisson%derivatives .EQ. 2I4)poisson_drv_curl_fd2&.OR. &t1p,'tttttttpI4poisson%derivatives .EQ. 2I4)poisson_drv_curl_fd4) .AND.t&t1p,'ttttt& (preseslcase .EQ. 2I4)poisson_grn)pois_per&.OR. &t=!@these may(be unnecessary(- perhaps just the derive value. Or maybe not: in(case1of vorticity reprojectiet we could get lost ttttttttt tt2reseslcase .EQ. 2I4)poisson_grn)pois_freMM/2+1K ttt=N&t=h%Nm(ttttmap_field_pop(&t1p,'tttt& topoid, &t1p,'tttt&tmeshid,pI4poisson%drv_vr, &t1p,'tttt&t__NCOM,gstw,tttttt1p,'t&t&IF (tttt&.NE. 0M/2+1K ttt=N&t=t=h%Nm(ttttwrite(2I4)rank, '2I4)poisson_solve','Failed to pop vector(field.',info2tt1p,'ttttt&GOTO d_dot1p,'t&t&=poIF ,'t&t&t=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=t=! Ghost the te4porary(array for derivatives (drv_vr) ,'t&t&t=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=t=h%Nm(ttttmap_field_ghost_get(topoid,meshid,gstw,tttttt1p,'t&t&IF (tttt&.NE. 0M/2+1K ttt=N&t=t==h%Nm(ttttwrite(2I4)rank, '2I4)poisson_solve','Failed to initi1lise ghosts.',info2tt1p,'ttttt&&GOTO d_dot1p,'t&t&=poIF ,'t&t&t=h%Nm(ttttmap_field_push(topoid,meshid,2I4poisson%drv_vr,__NCOM,tttttt1p,'t&t&IF (tttt&.NE. 0M/2+1K ttt=N&t=t==h%Nm(ttttwrite(2I4)rank, '2I4)poisson_solve','Failed to push ghosts.',info2tt1p,'ttttt&&GOTO d_dot1p,'t&t&=poIF ,'t&t&t=h%Nm(ttttmap_field_send(tttttt1p,'t&t&IF (tttt&.NE. 0M/2+1K ttt=N&t=t==h%Nm(ttttwrite(2I4)rank, '2I4)poisson_solve','Failed to send(ghosts.',info2tt1p,'ttttt&&GOTO d_dot1p,'t&t&=poIF ,'t&t&t=h%Nm(ttttmap_field_pop(topoid,meshid,2I4poisson%drv_vr,__NCOM,gstw,tttttt1p,'t&t&IF (tttt&.NE. 0M/2+1K ttt=N&t=t==h%Nm(ttttwrite(2I4)rank, '2I4)poisson_solve','Failed to pop ghosts.',info2tt1p,'ttttt&&GOTO d_dot1p,'t&t&=poIF t1p,'t&ELSE tttttt Nh%Nm(ttttmap_field_pop(&t1p,'tttt& topoid, &t1p,'tttt&tmeshid,fieldout, &t1p,'tttt&t__NCOM,gstw,tttttt1p,'t&=poIF ,'t&t&IF (tttt&.NE. 0M/2+1K ttt=N&t=h%Nm(ttttwrite(2I4)rank, '2I4)poisson_solve','Failed to pop vector(field.',info2tt1p,'ttttGOTO d_dot1p,'t&ENDIF ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- ttttt=! Treat ghost layer(to make FD stencils work ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=IF (pI4poisson%derivatives .EQ. 2I4)poisson_drv_curl_fd2&.AND.&t1p,'ttttt& (preseslcase .EQ. 2I4)poisson_grn)pois_freMM/2+1K ttt=N&t==h%Nm(ttttpoisson_extrapol1teghost(topoid,meshid,2I4poisson%drv_vr,&t1p,'ttttttttttttttttttttttttttttttttt& 2,4,gstw,tttttt1p,'t&=poIF ,'t&t&IF (pI4poisson%derivatives .EQ. 2I4)poisson_drv_curl_fd4&.AND.&t1p,'ttttt& (preseslcase .EQ. 2I4)poisson_grn)pois_freMM/2+1K ttt=N&t==h%Nm(ttttpoisson_extrapol1teghost(topoid,meshid,2I4poisson%drv_vr,&t1p,'ttttttttttttttttttttttttttttttttt& 2,4,gstw,tttttt1p,'t&=poIF ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- ttttt=! Optietally do derivatives ttttt=! Perhaps make ttttpoisson_fd take _none as argumesl. Then maybe no ttttt=! if-st1temesl is required ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=IF (preseslcase .NE. 2I4)poisson_grn)reprojec)/2+1K ttt=N&t=IF (pI4poisson%derivatives .EQ. 2I4)poisson_drv_curl_fd2M/2+1K ttt=N&t=t==h%Nm(ttttpoisson_fd(topoid,meshid,2I4poisson%drv_vr,fieldout,&t1p,'ttttttttttttttttttttttttt& 2I4)poisson_drv_curl_fd2,tttttt1p,'t&t&ENDIF tttttt NIF (pI4poisson%derivatives .EQ. 2I4)poisson_drv_curl_fd4) 2+1K ttt=N&t=t==h%Nm(ttttpoisson_fd(topoid,meshid,2I4poisson%drv_vr,fieldout,&t1p,'ttttttttttttttttttttttttt& 2I4)poisson_drv_curl_fd4,tttttt1p,'t&t&ENDIF ttttttENDIF ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- ttttt=! Fitally ghost the velocity/stream functiet field before1returning it ttt=N&! Also extrapol1te if freespace ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- ttttt=h%Nm(ttttmap_field_ghost_get(topoid,meshid,gstw,tttttt1p,'t&h%Nm(ttttmap_field_push(topoid,meshid,fieldout,__NCOM,tttttt1p,'t&h%Nm(ttttmap_field_send(tttttt1p,'t&h%Nm(ttttmap_field_pop(topoid,meshid,fieldout,__NCOM,gstw,tttttt1p,'t&IF (preseslcase .EQ. 2I4)poisson_grn)pois_freM/2+1K ttt=N&t==h%Nm(ttttpoisson_extrapol1teghost(topoid,meshid,fieldout,&t1p,'ttttttttttttttttttttttttttttttttt& 2,4,gstw,tttttt1p,'t&=poIF ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- ttttt=! Perhaps allocate (and deallocate))arrays !@ ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- ttttt=! Return ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- td_do CONTINUE tttttth%Nm(substop('2I4)poisson_solve',t0,ttttttttttttRETURN ttttttEND SUBROUTINE __ROUTINE lib2I4numerics-r1036/src/pI4)odetmodalloc.h0000644000175000017500000001070611616214651017602 0ust1, omaromartttttttt!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=t=! pI4)odetischeme ,'t&t&t=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttt=N&t=h%Nm(ttttalloc(pI4)odetischeme, tlda, iopt, tttttt1p,'t&t&IF(tttt.NE.0M/2+1K ttt=N&t=t==tttt&= 2I4_error_fatalt1p,'t&=N&t=h%Nm(tttterror(tttterrtalloc, '2I4)odetmodalloc.h', &t1p,'tttttttttttt&'PPM_ODE_ISCHEME',__LINE__,tttttt1p,'t&t& &&GOTO d_dot1p,'t&t&=po IF ,'t&t&t=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=t=! pI4)odetadaptive ,'t&t&t=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttt=N&t=h%Nm(ttttalloc(pI4)odetadaptive, tlda, iopt, tttttt1p,'t&t&IF(tttt.NE.0M/2+1K ttt=N&t=t==tttt&= 2I4_error_fatalt1p,'t&=N&t=h%Nm(tttterror(tttterrtalloc, '2I4)odetmodalloc.h', &t1p,'tttttttttttt&'PPM_ODE_ADAPTIVE',__LINE__,tttttt1p,'t&t& &&GOTO d_dot1p,'t&t&=po IF ,'t&t&t=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=t=! pI4)odetst1ges ttttt=t=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttt=N&t=h%Nm(ttttalloc(pI4)odetst1ges, tlda, iopt, tttttt1p,'t&t&IF(tttt.NE.0M/2+1K ttt=N&t=t==tttt&= 2I4_error_fatalt1p,'t&=N&t=h%Nm(tttterror(tttterrtalloc, '2I4)odetmodalloc.h', &t1p,'tttttttttttt&'PPM_ODE_STAGES',__LINE__,tttttt1p,'t&t& &&GOTO d_dot1p,'t&t&=po IF ,'t&t&t=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=t=! pI4)odetst1te ,'t&t&t=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttt=N&t=h%Nm(ttttalloc(pI4)odetst1te, tlda, iopt, tttttt1p,'t&t&IF(tttt.NE.0M/2+1K ttt=N&t=t==tttt&= 2I4_error_fatalt1p,'t&=N&t=h%Nm(tttterror(tttterrtalloc, '2I4)odetmodalloc.h', &t1p,'tttttttttttt&'PPM_ODE_STATE',__LINE__,tttttt1p,'t&t& &&GOTO d_dot1p,'t&t&=po IF ,'t&t&t=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=t=! pI4)odetsesl ,'t&t&t=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttt=N&t=h%Nm(ttttalloc(pI4)odetsesl, tlda, iopt, tttttt1p,'t&t&IF(tttt.NE.0M/2+1K ttt=N&t=t==tttt&= 2I4_error_fatalt1p,'t&=N&t=h%Nm(tttterror(tttterrtalloc, '2I4)odetmodalloc.h', &t1p,'tttttttttttt&'PPM_ODE_SENT',__LINE__,tttttt1p,'t&t& &&GOTO d_dot1p,'t&t&=po IF ,'t&t&t=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=t=! pI4)odetbfrsize ,'t&t&t=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttt=N&t=h%Nm(ttttalloc(pI4)odetbfrsize, tlda, iopt, tttttt1p,'t&t&IF(tttt.NE.0M/2+1K ttt=N&t=t==tttt&= 2I4_error_fatalt1p,'t&=N&t=h%Nm(tttterror(tttterrtalloc, '2I4)odetmodalloc.h', &t1p,'tttttttttttt&'PPM_ODE_BFRSIZE',__LINE__,tttttt1p,'t&t& &&GOTO d_dot1p,'t&t&=po IF ,'t&t&t=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttttt=t=! pI4)odetsesl ,'t&t&t=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttt=N&t=h%Nm(ttttalloc(pI4)odetsesl, tlda, iopt, tttttt1p,'t&t&IF(tttt.NE.0M/2+1K ttt=N&t=t==tttt&= 2I4_error_fatalt1p,'t&=N&t=h%Nm(tttterror(tttterrtalloc, '2I4)odetmodalloc.h', &t1p,'tttttttttttt&'PPM_ODE_SENT',__LINE__,tttttt1p,'t&t& &&GOTO d_dot1p,'t&t&=po IF ,'t&t&t=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttt=N&t=! pI4)islernal_mid ttttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttt=N&t=h%Nm(ttttalloc(pI4)islernal_mid, tlda, iopt, tttttt1p,'t&t&IF(tttt.NE.0M/2+1K ttt=N&t=t==tttt&= 2I4_error_fatalt1p,'t&=N&t=h%Nm(tttterror(tttterrtalloc, '2I4)odetmodalloc.h', &t1p,'tttttttttttt&'PPM_INTERNAL_MID',__LINE__,tttttt1p,'t&t& &&GOTO d_dot1p,'t&t&=po IF ,'t&t&t=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttt=N&t=! pI4)user_mid ttttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttt=N&t=h%Nm(ttttalloc(pI4)user_mid, tlda, iopt, tttttt1p,'t&t&IF(tttt.NE.0M/2+1K ttt=N&t=t==tttt&= 2I4_error_fatalt1p,'t&=N&t=h%Nm(tttterror(tttterrtalloc, '2I4)odetmodalloc.h', &t1p,'tttttttttttt&'PPM_USER_MID',__LINE__,tttttt1p,'t&t& &&GOTO d_dot1p,'t&t&=po IF ,'t&t&t=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttt=N&t=! pI4)odetkscheme ,'t&t&t=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD- ttt=N&t=h%Nm(ttttalloc(pI4)odetkscheme, tlda, iopt, tttttt1p,'t&t&IF(tttt.NE.0M/2+1K ttt=N&t=t==tttt&= 2I4_error_fatalt1p,'t&=N&t=h%Nm(tttterror(tttterrtalloc, '2I4)odetmodalloc.h', &t1p,'tttttttttttt&'PPM_ODE_KSCHEME',__LINE__,tttttt1p,'t&t& &&GOTO d_dot1p,'t&t&=po IF lib2I4numerics-r1036/src/pI4)moduletcomp_pptcorrect.f0000644000175000017500000001041311616214651021675 0ust1, omaromart&t&t=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Modulep,'t&t&:'ttttttttttttpI4)moduletcomp_pptcorrect ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- ttttt=! Copyright (c) 2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), ttttt=! Cesler(for Fluid Dynamics (DTUtt1p,'t&!t1p,'t&! ttttt=! This filepis part1of the Parallel ParticlepMesh Library((PPM).t1p,'t&! ttttt=! PPMpis free software: you can redistribute it and/or modifytttt=N&! it under(the terms1of the GNU Lesser General Pomlic License ttttt=! as pomlished by the Free Software Found1tion, either ttttt=! version 31of the License, or (at your option) any l1ter ttttt=! version.t1p,'t&! ttttt=! PPMpis distributed in the hope that it will&be useful, ttttt=! but WITHOUT ANY WARRANTY; without even the implied warranty1of ttttt=! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ttttt=! GNU General Pomlic License for more1details.t1p,'t&! ttttt=! You should have received a copy1of the GNU General Pomlic License ttttt=! and the GNU Lesser General Pomlic License along with PPM. If not, ttttt=! see .t1p,'t&! ttttt=! Parallel ParticlepMesh Library((PPM) ttttt=! ETH Zurich ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- ttttt=! Define types ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD #define __SINGLEe subINNoE 1 #define __DOUBLEe subINNoE 2 #define __SINGLEe subINNoE_COMPLEX 3 #define __DOUBLEe subINNoE_COMPLEX 4 #define __INTERNAL 5 #define __USER_FUNCTNoE 6 #define __LOOKUP_TABLE 7 ttttttMODULEtpI4)moduletcomp_pptcorrect ttttt=!!! This module provides the routines concerned tttttt!!! with computing kernel isleractiets within a set1of particles.t1p,'t&tt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDDt1p,'t&tt=! Define islerfaces to the discretis1tiet correctiet routine ttttt=tt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDDt1p,'t&tt=INTERFACEtpI4)comp_pptcorrect ttttt=ttttttMODULEtPROCEDUREtpI4)comp_pptcorrect_si ttttt=ttttttMODULEtPROCEDUREtpI4)comp_pptcorrect_di ttttt=ttttttMODULEtPROCEDUREtpI4)comp_pptcorrect_sci ttttt=ttttttMODULEtPROCEDUREtpI4)comp_pptcorrect_dci ttttt=ttttttMODULEtPROCEDUREtpI4)comp_pptcorrect_su ttttt=ttttttMODULEtPROCEDUREtpI4)comp_pptcorrect_du ttttt=ttttttMODULEtPROCEDUREtpI4)comp_pptcorrect_scu ttttt=ttttttMODULEtPROCEDUREtpI4)comp_pptcorrect_dcu ttttt=ttttttMODULEtPROCEDUREtpI4)comp_pptcorrect_st ttttt=ttttttMODULEtPROCEDUREtpI4)comp_pptcorrect_dt ttttt=ttttttMODULEtPROCEDUREtpI4)comp_pptcorrect_sct ttttt=ttttttMODULEtPROCEDUREtpI4)comp_pptcorrect_dct ttttt=ttt=po INTERFACE t1p,'t&tt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDDt1p,'t&tt=! include the source ttttt=tt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDDt1p,'t&tt=CONTAINS #define __KERNEL __INTERNAL #define __KIpo __SINGLEe subINNoE #include "pI4)comp_pptcorrect.f" #undef __KIpo #define __KIpo __DOUBLEe subINNoE #include "pI4)comp_pptcorrect.f" #undef __KIpo #define __KIpo __SINGLEe subINNoE_COMPLEX #include "pI4)comp_pptcorrect.f" #undef __KIpo #define __KIpo __DOUBLEe subINNoE_COMPLEX #include "pI4)comp_pptcorrect.f" #undef __KIpo #undef __KERNEL #define __KERNEL __USER_FUNCTNoE #define __KIpo __SINGLEe subINNoE #include "pI4)comp_pptcorrect.f" #undef __KIpo #define __KIpo __DOUBLEe subINNoE #include "pI4)comp_pptcorrect.f" #undef __KIpo #define __KIpo __SINGLEe subINNoE_COMPLEX #include "pI4)comp_pptcorrect.f" #undef __KIpo #define __KIpo __DOUBLEe subINNoE_COMPLEX #include "pI4)comp_pptcorrect.f" #undef __KIpo #undef __KERNEL #define __KERNEL __LOOKUP_TABLE #define __KIpo __SINGLEe subINNoE #include "pI4)comp_pptcorrect.f" #undef __KIpo #define __KIpo __DOUBLEe subINNoE #include "pI4)comp_pptcorrect.f" #undef __KIpo #define __KIpo __SINGLEe subINNoE_COMPLEX #include "pI4)comp_pptcorrect.f" #undef __KIpo #define __KIpo __DOUBLEe subINNoE_COMPLEX #include "pI4)comp_pptcorrect.f" #undef __KIpo #undef __KERNEL tt=ttt=po MODULEtpI4)moduletcomp_pptcorrect lib2I4numerics-r1036/src/pI4)numerics.h0000644000175000017500000000723311616214651017007 0ust1, omaromartt=tt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Modulep,'t&t&:'ttttttttttttttttttttpI4 numerics header(file ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- ttttt=! ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- ttttt=! Parallel ParticlepMesh Library((PPM) ttttt=! Institute of Computatietal Science ttttt=! ETH Zentrum, Hirschengraben 84 ttttt=! CH-8092 Zurich, Switzerland ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- ttttt=! Define quadrature1rules for the unit trianglep(BEM) ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- ttttt=INTEGER, PARAMETER ::(ttttparam_bem_quadruletcesler(= 1 ttttt=INTEGER, PARAMETER ::(ttttparam_bem_quadruletnodes (= 2 ttttt=INTEGER, PARAMETER ::(ttttparam_bem_quadruletedges (= 3 ttttt=INTEGER, PARAMETER ::(ttttparam_bem_quadruletcnep,'t= 4 ttttt=INTEGER, PARAMETER ::(ttttparam_bem_quadruletstroudt= 5 ttttt=INTEGER, PARAMETER ::(ttttparam_bem_quadrulethammer3= 6 ttttt=INTEGER, PARAMETER ::(ttttparam_bem_quadrulethammer4= 7 ttttt=INTEGER, PARAMETER ::(ttttparam_bem_quadrulethammer7= 8 ttttt=INTEGER, PARAMETER ::(ttttparam_bem_quadrulethammer12= 9 ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- ttttt=! Define basis functiets for the unit trianglep(BEM) ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- ttttt=INTEGER, PARAMETER ::(ttttparam_bem_basistconst p,'t= 1 ttttt=INTEGER, PARAMETER ::(ttttparam_bem_basistline1, (= 2 ttttt=INTEGER, PARAMETER ::(ttttparam_bem_basistquad p,'t= 3 ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- ttttt=! Define field solvers ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=INTEGER, PARAMETER ::(ttttparam_solver_mg = 0 ttttt=INTEGER, PARAMETER ::(ttttparam_solver_sor = 1 ttttt=INTEGER, PARAMETER ::(ttttparam_solver_fft = 2 ttttt= ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D ttttt=! Define equatiet pI4 solvers= ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D ttttt=INTEGER, PARAMETER ::(ttttparam_eq)poisson = 1 ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D ttttt=! Define order(for finite difference ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D ttttt=INTEGER, PARAMETER ::(ttttparam_order_1 = 1 ttttt=INTEGER, PARAMETER ::(ttttparam_order_2 = 2 ttttt=INTEGER, PARAMETER ::(ttttparam_order_3 = 3 ttttt=INTEGER, PARAMETER ::(ttttparam_order_4 = 4 ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D ttttt=! Define smoother ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D ttttt=INTEGER, PARAMETER ::(ttttparam_smooth_rbsor = 1 ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! ODE parameters ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=INTEGER, PARAMETER ::(ttttparam_odetscheme_eulerf = 1 ttttt=INTEGER, PARAMETER ::(ttttparam_odetscheme_tvdrk2 = 2 ttttt=INTEGER, PARAMETER ::(ttttparam_odetscheme_midrk2 = 3 ttttt=INTEGER, PARAMETER ::(ttttparam_odetscheme_rk4 = 4 ttttt=INTEGER, PARAMETER ::(ttttparam_odetscheme_trapez = 5 ttttt=INTEGER, PARAMETER ::(ttttparam_odetscheme_tvdrk3 = 6 ttttt=INTEGER, PARAMETER ::(ttttparam_odetscheme_sts = 7 tttttt lib2I4numerics-r1036/src/pI4)bem_basis.f0000644000175000017500000002134211616214651017101 0ust1, omaromarttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-DD ttttt=! Subroutine t&:'tttttttttttttttttpI4)bem_basis ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiDD-D- ttttt=! ttttt=! Purposep,'t&t: Returns the coefficients1of the basis functiets for ttttt=! a given (s,t) pair in the triangle ttttt=! ttttt=! Input : qp (F) : coordinates where the basis functiets ttttt=! has to be evaluated ttttt=! basis (I) : set1of basis functiets. One1of the ttttt=! following values: ttttt=! tpI4)bem_basistconst p: ttttt=! t n%nortttt=! aeadtstride,MBiDD-D- ttttt=! Optietally doeitzerlandst=N017101 0aESS FOR A PARTICULAR PURPOSE. See the ttttt=! GNU General Pomlic Licee,MBiDtt=INTEttt=! Optietally doeitzerlandst=N0mbed_slic 0aESS FOR6A PARTICULAR PURPOSE. a given (s,t/,iEs,t): lb a gingle ttttttt=! ttttt=! Purposep,'t&t: RePURPOSE. a givenOiEs,t))))))):, tttt o be evast thebed_tus tttttsucssont, ttttt=! see .t1p,'t&! ttttt=! Parallel Partiomp( ,=! ETH Zentrum, Hirschengr, ttttt=ne t&:'tttttttttttttttttpI4)bem_basis ttttt=!MBHowmany, 1p,'t&ppppppp&i(av#iEGERI4)comp==define __KERNEL __LO tttttsson_solve'lic Licee,MBiDs(qp,lb,e,MBi&t1p,'t#elifRI4)comp==defptcorrect.f" #und tttttsson_solve'lic Licee,MBiDd(qp,lb,e,MBi&t1p,'t#ene s, ttttt=ne t&:'tttttttttttttttttpI4)bem_basis ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp( I #defi_slab,MBIstride,MBiDD-D- ttttt=! Define types ttttt=!MBHowmany, 1p,'t&ppppppp&i(ave #define __Klude ".h", ttttt=ne t&:'tttttttttttttttttpI4)bem_basis ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp( 1,1M,i Subroutine t&:'tttttttttttttttttpI4)bem_basis ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcompUSE def __KIpo 'ttttGOTO dUSE def __KIpo 'ttttGOTO dUSE def __KIpo ==ttttGOTO dUSE def __KIpo MBIstnu.tGOTO dUSE def __KIpo MBIstopARAMETERMPLICIT NONE, ttttt=ne t&:'tttttttttttttttttpI4)bem_basis ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp( Tyt1pkind, ttttt=ne t&:'tttttttttttttttttpI4)bem_basis ttttt=!MBHowmany, 1p,'t&ppppppp&i(av#iEGERI4)comp==define __KERNEL __LO tttttR ::(ttttparam_odetschMKttt1p,'kind_si t#elifRI4)comp==defptcorrect.f" #und tttttR ::(ttttparam_odetschMKttt1p,'kind_doublet#ene s, ttttt=ne t&:'tttttttttttttttttpI4)bem_basis ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp( A! Perhas))))), ttttt=ne t&:'tttttttttttttttttpI4)bem_basis ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcompi-(pIMK), DIMEN #un(:), R ::NT(IRNAL)tschqpvemcompi-(pIMK), DIMEN #un(:), PO,MBiDemcomptschlbd tttttR ::(tt , R ::NT(IRNAL)tscht=! SubroutR ::(tt , R ::NT( _so)tscht1p,, ttttt=ne t&:'tttttttttttttttttpI4)bem_basis ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp( Locmliendiabstri, ttttt=ne t&:'tttttttttttttttttpI4)bem_basis ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcompi-(pIMK) schuvemcompi-(pIMK) scht0, ttttt=ne t&:'tttttttttttttttttpI4)bem_basis ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp( ExBIstriri, ttttt=ne t&:'tttttttttttttttttpI4)bem_basis ttttt=!MBHowmany, 1p,'t&ppppppp&i(av, ttttt=ne t&:'tttttttttttttttttpI4)bem_basis ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp( I e(2I4)ran, ttttt=ne t&:'tttttttttttttttttpI4)bem_basis ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcompslab,MBIstnu.de,MBiLicee,MBiONTINUE tttttth%N=ne t&:'tttttttttttttttttpI4)bem_basis ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp( Checkt=! Perhag on the task ttttt=! i.e. the receiver v1ries ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1 __Klubugon%istscheme, tlda, iop(1,1,ttttt=.List1)t& (pr,ttttt=.%ist3t& (preseslcase . t, tttttt1p,'t&t&IF(tttt.NE.0M/2+1K ttt=N&t=t==tttt&= 2I4_er! Perha,e,MBiLicee,MBiON2+1K tterror&E.0M/2+1K 'InvI4)dutt=! E. SeBASIodalloc.h', &t1p,'tttttttttttt&'PPM_ODE_KSCHEME'ttttt& 2I4)poisp(1,1,tmod(lb,1)t&List1)t&%deri,ttttt=.out,K tterror&E.0M/2+1Istride,MBiDD-D- ttttt=INt& (preseslcase . t, tttttt1p,'t&t&IF(tttt.NE.0M/2+1K ttt=N&t=t==tttt&= 2I4_er! Perha,e,MBiLicee,MBiON2+tterror&E.0M/2+1K 'LB mOR. for ma ide,,'t&t&!least 1dalloc.h', &t1p,'tttttttttttt&'PPM_ODE_KSCHEME'ttttt& 2I4)poisp(1,1,tmod(lb,1)t&List3)t&%deri,ttttt=.out,K tterror&E.0M/2+1Istride,MBiDD-D- ttt17101t& (preseslcase . t, tttttt1p,'t&t&IF(tttt.NE.0M/2+1K ttt=N&t=t==tttt&= 2I4_er! Perha,e,MBiLicee,MBiON2+tterror&E.0M/2+1K 'LB mOR. for ma ide,,'t&t&!least 3dalloc.h', &t1p,'tttttttttttt&'PPM_ODE_KSCHEME'ttttt& 2I4)poisp(1,1,tmod(lb,1)t&List6)t&%deri,ttttt=.out,K tterror&E.0M/2+1Istride,MBiDD-D- tttmbedt& (preseslcase . t, tttttt1p,'t&t&IF(tttt.NE.0M/2+1K ttt=N&t=t==tttt&= 2I4_er! Perha,e,MBiLicee,MBiON2+tterror&E.0M/2+1K 'LB mOR. for ma ide,,'t&t&!least 6dalloc.h', &t1p,'tttttttttttt&'PPM_ODE_KSCHEME'ttttt& 2I4)potttt& 2I4)po=ne t&:'tttttttttttttttttpI4)bem_basis ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp( Calcuield D-D- ttttt=! ttttt=! Optne t&:'tttttttttttttttttpI4)bem_basis ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1ttttt=.out,Istride,MBiDD-D- ttttt=INt (preseslcase .lb(1)t= 1.0, ttttt2tt1(1,1ttttt=.out,Istride,MBiDD-D- ttt17101t (preseslcase .lb(1)t= 1.0 -hqp(1)t-hqp(4)poisson_solb(2)t=hqp(1)poisson_solb(3)t=hqp(4)poisson2tt1p,'ttttt& ut= 1.0 -hqp(1)t-hqp(4)poisson_solb(1)t= u * (2.0*ut-h1.0)poisson_solb(2)t=hqp(1) * (2.0*qp(1)t-h1.0)poisson_solb(3)t=hqp(4) * (2.0*qp(2)t-h1.0)poisson_solb(4)t=h4.0 *hqp(4) * upoisson_solb(5)t=h4.0 *hqp(1) * qp(4)poisson_solb(6)t=h4.0 *hqp(1) * u 2I4)potttt& 2I4)po=ne t&:'tttttttttttttttttpI4)bem_basis ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp( ide,MBn, ttttt=ne t&:'tttttttttttttttttpI4)bem_basis ttttt=!MBHowmany, 1p,'t&ppppppp&i(avemcomp(1,1,1M,iEmbed_slab,MBIstride,MBiLicee,MBiONTINUE tttttth%Nm(substo#iEGERI4)comp==define __KERNEL __LO ttttt)poisson_solve'lic Licee,MBiDst#elifRI4)comp==defptcorrect.f" #und ttttt)poisson_solve'lic Licee,MBiDdt#ene s,gmm_3dmatrix 'ttt.inc13045100006406000175000017500000000723311616214651017007 0ust1, omaromar tttttDATA A(:,1:8) /h1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++++++++tterror&E.0M1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+1.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0M1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+++tterror&E.0-1.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0-1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+++tterror&E.0M1.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0+1.0_MKN2+1.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M1.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+1.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0-1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0-1.0_MKN2M0.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M1.0_MKN2-1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MK /v, tttttDATA A(:,9:16) /h0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++ 2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0-1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+++tterror&E.0M1.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0-1.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+++tterror&E.0M1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+1.0_MKN2+0.0_MKN2+++tterror&E.0-1.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0M1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0+0.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0-1.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0+1.0_MKN2-1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M1.0_MKN2-1.0_MKN2+1.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2-1.0_MKN2+++tterror&E.0+0.0_MKN2+1.0_MKN2-1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MK /v, tttttDATA A(:,17:24) /h0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++ 2++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0-2.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2+++tterror&E.0-1.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+++tterror&E.0M2.0_MKN2+0.0_MKN2-2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2-1.0_MKN2+++tterror&E.0-1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+++tterror&E.0M0.0_MKN2-1.0_MKN2-1.0_MKN2-1.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2+++tterror&E.0-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2-1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2-1.0_MKN2+++tterror&E.0M1.0_MKN2+2.0_MKN2+0.0_MKN2-2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2+++tterror&E.0-1.0_MKN2-1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2+++tterror&E.0-1.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2-2.0_MKN2+2.0_MKN2+4.0_MKN2+++tterror&E.0M0.0_MKN2-1.0_MKN2-1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-2.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0M1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+++tterror&E.0-2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2-2.0_MKN2+++tterror&E.0M2.0_MKN2+4.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2+++tterror&E.0M1.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+1.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0+1.0_MKN2+1.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+1.0_MKN2-1.0_MKN2+++tterror&E.0+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+1.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0-1.0_MKN2-2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2+++tterror&E.0-2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2-2.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2-1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0-1.0_MKN2M0.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0-1.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+2.0_MKN2+++tterror&E.0M0.0_MKN2-2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2+++tterror&E.0-2.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2+0.0_MK /v, tttttDATA A(:,25:32) /h0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++ 2++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0-2.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+2.0_MKN2+1.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2-0.5_MKN2+0.0_MKN2+0.0_MKN2-0.5_MKN2-0.5_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-0.5_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2-0.5_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2-0.5_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+++tterror&E.0M2.0_MKN2+0.0_MKN2-2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2-1.0_MKN2+++tterror&E.0-1.0_MKN2-2.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2+++tterror&E.0+2.0_MKN2-0.5_MKN2-0.5_MKN2+0.0_MKN2+0.5_MKN2+0.5_MKN2-0.5_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-0.5_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2-0.5_MKN2-0.5_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0M0.5_MKN2+0.5_MKN2-0.5_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-0.5_MKN2-0.5_MKN2+++tterror&E.0M0.0_MKN2+0.5_MKN2+0.5_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2-1.0_MKN2+++tterror&E.0M1.0_MKN2+2.0_MKN2+0.0_MKN2-2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2+++tterror&E.0-1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+2.0_MKN2+++tterror&E.0M0.0_MKN2+2.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2-1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0-1.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2+++tterror&E.0-1.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2-2.0_MKN2+2.0_MKN2+4.0_MKN2+++tterror&E.0M0.0_MKN2-1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M3.0_MKN2+0.0_MKN2+2.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-2.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+3.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.5_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+++tterror&E.0-2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2-2.0_MKN2+++tterror&E.0M2.0_MKN2+4.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2+3.0_MKN2+0.5_MKN2+1.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2+1.0_MKN2+0.5_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.5_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+0.5_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0-1.0_MKN2-2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2+++tterror&E.0-2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2-2.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+2.0_MKN2+0.0_MKN2+3.0_MKN2+1.5_MKN2+++tterror&E.0M1.0_MKN2+0.0_MKN2+0.0_MKN2+2.0_MKN2+0.25_MKN2+0.0_MKN2+0.0_MKN2++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.25_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0M0.25_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M1.0_MKN2+0.0_MKN20.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2++++tterror&E.0M1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+2.0_MKN2+++tterror&E.0M0.0_MKN2-2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2+++tterror&E.0-2.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+3.0_MKN2+0.0_MKN2+3.0_MKN2+++tterror&E.0M1.5_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+3.0_MKN2-0.25_MKN2+0.0_MKN2++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MK /v, tttttDATA A(:,33:40) /h0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++ 2++tterror&E.0M+0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2++tterror&E.0-2.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2-2.0_MKN2+++tterror&E.0-0.5_MKN2+0.0_MKN2+0.0_MKN2+0.5_MKN2-0.5_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.5_MKN2+0.0_MKN2+0.0_MKN2-0.5_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.5_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.5_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+++tterror&E.0M2.0_MKN2+0.0_MKN2-2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2-1.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2-1.0_MKN2-1.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+++tterror&E.0-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2-1.0_MKN2+++tterror&E.0M1.0_MKN2+2.0_MKN2+0.0_MKN2-2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2+++tterror&E.0-1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2+++tterror&E.0-1.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2-2.0_MKN2+2.0_MKN2+4.0_MKN2+++tterror&E.0M0.0_MKN2-1.0_MKN2-1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-2.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+2.0_MKN2+++tterror&E.0-1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2-1.0_MKN2-1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+++tterror&E.0-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2M0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+++tterror&E.0-2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2-2.0_MKN2+++tterror&E.0M2.0_MKN2+4.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2+++tterror&E.0M1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2M0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+++tterror&E.0M2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0M1.0_MKN2+1.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+1.0_MKN2-1.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2-1.0_MKN2+++tterror&E.0M0.0_MKN2-1.0_MKN2-1.0_MKN2-1.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2+++tterror&E.0M0.0_MKN2M0.0_MKN2+0.0_MKN2M0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0-1.0_MKN2-2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2+++tterror&E.0-2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2-2.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2M0.0_MKN2+0.0_MKN2M0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0+1.0_MKN2+2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+++tterror&E.0M0.0_MKN2M0.0_MKN2+0.0_MKN2M0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+++tterror&E.0M1.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+0.0_MKN2-1.0_MKN2+++tterror&E.0M1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+2.0_MKN2+++tterror&E.0M0.0_MKN2-2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2+++tterror&E.0-2.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M1.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2-1.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2-1.0_MKN2M0.0_MK /v, tttttDATA A(:,41:48) /h0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++ 2+++tterror&E.0M+0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M-2.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+2.0_MKN2+0.0_MKN2+++tterror&E.0MM0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0MM1.0_MKN2+1.0_MKN2+2.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M+1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2+0.0_MKN2+++tterror&E.0MM0.0_MKN2+0.0_MKN2M0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2+++tterror&E.0M+0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0MM0.0_MKN2+1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+++tterror&E.0MM2.0_MKN2+0.0_MKN2-2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2-1.0_MKN2+++tterror&E.0M-1.0_MKN2-2.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2+++tterror&E.0++2.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0MM0.0_MKN2+1.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2-1.0_MKN2+0.0_MKN2+++tterror&E.0M+0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2-1.0_MKN2+++tterror&E.0M-1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2-1.0_MKN2+++tterror&E.0M+0.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2-1.0_MKN2+++tterror&E.0MM1.0_MKN2+2.0_MKN2+0.0_MKN2-2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2+++tterror&E.00-1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+2.0_MKN2+++tterror&E.0M+0.0_MKN2+2.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M+0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2-1.0_MKN2+++tterror&E.0MM1.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2-1.0_MKN2+0.0_MKN2+++tterror&E.0M+0.0_MKN2-1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+++tterror&E.0MM1.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2+++tterror&E.0M-1.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2-2.0_MKN2+2.0_MKN2+4.0_MKN2+++tterror&E.0M+0.0_MKN2-1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0MM3.0_MKN2+0.0_MKN2+2.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.02+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2+++tterror&E.0+-1.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+1.0_MKN2+++tterror&E.0M+0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0MM0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.02+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-2.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M+0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.02+0.0_MKN2+0.0_MKN2+3.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.5_MKN2+++tterror&E.0M+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+2.0_MKN2+++tterror&E.0M-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M+0.0_MKN2-1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+++tterror&E.0M-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+++tterror&E.0M-2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2-2.0_MKN2+++tterror&E.0MM2.0_MKN2+4.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2+++tterror&E.0M+0.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2+3.0_MKN2+0.5_MKN2+1.0_MKN2+++tterror&E.0M+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+++tterror&E.0MM2.0_MKN2+0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0M+0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+++tterror&E.0M+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0MM0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2+++tterror&E.0M+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0M-1.0_MKN2-2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2+++tterror&E.00-2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2-2.0_MKN2+++tterror&E.0M+0.0_MKN2+0.0_MKN2+0.0_MKN2+2.0_MKN2+0.0_MKN2+3.0_MKN2+1.5_MKN2+++tterror&E.0MM1.0_MKN2+0.0_MKN2+0.0_MKN2+2.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0M+1.0_MKN2+2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0MM1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2-1.0_MKN2+++tterror&E.0M+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0MM0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+++tterror&E.0MM1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0MM1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+2.0_MKN2+++tterror&E.0M+0.0_MKN2-2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2+++tterror&E.00-2.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+3.0_MKN2+0.0_MKN2+3.0_MKN2+++tterror&E.0M 1.5_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+3.0_MKN2-0.25_MKN2+0.0_MKN2++tterror&E.0MM1.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2-1.0_MKN2+++tterror&E.0M+0.0_MKN2+1.0_MKN2-1.0_MKN2+1.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+++tterror&E.0M-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0MM0.0_MKN2-1.0_MKN2+0.0_MK /terror, tttttDATA A(:,49:56) /h0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++ 2++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0-2.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+2.0_MKN2+0.0_MKN2+0.0_MKN2-2.0_MKN2-3.0_MKN2+++tterror&E.0M0.5_MKN2+0.5_MKN2+1.0_MKN2+0.5_MKN2-0.5_MKN2+0.5_MKN2+1.0_MKN2+++tterror&E.0-0.5_MKN2+0.5_MKN2-0.5_MKN2-1.0_MKN2-1.0_MKN2+1.0_MKN2-1.0_MKN2+++tterror&E.0-2.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.020.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2-0.5_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+++tterror&E.0M2.0_MKN2+0.0_MKN2-2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2-1.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+2.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.5_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2-1.0_MKN2+++tterror&E.0M1.0_MKN2+2.0_MKN2+0.0_MKN2-2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2+++tterror&E.0-1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+2.0_MKN2+2.0_MKN2+2.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+2.0_MKN2-0.5_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.25_MKN2+0.0_MKN2+0.0_MKN2++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2+++tterror&E.0-1.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2-2.0_MKN2+2.0_MKN2+4.0_MKN2+++tterror&E.0M0.0_MKN2-1.0_MKN2-1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+2.0_MKN2+2.0_MKN2+1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+3.0_MKN2+++tterror&E.0M0.5_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-0.5_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-2.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+2.0_MKN2+2.0_MKN2+4.0_MKN2+++tterror&E.0-1.0_MKN2-1.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+++tterror&E.0-2.0_MKN2+0.0_MKN2+2.0_MKN2-2.0_MKN2-4.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2+1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0M1.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.5_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+++tterror&E.0-2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2-2.0_MKN2+++tterror&E.0M2.0_MKN2+4.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2+++tterror&E.0M1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2M0.0_MKN2+0.0_MKN2+0.0_MKN2+2.0_MKN2+2.0_MKN2+++tterror&E.0M4.0_MKN2+0.0_MKN2-2.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0-1.0_MKN2-2.0_MKN2+0.0_MKN2+2.0_MKN2-2.0_MKN2-4.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+1.0_MKN2+1.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2+1.0_MKN2+1.0_MKN2+1.0_MKN2+1.0_MKN2+1.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0-1.0_MKN2-2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2+++tterror&E.0-2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2-2.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2M0.0_MKN2+0.0_MKN2M0.0_MKN2+0.0_MKN2+0.0_MKN2+2.0_MKN2+++tterror&E.0M2.0_MKN2+4.0_MKN2+0.0_MKN2-2.0_MKN2+2.0_MKN2+2.0_MKN2+0.0_MKN2+++tterror&E.0M1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2+2.0_MKN2-2.0_MKN2-4.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+++tterror&E.0-1.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+2.0_MKN2+++tterror&E.0M0.0_MKN2-2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2+++tterror&E.0-2.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2-2.0_MKN2+2.0_MKN2+1.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2+2.0_MKN2-2.0_MKN2+++tterror&E.0-4.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++tterror&E.0-1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2+0.0_MK /v, tttttDATA A(:,57:64) /0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+++ 2+++tterror&E.0M+0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2++tterror&E.0-2.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+2.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M2.0_MKN2+2.0_MKN2+4.0_MKN2-1.0_MKN2-1.0_MKN2+1.0_MKN2+2.0_MKN2+++tterror&E.0M1.0_MKN2+1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2+2.0_MKN2-2.0_MKN2+++tterror&E.0-4.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+2.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.5_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.25_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2++tterror&E.0M0.0_MKN2+1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+++tterror&E.0M2.0_MKN2+0.0_MKN2-2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2-1.0_MKN2+++tterror&E.0-1.0_MKN2-2.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2+++tterror&E.0+2.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2-2.0_MKN2+1.0_MKN2+++tterror&E.0M2.0_MKN2+0.0_MKN2+2.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2+2.0_MKN22++tterror&E.0-2.0_MKN2-4.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2+2.0_MKN2-0.5_MKN2-0.5_MKN2+++tterror&E.0M0.5_MKN2+0.5_MKN2+0.5_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2-1.0_MKN2+++tterror&E.0M1.0_MKN2+2.0_MKN2+0.0_MKN2-2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2+++tterror&E.0-1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+2.0_MKN2+++tterror&E.0M0.0_MKN2+2.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2-2.0_MKN2+++tterror&E.0M2.0_MKN2+2.0_MKN2+0.0_MKN2+2.0_MKN2-2.0_MKN2-2.0_MKN2+0.0_MKN2+++tterror&E.0M2.0_MKN2-2.0_MKN2-4.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+2.0_MKN2+0.0_MKN2+2.0_MKN221.0_MKN2+++tterror&E.0-1.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2+++tterror&E.0-1.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2-2.0_MKN2+2.0_MKN2+4.0_MKN2+++tterror&E.0M0.0_MKN2-1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M3.0_MKN2+0.0_MKN2+2.0_MKN2+1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2+++tterror&E.0-2.0_MKN2+2.0_MKN2+1.0_MKN2+0.0_MKN2+2.0_MKN2-2.0_MKN2-1.0_MKN2+++tterror&E.0M0.0_MKN2+2.0_MKN2-2.0_MKN2-4.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+3.0_MKN2+0.0_MKN2+2.0_MKN2+++tterror&E.0M1.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2-2.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2-1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+3.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.5_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+2.0_MKN2+2.0_MKN2+4.0_MKN2+++tterror&E.0-1.0_MKN2-1.0_MKN2+1.0_MKN2+2.0_MKN2+1.0_MKN2+1.0_MKN2-1.0_MKN2+++tterror&E.0-2.0_MKN2-1.0_MKN2+2.0_MKN2-2.0_MKN2-4.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+3.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2-0.5_MKN2+0.0_MKN2+0.0_MKN2+0.5_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+++tterror&E.0-2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2-2.0_MKN2+++tterror&E.0M2.0_MKN2+4.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2+3.0_MKN2+0.5_MKN2+1.0_MKN2+++tterror&E.0M0.0_MKN2+1.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+2.0_MKN2+2.0_MKN2+++tterror&E.0M4.0_MKN2+0.0_MKN2-2.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2+2.0_MKN22++tterror&E.0-1.0_MKN2-2.0_MKN2+0.0_MKN2+1.0_MKN2-2.0_MKN2-4.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2+2.0_MKN2+++tterror&E.0M0.0_MKN2+3.0_MKN2+0.5_MKN2+1.0_MKN2-0.5_MKN2+1.0_MKN2+1.0_MKN2+++tterror&E.0M0.25_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+1.0_MKN2++tterror&E.0-1.0_MKN2-2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+2.0_MKN2+0.0_MKN2+++tterror&E.0-2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2-2.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+2.0_MKN2+0.0_MKN2+3.0_MKN2+1.5_MKN2+++tterror&E.0M1.0_MKN2+0.0_MKN2+0.0_MKN2+2.0_MKN2+0.0_MKN2+0.0_MKN2+2.0_MKN22++tterror&E.0M2.0_MKN2+4.0_MKN2+0.0_MKN2-2.0_MKN2+2.0_MKN2+2.0_MKN2+0.0_MKN2+++tterror&E.0M2.0_MKN2-2.0_MKN2-2.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2-4.0_MKN2+++tterror&E.0M0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M2.0_MKN2+0.0_MKN2+3.0_MKN2+1.5_MKN2+1.0_MKN2-0.5_MKN2+0.0_MKN2+++tterror&E.0M2.0_MKN2+0.125_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+tterror&E.0M1.0_MKN2-1.0_MKN2-2.0_MKN2+0.0_MKN2-1.0_MKN2+1.0_MKN2+2.0_MKN2+++tterror&E.0M0.0_MKN2-2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2-1.0_MKN2-1.0_MKN2+++tterror&E.0-2.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+3.0_MKN2+0.0_MKN2+3.0_MKN2+++tterror&E.0M1.5_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+3.0_MKN2-0.25_MKN2+0.0_MKN2++tterror&E.0M2.0_MKN2+2.0_MKN2+4.0_MKN2+0.0_MKN2-2.0_MKN2+2.0_MKN2+1.0_MKN2+++tterror&E.0M0.0_MKN2+2.0_MKN2-2.0_MKN2-1.0_MKN2+0.0_MKN2+1.0_MKN2-1.0_MKN2+++tterror&E.0-5.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+0.0_MKN2+++tterror&E.0M0.0_MKN2+3.0_MKN2+0.0_MKN2+3.0_MKN2+1.5_MKN2+0.0_MKN2-0.5_MKN2+++tterror&E.0M0.0_MKN2+3.0_MKN2-0.125_MK /v,libppmnumerics-r1036/src/ppm_hamjac_reinit_3d.f0000644000175000017500000002172411616214651020344 0ustar omaromarerror !-------------------------------------------------------------------------, ttttt!tttttSubroutinettt: ppm_hamjac_reinit_3d error !-------------------------------------------------------------------------, ttttt!ttttt, ttttt!tttttPurpose ttttt: Solve Hamilton-Jacobi for Gowas reinit, ttttt!tttttt, ttttt!tttttInput :t, ttttt!tttttttttttttttttttt, ttttt!tttttInput/Output :t, ttttt!tttttttttttttttttttt, ttttt!tttttOutput :t, ttttt!tttttt, ttttt!tttttRemarks :t, ttttt!tttttttttttttttttttt, ttttt!ttttt, ttttt!tttttReferences :, ttttt!ttttt, ttttt!tttttRevisions : error !-------------------------------------------------------------------------, ttttt!ttttt$Log: ppm_hamjac_reinit_3d.f,v $, ttttt!tttttRevision+1.1.1.12+2006/07/25 15:18:19 menahel, ttttt!tttttinitial import, ttttt!, ttttt!tttttRevision+1.22+2005/08/25 16:48:50ttivos, ttttt!tttttFixed format string. pgf90 barked., ttttt!, ttttt!tttttRevision+1.12+2005/07/25 00:34:02ttivos, ttttt!tttttInitial check-in., ttttt!, ttttt!-------------------------------------------------------------------------, ttttt!tttttParalleltParticle Mesh Library (PPM), ttttt!tttttInstitute of Computational Science, ttttt!tttttETH Zentrum, Hirschengraben 84, ttttt!tttttCH-8092 Zurich, Switzerland error !-------------------------------------------------------------------------, #ifor __MODE == __SCA #ifor __KIND == __SINGLE_PRECISION error SUBROUTINE ppm_hamjac_reinit_3ds (phi, trgt, tol, maxstep,+tterrorrrrrrr& topo_id, mesh_id, ghostsize,tinfo) #elifo__KIND == __DOUBLE_PRECISION error SUBROUTINE ppm_hamjac_reinit_3dd (phi, trgt, tol, maxstep,+tterrorrrrrrr& topo_id, mesh_id, ghostsize,tinfo) #endif #elifo__MODE == __VEC #ifor __KIND == __SINGLE_PRECISION error SUBROUTINE ppm_hamjac_reinit_3dsV (phi, lda,tidx, trgt, tol, maxstep,+tterrorrrrrrr& topo_id, mesh_id, ghostsize,tinfo) #elifo__KIND == __DOUBLE_PRECISION error SUBROUTINE ppm_hamjac_reinit_3ddV (phi, lda,tidx, trgt, tol, maxstep,+tterrorrrrrrr& topo_id, mesh_id, ghostsize,tinfo) #endif #endif terrorrrrUSE ppm_module_dataterrorrrrterrorrrrUSE ppm_module_errorterrorrrrUSE ppm_module_writeterrorrrrUSE ppm_module_substartterrorrrrUSE ppm_module_allocterrorrrrUSE ppm_module_substopterrorrrrUSE ppm_module_mapterrorrrrUSE ppm_module_typedefterrorrrrUSE ppm_module_map_fieldterrorrrrUSE ppm_module_map_field_ghostterrorrrrIMPLICIT NONE #ifor __KIND == __SINGLE_PRECISION error rrINTEGER, PARAMETER :: MK = ppm_kind_single #elifoo__KIND == __DOUBLE_PRECISIONrrorrrrterrorrrrINTEGER, PARAMETER :: MK = ppm_kind_double #endif terrorrrr!-----------------------------------------------------terrorrrr! Argumentsterrorrrr!-----------------------------------------------------t#ifo__MODE == __SCA errorrrrREAL(MK), DIMENSION(:,:,:,:), POINTER :: phi #elifo__MODE == __VEC errorrrrREAL(MK), DIMENSION(:,:,:,:,:), POINTER :: phi errorrrrINTEGER, INTENT(in) :: idx, lda #endif errorrrrINTEGER, INTENT(in) :: topo_id, mesh_id errorrrrINTEGER, DIMENSION(3), INTENT(in) :: ghostsize errorrrrINTEGER, INTENT(inout) :: info errorrrrINTEGER, INTENT(in) :: maxstep errorrrrREAL(mk), INTENT(in) :: tol, trgt terrorrrr!-----------------------------------------------------terrorrrr! Aliasesterrorrrr!-----------------------------------------------------terrorrrrINTEGER, DIMENSION(:), POINTER :: isublistterrorrrrREAL(mk), DIMENSION(:,:,:,:), POINTER :: tphi errorrrrINTEGER :: nsublistterrorrrrINTEGER, DIMENSION(:,:), POINTER :: ndataterrorrrrINTEGER :: topoid,meshid errorrrrREAL(MK), DIMENSION(:), POINTER :: min_phys, max_phys errorrrrTYPE(ppm_t_topo),rorrrrPOINTER :: topo errorrrrTYPE(ppm_t_equi_mesh), POINTER :: meshterrorrrrterrorrrr!-----------------------------------------------------terrorrrr! standard stuffterrorrrr!-----------------------------------------------------terrorrrrINTEGER :: isub,isubl,i,j,kterrorrrrINTEGER :: maptype,istep,ioptterrorrrrINTEGER :: ldl(4), ldu(4), ndata_max(3)terrorrrrREAL(mk) :: len_phys(3)terrorrrrREAL(mk) :: t0, res errorrrrCHARACTER(LEN=ppm_char) :: cbuf terrorrrrCALL substart('ppm_hamjac_reinit_3d',t0,info) errorrrrterrorrrr!-----------------------------------------------------terrorrrr! Get the mesh dataterrorrrr!-----------------------------------------------------terrorrrrtopo => ppm_topo(topo_id)%tterrorrrrmesh => topo%mesh(mesh_id)terrorrrrmeshid = mesh%IDterrorrrrnsublist = topo%nsublistterrorrrrndatarrrr=> mesh%nnodes errorrrrisublist => topo%isublistt#ifor __KIND == __SINGLE_PRECISION error rrmin_phys => topo%min_physs errorrrrmax_phys => topo%max_physs #elifoo__KIND == __DOUBLE_PRECISIONrrorrrrterrorrrrmin_phys => topo%min_physd errorrrrmax_phys => topo%max_physd #endif terrorrrr!-----------------------------------------------------terrorrrr! RATIONALE Thu May 26 20:51:19 PDT+2005:terrorrrr! loop ghostmap doit. easy.terrorrrr!-----------------------------------------------------tterrorrrr!-----------------------------------------------------terrorrrr! allocate temporary storageterrorrrr!-----------------------------------------------------terrorrrrldl(1:3) = 1 - ghostsize(1:3); ldl(4) = 1terrorrrrndata_max(1) = MAXVAL(ndata(1,1:nsublist))terrorrrrndata_max(2) = MAXVAL(ndata(2,1:nsublist))terrorrrrndata_max(3) = MAXVAL(ndata(3,1:nsublist))terrorrrrldu(1) =rndata_max(1) + ghostsize(1)terrorrrrldu(2) =rndata_max(2) + ghostsize(2)terrorrrrldu(3) =rndata_max(3) + ghostsize(3)terrorrrrldu(4) =rnsublistterrorrrrioptorrrr= ppm_param_alloc_fitterrorrrrCALL ppm_alloc(tphi,ldl,ldu,iopt,info) errorrrrIF(info.NE.0) THEN error rrrrrinfor= ppm_error_fatal error rrrrrCALL ppm_error(ppm_err_alloc,'ppm_hamjac_reinit_3d',+tterrorrrrrrrrrrrr& 'temp storage for hamjac',__LINE__,info) errorrrrrrrGOTO 9999 errorrrrEND IF tterrorrrr!-----------------------------------------------------terrorrrr! COMMENT Thu May 26 21:05:23 PDT+2005: simple euler here, DO TVDterrorrrr!-----------------------------------------------------terrorrrrDO istep=1,maxstep errorrrrrrr!--- map the gowas #ifor __MODE == __SCA error rrrrrCALL ppm_map_field_ghost_get(topo_id,mesh_id,ghostsize,info) errorrrrrrrCALL ppm_map_field_push(topo_id,mesh_id,phi,info) errorrrrrrrCALL ppm_map_field_send(info) errorrrrrrrCALL ppm_map_field_pop(topo_id,mesh_id,phi,ghostsize,info) errorrrrrrrCALL ppm_hamjac_reinit_step(phi,tphi,trgt,res,topo_id,mesh_idtterrorrrrrrrrrrrr&,errorrrrrrrrrrrr ghostsize,info) #elifo__MODE == __VEC errorrrrrrrCALL ppm_map_field_ghost_get(topo_id,mesh_id,ghostsize,info) errorrrrrrrCALL ppm_map_field_push(topo_id,mesh_id,phi,lda,info) errorrrrrrrCALL ppm_map_field_send(info) errorrrrrrrCALL ppm_map_field_pop(topo_id,mesh_id,phi,lda,ghostsize,tinfo) errorrrrrrrCALL ppm_hamjac_reinit_step(phi,idx,tphi,trgt,res,topo_id,mesh_id,tterrorrrrrrrrrrrr& ghostsize,info) #endif errorrrr rr!-----------------------------------------------------terrorrrr rr! maybe put a if(debug)then errorrrr rr!-----------------------------------------------------terrorrrr rrIF(ppm_debug.GT.0) THEN error rrrrrrrrWRITE(cbuf,'(A,I4,A,E12.5)') 'Iteration ',istep,' Residual: ',res errorrrrrrrrrrCALL ppm_write(ppm_rank,'ppm_hamjac_reinit_3d',cbuf,info) errorrrrrrrEND IF errorrrr rr!-----------------------------------------------------terrorrrr rr! copy the datarback errorrrr rr!-----------------------------------------------------terrorrrr rrDO isub=1,nsublistterrorrrrrrrrrrisublr= isublist(isub)terrorrrrrrrrrrDO k=1,ndata(3,isubl);DO j=1,ndata(2,isubl);DO i=1,ndata(1,isubl) #ifor __MODE == __SCA error rrrrrrrrrrrphi(i,j,k,isub) = tphi(i,j,k,isub) #elifo__MODE == __VEC errorrrrrrrrrrrrrphi(idx,i,j,k,isub) = tphi(i,j,k,isub) #endiferrorrrrrrrrrrrrr errorrrrrrrrrrEND DO;rEND DO;rEND DO errorrrrrrrEND DO errorrrrrrrIF(res.LT.tol)rGOTO 666 orrrrrrrEND DO terrorrrrinfor= ppm_error_warningterrorrrrCALL ppm_error(ppm_err_converge,'ppm_hamjac_reinit_3d',+tterrorrrrrrrrr& 'failed to reach target residual',__LINE__,info) errorrrrinfor= ppm_param_success 666orrrrCONTINUE terrorrrriopto= ppm_param_deallocterrorrrrCALL ppm_alloc(tphi,ldl,ldu,iopt,info) errorrrrIF(info.NE.0) THEN error rrrrrinfor= ppm_error_errorterrorrrrrrrCALL ppm_error(ppm_err_dealloc,'ppm_hamjac_reinit_3d',+tterrorrrrrrrrrrrr& 'temp storage for hamjac not freed',__LINE__,info) errorrrrrrrGOTO 9999 errorrrrEND IF tt9999rrrrCONTINUE t#ifor __MODE == __SCA #ifor __KIND == __SINGLE_PRECISION error END SUBROUTINE ppm_hamjac_reinit_3ds #elifo__KIND == __DOUBLE_PRECISION error END SUBROUTINE ppm_hamjac_reinit_3dd #endif #elifo__MODE == __VEC #ifor __KIND == __SINGLE_PRECISION error END SUBROUTINE ppm_hamjac_reinit_3dsV #elifo__KIND == __DOUBLE_PRECISION error END SUBROUTINE ppm_hamjac_reinit_3ddV #endif #endiferror terrorrrr errorrrrrrr terrorrrr errorrrrv,libppmnumerics-r1036/src/ppm_gmm_getfdta.inc0000644000175000017500000001066111616214651017761 0ustar omaromarrorrrr!-------------------------------------------------------------------------, ttttt!ttInclude file for reading the datarfrom fdta (level function)., ttttt!, ttttt!ttINPUT: INTEGER :: i,j,k -- Point to solve forterrorr!tttttttttttINTEGER :: order -- Desired order of FD scheme, ttttt!ttOUTPUT: REAL(MK)(-order:order,1:ppm_dim) :: phi -- levelterrorr!ttttttttttttttttttttttfunction at shifted locations in each dir., ttttt!, ttttt!-------------------------------------------------------------------------, ttttt!tt$Log: ppm_gmm_getfdta.inc,v $, ttttt!ttRevision+1.1.1.12+2007/07/13 10:18:55ttivos, ttttt!ttCBL version+of the PPM library, ttttt!, ttttt!ttRevision+1.12+2005/05/10 04:41:15ttivos, ttttt!ttNewly created during modularization of ppm_gmm_march. Marchingterrorr! and orthogonal extendion are now in separate routines for fasterterrorr!ttcompilation., ttttt!, ttttt!-------------------------------------------------------------------------, ttttt!ttParalleltParticle Mesh Library (PPM), ttttt!ttInstitute of Computational Science, ttttt!ttETH Zentrum, Hirschengraben 84, ttttt!ttCH-8092 Zurich, Switzerland error !-------------------------------------------------------------------------, error phi =M0.0_MK #ifor __DIM == __3DterrorrIF (order .EQ. ppm_param_order_3) THEN error rrrrphi(-3,1) = fdta(i-3,j,k,jsub)terrorrrrrrphi(-2,1) = fdta(i-2,j,k,jsub)terrorrrrrrphi(-1,1) = fdta(i-1,j,k,jsub)terrorrrrrrphi( 0,1) = fdta(i ,j,k,jsub)terrorrrrrrphi( 1,1) = fdta(i+1,j,k,jsub)terrorrrrrrphi( 2,1) = fdta(i+2,j,k,jsub)terrorrrrrrphi( 3,1) = fdta(i+3,j,k,jsub)t error rrrrphi(-3,2) = fdta(i,j-3,k,jsub)terrorrrrrrphi(-2,2) = fdta(i,j-2,k,jsub)terrorrrrrrphi(-1,2) = fdta(i,j-1,k,jsub)terrorrrrrrphi( 0,2) = fdta(i,j ,k,jsub)terrorrrrrrphi( 1,2) = fdta(i,j+1,k,jsub)terrorrrrrrphi( 2,2) = fdta(i,j+2,k,jsub)terrorrrrrrphi( 3,2) = fdta(i,j+3,k,jsub)t error rrrrphi(-3,3) = fdta(i,j,k-3,jsub)terrorrrrrrphi(-2,3) = fdta(i,j,k-2,jsub)terrorrrrrrphi(-1,3) = fdta(i,j,k-1,jsub)terrorrrrrrphi( 0,3) = fdta(i,j,k ,jsub)terrorrrrrrphi( 1,3) = fdta(i,j,k+1,jsub)terrorrrrrrphi( 2,3) = fdta(i,j,k+2,jsub)terrorrrrrrphi( 3,3) = fdta(i,j,k+3,jsub)terrorrELSEIF (order .EQ. ppm_param_order_2) THEN error rrrrphi(-2,1) = fdta(i-2,j,k,jsub)terrorrrrrrphi(-1,1) = fdta(i-1,j,k,jsub)terrorrrrrrphi( 0,1) = fdta(i ,j,k,jsub)terrorrrrrrphi( 1,1) = fdta(i+1,j,k,jsub)terrorrrrrrphi( 2,1) = fdta(i+2,j,k,jsub)tterrorrrrrrphi(-2,2) = fdta(i,j-2,k,jsub)terrorrrrrrphi(-1,2) = fdta(i,j-1,k,jsub)terrorrrrrrphi( 0,2) = fdta(i,j ,k,jsub)terrorrrrrrphi( 1,2) = fdta(i,j+1,k,jsub)terrorrrrrrphi( 2,2) = fdta(i,j+2,k,jsub)tterrorrrrrrphi(-2,3) = fdta(i,j,k-2,jsub)terrorrrrrrphi(-1,3) = fdta(i,j,k-1,jsub)terrorrrrrrphi( 0,3) = fdta(i,j,k ,jsub)terrorrrrrrphi( 1,3) = fdta(i,j,k+1,jsub)terrorrrrrrphi( 2,3) = fdta(i,j,k+2,jsub)terrorrELSEterrorrrrrrphi(-1,1) = fdta(i-1,j,k,jsub)terrorrrrrrphi( 0,1) = fdta(i ,j,k,jsub)terrorrrrrrphi( 1,1) = fdta(i+1,j,k,jsub)tterrorrrrrrphi(-1,2) = fdta(i,j-1,k,jsub)terrorrrrrrphi( 0,2) = fdta(i,j ,k,jsub)terrorrrrrrphi( 1,2) = fdta(i,j+1,k,jsub)tterrorrrrrrphi(-1,3) = fdta(i,j,k-1,jsub)terrorrrrrrphi( 0,3) = fdta(i,j,k ,jsub)terrorrrrrrphi( 1,3) = fdta(i,j,k+1,jsub)terrorrENDIF #elifo__DIM == __2DterrorrIF (order .EQ. ppm_param_order_3) THEN error rrrrphi(-3,1) = fdta(i-3,j,jsub)terrorrrrrrphi(-2,1) = fdta(i-2,j,jsub)terrorrrrrrphi(-1,1) = fdta(i-1,j,jsub)terrorrrrrrphi( 0,1) = fdta(i ,j,jsub)terrorrrrrrphi( 1,1) = fdta(i+1,j,jsub)terrorrrrrrphi( 2,1) = fdta(i+2,j,jsub)terrorrrrrrphi( 3,1) = fdta(i+3,j,jsub)t error rrrrphi(-3,2) = fdta(i,j-3,jsub)terrorrrrrrphi(-2,2) = fdta(i,j-2,jsub)terrorrrrrrphi(-1,2) = fdta(i,j-1,jsub)terrorrrrrrphi( 0,2) = fdta(i,j ,jsub)terrorrrrrrphi( 1,2) = fdta(i,j+1,jsub)terrorrrrrrphi( 2,2) = fdta(i,j+2,jsub)terrorrrrrrphi( 3,2) = fdta(i,j+3,jsub)terrorrELSEIF (order .EQ. ppm_param_order_2) THEN error rrrrphi(-2,1) = fdta(i-2,j,jsub)terrorrrrrrphi(-1,1) = fdta(i-1,j,jsub)terrorrrrrrphi( 0,1) = fdta(i ,j,jsub)terrorrrrrrphi( 1,1) = fdta(i+1,j,jsub)terrorrrrrrphi( 2,1) = fdta(i+2,j,jsub)tterrorrrrrrphi(-2,2) = fdta(i,j-2,jsub)terrorrrrrrphi(-1,2) = fdta(i,j-1,jsub)terrorrrrrrphi( 0,2) = fdta(i,j ,jsub)terrorrrrrrphi( 1,2) = fdta(i,j+1,jsub)terrorrrrrrphi( 2,2) = fdta(i,j+2,jsub)terrorrELSEterrorrrrrrphi(-1,1) = fdta(i-1,j,jsub)terrorrrrrrphi( 0,1) = fdta(i ,j,jsub)terrorrrrrrphi( 1,1) = fdta(i+1,j,jsub)tterrorrrrrrphi(-1,2) = fdta(i,j-1,jsub)terrorrrrrrphi( 0,2) = fdta(i,j ,jsub)terrorrrrrrphi( 1,2) = fdta(i,j+1,jsub)terrorrENDIF #endif libppmnumerics-r1036/src/ppm_util_gmres.f0000644000175000017500000004715611616214651017342 0ustar omaromarerrorr!-------------------------------------------------------------------------, ttttt!ttSubroutinettt: ppm_util_gmres, ttttt!-------------------------------------------------------------------------, ttttt!, ttttt!ttPurpose ttttt: Solve Av=b, ttttt!, ttttt!ttInput :tA (F)tfunction thattcomputes the LHS A.vterrorr!tttttttttttttttttb (F)tRight-hand sideterrorr!tttttttttttttttttn (I) size errorr!tttttttttttttttttm (I) restart size errorr!tt, ttttt!ttInput/Output :tX (F)tInitial guess/solution errorr!ttttttttttttttttttol (F)ttolerance, ttttt!, ttttt!ttOutput :tinfor (I) return status., ttttt!, ttttt!ttRemarks :t1) There is an optimal m... No real rule to get it...terrorr!ttttttttttttttttttttI would advise experimentation with values of m around error !tttttttttttttttttttt5 -> 10 -> 30, depending on the size+of the problem error !ttttttttttttttttttttand the available memory, ttttt!, ttttt!ttReferences : Y. SAAD AND M. SCHULTZ, GMRES:tA generalizedrminimal error !tttttttttttttttttresidual algorithm for solving nonsymmetric linear error !tttttttttttttttttsystems, SIAM J. Sci. Statist. Comput., 7 (1986), error !tttttttttttttttttpp. 856-869., ttttt!, ttttt!, ttttt!ttRevisions : error !-------------------------------------------------------------------------, ttttt!tt$Log: ppm_util_gmres.f,v $, ttttt!ttRevision+1.1.1.12+2007/07/13 10:19:01ttivos, ttttt!ttCBL version+of the PPM library, ttttt!, ttttt!ttRevision+1.12+2006/05/11 10:27:00ttpchatela, ttttt!ttInitial insertion errorr! errorr! errorr!-------------------------------------------------------------------------, ttttt!tCopyright (c)+2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), error !ttttttttttttttttttttCenter for Fluid Dynamics (DTU), ttttt!, ttttt!, ttttt!tThis file is part of the ParalleltParticle Mesh Library (PPM)., ttttt!, ttttt!tPPM is free software: you can redistribute ittand/or modify, ttttt! ittunder the terms of the GNU Lesser GeneraltPublic License error !tas publishedrby the Free Software Foundation, either error !tversion+3 of the License, or (attyour option)tany later error !tversion., ttttt!, ttttt!tPPM is distributed in the hope thattittwill be useful,, ttttt!tbut WITHOUT ANY WARRANTY; without even the implied warranty of, ttttt!tMERCHANTABILITY or FITNESS FORtA PARTICULAR PURPOSE. See the errorr!tGNU GeneraltPublic License for more details., ttttt!, ttttt!tYou should have received a copy of the GNU GeneraltPublic License error !tand the GNU Lesser GeneraltPublic License along with PPM. If not,, ttttt!tsee ., ttttt!, ttttt!tParalleltParticle Mesh Library (PPM), ttttt!tETH Zurich, ttttt!tCH-8092 Zurich, Switzerland errorr!-------------------------------------------------------------------------,#ifor __KIND == __SINGLE_PRECISION error SUBROUTINE ppm_util_gmres_s(A,b,X,n,m,tol,info,maxiter) #elifo__KIND == __DOUBLE_PRECISION error SUBROUTINE ppm_util_gmres_d(A,b,X,n,m,tol,info,maxiter) #endif errorr!-------------------------------------------------------------------------, ttttt!ttIncludes, ttttt!-------------------------------------------------------------------------,#include "ppm_define.h" errorr!-------------------------------------------------------------------------, ttttt!ttModules, ttttt!-------------------------------------------------------------------------, tttttUSE ppm_module_dataterrorrUSE ppm_module_substartterrorrUSE ppm_module_substopterrorrUSE ppm_module_errorterrorrUSE ppm_module_allocterrorrUSE ppm_module_writeterrorrIMPLICIT NONE #ifor __KIND == __SINGLE_PRECISION error INTEGER, PARAMETER :: MK = ppm_kind_single #elifo__KIND == __DOUBLE_PRECISION error INTEGER, PARAMETER :: MK = ppm_kind_double #endif t#ifdefo__MPI error INCLUDE 'mpif.h' #endif terrorr!-------------------------------------------------------------------------, ttttt!ttArgumentsterrorr!-------------------------------------------------------------------------,#ifor r __KIND == __SINGLE_PRECISION error INTERFACEterrorrrrrFUNCTION A(in,out,ninout,info) errorrrrrINTEGER , INTENT(OUT) :: info errorrrr REAL(KIND(1.0E0)), DIMENSION(:), INTENT(IN) :: in errorrrr REAL(KIND(1.0E0)), DIMENSION(:), INTENT(OUT) :: out errorrrrrINTEGER , INTENT(IN) :: ninout errorrrrrINTEGER :: A error rrrEND FUNCTION AterrorrEND INTERFACEt#else error INTERFACEterrorrrrrFUNCTION A(in,out,ninout,info) errorrrrrINTEGER , INTENT(OUT) :: info errorrrr REAL(KIND(1.0D0)), DIMENSION(:), INTENT(IN) :: in errorrrr REAL(KIND(1.0D0)), DIMENSION(:), INTENT(OUT) :: out errorrrrrINTEGER , INTENT(IN) :: ninout errorrrrrINTEGER :: A error rrrEND FUNCTION AterrorrEND INTERFACEt#endif errorrREAL(MK), DIMENSION(:), POINTER :: x errorrREAL(MK), DIMENSION(:), POINTER :: b errorrREAL(MK), INTENT(INOUT) :: tol error INTEGER , INTENT(IN) :: n error INTEGER , INTENT(IN) :: m error INTEGER , INTENT(OUT) :: info errorrINTEGER, OPTIONAL , INTENT(IN) :: maxiterterrorr!-------------------------------------------------------------------------, ttttt!ttLocaltvariables, ttttt!-------------------------------------------------------------------------, tttttREAL(MK) :: t0,tolin,lmyeps error INTEGER :: solver_info errorr, ttttt!tAccumulators, ttttt!tNeed double precision+for the inner productsterrorrREAL(KIND(1.0D0)),DIMENSION(:) ,POINTER :: tmphdterrorrREAL(KIND(1.0D0)),DIMENSION(:,:),POINTER :: ghdterrorrREAL(KIND(1.0D0)) :: lnorm,gnorm,groti,grotip1terrorrREAL(KIND(1.0D0)),DIMENSION(:),POINTER :: s,yterrorrREAL(KIND(1.0D0)),DIMENSION(:,:),POINTER :: cossin errorr errorrREAL(MK), DIMENSION(:), POINTER :: w errorrREAL(MK), DIMENSION(:,:), POINTER :: v error INTEGER :: i,j,k,l,throwaway, ioptterrorrINTEGER, DIMENSION(3) :: ldl,lduterrorrLOGICAL :: breakdown errorrCHARACTER(LEN=ppm_char) :: mesgt#ifdefo__MPI error INTEGER :: MPTYPE #endif tt#ifdefo__MPI error !-------------------------------------------------------------------------, ttttt!ttDefine MPI datartype error !-------------------------------------------------------------------------, tttttMPTYPE = MPI_DOUBLE_PRECISION #endif terrorr!-----------------------------------------------------------------------, ttttt!ttcall substartterrorr!-----------------------------------------------------------------------, tttttCALL substart('ppm_util_gmres',t0,info) terrorr!-----------------------------------------------------------------------, ttttt!ttcheck input argumentsterrorr!----------------------------------------------------------------------- error IF (ppm_debug .GT. 0) THEN error rrrIF (n.LT.0) THEN error rrrrrrrrinfor= ppm_error_errorterrorrrrrrr rrCALL ppm_error(ppm_err_argument,'ppm_util_gmres',++tterror&E.0MMMMMMMMM'passed a negative size+n',__LINE__,info) errorrrrrrr rrGOTO 9999 errorrrrrrENDIF rrrrrrENDIF rrrrrrIF (ppm_debug .GT. 0) THEN error rrrIF (m.LT.0) THEN error rrrrrrrrinfor= ppm_error_errorterrorrrrrrr rrCALL ppm_error(ppm_err_argument,'ppm_util_gmres',++tterror&E.0MMMMMMMMM'passed a restart parameter m < 1',__LINE__,info) errorrrrrrr rrGOTO 9999 errorrrrrrENDIF rrrrrrENDIF rrrrrrIF (ppm_debug .GT. 0) THEN error rrrIF (m.GT.n) THEN error rrrrrrrrinfor= ppm_error_errorterrorrrrrrr rrCALL ppm_error(ppm_err_argument,'ppm_util_gmres',++tterror&E.0MMMMMMMMM'restart parameter m > size+n',__LINE__,info) errorrrrrrr rrGOTO 9999 errorrrrrrENDIF rrrrrrENDIF #ifor __KIND == __SINGLE_PRECISION error lmyepsr= ppm_myepss #elifo__KIND == __DOUBLE_PRECISION error lmyepsr= ppm_myepsd #endif terrorr!-------------------------------------------------------------------------, ttttt!ttAllocationterrorr!-------------------------------------------------------------------------, tttttiopto= ppm_param_alloc_fitterrorrldl(1) = 1terrorrldu(1) = n error CALL ppm_alloc(w,ldl,ldu,iopt,info) errorrIF (infor.NE. 0) THEN error rrrrinfor= ppm_error_fatal error rrrrCALL ppm_error(ppm_err_alloc,'ppm_util_gmres',++++++++tterror&E.0MMMMM'allocation of vector w',__LINE__,info) errorrrrrrGOTO 9999 errorrENDIF rrrrrr, tttttiopto= ppm_param_alloc_fitterrorrldl(1) = 1terrorrldu(1) = m+1 error CALL ppm_alloc(s,ldl,ldu,iopt,info) errorrIF (infor.NE. 0) THEN error rrrrinfor= ppm_error_fatal error rrrrCALL ppm_error(ppm_err_alloc,'ppm_util_gmres',++++++++tterror&E.0MMMMM'allocation of vector s',__LINE__,info) errorrrrrrGOTO 9999 errorrENDIF rrrrrr, tttttiopto= ppm_param_alloc_fitterrorrldl(1) = 1terrorrldu(1) = nterrorrldl(2) = 1terrorrldu(2) = m+1 error CALL ppm_alloc(v,ldl,ldu,iopt,info) errorrIF (infor.NE. 0) THEN error rrrrinfor= ppm_error_fatal error rrrrCALL ppm_error(ppm_err_alloc,'ppm_util_gmres',++++++++tterror&E.0MMMMM'allocation of basis vectors v',__LINE__,info) errorrrrrrGOTO 9999 errorrENDIF rrrrrriopto= ppm_param_alloc_fitterrorrldl(1) = 1terrorrldu(1) = m error CALL ppm_alloc(y,ldl,ldu,iopt,info) errorrIF (infor.NE. 0) THEN error rrrrinfor= ppm_error_fatal error rrrrCALL ppm_error(ppm_err_alloc,'ppm_util_gmres',++++++++tterror&E.0MMMMM'allocation of vectors y',__LINE__,info) errorrrrrrGOTO 9999 errorrENDIF , tttttiopto= ppm_param_alloc_fitterrorrldl(1) = 1terrorrldu(1) = m+1 error CALL ppm_alloc(tmphd,ldl,ldu,iopt,info) errorrIF (infor.NE. 0) THEN error rrrrinfor= ppm_error_fatal error rrrrCALL ppm_error(ppm_err_alloc,'ppm_util_gmres',++++++++tterror&E.0MMMMM'allocation of vector TMPH of localtinner products',__LINE__,info) errorrrrrrGOTO 9999 errorrENDIF rrrrrr, tttttiopto= ppm_param_alloc_fitterrorrldl(1) = 1terrorrldu(1) = m+1 error ldl(2) = 1terrorrldu(2) = m error CALL ppm_alloc(ghd,ldl,ldu,iopt,info) errorrIF (infor.NE. 0) THEN error rrrrinfor= ppm_error_fatal error rrrrCALL ppm_error(ppm_err_alloc,'ppm_util_gmres',++++++++tterror&E.0MMMMM'allocation of matrix GH of globaltinner products',__LINE__,info) errorrrrrrGOTO 9999 errorrENDIF , tttttiopto= ppm_param_alloc_fitterrorrldl(1) = 1terrorrldu(1) = 2 error ldl(2) = 1terrorrldu(2) = m error CALL ppm_alloc(cossin,ldl,ldu,iopt,info) errorrIF (infor.NE. 0) THEN error rrrrinfor= ppm_error_fatal error rrrrCALL ppm_error(ppm_err_alloc,'ppm_util_gmres',++++++++tterror&E.0MMMMM'allocation of matrix COSSIN of cosines/sines of rotation angles',__LINE__,info) errorrrrrrGOTO 9999 errorrENDIF , ttttt!-------------------------------------------------------------------------, ttttt!ttIterations, ttttt!-------------------------------------------------------------------------, ttttttolin = tol error j =M0 error DO errorrrrrj =Mj+1terrorrrrt!----------------------------------------------------------------------terrorrrrt! (Re)-Initializationterrorrrrt!----------------------------------------------------------------------terrorrrrtthrowaway =MA(x,w,n,info) errorrrrrw =Mb(1:n) - w(1:n)t#ifdefo__MPI error orrlnorm =Mdot_product(w,w) errorrrrr!lnorm =M0.0 errorrrrr!DO k=1,nterrorrrrt! rlnorm =Mlnorm +rrREAL(w(k),KIND(1.0D0))**2terrorrrrt!END DO errorrrrrCALL MPI_Allreduce(lnorm,gnorm,1,MPTYPE,MPI_SUM,ppm_comm,info) #elseterrorrrr gnorm =Mdot_product(w,w) errorrrrr!gnorm =M0.0 errorrrrr!DO k=1,nterrorrrrt! rgnorm =Mgnorm +rREAL(w(k),KIND(1.0D0))**2terrorrrrt!END DO #endif errorrrr gnorm =MSQRT(gnorm) errorrrrrv(:,1) = w / gnorm errorrrrr errorrrrrs =M0.0 errorrrrrs(1) = gnorm errorrrrr errorrrrrbreakdown = .FALSE. errorrrr ghd =M0.0 errorrrrrDO i=1,m errorrrrr rt!------------------------------------------------------------------- errorrrrr rt! Growing the Krylov space basis:tModified Gram-Schmidt errorrrrr rt! NB: could switch to a more stable orthognalization scheme, tttttorrrrt! rrrrlike Householder error rrr rt!------------------------------------------------------------------- errorrrrr rtthrowaway =MA(v(:,i),w,n,info) #ifdefo__MPI error orr rttmphd =M0.0 errorrrrrrrrDO k=1,i errorrrrrrrr rttmphd(k) =Mdot_product(w,v(:,k)) errorrrrrrr rrr!DO l=1,nterrorrrrtorrrrt! rtmphd(k) =Mtmphd(k) ++tterro!& rrREAL(w(l),KIND(1.0D0))*REAL(v(l,k),KIND(1.0D0))terrorrrrtorrrrt!END DO errorrrrrrrrEND DO errorrrrrrrrCALL MPI_Allreduce(tmphd(1:i),ghd(1:i,i),i,MPTYPE,MPI_SUM,ppm_comm,info) #elseterrorrrr rrrDO k=1,i errorrrrrrrr rtghd(k,i) =Mdot_product(w,v(:,k)) errorrrrrrr rrr!DO l=1,nterrorrrrtorrrrt! rghd(k,i) =Mghd(k,i) ++tterro!& rrREAL(w(l),KIND(1.0D0))*REAL(v(l,k),KIND(1.0D0))terrorrrrtorrrrt!END DO errorrrrrrrrEND DO #endif errorrrr rrrDO k=1,i errorrrrrrrr rtw = w -Mghd(k,i)*v(:,k) errorrrrrrrrEND DO #ifdefo__MPI error orr rtlnorm =Mdot_product(w,w) errorrrrr rr!lnorm =M0.0 errorrrrr rr!DO k=1,nterrorrrrt rt! rlnorm =Mlnorm +rREAL(w(k),KIND(1.0D0))**2terrorrrrtrrt!END DO errorrrrrrrrCALL MPI_Allreduce(lnorm,gnorm,1,MPTYPE,MPI_SUM,ppm_comm,info) #elseterrorrrr r gnorm =Mdot_product(w,w) errorrrrr rr!gnorm =M0.0 errorrrrr rr!DO k=1,nterrorrrrt rt! rgnorm =Mgnorm +rREAL(w(k),KIND(1.0D0))**2terrorrrrt rt!END DO #endif errorrrr r gnorm =MSQRT(gnorm) errorrrrr rghd(i+1,i) = gnorm errorrrrr rIF (ghd(i+1,i).LT.lmyeps) THEN error rrrrrrrrrIF (ppm_debug .GE. 1) THEN error rrrrrrrrr rrWRITE(mesg,'(A, ES9.2,A,ES9.2)') 'Breakdown: ',rghd(i+1,i), ' < ',rlmyeps error errorrrrrrrrCALL ppm_write(ppm_rank,'ppm_util_gmres',++tterrorrrrrrrrrrrrrr& mesg,info) errorrrrrrr rrrENDIF rrrrrrrrrrrrrrrbreakdown = .TRUE. errorrrr rr rrrEXIT errorrrrrrrrEND IF , tttttttttttv(:,i+1) = w / ghd(i+1,i), tttttttttttterrorrrrt rt! Apply previous Givens rotations errorrrr rrrDO k=1,i-1 errorrrr rr rrrgroti rr= cossin(1,k)*ghd(k,i) ++cossin(2,k)*ghd(k+1,i), tttttttttttrrrgrotip1r= -cossin(2,k)*ghd(k,i) ++cossin(1,k)*ghd(k+1,i), tttttttttttrrrghd(k,i) =Mgroti, tttttttttttrrrghd(k+1,i) = grotip1terrorrrrrrrrEND DO errorrrrrrrr!WRITE(*,*) 'gh(',i,'+1,',i,') after prev rots= ',rgh(i+1,i), ttttttttttt! Build the new oneterrorrrr r lnorm =MSQRT(ghd(i,i)**2+ghd(i+1,i)**2), tttttttttttcossin(1,i)=ghd(i,i) /lnorm errorrrrrtttcossin(2,i)=ghd(i+1,i)/lnorm errorrrrrttt! And apply it errorrrrr rtgroti rr= cossin(1,i)*ghd(i,i) ++cossin(2,i)*ghd(i+1,i), tttttttttttgrotip1r= -cossin(2,i)*ghd(i,i) ++cossin(1,i)*ghd(i+1,i), tttttttttttghd(i,i) =Mgroti, tttttttttttghd(i+1,i) = 0.0 errorrrrr rr! Update s errorrrrr rtgroti rr= cossin(1,i)*s(i)! ++cossin(2,i)*s(i+1), tttttttttttgrotip1r= -cossin(2,i)*s(i)! ++cossin(1,i)*s(i+1), ttttttttttts(i) =Mgroti, ttttttttttts(i+1) = grotip1terrorrrrrrrrtol =MABS(s(i+1)), tttttttttttterrorrrrt rtIF (tol.LT.tolin) THEN error rrrrrrrrr! We are done, update tol, compute solutiontand exitterrorrrrrrrrrrrIF (ppm_debug .GE. 1) THEN error rrrrrrrrr rrWRITE(mesg,'(A, ES9.2,A,ES9.2,A,I4)') 'Converged: ',rtterro& tol, ' < ',rtolin, ',rOuter iterations: ',j error errorrrrrrrrCALL ppm_write(ppm_rank,'ppm_util_gmres',++tterrorrrrrrrrrrrrrr& mesg,info) errorrrrrrr rrrENDIF rrrrrrrrrrrrrrr rrrrrrrrrrrrrrrCALL ppm_util_gmres_solveupper(ghd,s,y,i,info) errorrrrrrrrrrrIF (infor.NE. 0) THEN error rrrrrrrrrrrrinfor= ppm_error_fatal error rrrrrrrrrrrrCALL ppm_error(ppm_err_alloc,'ppm_util_gmres',+++++++tterror&E.0MMMMMMMMMMMMMM'failed to solve hy=s',__LINE__,info) errorrrrrrrrrrrrrrGOTO 9999 errorrrrrrr rrrENDIF errorrrrrrr rrrDO k=1,i errorrrrrrrrrrrrrrxr= x ++y(k)*v(1:n,k) errorrrrrrrr rrEND DO errorrrrrrrrrrrsolver_infor= ppm_gmres_param_success orrrrrrrrrrrrrrGOTO 8000 errorrrrr rrEND IF errorrrr rrr rrrrrrrrrEND DO errorrrrrterrorrrrt! We got out of the inner loop, either i=m+1 or breakdown and i<=m+1terrorrrrttol =MABS(s(i)), ttttttttIF (.NOT.breakdown) THEN error rrrrrri = m error rrEND IF errorrrr CALL ppm_util_gmres_solveupper(ghd,s,y,i,info) errorrrrrIF (infor.NE. 0) THEN error rrrrrrinfor= ppm_error_fatal error rrrrrrCALL ppm_error(ppm_err_div_zero,'ppm_util_gmres',++++++++tterror&E.0MMMMM MM'failed to solve hy=s',__LINE__,info) errorrrrrrrrsolver_infor= ppm_gmres_param_failureterrorrrr r GOTO 8000 errorrrrrENDIF rrrrrrrrrDO k=1,i errorrrrrrrrxr= x ++y(k)*v(1:n,k) errorrrrrEND DO errorrrrrIF (tol.LT.tolin) THEN error rrrrrrIF (ppm_debug .GE. 1) THEN error rrrrrrrrrWRITE(mesg,'(A, ES9.2,A,ES9.2,A,I4)') 'Converged: ',rtterror&E.0MMMMMMMMMMMMtol, ' < ',rtolin,',rOuter iterations: ',j error errorrrrrCALL ppm_write(ppm_rank,'ppm_util_gmres',++tterrorrrrrrrrrrr& mesg,info) errorrrrrrr ENDIF rrrrrrrrrrrrsolver_infor= ppm_gmres_param_success orrrrrrrrrrrGOTO 8000 errorrrrrEND IF errorrrr IF (PRESENT(maxiter)) THEN error rrrrrrIF (j.GE.maxiter) THEN error rrrrrrrrrIF (ppm_debug .GE. 1) THEN error rrrrrrrrr rrWRITE(mesg,'(A,I4,A,ES9.2,A,ES9.2)') 'Reached ',rtterror&E.0MMMMMMMMMMMM maxiter,' iterations and residue still at ',rtterror&E.0MMMMMMMMMMMM tol, ' < ',rtolin error errorrrrrrrrCALL ppm_write(ppm_rank,'ppm_util_gmres',++tterrorrrrrrrrrrrrrr& mesg,info) errorrrrrrr rrrENDIF rrrrrrrrrrrrrrrsolver_infor= ppm_gmres_param_maxiterterrorrrrrrrrrrrGOTO 8000 errorrrrr rrEND IF errorrrr ENDIF rrrrrrEND DO terrorrterrorr!-------------------------------------------------------------------------, ttttt!ttDe-allocateterrorr!-------------------------------------------------------------------------, 8000rCONTINUE errorriopto= ppm_param_deallocterrorrCALL ppm_alloc(cossin,ldl,ldu,iopt,info) errorrIF (infor.NE. 0) THEN error rrrrinfor= ppm_error_fatal error rrrrCALL ppm_error(ppm_err_alloc,'ppm_util_gmres',++++++++tterror&E.0MMMMM'deallocation of vector tmpv',__LINE__,info) errorrrrrrGOTO 9999 errorrENDIF rrrrrrCALL ppm_alloc(s,ldl,ldu,iopt,info) errorrIF (infor.NE. 0) THEN error rrrrinfor= ppm_error_fatal error rrrrCALL ppm_error(ppm_err_alloc,'ppm_util_gmres',++++++++tterror&E.0MMMMM'deallocation of vector s',__LINE__,info) errorrrrrrGOTO 9999 errorrENDIF rrrrrrCALL ppm_alloc(v,ldl,ldu,iopt,info) errorrIF (infor.NE. 0) THEN error rrrrinfor= ppm_error_fatal error rrrrCALL ppm_error(ppm_err_alloc,'ppm_util_gmres',++++++++tterror&E.0MMMMM'deallocation of basis vectors v',__LINE__,info) errorrrrrrGOTO 9999 errorrENDIF rrrrrrCALL ppm_alloc(w,ldl,ldu,iopt,info) errorrIF (infor.NE. 0) THEN error rrrrinfor= ppm_error_fatal error rrrrCALL ppm_error(ppm_err_alloc,'ppm_util_gmres',++++++++tterror&E.0MMMMM'deallocation of basis vectors v',__LINE__,info) errorrrrrrGOTO 9999 errorrENDIF rrrrrrCALL ppm_alloc(y,ldl,ldu,iopt,info) errorrIF (infor.NE. 0) THEN error rrrrinfor= ppm_error_fatal error rrrrCALL ppm_error(ppm_err_alloc,'ppm_util_gmres',++++++++tterror&E.0MMMMM'deallocation of vectors y',__LINE__,info) errorrrrrrGOTO 9999 errorrENDIF rrrrrrCALL ppm_alloc(tmphd,ldl,ldu,iopt,info) errorrIF (infor.NE. 0) THEN error rrrrinfor= ppm_error_fatal error rrrrCALL ppm_error(ppm_err_alloc,'ppm_util_gmres',++++++++tterror&E.0MMMMM'deallocation of vector TMPH of localtinner products',__LINE__,info) errorrrrrrGOTO 9999 errorrENDIF rrrrrrCALL ppm_alloc(ghd,ldl,ldu,iopt,info) errorrIF (infor.NE. 0) THEN error rrrrinfor= ppm_error_fatal error rrrrCALL ppm_error(ppm_err_alloc,'ppm_util_gmres',++++++++tterror&E.0MMMMM'deallocation of matrix GH of globaltinner products',__LINE__,info) errorrrrrrGOTO 9999 errorrENDIF errorr!-------------------------------------------------------------------------, ttttt!ttMade ittthrough: we set the output inforto the status of the solver errorr!-------------------------------------------------------------------------, tttttinfor= solver_info errorr!-------------------------------------------------------------------------, ttttt!ttReturn errorr!-------------------------------------------------------------------------, 9999rCONTINUE errorrCALL substop('ppm_util_gmres',t0,info) errorrRETURN #ifor __KIND == __SINGLE_PRECISION END SUBROUTINE ppm_util_gmres_s #elifo__KIND == __DOUBLE_PRECISION END SUBROUTINE ppm_util_gmres_d #endif libppmnumerics-r1036/src/ppm_module_ode_init.f0000644000175000017500000000462111616214651020315 0ustar omaromarerrorr!-------------------------------------------------------------------------, ttttt!ttModuleorrrrrr: ppm_module_ode_init errorr!-------------------------------------------------------------------------, ttttt!, ttttt!ttPurpose ttttt: procedure module for ppm_ode_init errorr!, ttttt!ttRemarks :t errorr!, ttttt!ttReferences : errorr!, ttttt!ttRevisions : error !-------------------------------------------------------------------------, ttttt!tt$Log: ppm_module_ode_init.f,v $, ttttt!ttRevision+1.1.1.12+2007/07/13 10:19:00ttivos, ttttt!ttCBL version+of the PPM library, ttttt!, ttttt!ttRevision+1.22+2004/07/26 11:21:24rrmichaebe errorr!ttadded dummytinterface, ttttt!, ttttt!ttRevision+1.12+2004/07/26 07:45:48rrmichaebe errorr!ttProcedure modules created in the course+of atomization., ttttt!, ttttt!, ttttt!-------------------------------------------------------------------------, ttttt!tCopyright (c)+2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), error !ttttttttttttttttttttCenter for Fluid Dynamics (DTU), ttttt!, ttttt!, ttttt!tThis file is part of the ParalleltParticle Mesh Library (PPM)., ttttt!, ttttt!tPPM is free software: you can redistribute ittand/or modify, ttttt! ittunder the terms of the GNU Lesser GeneraltPublic License error !tas publishedrby the Free Software Foundation, either error !tversion+3 of the License, or (attyour option)tany later error !tversion., ttttt!, ttttt!tPPM is distributed in the hope thattittwill be useful,, ttttt!tbut WITHOUT ANY WARRANTY; without even the implied warranty of, ttttt!tMERCHANTABILITY or FITNESS FORtA PARTICULAR PURPOSE. See the errorr!tGNU GeneraltPublic License for more details., ttttt!, ttttt!tYou should have received a copy of the GNU GeneraltPublic License error !tand the GNU Lesser GeneraltPublic License along with PPM. If not,, ttttt!tsee ., ttttt!, ttttt!tParalleltParticle Mesh Library (PPM), ttttt!tETH Zurich, ttttt!tCH-8092 Zurich, Switzerland errorr!-------------------------------------------------------------------------,errorrMODULE ppm_module_ode_init errorrrr!-----------------------------------------------------terrorrrr! Dummytinterface, tttttrr!-----------------------------------------------------terrorrrrINTERFACE ppm_ode_init errorrrrorrMODULE PROCEDURE ppm_ode_init errorrrrEND INTERFACEt errorrCONTAINS,#include "ppm_ode_init.f" errorrEND MODULE ppm_module_ode_init errorrrr libppmnumerics-r1036/src/ppm_module_mg_finalize.f0000644000175000017500000000665511616214651021020 0ustar omaromarerrorr!-------------------------------------------------------------------------,errorr!tModuleorrrrrrrr: ppm_module_mg_finalize errorr!-------------------------------------------------------------------------, ttttt!, ttttt!tPurpose tttttr: multigrid finalize module error !ttttttttttttttt, ttttt!, ttttt!tRemarks : error !, ttttt!tReferences : errorr!, ttttt!tRevisions : error !-------------------------------------------------------------------------, ttttt!tt$Log: ppm_module_mg_finalize.f,v $, ttttt!ttRevision+1.1.1.12+2007/07/13 10:19:00ttivos, ttttt!ttCBL version+of the PPM library, ttttt!, ttttt!ttRevision+1.12+2004/09/22 18:49:34rrkotsalie error !ttMG new version, ttttt!, ttttt!, ttttt!-------------------------------------------------------------------------, ttttt!tCopyright (c)+2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), error !ttttttttttttttttttttCenter for Fluid Dynamics (DTU), ttttt!, ttttt!, ttttt!tThis file is part of the ParalleltParticle Mesh Library (PPM)., ttttt!, ttttt!tPPM is free software: you can redistribute ittand/or modify, ttttt! ittunder the terms of the GNU Lesser GeneraltPublic License error !tas publishedrby the Free Software Foundation, either error !tversion+3 of the License, or (attyour option)tany later error !tversion., ttttt!, ttttt!tPPM is distributed in the hope thattittwill be useful,, ttttt!tbut WITHOUT ANY WARRANTY; without even the implied warranty of, ttttt!tMERCHANTABILITY or FITNESS FORtA PARTICULAR PURPOSE. See the errorr!tGNU GeneraltPublic License for more details., ttttt!, ttttt!tYou should have received a copy of the GNU GeneraltPublic License error !tand the GNU Lesser GeneraltPublic License along with PPM. If not,, tror !tsee ., ttttt!, ttttt!tParalleltParticle Mesh Library (PPM), ttttt!tETH Zurich, ttttt!tCH-8092 Zurich, Switzerland errorr!-------------------------------------------------------------------------, #define __SINGLE_PRECISION 1 #define __DOUBLE_PRECISION 2 #define __INTEGER 3 #define __LOGICAL 4 #define __2Dttttttttttttttt7 #define __3Dttttttttttttttt8 #define __SFIELDttttttttttt9 #define __VFIELDtttttttttt10 MODULE ppm_module_mg_finalize tt, t!--------------------------------------------------------------------------, t!Modules, t!-----------------------------------------------------------------------------, t!-----------------------------------------------------------------------------, t! INCLUDE THE SOURCES, t!-----------------------------------------------------------------------------, CONTAINS,#define __DIM __SFIELD,#define __MESH_DIM __2D,#define __KIND __SINGLE_PRECISION #include "ppm_mg_finalize.f" #undefo__KIND ,#define __KIND __DOUBLE_PRECISION #include "ppm_mg_finalize.f" #undefo__KIND #undefo__MESH_DIM ,#define __MESH_DIM __3D,#define __KIND __SINGLE_PRECISION #include "ppm_mg_finalize.f" #undefo__KIND ,#define __KIND __DOUBLE_PRECISION #include "ppm_mg_finalize.f" #undefo__KIND #undefo__MESH_DIM #undefo__DIM ,#define __DIM __VFIELD,#define __MESH_DIM __2D,#define __KIND __SINGLE_PRECISION #include "ppm_mg_finalize.f" #undefo__KIND ,#define __KIND __DOUBLE_PRECISION #include "ppm_mg_finalize.f" #undefo__KIND #undefo__MESH_DIM ,#define __MESH_DIM __3D,#define __KIND __SINGLE_PRECISION #include "ppm_mg_finalize.f" #undefo__KIND ,#define __KIND __DOUBLE_PRECISION #include "ppm_mg_finalize.f" #undefo__KIND #undefo__MESH_DIM #undefo__DIM , END MODULE ppm_module_mg_finalize libppmnumerics-r1036/src/ppm_module_fdsolver_poisson.f0000644000175000017500000000560711616214651022126 0ustar omaromar#ifdefo__XLF @PROCESS NOHOT #endif errorr!-------------------------------------------------------------------------, ttttt!ttModuleorrrrrr: ppm_module_fdsolver_poisson errorr!-------------------------------------------------------------------------, ttttt!, ttttt!ttPurpose ttttt: This module includes the source code for field solver error !ttttttttttttttttttttttttroutines., ttttt!, ttttt!ttRemarks : errorr!, ttttt!ttReferences : errorr!, ttttt!ttRevisions : error !-------------------------------------------------------------------------, ttttt!, ttttt!-------------------------------------------------------------------------, ttttt!tCopyright (c)+2010 CSE Lab (ETH Zurich), MOSAIC Group (ETH Zurich), error !ttttttttttttttttttttCenter for Fluid Dynamics (DTU), ttttt!, ttttt!, ttttt!tThis file is part of the ParalleltParticle Mesh Library (PPM)., ttttt!, ttttt!tPPM is free software: you can redistribute ittand/or modify, ttttt! ittunder the terms of the GNU Lesser GeneraltPublic License error !tas publishedrby the Free Software Foundation, either error !tversion+3 of the License, or (attyour option)tany later error !tversion., ttttt!, ttttt!tPPM is distributed in the hope thattittwill be useful,, ttttt!tbut WITHOUT ANY WARRANTY; without even the implied warranty of, ttttt!tMERCHANTABILITY or FITNESS FORtA PARTICULAR PURPOSE. See the errorr!tGNU GeneraltPublic License for more details., ttttt!, ttttt!tYou should have received a copy of the GNU GeneraltPublic License error !tand the GNU Lesser GeneraltPublic License along with PPM. If not,, tror !tsee ., ttttt!, ttttt!tParalleltParticle Mesh Library (PPM), ttttt!tETH Zurich, ttttt!tCH-8092 Zurich, Switzerland errorr!-------------------------------------------------------------------------,rrorr errorr!-------------------------------------------------------------------------, ttttt!ttDefine typesterrorr!-------------------------------------------------------------------------,#define __SINGLE_PRECISION 1 #define __DOUBLE_PRECISION 2 #define __COMPLEX 3 #define __DOUBLE_COMPLEX 4 errMODULE ppm_module_fdsolver_poisson errorrrroINTERFACE ppm_fdsolver_poisson errorrrrrrrrMODULE PROCEDURE ppm_fdsolver_poisson_2dc errorrrrrrrrMODULE PROCEDURE ppm_fdsolver_poisson_2dcc errorrrrrrrrMODULE PROCEDURE ppm_fdsolver_poisson_3dc errorrrrrrrrMODULE PROCEDURE ppm_fdsolver_poisson_3dcc errorrrrrEND INTERFACEt errorrorr!---------------------------------------------------------------------- errorrorr! include the source errorrorr!---------------------------------------------------------------------- errorrorrCONTAINS,,#define __KIND __COMPLEX #include "ppm_fdsolver_poisson_2d.f" #include "ppm_fdsolver_poisson_3d.f" #undefoo__KIND ,#define __KIND __DOUBLE_COMPLEX #include "ppm_fdsolver_poisson_2d.f" #include "ppm_fdsolver_poisson_3d.f" #undefoo__KIND , errorrEND MODULE ppm_module_fdsolver_poisson libppmnumerics-r1036/config.status0000755000175000017500000006201711616214646016070 0ustar omaromar#! /bin/bash # Generatedrby configure. # Run this file to recreate the current configuration.,# Compiler output producedrby configure, useful for debugging,# configure, is in config.log iftittexists., debug=falsetac_cs_recheck=falsetac_cs_silent=falset SHELL=${CONFIG_SHELL-/bin/bash} export SHELL ## -------------------- ## ## M4sh Initialization. ## ## -------------------- ## ,# Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh ifttest -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : eremulate sh erNULLCMD=: er# Pre-4.2tversions of Zsh do word splitting on ${1+"$@"}, which, t# is contrary to our usage.ttDisable this feature. alias -g '${1+"$@"}'='"$@"' setoptoNO_GLOB_SUBST elsetercase `(set -o)+2>/dev/null` in #(ter*posix*) : erroset -o posix ;; #(ter*) : erro ;; esac fi, as_nl=' ' export as_nl # Printing a long string crashes Solaris 7 /usr/bin/printf. as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo # Prefer a ksh shell builtin over an externaltprintf program on Solaris, # but without wasting forks for bash or zsh. ifttest -z "$BASH_VERSION$ZSH_VERSION" \ erro&& (test "X`print -r -- $as_echo`" = "X$as_echo")+2>/dev/null; then as_echo='print -r --' as_echo_n='print -rn --' elifo(test "X`printf %s $as_echo`" = "X$as_echo")+2>/dev/null; then as_echo='printf %s\n' as_echo_n='printf %s' elseterifttest "X`(/usr/ucb/echo -n -n $as_echo)+2>/dev/null`" = "X-n $as_echo"; then as_echo_body='evalt/usr/ucb/echo -n "$1$as_nl"' as_echo_n='/usr/ucb/echo -n' elseterroas_echo_body='evaltexpr "X$1" : "X\\(.*\\)"' as_echo_n_body='eval errorrarg=$1; errorrcase $arg in #(terrrrr*"$as_nl"*) expr "X$arg" : "X\\(.*\\)$as_nl"; arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; errorresac; errorrexpr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" erro' export as_echo_n_body as_echo_n='sh -c $as_echo_n_body as_echo' fi erexport as_echo_body as_echo='sh -c $as_echo_body as_echo' fi, # The user is always right. ifttest "${PATH_SEPARATOR+set}" !=oset; then PATH_SEPARATOR=: er(PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1o&& { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1o|| errorrPATH_SEPARATOR=';' } fi, # IFS # We need space, tabtand new line, in precisely thattorder.ttQuoting is # there to prevent editors from complaining about space-tab.,# (If _AS_PATH_WALK were called with IFS unset,tittwould disable word,# splitting by setting IFS to empty value.) IFS=" "" $as_nl" ,# Find who we are.ttLook in the pathriftwe contain no directory separator. case $0 in #((ter*[\\/]* ) as_myself=$0 ;; er*) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do erIFS=$as_save_IFS ertest -z "$as_dir" && as_dir=., ttttest -r "$as_dir/$0" && as_myself=$as_dir/$0 && break, tdone IFS=$as_save_IFS erro ;; esac # We did not find ourselves, most probablytwe were run as `sh COMMAND' # in whichrcase we are not to be found in the path. ifttest "x$as_myself" = x; then as_myself=$0 fi,ifttest ! -f "$as_myself"; then $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 erexitt1 fi, # Unsettvariables thattwe do not need and whichrcause bugs (e.g. in # pre-3.0 UWIN ksh).ttBut do not cause bugs in bash 2.01; the "||rexitt1",# suppressestany "Segmentation fault" message there.tt'((' could # trigger a bug in pdksh 5.2.14. for as_var in BASH_ENV ENV MAIL MAILPATH do evalttest x\${$as_var+set} = xsett\ er&& ( (unset $as_var) ||rexitt1) >/dev/null 2>&1o&& unset $as_var ||r: done PS1='$o' PS2='>o' PS4='+o' # NLS nuisances. LC_ALL=C export LC_ALL LANGUAGE=C export LANGUAGE # CDPATH. (unset CDPATH) >/dev/null 2>&1o&& unset CDPATH, # as_fn_error STATUS ERROR [LINENOrLOG_FD] # ---------------------------------------- #rOutput "`basename $0`: error: ERROR" to stderr. If LINENOrand LOG_FD are # provided, also output the error to LOG_FD, referencing LINENO. Thenrexittthe # script with STATUS, using 1riftthattwas 0. as_fn_error () { as_status=$1;ttest $as_status -eq 0 && as_status=1terifttest "$4"; then as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 fi er$as_echo "$as_me: error: $2" >&2 as_fn_exitt$as_status } # as_fn_error, # as_fn_set_status STATUS # ----------------------- # Set $? to STATUS, without forking. as_fn_set_status () { return $1 } # as_fn_set_status # as_fn_exittSTATUS # ----------------- # Exittthe shell with STATUS, even in a "trap 0" or "set -e" context. as_fn_exitt() { set +e as_fn_set_status $1 erexitt$1 } # as_fn_exitt # as_fn_unset VAR # --------------- # Portablytunset VAR. as_fn_unset () { { evalt$1=; unset $1;} } as_unset=as_fn_unset # as_fn_append VAR VALUE # ---------------------- # Append the text in VALUErto the end of the definition contained in VAR. Take # advantage+of any shell optimizations thattallow amortized linear growth over # repeated appends, instead of the typicaltquadratic growth present in naive # implementations. ift(evalt"as_var=1; as_var+=2;ttest x\$as_var = x12")+2>/dev/null; then : erevalt'as_fn_append (), t{ evalt$1+=\$2 }' elseteras_fn_append (), t{ evalt$1=\$$1\$2 } fi # as_fn_appendt # as_fn_arith ARG... # ------------------ # Perform arithmetic evaluation on the ARGs, and store the result in the # globalt$as_val. Take advantage+of shells thattcan avoid forks. The argumentst# must be portable across $(())tand expr. ift(evalt"test \$(( 1r+ 1r)) = 2")+2>/dev/null; then : erevalt'as_fn_arith (), t{ as_val=$(( $* )) }' elseteras_fn_arith (), t{ as_val=`expr "$@" ||rtest $? -eq 1` } fi # as_fn_arith, iftexpr a : '\(a\)' >/dev/null 2>&1o&& ttttest "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr elseteras_expr=falsetfi, ift(basename -- /) >/dev/null 2>&1o&& test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename elseteras_basename=falsetfi, ift(as_dir=`dirname -- /`o&& test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname elseteras_dirname=falsetfi, as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \|t\ X"$0" : 'X\(//\)$' \|t\ X"$0" : 'X\(/\)' \|t.+2>/dev/null || $as_echo X/"$0" | errosed '/^.*\/\([^/][^/]*\)\/*$/{ rros//\1/ rroq r} r/^X\/\(\/\/\)$/{ rros//\1/ rroq r} r/^X\/\(\/\).*/{ rros//\1/ rroq r} rs/.*/./; q'`t # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in #((((( -n*)tercase `echo 'xy\c'` in er*c*) ECHO_T=' ';; # ECHO_T is single tab character., txy) ECHO_C='\c';; er*) erecho `echo ksh88 bug on AIX 6.1` > /dev/null errorroECHO_T=' ';; rresac;; *)terECHO_N='-n';; esac rm -f conf$$ conf$$.exe conf$$.file ifttest -d conf$$.dir; then rm -f conf$$.dir/conf$$.file elseterrm -f conf$$.dirtermkefin(' as_cr_LETTERS='Aecho='sh `echo ksh88 bug on AIX 6.1` > /dev/null errorroECHO_T=' ';; rresac;; *)terEC>h `echo ksseterifttest "X`(/usr/; *ln -se elseterrm f$$.dir/terifttest "X`(/usr/no_sta---='ln -sho' # namZSH_VATH_WAmysetworrrt` >s:o' # o' On MSYas_bo, `ln -serrm fCHO'alt'a`ln rrm fCHO'arrrr.o' # 2) DJGPP s*) asymc gks; `ln -s'-------in wr evar)'`ecu/null.o' # In_bo, cterllswee GNU sh_cras_v sh`cp -p'.o' ln -se elseterrm f$$.dirECHO_T=' ';; rrelseteras_! AIX 6.1` >filew line, i_sta---='cp -p'_body; *ln elseterrm f$$.dir/terifttest "X`(/usr/no_sta---=ln_body='eval erra---='cp -p'_boac;"$0" : '.*a---='cp -p'_ac;f conf$$.dir/conf$$.file elseteo='sh `echo kse elseterrm -rmll errorroECHO_T=' ';; rresation on tnull _p store the resulror re, us && break,ain s_save_IF,-------as_cpar des/; *ner)) arys_fn_appnull _pAR VAL arg=`exttttest -arg" -$as_sa IFS=/exttttele ifttes=$as_dir/ds && break,' PSvtst# munull _pA' Ppr a : '\ll s=r a :wh kse:; _dir/"; arg=`exttttest -arg" : ".*\'$as_saq_dirnor, # as_fn_sreak,'\)$/{"s/'/\\\\\\\\\''/go' #'rg" : ".*as_saq_direxttttele ifexport aline, i_stll s="'$_saq_di'`exttttes"line, i_stll rnor, ame=dirname && break,' \ X"$0" : && break,[^/]*\.* rrull/*\1/ rrol || $as_echo X& break,[^/]*\rros rr| $as_echo X& break,[^/]*\rros|| $as_echo X& break,[^/]*\r\/*$/{ rros//\1/ rroq r} r && break,'\/\/\)$/{ ]*\.* rrulq *\1/ rro r} r/^X\/\(\/\).*/{ rros//\1/ oq r} rrharacter Ranges. as_cr_letters='/ oq r}} r/^X\/\(\/\).*/{ rros//\1/ oq Character Ranges. as_cr_letters='abcdefghijklmine, is_dir/ds && break,lves, most t probae, is_dir/$0 && breask,' PSvtst"null eexttttes"lin}ll 2>&1o&/ds && break,' Perifttest "$& t" # Unseure, uss_save_IFS&& breaksatAR. as_fn_null _p ; *null e-p rros//\1/ as_myself: erull _p='null e-p && break} fi # as>&1o&/ds./-p lvermll e./-pelf: erull _p=l 2>&1; then >&1o&/xtfi as_me=`$as_basename -- "$0>&1o_x='>&1o&/xn $as_echo";tan-dLtfi as_me=`$as_basename -- : '.*as_L_ in th=L_body='eval erras_L_ in th=s_fn_err"$0>&1o_x='----------We nee'\''mine, if conf$$.di"$1=`dirnam onf$$.di"$1/."e ifexpory='e arg=`e1st -arg -$a----"=/e1=`; rt as_ arg=``tan-ld'$_saas_L_ in th'i"$1= esac fi, as_nl=' rg ???[sx]*):;;*)l 2>&;;rt asfT.toli'\''$@"}, '_ac; X"$ecu/null_p=$"$0>&1o_x 1 } #'as_fn)) vant shmapn \\\\\\\onholde---tuvCPP =dirs_fn_tr_cpp="-----W$/{ y%*_cr_Letters$as%P_cr_digits EC%;s%[^_$`echo -n x`]%_%g'" 1 } #'as_fn)) vant shmapn \\\\\\\onholde---tuvUWIN ksh =dirs_fn_tr_sh="-----W$/{ y%*+%pp%;s%[^_$`echo -n x`]%_%g'" 1 "$ec 6basxport DUALCASE # for MKSSSSSSSSSSSSSSSSourne co er*R+setof $h Initia #rOuts=$1;t1; export DUALCASE # for MKSSSSSSSSSSSSSSSSourne SGNU he SHE in BASterr keepH_SE thato;; emeaittwty oor !tson naivr is cturr!--th Sontaiusageh InitiFILES etc.tions. ift(evaliin nontaius r ln in thse GndlxittSTc_ SH=" , ttttt!tPatussh ondtittexHOUTfn_setbrary9g '${1+Patu gration.,# Co&1o&&#-c :0s_dir/arg=`e1st -----*=?*------Tc_ in th=`rcase $arg in/]*\[^=roq =klmine,Tc_ ing" : "X\\(.*\rg in/][^=ro=n='sh)klmine,Tc_shift=:o' le if--*=------Tc_ in th=`rcase $arg in/]*\[^=roq =klmine,Tc_ ing" :mine,Tc_shift=:o' le if*------Tc_ in th=$1mine,Tc_ ing" :$2mine,Tc_shift=shifto' le if rm - arg=`exc_ in thst ---# HGndlxitft(evalt in ths.o' -rt SHEL'|'--rt SHEL'|'--rt SHE'|'--rt SH'|'--rt S'|'--rt '|'--rt'|'--r------Tc_xport SHELL: le if--on., ttt|f--on., tt|f--on., t|f--on.,t|f--on.t|f--ont|f--ot|f-V )_echo "$as_me: er-----on., tt";ytunsele if--ugging$|f--uggin$|f--uggi$|f--ugg$|f--ug$|f--u )_echo "$as_me: er-----ugging";ytunsele if--)') 'R|f--)') R|f--)')R|f--)'R|f--)R|f-d )_echoLL-/bi: le if--tt!tP|f--tt!P|f--ttP|f--t )_echo "c_shift_echoarg=`exc_ inxpr "X_echo*\'$as_c_ ing" : "$as_me: er-- ing" k,'\)$/{"s/'/\\\\\\\\\''/go' le ifex'')Perifttest "$& t"mi) vo&& t!tP( 1r+ 1r" le ifexrt aline,_arith ARG...h InitiFILES " 'er-- ing" '"-----Tc_use __cras_vs=l 2>&;; if--SH'|'--S'|'rt helpf|rt helf|rth )_echo "$as_me: er-----O_GLO";ytunsele if-qf|rtquiIFf|rt quiIFf|rt quiIf|rt quif|rt quf|rt q||r: |rt------f|rt ------f|rt -----f|rt ----f|rt ---f|rt --f|rt -------Tc_xpo-------: le ---# , tttEPARnstatus.g" -$as_safttest "$& t"unrt ggndrati in th: \`f1' T s\`f0rt help'the GNU Geppm_rm confi" le ---$as_saftt ARG...Tc_x_ng" eG_d"`e1"line, Tc_use __cras_vs=l 2>& le ---rt alinshift_proba Tc_xc_cX"$tra_g" s=then $Tc_xpo------ename -- "$ec 6bconf$$ conf$Tc_xc_cX"$tra_g" s= er---c_cX"$tra_g" srt ------"1; then $Tc_xport SHELename -- ----X 'ion. ## #' './alsetac_c' '--en ksh-mpi=openmpi' '-- set-ppm=../../ppmcore/' 'LDFLAGS=-L/home//sw/_vals/--tel//' er---c_cX"$tra_g" srt no-ure, ust no-rt u--------shift_ec "$as_me: runittwoh Initializa=ion. ## # $*TUS 6 eh Initializa='ion. ## #' e user ish Initializa-- "$ec v/nu1; th"$ec 5>>=falset SHVALUEolari/\)$/{ h;s/./-/g;s/^nam/por/;s/...$/our/;p;x;p;x' <<_ASBOXxporRunittwofn_set1; ex_ASBOXxho "$as_me: er-- SH" }US 5satioHGndlxitft(e( 1r+ 1r)t} = xsc_x_ng" eGst -rTc_x_ng" eG_s_dir/arg=`esc_x_ng" eGst line,"o kett!ta).h InitiFILES= eh InitiFILES o kett!ta le ---$as_safttest "$& t"in---tuv( 1r+ 1r: \`fsc_x_ng" eG'": efn_exi" 5 le if rm proba otin(evaltATH_Sdwhichrcfault\$(( 1r+ 1r) to LpecthyeCULAR es) to ionsanti---,S_PATHnhell opvt\ er&terrorrtEPAfaudi # aon abouosen the myself=.' # infault\$(\\\\\globa = xt P_cras_v a) vgn+ 1r ben faulepeatssh aimelyN$ZSizaor '-n';; eSunOS 4ary3.hen $Tc_use __cras_vsename -- /bin;/bih InitiFILESH; sh - :) >,' Ph InitiFILES=$_tt!ts n # prHGNU a eseo' ss_save_IFS = xcons:ni----. o ke=" "_ge+of btttttt(atatus+2>/y ben faulATH_WAis*) are,snfs gaionse GN(If _se e_cs_aest ! addi----,S_Pure, ttwoubdoenvvo&& t!tth IFS /tmppr. iso_valm---- faulfounles).' #Hr*[\ = xir) aimoNalnunltstics_rechec.' #Noten the ATH_WAis*a sma{ sndowf" = x; tht P__save_IFSlied chrcb---leaned:tionfmres',------- tttSH_VbefU Gep,--=dirn >s*been a) vgnaram_f`$tmp'. $)') 'R||VALUEtmp:minus $1'tuns as_li? UE #s_dir/$0 &tmpull 2>&1o&!$.di"$tmpull 2f conri"$tmpu; } lvetunsettuns as_ ' 0minus $1'tt # as_fn_1' 1 2 tt!t5 }ror re, usa (st u-e)Etmpss_save_IFS = xtmps t!tt. VALUEtmp:`(umask 077 lvemk ese$.di"./alseXXXXXX"; esac fi, as_lseteremulate stmpulseteras_.di"$tmpu }UR||VALUEtmp:.sh `ec-$RANDOMLUE(umask 077 lvemkll e"$tmpu) },' Perifttest "$& t" # Unseure, usa eseo' ss_save_IFS" =.": efn_exi" 5 1 } # aupe+of s=$1;tst "X`h InitiFILES st configurNoause bm_fgration.e+ofmi)(evalrs_myself`h InitiFILES. # , ttth ARG.st "X`ionsanrrt set `.0000th'. : eremulate sh InitiFILES=`dirnama Tc_xr=)terECX $as_eX '\015klm# On cygw,'pp## # r. ie, \X`ioni)'R``i)(evaltATH_Srequemutizegncr. # Segmwe knowfoalleto erro() { alrs_mc_xr"" $as_b--ftwe cal;eterrexior&t,ato;f=$0. ifaulap## #ism,ain l 2lbackmyself"; then c_xrho "$as_myself-----Tc_xr=\$\\\\r\'_ac; c_xpoawk_xr=)sAWK 'BEGINE #/null;"a\rb" }' "$tmp/LE_P1.awkulse cal;>>"$tmp/LE_P1.awkul<<\_ACAWK se S["LTLIBOBJS"]="" S["LIBOBJS"]="" S["DEBUG"]="" S["F90_LIBS_"]="-l" S["F90_LDFLAGS_"]="-L../../ppmcore//" S["F90__"]="-I../../ppmcore// ppm_mo/" S["F90_HEAD E_"]="" S["ax_cv_f90_modflag"]="-I" S["EGREP"]="ion. gree$.E" S["GREP"]="ion. gree" S["FCLIBS"]=" -L/home//sw/_vals/--tel// -L/ in/openmpi/1.5/--tel/ -L/ in/openmpi/1.5/--tel// -L/ in/--tel/unseoserxe-2011ar+s37/unses in//--tel64"\ " -L/ in/--tel/unseoserxe-2011ar+s37/ipp/../unses in//--tel64 -L/ in/--tel/unseoserxe-2011ar+s37/ipp//--tel64 -L/ in/--tel/unseoserxe-2011ar+s3"\ "7/mkl//--tel64 -L/ in/--tel/unseoserxe-2011ar+s37/tbb//--tel64//cc4ary0_c2.4_kernel2.6.16.21 -L/"' /x86_64-lxiux-gnu/gcc/x86_64-lxiux-g"\ "nu/4.5.2 -L/"' /x86_64-lxiux-gnu/gcc/x86_64-lxiux-gnu/4.5.2/../../.. -L/64 -L/ -L/"' 64 -L/"' -L/"' /x86_64-lxiux-gnu -lses_f"\ "90 -lses_f77 -lsesn-ldln-lnsln-ln-lifer is-lifcores-limfs-lsvmn-lms-lipgos-lircs-lpthr. if-lirc_s" S["ac_xt_FC"]="" S["FCFLAGS"]="-O3 -FR -I../../ppmcore// ppm_mo/" S["FC"]="sesf90" S["RANLIB"]="ran" S["SET_MAKE"]="" S["CPP"]="sescc$.E" S["ac_xt_CC"]="sescc" S["CFLAGS"]="-O3" S["CC"]="sescc" S["OBJEXT"]="o" S["EXEEXT"]="" S["ac_xt_CXX"]="" S["CPPFLAGS"]=" -D__F2003" S["LDFLAGS"]="-L/home//sw/_vals/--tel// -L../../ppmcore// -L../../ppmcore//" S["CXXFLAGS"]="-O3" S["CXX"]="sesc++" S["MPIFC"]="sesf90" S["MPICXX"]="sesc++" S["MPICC"]="sescc" S["ng" eG_o)+2>"]="" S["host_o)+2>"]="" S["btttt_o)+2>"]="" S["LIBS"]="-lfftw3 -l -l " S["Econf$"]="" S["f$$.di"]="-n" S["f$$.dC"]="" S["DEFS"]="-DPACKAGE_NAME=\\\"PPM\\\" -DPACKAGE_TARNAME=\\\"\\\" -DPACKAGE_v/null;=\\\"rary9\\\" -DPACKAGE_STRING=\\\"PPM\\ rary9\\\" -DPACKAGE_BUGREPORT=\\\"\\\" -DPACKAGE_URL="\ "\\\"\\\" -DSTDCiHEAD EC=1 -DHAVE_SYS_TYPES_H=1 -DHAVE_SYS_a #r_H=1 -DHAVE_STDLIB_H=1 -DHAVE_STRING_H=1 -DHAVE_MEMORY_H=1 -DHAVE_STRINGS_H=1 -DHAVE_INTTY"\ "PES_H=1 -DHAVE_STDINT_H=1 -DHAVE_UNISTD_H=1 -DSIZEOF_LONG_lver_p=16 -DHAVE_LIBFFTW3=1" S["=r !ir"]="${dang"oot!ir}/=r " S["rrrrre!ir"]="${dang"oot!ir}/rrrrre" S["rib!ir"]="${"$ec_prefix}/" S["ps!ir"]="${docll }" S["pdf!ir"]="${docll }" S["dvi!ir"]="${docll }" S["html!ir"]="${docll }" S["ppm_!ir"]="${dang"oot!ir}/ppm_" S["docll "]="${dang"oot!ir}/doc/bin'CKAGE_TARNAME}" S["ol!ippm_moll "]="/"' ippm_mo" S["pppm_moll "]="${prefix}/ippm_mo" S["rrrrr00oll "]="${prefix}/var" S["shmysd00oll "]="${prefix}/uns" S["sysll "]="${prefix}/etc" S["dangll "]="${dang"oot!ir}" S["dang"oot!ir"]="${prefix}/shmys" S["rib"$ec!ir"]="${"$ec_prefix}/"$ec" S["son.!ir"]="${"$ec_prefix}/son." S["bn.!ir"]="${"$ec_prefix}/on." S["st -z "_us nsglob_rcaus]="s,x,x," S["stefix"]="/"' rrrrr" S[""$ec_prefix"]="${prefix}" S["PACKAGE_URL"]="" S["PACKAGE_BUGREPORT"]="" S["PACKAGE_STRING"]="HOUTrary9" S["PACKAGE_v/null; ]="rary9" S["PACKAGE_TARNAME ]="" S["PACKAGE_NAME"]="HOU" S["PAdir" && as_d"]=":" S["Sliza"]="ion. ## #" _ACAWK cal;>>"$tmp/LE_P1.awkul<<_ACAWK se t "X`(keFS" =S) S_is----[keF]as_1minFSin("" }rALUEc grP= $ 0minnttRems- :)we a(from cttRem, "@"----LE_PRtiz= 0min---f=n---gth(ttRem[1]) t "X`(i* )); i "$tmp/LE_P.awkul|r: | Perifttest "$& t" $as_atiosetupt& t!tthmachromry": efn_exi" 5 xpr 0remulate sh InitiFILES= 1 "----W$--X " :F($h InitiFILESval --" shift_ = xsc_tags_dir/arg=`esc_tagst lin:[FHLC]as_c_mode=esc_tag;low axiuele ifttes=$aarg=`esc_modeesc_tagst lin:[FHL]*:*)le if:L* | :C*:*)s_safttest "$& t"in---tuvtags\`fsc_tag'": efn_exi" 5 le if:[FH]-)xsc_tag=-:-le if:[FH]*)xsc_tag=fsc_tag:fsc_tag.inle ifttes=$a"c_se_IFS ertest r/$0" :-- ----x`esc_tag r/$0" &&cas_myself=$ashift_ec&catt!t=$1minshift_=$aarg=`esc_modest lin:L)xsc_------linee if:[FH]------Tc_tt!t_--th s=r a : = xsc_ error_dir/"; arg=`exc_ st line, -)xsc_f="$tmp/Lt!in"le ifexpo*)x#ter*[\ = xt P t!tPfirs "_ge+of btttttt(at,_fn_ar_ge+of s------t(ata x#t()(evaltas_mysstationeed andny " \$((eed and as_my # Unsebe DOS-stF--,a x#tben faulexc_ s # Unseu ;; er*`:'.a xremulaf;/b c_fk,' \ ; arg=`exc_ st l ; r as$]*)xl 2>&;; xpo*)xremulaf;/bsrcll /b c_fk,_linc_f="$srcll /b c_fk;; xpottes,' \ ; _safttest "$1t" # Unsettvar--th S t!t: \`fsc_f'": efn_exi" 5 le ififexrt aline, arg=`exc_ st o*\'$as_c_f: "$as_me: er--fk,'\)$/{"s/'/\\\\\\\\\''/go' rt aline, i_stftt ARG...Tc_tt!t_--th s " 'er--f'"-----proba ----#teet's stied pre ond=" "_s `alsetac_c' x; thionsanti---in(i.e.,eenn't ----#tusTHfn_set), peop# Fin$as_b--sur/nuse bm_fr. i:o' # /*thy "uration.,# Compiler0000y "*/_echoac_cX--th ='uration.,# IFS '`\ ; "$as_me: e*k,'\)$/{'s|^[^:]*/||;s|:[^:]*/|, |g' `'# Compiler out'-----; * e er--ft!ta != x-ename -- : hoac_cX--th = er--ft!ty "$ac_cX--th "line, i{o "$as_me: error: $2" >&2 as_fn_exitt$ure, ttwoer--ft!ta S 5sor, # as_fn_set_sure, ttwoer--ft!ta S 6;}r a : io' # Neuus -----Lpect---` > /dev/ser&terpre odtLook st ! replacdev/n \\\\\\Public arg=`eac_cX--th st -arg" : *\&* | *\|* | *\\* --------xsc_-ed_xX--th = "$as_me: eac_cX--th " line, i\)$/{'s/[\\\\&|]/\\\\&/g'`g string--$as_c_-ed_xX--th =eac_cX--th le ifexrt al_echoarg=`exc_tagst lin--$:-:* | *:-)xcal;>"$tmp/Lt!in"then : | Perifttest "$& t" $as_atioure, user--ft!ta efn_exi" 5 le ifexrt aline,le if rm - r--ll rnor, ame=dirname &&--ft!ta ' \ X"$0" : &&--ft!ta [^/]*\.* rrull/*\1/ rrol || $as_echo X&--ft!ta [^/]*\rros rr| $as_echo X&--ft!ta [^/]*\rros|| $as_echo X&--ft!ta [^/]*\r\/*$/{ rros//\1/ rroq r} r &&--ft!ta ' , i\)$/{' ]*\.* rrulq *\1/ rro r} r/^X\/\(\/\).*/{ rros//\1/ oq r} rrharacter Ranges. as_cr_letters='/ oq r}} r/^X\/\(\/\).*/{ rros//\1/ oq Character Ranges. as_cr_letters='abcdefghijklmin_stll r &&--!ir"; as_fn_null _p r--btttt IFS=$=' ';; &&--!ir"st l.) r--ll _suffix=xsc_top-btttt IF_sub=.xsc_top-btttt_prefix= t -d conr--ll _suffix=/ "$as_me: er--reak,'\)$/{'s|^\.r as_||klmin# A ".."\ = xeachss_save_IFS" =$r--ll _suffix.conr--top-btttt IF_sub= "$as_me: er--rea_suffixk,'\)$/{'s|/[^ as_d|/..|g;s|/||klminarg=`exc_top-btttt IF_subst lin"")xsc_top-btttt IF_sub=.xsc_top-btttt_prefix= t -; rressc_top-btttt_prefix=exc_top-btttt IF_sub/,le if rm COMMAND'xc_(ee_top-btttt IF=exc_pwd'xc_(ee_btttt IF=exc_pwder--rea_suffix #t "X`prckward_VERSION+ie ay: xc_top-btttt IF=exc_top-btttt_prefix$=' ';;$srcll st lin.) # inarf btttt(If _geplacd.-----Tc_srcll r.-----Tc_top-srcll rexc_top-btttt IF_sub-----Tc_(ee_top-srcll rexc_pwd,le ifr as_di| ?:r as_dir n# Aeed and =dirs_----Tc_srcll r$srcll er--rea_suffix;-----Tc_top-srcll resrcll -----Tc_(ee_top-srcll resrcll st -; rre# RelIONvd =dirs_----Tc_srcll r$xc_top-btttt_prefix$srcll er--rea_suffix-----Tc_top-srcll rexc_top-btttt_prefix$srcll -----Tc_(ee_top-srcll rexc_pwd/esrcll st -MAND'xc_(ee_srcll rexc_(ee_top-srcll er--rea_suffix-_=$aarg=`esc_modest lin:F con#min# h InitiFILEcon#motin(evaltteset,--Sdoestatioknowfuld didang"oot!ir, useaest =.' #FIXME: , ttth cktand thebenaimoNUGenefew yearus r ln2.60tSTc_dang"oot!ir_h ck=; Tc_dang"oot!ir_seen= _c_-ed_dang"oot=' /dang"oot!ir/Ppr ap q }r/@dangll @/pr/@docll @/pr/@ppm_!ir@/pr/@rrrrre!ir@/pr/@=r !ir@/p'=' ';; #vtst")$/{ate\"\$_c_-ed_dang"oot\"ser--ft!t_--th s"_C='\*dang"oot!ir$as_c_dang"oot!ir_seen=yest -d@dangll @*|*@docll @*|*@ppm_!ir@*|*@rrrrre!ir@*|*@=r !ir@d con{o "$as_me: error: $2" >&2 as_fn_exitt$WARNING:ser--ft!t_--th s Mess) to igncan avoi--dang"oot!irsk in tha S 5sor, # as_fn_set_sWARNING:ser--ft!t_--th s Mess) to igncan avoi--dang"oot!irsk in tha S 2;}r aTc_dang"oot!ir_h ck=osix*&@dangll @&${dang"oot!ir}&gsix*&@docll @&${dang"oot!ir}/doc/bin'CKAGE_TARNAME}&gsix*&@ppm_!ir@&${dang"oot!ir}/ppm_&gsix*&@rrrrre!ir@&${dang"oot!ir}/rrrrre&gsix*&@=r !ir@&${dang"oot!ir}/=r &gsix*&\${dang"oot!ir}&${prefix}/shmys&g'st -MAND'xc_-ed_"$tra=" :tr/@[a-zA-Z_][a-zA-Z_0-9]*@/!b s|@ac_cX--th @|$_c_-ed_xX--th |;t t *&@top-btttt IF@&$xc_top-btttt IF_sub&;t t *&@top-btttt_prefix@&$xc_top-btttt_prefix&;t t *&@srcll @&$xc_srcll &;t t *&@(ee_srcll @&$xc_(ee_srcll &;t t *&@top-srcll @&$xc_top-srcll &;t t *&@(ee_top-srcll @&$xc_(ee_top-srcll &;t t *&@btttt IF@&$xc_btttt IF&;t t *&@(ee_btttt IF@&$xc_(ee_btttt IF&;t t *&@(ee_top-btttt IF@&$xc_(ee_top-btttt IF&;t t $Tc_dang"oot!ir_h ck " -----W$/{\"\$_c_-ed_"$tra\"e &&--ft!t_--th s"i| sAWK af;/btmp/LE_P.awkul>btmp/d di|r: | Perifttest "$& t" $as_atioure, user--ft!ta efn_exi" 5 s_dir/$0 &&c_dang"oot!ir_h ck&&c_dang"oot!ir_seen" se t{s_c_ h = )$/{ate'/\${dang"oot!ir}/p';/btmp/ h "`;0remulate s_c_ h u; } lv t{s_c_ h = )$/{ate'/^[ ]*dang"oot!ir[ ]*:*=/p';/btmp/ h "`;0remulaze s_c_ h u; } lv t{s "$as_me: error: $2" >&2 as_fn_exitt$WARNING:ser--ft!teu ;; erin ttwas 0.ee shell UWIN ksh \`dang"oot!ir' x; thMess) to warrnncludedi Ple ';;m ke=sure=" "_s ncludeda S 5sor, # as_fn_set_sWARNING:ser--ft!teu ;; erin ttwas 0.ee shell UWIN ksh \`dang"oot!ir' x; thMess) to warrnncludedi Ple ';;m ke=sure=" "_s ncludeda S 2;}r g on AIX"$tmp/Lt!in"=$aarg=`esc_tt!tPP ----)xcal;/btmp/ h " lverm AIX"$tmp/ h u; -; rrerm AIX"$r--ft!ta lvemv;/btmp/ h " "$r--ft!tale if rm |r: | Perifttest "$& t" $as_atioure, user--ft!ta efn_exi" 5 le - ---rt al probll 2>&1sc_tag itt # as_fn_0libppmnumerics-r1036/config.statusure6565264ustar omaromar currentonfiguutstiontaius2>&1systes-wxyz' v/n UWIN ksh). bdoure, uso kett!t).' #Gration.,# Co&1HOUTrary9.' ' ' C-or !tttttCtt1992,t1993,t1994,t1995,t1996,t1998,t1999, 2, 21,S_P22, 23, 24, 25, 26, 27, 28, 29, 2ttt (attyour opt' #Fn)tany lateInc. ' ' , ttture=s=$1;tter the terms of ;e, or (attyour option)tany la # giv-inunlimin.,#varmi) vant shralt,NY WARRANTYr bdoense it.-------- ## ,# Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh ifttest -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : eremulate sh erNULLCMD=: er# Pre-4.2tversions of Zsh do word splitting on ${1+"$@"}, which, t# is contrary to our usage.ttDisable this feature. alias -g '${1+"$@"}'='"$@"' setoptoNO_GLOB_SUBST elsetercase `(set -o)+2>/dev/null` in #(ter*posix*) : erroset -o posix ;; #(ter*) : erro ;; esac fi, as_nl=' ' export as_nl # Printing a long string crashes Solaris 7 /usr/bin/printf. as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo # Prefer a ksh shell builtin over an externaltprintf program on Solaris, # but without wasting forks for bash or zsh. ifttest -z "$BASH_VERSION$ZSH_VERSION" \ erro&& (test "X`print -r -- $as_echo`" = "X$as_echo")+2>/dev/null; then as_echo='print -r --' as_echo_n='print -rn --' elifo(test "X`printf %s $as_echo`" = "X$as_echo")+2>/dev/null; then as_echo='printf %s\n' as_echo_n='printf %s' elseterifttest "X`(/usr/ucb/echo -n -n $as_echo)+2>/dev/null`" = "X-n $as_echo"; then as_echo_body='evalt/usr/ucb/echo -n "$1$as_nl"' as_echo_n='/usr/ucb/echo -n' elseterroas_echo_body='evaltexpr "X$1" : "X\\(.*\\)"' as_echo_n_body='eval errorrarg=$1; errorrcase $arg in #(terrrrr*"$as_nl"*) expr "X$arg" : "X\\(.*\\)$as_nl"; arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; errorresac; errorrexpr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" erro' export as_echo_n_body as_echo_n='sh -c $as_echo_n_body as_echo' fi erexport as_echo_body as_echo='sh -c $as_echo_body as_echo' fi, # The user is always right. ifttest "${PATH_SEPARATOR+setecho' fi,; then PATH_SEPARATOR=: er(PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1o&& { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1o|| errorrPATH_SEPARATOR=';' } fi, # IFS # We need space, tabtand new line, in precisely thattorder.ttQuoting is # there to prevent editors from complaining about space-tab.,# (If _AS_PATH_WALK were called with IFS unset,tittwould disable word,# splitting by setting IFS to empty value.) IFS=" "" $as_nl" ,# Find who we are.ttLook in the pathriftwe contain no directory separator. case $0 in #((ter*[\\/]* ) as_myself=$0 ;; er*) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do erIFS=$as_save_IFS ertest -z "$as_dir" && as_dir=., ttttest -r "$as_dir/$0" && as_myself=$as_dir/$0 && break, tdone IFS=$as_save_IFS erro ;; esac # We did not find ourselves, most probablytwe were run as `sh COMMAND' # in whichrcase we are not to be found in the path. ifttest "x$as_myself" = x; then as_myself=$0 fi,ifttest ! -f "$as_myself"; then $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 erexitt1 fi, # Unsettvariables thattwe do not need and whichrcause bugs (e.g. in # pre-3.0 UWIN ksh).ttBut do not cause bugs in bash 2.01; the "||rexitt1",# suppressestany "Segmentation fault" message there.tt'((' could # trigger a bug in pdksh 5.2.14. for as_var in BASH_ENV ENV MAIL MAILPATH do evalttest x\${$as_var+set} = xsett\ er&& ( (unset $as_var) ||rexitt1) >/dev/null 2>&1o&& unset $as_var ||r: done PS1='$o' PS2='>o' PS4='+o' # NLS nuisances. LC_ALL=C export LC_ALL LANGUAGE=C export LANGUAGE # CDPATH. (unset CDPATH) >/dev/null 2>&1o&& unset CDPATH, # as_fn_error STATUS ERROR [LINENOrLOG_FD] # ------------------------self"; thenh Initializaho "$as_myself: eb${ZSH_VERSION+se=": eremulate\"\$h erNULLCMD=: er#\ Pre-4.2tversions of Zsh do word splitting on ${1+"$@"}, which, t# is contrary to our usage.ttDisable this feature. \null\"\$@\ -g '${1+"$@"}'='"$@"' setoptoNO_GLOB_SUBST elsetercase `(set -o)+2>/dev/\null\"\$@\ -#(t\"\$@\ osix*) : erroset -o posix ;; #(ter*) \: erro ;; esac fi, a\s_nl=' ' export as_nl # Printing a long string crashes Solaris 7 /u"elf: erequ_sad="tt # a- # Exi() {-4.4='+\$1); }STATUS #ucr)) i() {-tt # a- # Exi0; }STATUS rrrrure=() {-tt # a- # Exi1; }STATUS r----ucr)) i() {-- # Exi0; }STATUS r---rrrrure=() {-- # Exi1; }S .4='!, t=0STATUS #ucr)) i' Pp .4='!, t=ulate naTATUS #ucr)) irrrred.; }STATUS rrrrure=rror .4='!, t=ulate naTATUS rrrrure=#ucr)eded.; }STATUS r----ucr)) i' Pp .4='!, t=ulate naTATUS r----ucr)) irrrred.; }STATUS r---rrrrure=rror .4='!, t=ulate naTATUS r---rrrrure=#ucr)eded.; }S_ech ----x;aTATUS r----ucr)) iylseteras_xo "\"\$1\ P)splittingx ;; #(t.4='!, t=ulate na a l. fozsh.FS;meev/se pathatiosre d.7 /u/null 2>.4='!, to "$0 could # trihen uo ePRtiire:${as_linen1=";n uo ePRtii$n uo ePRtiefn_exi;n uo ePRtii$n uo ePRti":${as_linen1a=\efn_exi e:${as_linen2=";n uo ePRtii$n uo ePRtiefn_exi;n uo ePRtii$n uo ePRti":${as_linen2a=\efn_exi e:(), t{{ "evalt$s_linen1'valt$ttwt\"-c : "evalt$s_linen2'valt$ttwt\"-lseteremul "ev "X\\(valt$s_linen1'valt$ttwtl=$(\`\" : "evalt$s_linen2'valt$ttwt\"' could # t { as_val=$(( $* )) could # triherith (), t$: erequ_sad }' elseteras_fn_arith : e GNUerequ_sad=yes;"$0" : '.* GNUerequ_sad=no The ; * e$'.* GNUerequ_sado "$yesPre-4.(), t$: e uo ePRti" }' elseteras_fn_arit;"$0" : '.*ve_IFS ertest -z "$as_dir" && as_diTATUttes=l 2>&1;=., ttttest -;' as_dir" && as_d\\\\\\\\as_dir" && as_dr "$as_dir/$0" && as_myself=$as_dir/$0 && break, tdone IFS=$asTATUttes=: arg=`exttttest -arg /(.*\ : = xs"$0" :st -ttDge ththout 5; _dias_cr-# , son ab(())tand expONFIGterr s_my --to alalt"tesias_cr-& as())tt find ours"$0" :ias_cr-; *{xremulaf;/b as())tull 2>&1o⁡/b as())t.filu; } lv as_cr{s "$as_me: errob${ZSH_VERSION+se"t$: erequ_sad Perittw=a;/b as())tu; } }' elseteras_fn_arith h Initializa=b as())t : e GNUerequ_sad=yes; as_c; *{x "$as_me: errob${ZSH_VERSION+se"t$: e uo ePRti": Perittw=a;/b as())tu; } }' elseteras_fn_arith s, mo 2 Th Thas_cLL L expofttes=$a"ATUttes=l 2>&1LL LA$"ATUttesi' Pp ; *{xremulaf;/balizahol 2>&1o⁡/baliza.filu; } lv expof{s "$as_me: errob${ZSH_VERSION+se"t$: erequ_sad Perittw=a;/balizah; } }' elseteras_fn_arith h Initializa=baliza : e GNUerequ_sad=yes;fi; }Sblytwe were run as expoself"; thenh Initializaho! "$as_mys # is cWe, # Unseyev a) umulapdecv/n \())t,ato;f=$ GNU shittthe a #ausuus ---4. forontaif2>&1s())tanERSION" -----;or !tshEPARAso #aw(testarttesi(())tand expr. chrcf-----nL LNFIGv/n UWIN ksh)sia ( (unse=conf$$ con nse=conf$$ con ERROR [ ( (unserLOG_FD] # ---------------- ( (unset $a*\\)"r ish Initializa- "$ec v/h Initializahorerun with a alias -in # expoself"; te$'.* GNUerequ_sado "$noas_mys # is "$as_me: e0: , ttts=$1;ttrequ_sas*a s())t t -n moder! -fot nly as_ "$as_me: e0: xitt() { and expIifttestforyptoNsystes."he ; * e$h erNULLCMD=: er#as_var |_n='/usr/uc "$as_me: e0: Inh.FStic${1r,r -- 2>/dev/null;n >s*b" me thatnd th"sr/uc "$as_me: e0: warrpgrade bm_f -- 4.3.4t -r{1+"r."he dy='eval "$as_me: e0: Ple ';;twasting-autorror@gnu.orwould diyptoNsystes, e0: ------as_c pdkest "$ a si in with SbefU Geeterre0: in BASor () {ionsa)t : moder! \())t,ae GNanua)tyh. i e0: xitt(=$1;ttrnncr=#uch*a s())t ; *yptDisa GNU L L."he The us.g. in #n #n #aliza=b{h Initializa-rrenton}PATH, #aliza-pre-3.0 t -n UWIN ksh).known to ioterrpath do nbe GN(e Gof9rm =ant sol)siCLICOLOR_FORCE= GREP_OPTIONS= -------LICOLOR_FORCE GREP_OPTIONS xport DUALCASE # for MKSSourne compatS())t Funct----1; export DUALCASE # for MKSSourne a{ { evalt$1=; unset $1;} } as_unset=as_fn_unset # as_fn_append VAR VALUE # ---------------------- # Append the text inS, without forking. as_fn_set_status () { return $1 } # as_fn_set_status # as_fn_exittSTATUS # ----------------- # Exittthe shell with STATUS, even in a "trap 0" or "set -e" context. as_fn_exitt() { set +e as_fn_set_status $1 erexitt$1 } # as_fn_exitt # as_fn_unset VAR # --------------- # Portablytunset VAR. as_fn_unset () { {null _p store the resulror re, us && break,ain s_save_IF,-------as_cpar des/; *ner)) arys_fn_appnull _pAR VAL arg=`exttttest -arg" -$as_sa IFS=/exttttele ifttes=$as_dir/ds && break,' PSvtst# munull _pA' Ppr a : '\ll s=r a :wh kse:; _dir/"; arg=`exttttest -arg" : ".*\'$as_saq_dirnor, # as_fn_sreak,'\)$/{"s/'/\\\\\\\\\''/go' #'rg" : ".*as_saq_direxttttele ifexport aline, i_stll s="'$_saq_di'`exttttes"line, i_stll rnor, ame=dirname && break,' \ X"$0" : && break,[^/]*\.* rrull/*\1/ rrol || $as_echo X& break,[^/]*\rros rr| $as_echo X& break,[^/]*\rros|| $as_echo X& break,[^/]*\r\/*$/{ rros//\1/ rroq r} r && break,'\/\/\)$/{ ]*\.* rrulq *\1/ rro r} r/^X\/\(\/\).*/{ rros//\1/ oq r} rrharacter Ranges. as_cr_letters='/ oq r}} r/^X\/\(\/\).*_cr_letters='/ oq Character Ranges. as_cr_letters='abcdefghijklmine, is_dir/ds && break,lves, most t probae, is_dir/$0 && breask,' PSvtst"null eexttttes"lin}ll 2>&1o&/ds && break,' Perifttest "$& t" # Unseure, uss_save_IFS&& breaksatAR. as_fn_null _p VALUErto the end of the definition contained in VAR. Take # advantage+of any shell optimizations thattallow amortized linear growth over # repeated appends, instead of the typicaltquadratic growth present in naive # implementations. ift(evalt"as_var=1; as_var+=2;ttest x\$as_var = x12")+2>/dev/null; then : erevalt'as_fn_append (), t{ evalt$1+=\$2 }' elseteras_fn_append (), t{ evalt$1=\$$1\$2 } fi # as_fn_appendt # as_fn_arith ARG... # ------------------ # Perform arithmetic evaluation on the ARGs, and store the result in the # globalt$as_val. Take advantage+of shells thattcan avoid forks. The argumentst# must be portable across $(())tand expr. ift(evalt"test \$(( 1r+ 1r)) = 2")+2>/dev/null; then : erevalt'as_fn_arith (), t{ as_val=$(( $* )) }' elseteras_fn_arith (), t{ as_val=`expr "$@" ||rtest $? -eq 1` } fi # as_fn_arith, iftexpr a : '\(a\)' >/dev/null 2>&1o&& ttttest "X`expr 00001 : '.*\(..Set $? to STA +e a ERROR [fn_exi LOG_FD]set_status () { return $re the result in theOwith S"sename=fal$0`xitt1 fi,ERROR"err stncrr.in(efn_exi lt'aLOG_FD opt' #ittthe d,ARAso with Sell o STA rr LOG_FD, ttwas 0.as_cfn_exior () {efn_exitigge=$1;tt set +e as_u vo&&1i)(evaa" \ e 0xitt # as STA unset Ve we as_li1t{ $e we as_tttte0, tdonee as_l1echo"; then $4o_n='/usr/ucb/es_line=$2" >&2 as"$3"}:${as_linene ck=${as_linene ck=$${as_linene ckeval "$as_me: earor: $2" >&2 as_fn_exitt$tt1 fi,$2se b$4he The or, # as_fn_set_stt1 fi,$2se b2 as_fn_artunsetonee as_VAR. as_fn_ut1 f...\)'`" = X001; then as_expr=expr elseteras_expr=falsetfi, ift(basename -- /) >/dev/null 2>&1o&& test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename elseteras_basename=falsetfi, ift(as_dir=`dirname -- /`o&& test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname elseteras_dirname=falsetfi, as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \|t\ X"$0" : 'X\(//\)$' \|t\ X"$0" : 'X\(/\)' \|t.+2>/dev/null || $as_echo X/"$0" | errosed '/^.*\/\([^/][^/]*\)\/*$/{ rros//\1/ rroq r} r/^X\/\(\/\/\)$/{ rros//\1/ rroq r} r/^X\/\(\/\).*/{ rros//\1/ rroq r} rs/.*/./; q'`t # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in #((((( -n*)tercase `echo ' e:${as_linen1=$fn_exi l{as_linen1a=efn_exi e:${as_linen2=$fn_exi l{as_linen2a=efn_exi e:(), t{{ hen s_linen1'alt$ttwtho! "hen s_linen2'alt$ttwtholseteremul"x=falsen s_linen1'alt$ttwtl=$(t(as_den s_linen2'alt$ttwth'A' Ppr a# Bl'X\(Lee E. McMahLET(1931-1989)f2>&1sed's sy acx. :-----L$/{ate'\/\/\p\/\/\/[$]fn_exi/=r a' /dev/.blyxy) f$$.dC='\c't -; rresate na #_bodksh88'-n';; eAIX 6.1`-f conf$$ co expof conf$$' ';; ifttest -d conf$$.dir'-n'olaris 7;f conf$$.dir/conf$$.file elseterrm -f conf$$.dirrorroECHOename -- f conf$$.direo='sh `echo ks/"$0" : f conf$$.direo=' : null errorroECHO_T=' ';; rresot fin(#_bod>h `echo ksseterifttest "X`(/usr/; *ln -se elseterrm f$$.dir/terifttest "X`(/usr/no_sta---='ln -s mine,# namZbue ATH_WAmysetwo got` >s:o' # 1) On MSYas_boet `ln -serrm f_di'` tha`ln rrm f_di'`rrrr.o' # 2) DJGPP s*neosyms_lks; `ln -s'eure, uin wr evar "$ecu/null.o' # In_boet ' ';llsf=$ GNU sh_cras_v m_f`cp -p'.o' ln -se elseterrm f$$.dirECHO_T=' ';; rrelseteras_!conf$$.direfilew line, i_sta---='cp -p'he dy; *ln elseterrm f$$.dir/terifttest "X`(/usr/no_sta---=ln body='eval erra---='cp -p'he ot "$0" : '.*a---='cp -p'hot f conf$$.dir/conf$$.file elseteo='sh `echo kse elseterrm -rmll errorroECHO_T=' ';; rres ; *null e-p rros//\1/ as_myself: erull _p='null e-p && break} fi # as>&1o&/ds./-p lvermll e./-pelf: erull _p=l 2>&1; then >&1o&/xtfi as_me=`$as_basename -- "$0>&1o_x='>&1o&/xn $as_echo";tan-dLtfi as_me=`$as_basename -- : '.*as_L_ in th=L_body='eval erras_L_ in th=s_fn_err"$0>&1o_x='----------We nee'\''mine, if conf$$.di"$1=`dirnam onf$$.di"$1/."e ifexpory='e arg=`e1st -arg -$a----"=/e1=`; rt as_ arg=``tan-ld'$_saas_L_ in th'i"$1= esac fi, as_nl=' rg ???[sx]*):;;*)l 2>&;;rt asfT.toli'\''$@"}, '_ac; X"$ecu/null_p=$"$0>&1o_x 1 } #'as_fn)) vant shmapn \\\\\\\onholde---tuvCPP =dirs_fn_tr_cpp="-----W$/{ y%*_cr_Letters$as%P_cr_digits EC%;s%[^_$`echo -n x`]%_%g'" 1 } #'as_fn)) vant shmapn \\\\\\\onholde---tuvUWIN ksh =dirs_fn_tr_sh="-----W$/{ y%*+%pp%;s%[^_$`echo -n x`]%_%g'" 1 remulate sDJDIRk,' PS$ec 7<&0 #z' af #ifdcr STDCiHEAD ECelf" pm_mo #f" pm_mo #zy='e#f"fdcr HAVE_STDLIB_He#ff" pm_mo #fz' af #z' af #ifdcr HAVE_STRING_He#f"f !ncluded STDCiHEAD EC lvencluded HAVE_MEMORY_He#ff" pm_mo #fz' af #f" pm_mo #z' af #ifdcr HAVE_STRINGS_H #f" pm_mo #z' af #ifdcr HAVE_INTTYPES_Helf" pm_mo #z' af #ifdcr HAVE_STDINT_H #f" pm_mo #z' af #ifdcr HAVE_UNISTD_H #f" pm_mo #z' afara---LE_PR$1+=-='LTLIBOBJS$LIBOBJS DEBUG F90_LIBS_ F90_LDFLAGS_ F90__ F90_HEAD E_ ax_cv_f90_modflag EGREP GREP FCLIBS Tc_xt_FC FCFLAGS FC RANLIB SET_MAKE CPP Tc_xt_CC CFLAGS CC OBJEXT EXEEXT Tc_xt_CXX CPPFLAGS LDFLAGS CXXFLAGS CXX MPIFC MPICXX MPICC ng" eG_o)+2> host_o)+2> btttt_o)+2> LIBS conf$ confN f$$.dC DEFS =r !ir rrrrre!ir rib!ir ps!ir pdf!ir dvi!ir html!ir ppm_!ir docll ol!ippm_moll ippm_moll rrrrr00oll shmysd00oll sysll dangll dang"oot!ir rib"$ec!ir son.!ir on.!ir st -z "_us nsglob_rcau prefix$"$ec_prefix PACKAGE_URL PACKAGE_BUGREPORT PACKAGE_STRING PACKAGE_v/null; PACKAGE_TARNAME PACKAGE_NAME s_dir" && as_dializa'a---LE_PR$tt!ts=''a---ATH__ ins=' en ksh_ in th_ SHEL\\\ en ksh_ses do _ en ksh_lxiux en ksh_valm- en ksh_vave_I en ksh_sathke(uns en ksh_sxf90 en ksh_crayfishpack en ksh_hypre en ksh_no_mi'heionsI en ksh_s// en ksh_s/-n' 'mine, iac_precious$1+=-='btttt_o)+2> host_o)+2> ng" eG_o)+2> CXX CXXFLAGS LDFLAGS LIBS CPPFLAGS CCC CC CFLAGS CPP FC FCFLAGS'Quotinble DUALeiso_vNUWIN ksh).----byt in ths.oTc_ipit_help=oTc_ipit_on., tt=l 2>&1---Anrt ggndrat_ ins=1---Anrt ggndrat_sep=oen PUWIN ksh). GNU itt(dirnrcaus e valt in thstus #oend\\\\\\chFGHI bm_frnncrs_lisS=$P SHatt!t=as_me=`$a "$ec_prefix=NONE no_ure, u= no_rt u-----= prefix=NONE st -z "_prefix=NONE st -z "_suffix=NONE st -z "_us nsglob_rcau=s,x,x, ------- -- u= srcll r on.bosu= x_ippm_mos=NONE x_rWINos=NONE otinbnsa)tadvants_save_IFS in ths.oen sWAmyselefttrnuseaesehato;ATH_spr. i"m ke=ionsa)t "$ec_prefix=/foorigg thaa)t t PUWIN ksh). the myseer aose bm_fbeDge estfor"$ec_prefix #-byt_cras_v lied aveua)tyhchFGHI.oenUaultracestions. ift(epar dstben faulsh, perl, etc.ARAso accepe ATHmd,# s PliLteheypics itt(dirnpace- e valtev/nnt Cygnutture= in thstuto;f=$0. idiagnosen yaos.e hoarg=`exc_dashdashexc_ in thaP -----------Tc_dashdash=yesPle ----on.!irf|rt on.!irf|rt on.!if|rt on.!f|rt on.f|rt on)se, iac_prev=on.!irfle if on.!ir=*f|rt on.!ir=*f|rt on.!i=*f|rt on.!=*f|rt on.=*f|rt on=*)se, ion.!ir=$ac_ ing" Ple ----ottttt|rt ottttt|rt otttt|rt ottt|rt ot)se, iac_prev=otttt_o)+2>fle if otttt=*f|rt otttt=*f|rt ottt=*f|rt ott=*f|rt ot=*)se, iotttt_o)+2>=$ac_ ing" Ple ----$P SH-o kse|rt $P SH-o kse|rt $P SH-o ke|rt $P SH-o |r: |rt $P SH-o |rt $P SH- |rt $P SH |rt $P S |rt $P |rt $P |rt $)se, iac_prev=$P SHatt!tfle if $P SH-o ks=*f|rt $P SH-o ks=*f|rt $P SH-o k=*f|rt $P SH-o =*f|r: |rt $P SH-o=*f|rt $P SH-=*f|rt $P SH=*f|rt $P S=*f|rt $P =*f|rt $P=*f|rt $=*)se, i$P SHatt!t=$ac_ ing" Ple ----- $P SH |rtC)se, i$P SHatt!t=mpiler$P SH le ----dangll f|rt dangll f|rt dangllf|rt dangl)se, iac_prev=dangll fle if dangll =*f|rt dangll =*f|rt dangll=*f|rt dangl=*)se, idangll =$ac_ ing" Ple ----dang"oot!irs|rt dang"oot!irs|rt dang"oot!is|rt dang"oot!s|rt dang"ootf|r: |rt dang"oo |rt dang"o |rt dang")se, iac_prev=dang"oot!irsle if dang"oot!ir=*s|rt dang"oot!ir=*s|rt dang"oot!i=*s|rt dang"oot!=*f|r: |rt dang"oot=*s|rt dang"oo=*s|rt dang"o=*s|rt dang"=*)se, idang"oot!ir=$ac_ ing" Ple ----dBST el-*s|rt dBST el-*)se, iac_ATH_ in: _body x c_ in th/][^/x-*dBST el- ='sh)''o' # Rejavenrcaus the myself=e---tuv appenUWIN ksh =dirPublic _body x c_ATH_ in | tr -[^-+._$`echo -n x`]" =' ';; rrelseline, i_stfttest "$& t"in---tuvase `(s =dir:ser--ATH_ in se, iac_ATH_ in_or`e=er--ATH_ inse, iac_ATH_ in: "$as_me: erc_ATH_ in |'\)$/{'s/[-+.]/_/g'`se, i$Pg=`exc_ATH__ insst line, *" "en ksh_er--ATH_ in s"rrele ifexpo*)x---Anrt ggndrat_ ins= erc_Anrt ggndrat_ inserc_Anrt ggndrat_sept dBST el-$ac_ATH_ in_or`e" x---Anrt ggndrat_sep=', 'le ifexrt aline,errorrn ksh_er--ATH_ in=noPle ----docll s|rt docll s|rt doclls|rt docs|rt do)se, iac_prev=doc!irsle if docll =*s|rt docll =*s|rt docll=*s|rt doc=*s|rt do=*)se, idoc!ir=$ac_ ing" Ple ----dvi!irs|rt dvi!irs|rt dvi!is|rt dvi!s|rt dvis|rt dv)se, iac_prev=dvi!irsle if dvi!ir=*s|rt dvi!ir=*s|rt dvi!i=*s|rt dvi!=*s|rt dvi=*s|rt dv=*)se, idvi!ir=$ac_ ing" Ple ----rn ksh-*s|rt rn ksh-*)se, iac_ATH_ in: _body x c_ in th/][^/x-*rn ksh-//\1=]sh)''o' # Rejavenrcaus the myself=e---tuv appenUWIN ksh =dirPublic _body x c_ATH_ in | tr -[^-+._$`echo -n x`]" =' ';; rrelseline, i_stfttest "$& t"in---tuvase `(s =dir:ser--ATH_ in se, iac_ATH_ in_or`e=er--ATH_ inse, iac_ATH_ in: "$as_me: erc_ATH_ in |'\)$/{'s/[-+.]/_/g'`se, i$Pg=`exc_ATH__ insst line, *" "en ksh_er--ATH_ in s"rrele ifexpo*)x---Anrt ggndrat_ ins= erc_Anrt ggndrat_ inserc_Anrt ggndrat_sept rn ksh-$ac_ATH_ in_or`e" x---Anrt ggndrat_sep=', 'le ifexrt aline,errorrn ksh_er--ATH_ in=\$ac_ ing" Ple ----r$ec-prefixs|rt r$ec_prefixs|rt r$ec-prefixs|rt r$ec-prefif|r: |rt r$ec-pref |rt r$ec-pre |rt r$ec-pr |rt r$ec-p |rt r$ec-f|r: |rt r$ec |rt r$e |rt r$)se, iac_prev=r$ec_prefixsle if r$ec-prefix=*s|rt "$ec_prefix=*s|rt r$ec-prefix=*s|rt r$ec-prefi=*f|r: |rt r$ec-pref=*s|rt r$ec-pre=*s|rt r$ec-pr=*s|rt r$ec-p=*s|rt r$ec-=*f|r: |rt r$ec=*s|rt r$e=*s|rt r$=*)se, i"$ec_prefix=$ac_ ing" Ple ----g2>f|rt g2>f|rt g2f|rt g)o' # Oeed ete;tusTH--s # g2>ublic do _g2>=yesPle ----helpf|rt helpf|rt helf|rt hef|rth)se, iac_ipit_help=\\\\\le if help=r*f|rt help=r*f|rt hel=r*f|rt he=r*f|rthr*)se, iac_ipit_help=rt u---ve\le if help=s*f|rt help=s*f|rt hel=s*f|rt he=s*f|rths*)se, iac_ipit_help=sh, #le ----hUmul|rt hUmul|rt hUml|rt hU)se, iac_prev=host_o)+2>\le if host=*s|rt host=*s|rt hos=*s|rt ho=*)se, ihost_o)+2>=$ac_ ing" Ple ----html!irs|rt html!irs|rt html!is|rt html!s|rt htmls|rt htms|rt ht)se, iac_prev=html!irsle if html!ir=*s|rt html!ir=*s|rt html!i=*s|rt html!=*s|rt html=*s|rt htm=*f|r: |rt ht=*)se, ihtml!ir=$ac_ ing" Ple ----ippm_moll |rt ippm_moll |rt ippm_moll |rt ippm_mol |rt ippm_mof|r: |rt ippm_m |rt ippm_ |rt ippm |rt ipp)se, iac_prev=ippm_moll le if ippm_moll \* |rt ippm_moll \* |rt ippm_moll\* |rt ippm_mol\* |rt ippm_mo=*f|r: |rt ippm_m\* |rt ippm_\* |rt ippm\* |rt ipp=*)se, iippm_moll \$ac_ ing" Ple ----ipm_!ir |rt ipm_!ir |rt ipm_!i |rt ipm_! |rt ipm_ |rt ipm)se, iac_prev=ipm_!ir le if ipm_!ir=* |rt ipm_!ir=* |rt ipm_!i=* |rt ipm_!=* |rt ipm_=* |rt ipm=*)se, iipm_!ir=$ac_ ing" Ple ----rib!ir |rt rib!ir |rt rib!i |rt rib!)se, iac_prev=rib!ir le if rib!ir=* |rt rib!ir=* |rt rib!i=* |rt rib!=*)se, irib!ir=$ac_ ing" Ple ----rib"$ec!ir |rt rib"$ec!ir |rt rib"$ec!i |rt rib"$ec! |rt rib"$ecf|r: |rt rib"$e |rt rib"$ |rt rib")se, iac_prev=rib"$ec!ir le if rib"$ec!ir=* |rt rib"$ec!ir=* |rt rib"$ec!i=* |rt rib"$ec!=* |rt rib"$ec=*f|r: |rt rib"$e=* |rt rib"$=* |rt rib"=*)se, irib"$ec!ir=$ac_ ing" Ple ----rrrrre!ir |rt rrrrre!ir |rt rrrrre!i |rt rrrrre! |rt rrrrre)se, iac_prev=rrrrre!ir le if rrrrre!ir=* |rt rrrrre!ir=* |rt rrrrre!i=* |rt rrrrre!=* |rt rrrrre=*)se, irrrrre!ir=$ac_ ing" Ple ----rrrrr00oll |rt rrrrr00oll |rt rrrrr00oll |rt rrrrr00olf|r: |rt rrrrr00o |rt rrrrr00 |rt rrrrr0 |rt rrrrr |rt rrrrr)se, iac_prev=rrrrr00oll le if rrrrr00oll =* |rt rrrrr00oll =* |rt rrrrr00oll=* |rt rrrrr00ol=*f|r: |rt rrrrr00o=* |rt rrrrr00=* |rt rrrrr0=* |rt rrrrr=* |rt rrrrr=*)se, irrrrr00oll =$ac_ ing" Ple ----=r !ir |rt =r !ir |rt =r !i |rt =r ! |rt =r |rt =r |rt =)se, iac_prev==r !ir le if =r !ir=* |rt =r !ir=* |rt =r !i=* |rt =r !=* |rt =r =* |rt =r=* |rt ==*)se, i=r !ir=$ac_ ing" Ple ----nfpf|rt nfpf|rt nf)o' # Oeed ete;tusTH--s #out-fpublic do _fp=noPle ----no-ure, us|rt no-ure, us|rt no-ure, s|rt no-ure,s|rt no-uref|r: |rt no-ur |rt no-u |rtn)o' no_ure, u=yesPle ----no-rt u----- |rt no-rt u----- |rt no-rt u---- |rt no-rt u---f|r: |rt no-rt u-- |rt no-rt u- |rt no-rt u |rt no-rt |rt no-rt |rt no-r)o' no_rt u-----=yesPle ----ol!ippm_moll |rt ol!ippm_moll |rt ol!ippm_moll |rt ol!ippm_molf|r: |rt ol!ippm_mo |rt ol!ippm_m |rt ol!ippm_ |rt ol!ippm |rt ol!ippf|r: |rt ol!ip |rt ol!i |rt ol! |rt ol |rt o)se, iac_prev=ol!ippm_moll le if ol!ippm_moll \* |rt ol!ippm_moll \* |rt ol!ippm_moll\* |rt ol!ippm_mol=*f|r: |rt ol!ippm_mo\* |rt ol!ippm_m\* |rt ol!ippm_\* |rt ol!ippm\* |rt ol!ipp=*f|r: |rt ol!ip\* |rt ol!i\* |rt ol!\* |rt ol\* |rt o=*)se, iol!ippm_moll \$ac_ ing" Ple ----prefixs|rt prefixs|rt prefis|rt prefs|rt pres|rt prs|rt p)se, iac_prev=prefixsle if prefix=*s|rt prefix=*s|rt prefi=*s|rt pref=*s|rt pre=*s|rt pr=*s|rt p=*)se, iprefix=$ac_ ing" Ple ----st -z " prefixs|rt pr -z " prefixs|rt pr -z " prefis|rt pr -z " preff|r: |rt pr -z " pre |rt pr -z " pr |rt pr -z " p)se, iac_prev=pr -z "_prefixsle if pr -z " prefix=*s|rt pr -z " prefix=*s|rt pr -z " prefi=*f|r: |rt pr -z " pref=*s|rt pr -z " pre=*s|rt pr -z " pr=*s|rt pr -z " p=*)se, ipr -z "_prefix=$ac_ ing" Ple ----st -z " suffixs|rt pr -z " suffixs|rt pr -z " suffis|rt pr -z " sufff|r: |rt pr -z " suf |rt pr -z " su |rt pr -z " s)se, iac_prev=pr -z "_suffixsle if pr -z " suffix=*s|rt pr -z " suffix=*s|rt pr -z " suffi=*f|r: |rt pr -z " suff=*s|rt pr -z " suf=*s|rt pr -z " su=*s|rt pr -z " s=*)se, ipr -z "_suffix=$ac_ ing" Ple ----st -z " us nsglob-=dirn'rt pr -z " us nsglob-=dirn|r: |rt pr -z " us nsglob-=di |rt pr -z " us nsglob-=dn|r: |rt pr -z " us nsglob-= |rt pr -z " us nsglob-n|r: |rt pr -z " us nsglob |rt pr -z " us nsglon|r: |rt pr -z " us nsgl |rt pr -z " us nsgn|r: |rt pr -z " us ns |rt pr -z " us nn|r: |rt pr -z us |rt pr -z " us |rt pr -z " u)se, iac_prev=pr -z "_us nsglob_rcausle if pr -z " us nsglob-=dir=*s|rt pr -z " us nsglob-=dir=*s|r: |rt pr -z " us nsglob-=di=*s|rt pr -z " us nsglob-=d=*s|r: |rt pr -z " us nsglob-==*s|rt pr -z " us nsglob-=*s|r: |rt pr -z " us nsglob=*s|rt pr -z " us nsglo=*s|r: |rt pr -z " us nsgl=*s|rt pr -z " us nsg=*s|r: |rt pr -z " us ns=*s|rt pr -z " us n=*s|r: |rt pr -z us =*s|rt pr -z " us=*s|rt pr -z " u=*)se, ipr -z "_us nsglob_rcau=$ac_ ing" Ple ----sdf!irs|rt pdf!irs|rt pdf!is|rt pdf!s|rt pdfs|rt pd)se, iac_prev=pdf!irsle if pdf!ir=*s|rt pdf!ir=*s|rt pdf!i=*s|rt pdf!=*s|rt pdf=*s|rt pd=*)se, ipdf!ir=$ac_ ing" Ple ----ss!irs|rt ps!irs|rt ps!is|rt ps!s|rt ps)se, iac_prev=ps!irsle if ps!ir=*s|rt ps!ir=*s|rt ps!i=*s|rt ps!=*s|rt ps=*)se, ips!ir=$ac_ ing" Ple ----qs|rtquie s|rt quie s|rt quies|rt quis|rt qus|rt qs|r: |rt------s|rt ------s|rt -----s|rt ----s|rt ---)se, i-------yesPle ----son.!irf|rt son.!irf|rt son.!if|rt son.!f|rt son.f|rt sonf|rt so)se, iac_prev=son.!irfle if son.!ir=*f|rt son.!ir=*f|rt son.!i=*f|rt son.!=*f|rt son.=*s|r: |rt sbi=*f|rt so=*)se, ison.!ir=$ac_ ing" Ple ----shmysd00oll f|rt shmysd00oll f|rt shmysd00olls|r: |rt shmysd00ol |rt shmysd00o |rt shmysd00 |rt shmysd0s|r: |rt shmysd |rt shmysd |rt shmysd |rt shmys |rt shmys|r: |rt shm |rt sh)se, iac_prev=shmysd00oll fle if shmysd00oll =*f|rt shmysd00oll =*f|rt shmysd00oll=*s|r: |rt shmysd00ol=*f|rt shmysd00o=*f|rt shmysd00=*f|rt shmysd0=*s|r: |rt shmysd=*f|rt shmysd=*f|rt shmysd=*f|rt shmys=*f|rt shmy=*s|r: |rt shm=*f|rt sh=*)se, ishmysd00oll =$ac_ ing" Ple ----si0o |rt si0o |rt si0)se, iac_prev=si0o le if si0o=*f|rt si0o=*f|rt si0=*)se, isi0o=$ac_ ing" Ple ----src!ir |rt src!ir |rt src!i |rt src! |rt src |rt sr)se, iac_prev=srcll st -; src!ir=*f|rt src!ir=*f|rt src!i=*f|rt src!=*f|rt src=*f|rt sr=*)se, isrc!ir=$ac_ ing" Ple ----sysll f|rt sysll f|rt sysllf|rt syslf|rt syss|r: |rt sys |rt sys |rt sys |rt sys |rt sy)se, iac_prev=sysll ft -; sysll =*f|rt sysll =*f|rt sysll=*f|rt sysl=*f|rt sys=*s|r: |rt sys=*f|rt sys=*f|rt sys=*f|rt sys=*f|rt sy=*)se, isysll =$ac_ ing" Ple ----ng" eGf|rt ng" eGf|rt ng" ef|rt ng" f|rt ng"f|rt ngf|rt n)se, iac_prev=ng" eG_o)+2>ft -; ng" eG=*f|rt ng" eG=*f|rt ng" e=*f|rt ng" =*f|rt ng"=*f|rt ng=*f|rt n=*)se, ing" eG_o)+2>=$ac_ ing" Ple ----vf|rton.bosuf|rt on.bosuf|rt on.bosf|rt on.bof|rt on.b)se, ion.bosu=yesPle ----on., ttf|rt on., ttf|rt on., tf|rt on., f|rt on.,f|rtV)se, iac_ipit_on., tt=:Ple ----s # *f|rt s # *)se, iac_ATH_ in: _body x c_ in th/][^/x-*s # //\1=]sh)''o' # Rejavenrcaus the myself=e---tuv appenUWIN ksh =dirPublic _body x c_ATH_ in | tr -[^-+._$`echo -n x`]" =' ';; rrelseline, i_stfttest "$& t"in---tuvpackcro =dir:ser--ATH_ in se, iac_ATH_ in_or`e=er--ATH_ inse, iac_ATH_ in: "$as_me: erc_ATH_ in |'\)$/{'s/[-+.]/_/g'`se, i$Pg=`exc_ATH__ insst line, *" " do _er--ATH_ in s"rrele ifexpo*)x---Anrt ggndrat_ ins= erc_Anrt ggndrat_ inserc_Anrt ggndrat_sept s # $ac_ATH_ in_or`e" x---Anrt ggndrat_sep=', 'le ifexrt aline,error do _er--ATH_ in=\$ac_ ing" Ple ----s #out-*f|rt s #out-*)se, iac_ATH_ in: _body x c_ in th/][^/x-*s #out- ='sh)''o' # Rejavenrcaus the myself=e---tuv appenUWIN ksh =dirPublic _body x c_ATH_ in | tr -[^-+._$`echo -n x`]" =' ';; rrelseline, i_stfttest "$& t"in---tuvpackcro =dir:ser--ATH_ in se, iac_ATH_ in_or`e=er--ATH_ inse, iac_ATH_ in: "$as_me: erc_ATH_ in |'\)$/{'s/[-+.]/_/g'`se, i$Pg=`exc_ATH__ insst line, *" " do _er--ATH_ in s"rrele ifexpo*)x---Anrt ggndrat_ ins= erc_Anrt ggndrat_ inserc_Anrt ggndrat_sept s #out-$ac_ATH_ in_or`e" x---Anrt ggndrat_sep=', 'le ifexrt aline,error do _er--ATH_ in=noPle -----x)o' # Oeed ete;tusTH--s # xublic do _x=yesPle ----x ippm_mosf|rt x ippm_mosf|rt x ippm_mof|rt x ippm_mf|rt x ippm_s|r: |rt x ippm |rt x ipp |rt x ip |rt x i)se, iac_prev=x_ippm_mosft -; x ippm_mos=*f|rt x ippm_mos=*f|rt x ippm_mo=*f|rt x ippm_m=*f|rt x ippm_=*s|r: |rt x ippm\* |rt x ipp=* |rt x ip=* |rt x i=*)se, ix_ippm_mos=$ac_ ing" Ple ----x-rWINos |rt x rWINos |rt x rWINo |rt x rWINs|r: |rt x rWI |rt x rW |rt x r |rt x |rt x |rt x )se, iac_prev=x_rWINos t -; x rWINos=* |rt x rWINos=* |rt x rWINo=* |rt x rWIN=*s|r: |rt x rWI=* |rt x rW=* |rt x r=* |rt x =* |rt x =* |rt x =*)se, ix_rWINos=$ac_ ing" Ple ----*as_safttest "$& t"Anrt ggndrat= in th: \` c_ in th' , s\` 0 t help'ehe GNUre="nglobadvan se, ile ---*=*)se, iac_envs_fn _body x c_ in th/][^/x//\1=]sh)=''o' # Rejavenrcaus the myself=e---tuv appenUWIN ksh =dirPublic $Pg=`exc_envs_fst -arg" : ".'' |r[0-9]* |r*[!_$`echo -n x`]* )line, i_stfttest "$& t"in---tuvUWIN ksh =dir: \` c_envs_f'" le ifexrt aline,error c_envs_f=\$ac_ ing" blic _bo, #exc_envs_fsle ---*)o' # FIXME:atnd thfbeDremovtized autorror 3.0ublic "$as_me: error: iWARNING:syptDtnd thfusTH--otttt, t host,rt ng" eGse b2 asc _body x c_ in th/][^r -[^-._$`echo -n x`]" =' ';; rrelseline, i "$as_me: error: iWARNING:sin---tuvhUmultypI: c_ in th/] b2 asc : {otttt_o)+2>=$ac_ in th} {host_o)+2>=$ac_ in th} {ng" eG_o)+2>=$ac_ in th}se, ile ---rt alproba f conf$$.te s_c_wereo_n='/usr/ac_ in th=-- #_bods_c_were|'\)$/{'s/_/-/g'`se,_stfttest "$& t"mi) vs_c 1r+ 1rbm_f c_ in th/1; then >&1o&/te s_c_Anrt ggndrat_ inso_n='/usr/$Pg=`een ksh_ in th_ SHEL\\\st line,norele ifexfatalas_safttest "$& t"Anrt ggndrat= in ths:ser--Anrt ggndrat_ insoele ifexrres ii "$as_me: error: iWARNING:sAnrt ggndrat= in ths:ser--Anrt ggndrat_ insoe b2Ple if rm n # prCSHELaa)t d_save_IFS( 1r+ 1r)ehe GrrosFIGv/cy._ = xsc_s_fst r$ec_prefixsprefixson.!irfson.!irfrib"$ec!ir dang"oot!irs\ dangll fsysll fshmysd00oll frrrrr00oll ippm_moll \ ol!ippm_moll doc!irsipm_!ir html!irsdvi!irspdf!irsps!irs\ rib!ir rrrrre!ir =r !ir _dir/errorsc_s_l--- sc_s_f # Removt tras \\\ sl\\\\\. c $Pg=`exc_rrort line,*/ )line, i_c\(a\)' >/devXexc_rrok,[^/]*\.* rrul*$/{ vXexc_rrok,[^/]*\.*h)''o' e,error c_s_f=\$ac_rrole ifttes=$afttessu_WALK GNU need and d_save_IFS=dirPubli$Pg=`exc_rrort line,r as$]* |r?:r as_dir :ow axiuele ifexNONE |r'' )i$Pg=`exc_rrfst -*prefixs):ow axiuelefttest -ofttes=$a"ATUttest "$& t" >/avee bug need and d_save_IFS=direhe G--exc_rrf:`exc_rro"lproba en re m!tttt2>/deop# Fihovwxyz' tage+of ol! brokennbe GN(e : `$hostselfuse bm_fhol! t\$(( 1r+ 1rft(et hUmuletc. # FIXME:aToDremovtiso_vNday._otttt=$btttt_o)+2> host=$host_o)+2> ng" eG=$ng" eG_o)+2> # FIXME:aToDremovtiso_vNday._self"; thenhost_o)+2>ho! "$as_mys poself"; thenbtttt_o)+2>ho "$as_myself :ohen _unses \\\=mayb'eval "$as_me: error: iWARNING:si *yptDwante bm_f----t\$(t ottttttypI, pro'tfusTH--hostd val If a:ohen unses H_SEPAdetevee bfn_arohen unses H mode lied b PATHdse bugs (lself"; thenbtttt_o)+2>ho! "henhost_o)+2>has_myself :ohen _unses \\\=yes;_fn_e/*$' c_ sol_prefix= remulate shost_o)+2>ho tdoc_ sol_prefix=shost_o)+2>-1 remul"$------ho "yesPre-"$ec 6b' ';; rres a---wwd=`wwdelseteras_.te s_c_wwdholse_c_l bre=`tan-di .`olse_c_wwd_l bre=`cde s_c_wwdhols tan-di .`ow lin"ATUttest "$& t"wn_exit d_save_IFS # UnsebeAdetermuded" eras_dirnc_l bre='printfc_wwd_l bre"ow lin"ATUttest "$& t"wwd prestatioreo, # 'X\(of wn_exit d_save_IF" rator. ca itt(ourcd whictatif rrrrn thawastatioLpectfi d.7as_echo`" = "src!iro_n='/usr/ac_src!ir_dcras_vad=yes;r-# , st P__save_IFS w amorxit t ttts=$1;t,bfn_ar-f "$ar deP__save_IF.sr/ac_ll =nor, ame=dirname && b with a ' \ X"$0" : && b with a [^/]*\.* rrull/*\1/ rrol || $as_echo X& b with a [^/]*\rros rr| $as_echo X& b with a [^/]*\rros|| $as_echo X& b with a [^/]*\r\/*$/{ rros//\1/ rroq r} r && b with a 'se, is$/{ ]*\.* rrulq *\1/ rro r} r/^X\/\(\/\).*/{ rros//\1/ oq r} rrharacter Ranges. as_cr_letters='/ oq r}} r/^X\/\(\/\).*_cr_letters='/ oq Character Ranges. as_cr_letters='abcdefghijklminsrc!ir=$ac_ll poself"; t!IFS esrc!ir/er--AniquHatt!thas_myself :src!ir=.. e ot "$0" : 'c_src!ir_dcras_vad=no Thself"; t!IFS esrc!ir/er--AniquHatt!thas_myselfremul"$'c_src!ir_dcras_vadho "yesPre-src!ir="$ac_ll rexi.."lin"ATUttest "$& t" # Unsettvar(ourcds (er--AniquHatt!t)st -rsrc!iro_ac; c_msg="(ourcds are="n-rsrc!ir,Zbue \`cdersrc!ir' prestatiown_e"; c_nee_ll =n( cde ssrc!irolseteras_.r-"=/en--AniquHatt!th,' Perifttest "$& t"$ c_msg" wwd)`' # n_arbtttt\\\st "$lacd,f----src!ir=.TH='/bin;/b c_nee_ll ='pris_c_wwdhas_myselfsrc!ir=.Tac;# Removt unner)) ary tras \\\ sl\\\\\h IFS src!ir. # Douksh sl\\\\\hin whichrcau\hin objavenrrm f_/-n'g\\\st fo) = )) iup M-x gdbhin EmacsS=$PATH_srcll st l*/)fsrc!ir=' >/devXesrc!irol[^/]*\.* rrul*$/{ vXesrc!irol[^/]*\.*h)''olaris 7 = xsc_s_fst ds_c_wercious$1+=-; _dir/errorsc_env_${sc_s_f}----=2>&1{sc_s_f}: er#ir/errorsc_env_${sc_s_f}-ontai--- {sc_s_f}ir/errorsc_cv_env_${sc_s_f}----=2>&1{sc_s_f}: er#ir/errorsc_cv_env_${sc_s_f}-ontai--- {sc_s_f}iproba e;# Reo, #t\$(t helpf in BASo e;H='/bin;/b c_ipit_help='pri\\\\has_myself# Omn_eeo_vNioterozshe Goeed ete= in thst shmakU ittliLtel)) i+2>esxittSr-# , ttt in BASHiandoo \\\\\m_fbeD \\\\\\\ ! -f "A/UX 3.1fshubli$Pt <<_ACEOF \`cure'tures HOUTrary9\m_fadaptt shmany exidusagesystess. U BAS:H_SE[OPTION]namZ[VAR=of an]nam To a) vgn environmv/n UWIN ksh)e "||r, CC, CFLAGSnam),oLpectf st m a) VAR=of an. Seefbepica = xdes=$1;tur usageeo_vNof valtATHful UWIN ksh)si Dcras_v)ehe Gvalt in ths myseepectfi dessagrackeustS Currn th:o' -h,(t helpffffffffffffffdis$lay t ttthelpflt'as_ito' e,t help=sh, #fffffffdis$lay in ths epectfice shelisvpackcroo' e,t help=rt u---ve\fffdis$lay t ulsh, #helpfepea)t t Pippm_molfpackcros;r--V,rt on., ttfffffffffffdis$lay on., ttf"nglobadvanflt'as_ito' -q,rt quie , t ------s mentatiop\\\e \`cSHEL\\\snam't in BASso' e,t $P SH-o ks=FILE i$P SH'/bin;d fork\hin FILE [dBST eld]o' -C, t $P SH ne, i_)+2>fglon|`t $P SH-o ks=mpiler$P SH'min-n, t no-ure, usffffffffdntationre, us with Swhicto' e,t src!ir=DIRfffffffff. ca itt(ourcd\hin DIRf[ure=ll rexi\`am'] nbnsa)tadvants_save_Iies:o' t prefix=PREFIXsffffffffionsa)t :rchiteveure-. cxyz' ---swhicthin PREFIX [exc_dcras_v_prefix]o' - r$ec-prefix=EPREFIXsffionsa)t :rchiteveure-cxyz' ---swhicthin EPREFIX [PREFIX] Byt_cras_v,i\`m ke=ionsa)t' lied ionsa)t :)t t Pwhicthin \` c_dcras_v_prefix/on.', \` c_dcras_v_prefix/rib' etc.A YptD0. iLpectf a {ionsa)tadvantprefixsoATH_ -fot \` c_dcras_v_prefix'_u vo&&|`t prefix',7 = xionsance&|`t prefix---HOME'tS F= xbers$a'"$@"'ol,fusTHvalt in ths bepictS Fude turxit of valtibnsa)tadvants_save_Iies:o' t on.!ir=DIRffffffffffffATH_ "$ecu/nulls [EPREFIX/on.]o' - son.!ir=DIRfffffffffffsystesfadmud "$ecu/nulls [EPREFIX/son.]o' - rib"$ec!ir=DIRffffffffpr -z " "$ecu/nulls [EPREFIX/rib"$ec]o' - sysll =DIRffffffffre,d-on ab(as_el-machude dang [PREFIX/etc]o' - shmysd00oll =DIRffffmodtfinull; rchiteveure-. cxyz' ---sdang [PREFIX/com]o' - rrrrr00oll =DIRfffffmodtfinull;(as_el-machude dang [PREFIX/UWI]o' - rib!ir=DIRffffffffffffobjaven!, torWINos [EPREFIX/rib]o' - ippm_moll \DIRffffffffC headv/Pwhicth[PREFIX/ippm_mo]o' - ol!ippm_moll \DIRfffffC headv/Pwhicth = xnon-gcc [)"' ippm_mo]o' - dang"oot!ir=DIRfffffffre,d-on ab rch.-. cxyz' ---sdang "ootf[PREFIX/shmys]o' - dang!ir=DIRfffffffffffre,d-on ab rchiteveure-. cxyz' ---sdang [DATAROOTDIR]o' - ipm_!ir=DIRfffffffffffipm_ docuev/null; [DATAROOTDIR/ppm_]o' - rrrrroll \DIRffffffff rrrrre-cxyz' ---sdang [DATAROOTDIR/rrrrre]o' - =r !ir=DIRffffffffffff=r docuev/null; [DATAROOTDIR/=r ]o' - doc!ir=DIRffffffffffffdocuev/null; "ootf[DATAROOTDIR/doc/ppm]o' - html!ir=DIRfffffffffffhtmlsdocuev/null; [DOCDIR]o' - dvi!ir=DIRffffffffffffdvisdocuev/null; [DOCDIR]o' - pdf!ir=DIRffffffffffffpdfsdocuev/null; [DOCDIR]o' - ps!ir=DIRffffffffffff pssdocuev/null; [DOCDIR]o_ACEOF bli$Pt <<\_ACEOF _ACEOF ; then >&1o&/te s_c_ipit_help=_n='/usr/$Pg=`e_c_ipit_helpst line, sh, #| rt u---ve\)ate na"Currn th of HOUTrary9:"le ifettes=$a$Pt <<\_ACEOF Oin thzshFse `(ss:o' t dBST el- in th-cSHEL\\\s vgnUre=Anrt ggndrat=t rn ksh/--s #t in thso' t dBST el-FEATUREfffffffdotatioippm_mofFEATUREf((dirn2>ft rn ksh-FEATURE=no)se,t rn ksh-FEATURE[=ARG] oippm_mofFEATUREf[ARG=yes]se,t rn ksh-mpi[=+2>/.]ffffusTHMPI (_cras_v sstat),on(evaltMPI +2>/dev/null; ofiyptoNe nice#ittthe unses H wr evars the mysei s_di,onD0. iL---t\$m with ,Ne nosS:Hgu)) i(I lied e nosS t Pwhr1o&+2>/dev/null; onD0. if. c), oyz'ses, lamses, sesch, sesch2,Niotelses_gnu (Iotel'stMPI s #tft s # n'CKAGE=no)se,t s # ppm=path ----t\$(path shell ppm unrtorWIy - THIS FLAG IS MANDas_dY So_vNioftaine DU environmv/n UWIN ksh):o' CXX C++ unses H_Srm =r !o' CXXFLAGS C++ unses H_Sflagso' LDFLAGS s_lkH_Sflags, "||r -L< !ir>si *yptD GNU rWINos ed a nonst thardP__save_IFS< !ir>o' LIBS rWINos shpass shell s_lkH_, "||r -l<rWIy>o' CPPFLAGS (Objave-ve) C/C++ prevror)) o_Sflags, "||r -Isi yptD GNU headv/set_stanonst thardP__save_IFSo' CC C unses H_Srm =r !o' CFLAGS C unses H_Sflagso' CPP C prevror)) o_o' FC F= us nnunses H_Srm =r !o' FCFLAGS F= us nnunses H_Sflagso UsS t s PUWIN ksh). oent irhe hell e nicesf=re hby `cure'tTA rr help itt shf. carWINos thapr -z "s s #tnonst thardPrcau\/rrrrn thstS Reo, #-n's shell packcro ittthe r. _ACEOF 'c_s as_li? ; then >&1o&/b c_ipit_help='prirt u---vehas_myself# n(eval_WAmysesubll s,oreo, #vall fspectficet help. e o= xsc_ll st :`exc_subll s_a asdot{ hen cme=falsex:lsetow axiues_f is_dir/ds &&cbreak,' \ { cde ssrc!irolset---wwd=`wwdelsetsrc!ir=.lseteras_.ds &&cbreak;n}ll \ ow axiues_f i&cbbtttt!ir=.T=$PATH &&cbreak,i .)xsc_ll _suffix=doc_ spbbtttt!ir_sub=.loc_ spbbtttt_prefix= t -d consc_ll _suffix=/ "$as_me: erc_deak,'\)$/{'s|^\.r as_||klmin# A ".." o= xeP S __save_IFSt ds_c_ll _suffix.sr/ac_ spbbtttt!ir_sub= "$as_me: erc_dea_suffixk,'\)$/{'s|/[^ as_d|/..|g;s|/||klmin$Pg=`e_c_ spbbtttt!ir_subei "")doc_ spbbtttt!ir_sub=.loc_ spbbtttt_prefix= t -exrresoc_ spbbtttt_prefix=e_c_ spbbtttt!ir_sub/Ple if rm olaris 7 c_nee_ spbbtttt!ir=s_c_wwd7 c_nee_btttt!ir=s_c_wwderc_dea_suffix # o= xbackwardPunsern bility: _c_ spbbtttt!ir=e_c_ spbbtttt_prefix =$PATH_srcll st l .)xn# WWAmysebtttt\\\st "$lacd.s_f i&cbsrc!ir=.T_f i&cb spbsrc!ir=$ac_ spbbtttt!ir_subT_f i&cbnee_ spbsrc!ir=$ac_wwd le ifr as_di|r?:r as_dir :# Aeed and =dirs__f i&cbsrc!ir=_srcll erc_dea_suffix;T_f i&cb spbsrc!ir=$src!irT_f i&cbnee_ spbsrc!ir=$srcll st -; rre# Retadvvd =dirs__f i&cbsrc!ir=__c_ spbbtttt_prefix_srcll erc_dea_suffixT_f i&cb spbsrc!ir=$ac_ spbbtttt_prefix_srcll T_f i&cbnee_ spbsrc!ir=$ac_wwd/$srcll st -ris 7 c_nee_src!ir=$ac_nee_ spbsrc!irerc_dea_suffixTelf :ods &&cbreak,' { 'c_s as_li?;:ow axiuel }se, iprCSHELao= xgu))ee bcures__f ien >&1o&/fl"$'c_src!ir/curesgnuhas_myself :sate naseline, i alizal"$'c_src!ir/curesgnuh,t help=rt u---veline,(lself"; t/fl"$'c_src!ir/curehas_myself :sate naseline, i alizal"$'c_src!ir/cureh,t help=rt u---veline,(lsi "$as_me: error: iWARNING:snorcurrn th "nglobadvanfisSt ds_c_ll /] b2 asc fis|| 'c_s as_li?elf :ods &&cbwwdho' { 'c_s as_li?;:breakl }se,proba; th>&1o&/te s_c_ipit_help=Pre-"$i #exc_e as_Vsels_c_ipit_on., tt_n='/usr/$Pt <<\_ACEOF HOUTure=rary9 gener00ol by &2 asefn_exi}:`exc_try_s_me\"" "$as_me: erc_try_s_mek;n}l>&5-; (error"$ac_ses H") rr$$.d>&1o. irsr/ac_s as_li?elfself"; t/s $$.d>&1o. iras_myself :greo--vf'^ *+' $$.d>&1o. ir r$$.d>&1o. i1elf :oat $$.d>&1o. i1l>&5-; mvconf$$.d>&1o. i1l$$.d>&1o. irsr/fT.to "$as_me: error: $2" >&2 asefn_exi}:`\$?lseexc_e as_"l>&5-; f"; texc_e as_lse0;n}lre-acteecho`" = "ac_xx_west "_flagk,' \ lf"; t!IFsl$$.d>&1o. irsr//////}lseteras_.sf$$.d>&1o.exc_objaxtas_mys :sr/ac_- #(a\)0 "$0" : "$as_me: error: irrrrehapr -z "awas:"l>&5-)$/{'s/^/| /' rror>&1o.exc_exrl>&5- ac_- #(a\)1 fT.toerror {as_linene ck;t{ hen {as_linene ckalsexlre-aVe ws_line=; un----e ws_line;} in"ATUtt---_e as_l$ac_- #(a\ } gg cifttcxx_try_unses H igg cifttc_try_unses H fn_exi et_status () { return $rrr # , sto unses H rror>&1o.exc_exr, atha- # Ex alATH_ -ftttsucceed d.7 cifttc_try_unses H unset Ve ws_line=$2" >&2 as"$1"}:${as_linene ck=${as_linene ck=$${as_linene ckevaf conf$$.d>&1o.exc_objaxto' sel{ { 'c_try="$ac_ses H"=$PATH ((er--try"aP ---*\"* |r*\`* |r*\\*)x---try_s_me=\$ac_tryt -; rre---try_s_me=$ac_tryt -ris 7errorsc_try_s_me="\"\error: $2" >&2 asefn_exi}:`exc_try_s_me\"" "$as_me: erc_try_s_mek;n}l>&5-; (error"$ac_ses H") rr$$.d>&1o. irsr/ac_s as_li?elfself"; t/s $$.d>&1o. iras_myself :greo--vf'^ *+' $$.d>&1o. ir r$$.d>&1o. i1elf :oat $$.d>&1o. i1l>&5-; mvconf$$.d>&1o. i1l$$.d>&1o. irsr/fT.to "$as_me: error: $2" >&2 asefn_exi}:`\$?lseexc_e as_"l>&5-; f"; texc_e as_lse0;n}lre-acteecho`" = "ac__west "_flagk,' \ lf"; t!IFsl$$.d>&1o. irsr//////}lseteras_.sf$$.d>&1o.exc_objaxtas_mys :sr/ac_- #(a\)0 "$0" : "$as_me: error: irrrrehapr -z "awas:"l>&5-)$/{'s/^/| /' rror>&1o.exc_exrl>&5- ac_- #(a\)1 fT.toerror {as_linene ck;t{ hen {as_linene ckalsexlre-aVe ws_line=; un----e ws_line;} in"ATUtt---_e as_l$ac_- #(a\ } gg cifttc_try_unses H igg cifttc_try_upp fn_exi et_status () { return # , sto prevror)) rror>&1o.exc_exr, atha- # Ex alATH_ -ftttsucceed d.7 cifttc_try_upp unset Ve ws_line=$2" >&2 as"$1"}:${as_linene ck=${as_linene ck=$${as_linene ckevasel{ { 'c_try="$ac_pp rror>&1o.exc_exr"=$PATH ((er--try"aP ---*\"* |r*\`* |r*\\*)x---try_s_me=\$ac_tryt -; rre---try_s_me=$ac_tryt -ris 7errorsc_try_s_me="\"\error: $2" >&2 asefn_exi}:`exc_try_s_me\"" "$as_me: erc_try_s_mek;n}l>&5-; (error"$ac_pp rror>&1o.exc_exr") rr$$.d>&1o. irsr/ac_s as_li?elfself"; t/s $$.d>&1o. iras_myself :greo--vf'^ *+' $$.d>&1o. ir r$$.d>&1o. i1elf :oat $$.d>&1o. i1l>&5-; mvconf$$.d>&1o. i1l$$.d>&1o. irsr/fT.to "$as_me: error: $2" >&2 asefn_exi}:`\$?lseexc_e as_"l>&5-; f"; texc_e as_lse0;n}l>l$$.d>&1o.ilre-acteecho`" = "ac__prevror_wmyn_flag"ac__west "_flagk,' \ lf"; t!IFsl$$.d>&1o. irsr//////}as_mys :sr/ac_- #(a\)0 "$0" : "$as_me: error: irrrrehapr -z "awas:"l>&5-)$/{'s/^/| /' rror>&1o.exc_exrl>&5- _f i&cb- #(a\)1 fT.toerror {as_linene ck;t{ hen {as_linene ckalsexlre-aVe ws_line=; un----e ws_line;} in"ATUtt---_e as_l$ac_- #(a\ } gg cifttc_try_upp igg cifttfc_try_unses H fn_exi et_status () { return $rrrr # , sto unses H rror>&1o.exc_exr, atha- # Ex alATH_ -ftttsucceed d.7 cifttfc_try_unses H unset Ve ws_line=$2" >&2 as"$1"}:${as_linene ck=${as_linene ck=$${as_linene ckevaf conf$$.d>&1o.exc_objaxto' sel{ { 'c_try="$ac_ses H"=$PATH ((er--try"aP ---*\"* |r*\`* |r*\\*)x---try_s_me=\$ac_tryt -; rre---try_s_me=$ac_tryt -ris 7errorsc_try_s_me="\"\error: $2" >&2 asefn_exi}:`exc_try_s_me\"" "$as_me: erc_try_s_mek;n}l>&5-; (error"$ac_ses H") rr$$.d>&1o. irsr/ac_s as_li?elfself"; t/s $$.d>&1o. iras_myself :greo--vf'^ *+' $$.d>&1o. ir r$$.d>&1o. i1elf :oat $$.d>&1o. i1l>&5-; mvconf$$.d>&1o. i1l$$.d>&1o. irsr/fT.to "$as_me: error: $2" >&2 asefn_exi}:`\$?lseexc_e as_"l>&5-; f"; texc_e as_lse0;n}lre-acteecho`" = "ac_f_west "_flagk,' \ lf"; t!IFsl$$.d>&1o. irsr//////}lseteras_.sf$$.d>&1o.exc_objaxtas_mys :sr/ac_- #(a\)0 "$0" : "$as_me: error: irrrrehapr -z "awas:"l>&5-)$/{'s/^/| /' rror>&1o.exc_exrl>&5- ac_- #(a\)1 fT.toerror {as_linene ck;t{ hen {as_linene ckalsexlre-aVe ws_line=; un----e ws_line;} in"ATUtt---_e as_l$ac_- #(a\ } gg cifttfc_try_unses H igg cifttc_try_run fn_exi et_status () { return # , sto s_lk rror>&1o.exc_exr, atha- # Ex alATH_ -ftttsucceed d. Assumes # the "$ecu/nulls *can*fbeDrun.7 cifttc_try_run unset Ve ws_line=$2" >&2 as"$1"}:${as_linene ck=${as_linene ck=$${as_linene ckevasel{ { 'c_try="$ac_s_lk"=$PATH ((er--try"aP ---*\"* |r*\`* |r*\\*)x---try_s_me=\$ac_tryt -; rre---try_s_me=$ac_tryt -ris 7errorsc_try_s_me="\"\error: $2" >&2 asefn_exi}:`exc_try_s_me\"" "$as_me: erc_try_s_mek;n}l>&5-; (error"$ac_s_lk") rr&5-; ac_s as_li?elf "$as_me: error: $2" >&2 asefn_exi}:`\$?lseexc_e as_"l>&5-; f"; texc_e as_lse0;n}lre-a 'c_try='./rror>&1oexc_exeexr'min{ { $PATH ((er--try"aP ---*\"* |r*\`* |r*\\*)x---try_s_me=\$ac_tryt -; rre---try_s_me=$ac_tryt -ris 7errorsc_try_s_me="\"\error: $2" >&2 asefn_exi}:`exc_try_s_me\"" "$as_me: erc_try_s_mek;n}l>&5-; (error"$ac_try") rr&5-; ac_s as_li?elf "$as_me: error: $2" >&2 asefn_exi}:`\$?lseexc_e as_"l>&5-; f"; texc_e as_lse0;n};/}as_mys :sr/ac_- #(a\)0 "$0" : "$as_me: error: ipr -z " "$i0ol s #te as_l$ac_e as_"l>&5-; "$as_me: error: irrrrehapr -z "awas:"l>&5-)$/{'s/^/| /' rror>&1o.exc_exrl>&5- _f if i&cb- #(a\)exc_e as_VfT.tof cornf$$.d>&1o.dSYMf$$.d>&1o_ipa8_$$.d>&1o.oo.toerror {as_linene ck;t{ hen {as_linene ckalsexlre-aVe ws_line=; un----e ws_line;} in"ATUtt---_e as_l$ac_- #(a\ } gg cifttc_try_run igg cifttc_unseute_iot fn_exi EXPR VAR INCLUDES et_status () { return $rrrrrs () { return # , Nos shf. ca ittunses H-alm- ontai ofiEXPR t_stapr -z "a the ippm_mosotinNCLUDES,f---t\\\sVAR accort\\\ly. R # Exs alATH_ -f- ontai cd thfbeotiunseuted cifttc_unseute_iot unset Ve ws_line=$2" >&2 as"$1"}:${as_linene ck=${as_linene ck=$${as_linene ckevasel>&1o&/bohen _unses \\\ho "yesas_myself :# Dxyz' \\\supage+of size,iunseutehell so athahi bouthsS=$Pt $$.ddefs.h - <<_ACEOF r$$.d>&1o.exc_exr /* z' t$$.ddefs.h.e,*/ $4 iot main unsete aicNiotl>&1o_array [1 - 2 * !((e2) >se0)]; >&1o_array [0]lse0- _f -; - # Ex 0; }-_ACEOF sel cifttc_try_unses H "efn_exi"as_mys :sr/ac_lo=0/ac_mid)0 as H :; _dir/ :oat $$.ddefs.h - <<_ACEOF r$$.d>&1o.exc_exr /* z' t$$.ddefs.h.e,*/ $4 iot main unsete aicNiotl>&1o_array [1 - 2 * !((e2) &1o_array [0]lse0- _f -; - # Ex 0; }-_ACEOF sel cifttc_try_unses H "efn_exi"as_mys :sr/ac_hi=exc_mid;:break "$0" : 'ATUttar #texc_mid + 1lset---lo=$${a(a\ sel>&1o&$ac_so -le exc_mid;:_myse r/ac_lo=/ac_hi=e r/break fT. 'ATUttar #t2 '*'texc_mid + 1lset---mid)$${a(a\ fT.f conf$$re $$.d>&1o. ir $$.d>&1o.exc_objaxt rror>&1o.exc_exrse,proba"$0" : oat $$.ddefs.h - <<_ACEOF r$$.d>&1o.exc_exr /* z' t$$.ddefs.h.e,*/ $4 iot main unsete aicNiotl>&1o_array [1 - 2 * !((e2) &1o_array [0]lse0- _f -; - # Ex 0; }-_ACEOF sel cifttc_try_unses H "efn_exi"as_mys :sr/ac_hi=-1t---mid)-1 as H :; _dir/ :oat $$.ddefs.h - <<_ACEOF r$$.d>&1o.exc_exr /* z' t$$.ddefs.h.e,*/ $4 iot main unsete aicNiotl>&1o_array [1 - 2 * !((e2) >seexc_mid)]; >&1o_array [0]lse0- _f -; - # Ex 0; }-_ACEOF sel cifttc_try_unses H "efn_exi"as_mys :sr/ac_lo=exc_mid;:break "$0" : 'ATUttar #t'('texc_mid ')' - 1lset---hi=ex{a(a\ sel>&1o&$ac_mid -le exc_hi;:_myse r/ac_lo=/ac_hi=e r/break fT. 'ATUttar #t2 '*'texc_mid set---mid)$${a(a\ fT.f conf$$re $$.d>&1o. ir $$.d>&1o.exc_objaxt rror>&1o.exc_exrse,proba"$0" : ac_lo=/ac_hi=efT.f conf$$re $$.d>&1o. ir $$.d>&1o.exc_objaxt rror>&1o.exc_exrsfT.f conf$$re $$.d>&1o. ir $$.d>&1o.exc_objaxt rror>&1o.exc_exrs# BinWIy se rchxberweys so athahi bouthsS= as H { hen cmloho! "henac_hi"; _dir/'ATUttar #t'('texc_hi -&$ac_so ')' /t2 +&$ac_so set---mid)$${a(a\ :oat $$.ddefs.h - <<_ACEOF r$$.d>&1o.exc_exr /* z' t$$.ddefs.h.e,*/ $4 iot main unsete aicNiotl>&1o_array [1 - 2 * !((e2) &1o_array [0]lse0- _f -; - # Ex 0; }-_ACEOF sel cifttc_try_unses H "efn_exi"as_mys :sr/ac_hi=exc_mid "$0" : 'ATUttar #t'('texc_mid ')' + 1lset---lo=$${a(a\ fT.f conf$$re $$.d>&1o. ir $$.d>&1o.exc_objaxt rror>&1o.exc_exrsproba$Pg=`e_c_so t -ar( ?rreerror"$3=\$ac_lek;nac_- #(a\)0st -'')i&cb- #(a\)1st -ris 7e,(lsi oat $$.ddefs.h - <<_ACEOF r$$.d>&1o.exc_exr /* z' t$$.ddefs.h.e,*/ $4 e aicN\\\\\iotl\\\\rror()-aV- # Ex $2l }se aicNun-ign$/{\\\\\iotlu\\\\rror()-aV- # Ex $2l }s#ippm_mofs#ippm_mofsiot main unset FILE *flsefoyz' ("$$.d>&1o.rro", "w");evasel(! f)o' - # Ex 1;evasel((e2) f-ftttcausos \r\nt$$.dusl; ageeo_vNplatglobs.e,*/ - # Ex fest "$(f)o' fclosS (f)o!se0;- _f -; - # Ex 0; }-_ACEOF sel cifttc_try_run "efn_exi"as_mys :sr/s_me:>>$$.d>&1o.rro;fre,d $3 <$$.d>&1o.rro;fac_- #(a\)0 "$0" : ac_- #(a\)1 fT.f conf$$re *.$$re $$re.$$.d>&1o.* gmon. wi bb. wi rror>&1oexc_exeexrs|r: $$.d>&1o.exc_objaxt rror>&1o.beam rror>&1o.exc_exrsf conf$$.d>&1o.(a\ r/fT.toerror {as_linene ck;t{ hen {as_linene ckalsexlre-aVe ws_line=; un----e ws_line;} in"ATUtt---_e as_l$ac_- #(a\ } gg cifttc_unseute_iot igg cifttc_uSHEL_headv/_unses H fn_exi HEADER VAR INCLUDES et_status () { return $rrrrrs () { return { return # , s alATH_ HEADER exi s atha0. ibttunses Hd_u vo&&t Pippm_moPwhicthin tinNCLUDES,f---t\\\s ittuP SH UWIN ksh VAR accort\\\ly. cifttc_uSHEL_headv/_unses H unset Ve ws_line=$2" >&2 as"$1"}:${as_linene ck=${as_linene ck=$${as_linene ckeva{f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$2"l>&5- "$as_me_n "cSHEL\\\so= x$2namZ"l>&6l }sselerror"{ \"\e{$3: er#\"alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : oat $$.ddefs.h - <<_ACEOF r$$.d>&1o.exc_exr /* z' t$$.ddefs.h.e,*/ $4 #ippm_mof<$2>-_ACEOF sel cifttc_try_unses H "efn_exi"as_mys :sr/error"$3=yes"a"$0" : error"$3=no"efT.f conf$$re $$.d>&1o. ir $$.d>&1o.exc_objaxt rror>&1o.exc_exrsfT.errorsc_res--- 3 as_cr va{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$ac_- s"l>&5- "$as_mer"$ac_- s"l>&6l }se,error {as_linene ck;t{ hen {as_linene ckalsexlre-aVe ws_line=; un----e ws_line;} } gg cifttc_uSHEL_headv/_unses H igg cifttfc_try_run fn_exi et_status () { return # , sto s_lk rror>&1o.exc_exr, atha- # Ex alATH_ -ftttsucceed d. Assumes # the "$ecu/nulls *can*fbeDrun.7 cifttfc_try_run unset Ve ws_line=$2" >&2 as"$1"}:${as_linene ck=${as_linene ck=$${as_linene ckevasel{ { 'c_try="$ac_s_lk"=$PATH ((er--try"aP ---*\"* |r*\`* |r*\\*)x---try_s_me=\$ac_tryt -; rre---try_s_me=$ac_tryt -ris 7errorsc_try_s_me="\"\error: $2" >&2 asefn_exi}:`exc_try_s_me\"" "$as_me: erc_try_s_mek;n}l>&5-; (error"$ac_s_lk") rr&5-; ac_s as_li?elf "$as_me: error: $2" >&2 asefn_exi}:`\$?lseexc_e as_"l>&5-; f"; texc_e as_lse0;n}lre-a 'c_try='./rror>&1oexc_exeexr'min{ { $PATH ((er--try"aP ---*\"* |r*\`* |r*\\*)x---try_s_me=\$ac_tryt -; rre---try_s_me=$ac_tryt -ris 7errorsc_try_s_me="\"\error: $2" >&2 asefn_exi}:`exc_try_s_me\"" "$as_me: erc_try_s_mek;n}l>&5-; (error"$ac_try") rr&5-; ac_s as_li?elf "$as_me: error: $2" >&2 asefn_exi}:`\$?lseexc_e as_"l>&5-; f"; texc_e as_lse0;n};/}as_mys :sr/ac_- #(a\)0 "$0" : "$as_me: error: ipr -z " "$i0ol s #te as_l$ac_e as_"l>&5-; "$as_me: error: irrrrehapr -z "awas:"l>&5-)$/{'s/^/| /' rror>&1o.exc_exrl>&5- _f if i&cb- #(a\)exc_e as_VfT.tof cornf$$.d>&1o.dSYMf$$.d>&1o_ipa8_$$.d>&1o.oo.toerror {as_linene ck;t{ hen {as_linene ckalsexlre-aVe ws_line=; un----e ws_line;} in"ATUtt---_e as_l$ac_- #(a\ } gg cifttfc_try_run igg cifttfc_try_s_lk fn_exi et_status () { return $r # , sto s_lk rror>&1o.exc_exr, atha- # Ex alATH_ -ftttsucceed d. cifttfc_try_s_lk unset Ve ws_line=$2" >&2 as"$1"}:${as_linene ck=${as_linene ck=$${as_linene ckevaf conf$$.d>&1o.exc_objaxt rror>&1oexc_exeexrevasel{ { 'c_try="$ac_s_lk"=$PATH ((er--try"aP ---*\"* |r*\`* |r*\\*)x---try_s_me=\$ac_tryt -; rre---try_s_me=$ac_tryt -ris 7errorsc_try_s_me="\"\error: $2" >&2 asefn_exi}:`exc_try_s_me\"" "$as_me: erc_try_s_mek;n}l>&5-; (error"$ac_s_lk") rr$$.d>&1o. irsr/ac_s as_li?elfself"; t/s $$.d>&1o. iras_myself :greo--vf'^ *+' $$.d>&1o. ir r$$.d>&1o. i1elf :oat $$.d>&1o. i1l>&5-; mvconf$$.d>&1o. i1l$$.d>&1o. irsr/fT.to "$as_me: error: $2" >&2 asefn_exi}:`\$?lseexc_e as_"l>&5-; f"; texc_e as_lse0;n}lre-acteecho`" = "ac_f_west "_flagk,' \ lf"; t!IFsl$$.d>&1o. irsr//////}lseteras_.sf$$.d>&1oexc_exeexrsre-acteecho`/bohen _unses \\\ho "yes,' \ lerro>&1o_x rror>&1oexc_exeexreva/////}as_mys :sr/ac_- #(a\)0 "$0" : "$as_me: error: irrrrehapr -z "awas:"l>&5-)$/{'s/^/| /' rror>&1o.exc_exrl>&5- ac_- #(a\)1 fT.to# Dx ete= ittIPA/IPO (Ioter Pror)durrorAnalysis/Oin mALCASE=) "nglobadvan.to# nre, ul by ittPGInunses H_S($$.d>&1o_ipa8_$$.d>&1o.oo),n2>fiiownuld.to# ioterfl_WAs #t ittnexrls_lk rr =r !;falsovwx ete=a __save_IFS the is;r-# lefsebeh. caby Apple' unses H_.e,Wesdot{ftttbef$re "$ecu/\\\s ittacn thstStof cornf$$.d>&1o.dSYMf$$.d>&1o_ipa8_$$.d>&1o.oo.toerror {as_linene ck;t{ hen {as_linene ckalsexlre-aVe ws_line=; un----e ws_line;} in"ATUtt---_e as_l$ac_- #(a\ } gg cifttfc_try_s_lk=$Pt r$$.dig.log <<_ACEOF , tttfs H rroamors atyt in BASsapr ducul by unses H_s as H runrxit $$.digure,\m_faidf_/-n'g\\\stfture=m kes a mi ke. Itawastnre, ul by HOUTerror:=rary9, aschawas gener00ol by r$$.dig.logset$Pt <<_ASUNAME pet_status ( ## petPlatglob. ## pet_status ( ## ihost=dirn= `(host=dirn|| undirnan) rros//\1/ r\)$/{1q` undirnamn= `(undirnam) rros//\1/ r|/s_me:unknown` undirnarn= `(undirnar) rros//\1/ r|/s_me:unknown` undirnasn= `(undirnas) rros//\1/ r|/s_me:unknown` undirnavn= `(undirnav) rros//\1/ r|/s_me:unknown` )"' bin/undirnapn= `()"' bin/undirnap) rros//\1/ r|/s_me:unknown` bin/undirnaX = `()bin/undirnaX) rros//\1/ r|/s_me:unknown` )bin/ rchxxxxxxxxxxxxxx= `()bin/ rch) rros//\1/ r|/s_me:unknown` "' bin/ rchx-kxxxxxxx= `()"' bin/ rchx-k) rros//\1/ r|/s_me:unknown` "' $$.vex/getsysipm_ = `()"' $$.vex/getsysipm_) rros//\1/ r|/s_me:unknown` "' bin/hostipm_ xxxxx= `()"' bin/hostipm_) rros//\1/ r|/s_me:unknown` bin/machude xxxxxxxxxx= `()bin/machude) rros//\1/ r|/s_me:unknown` "' bin/oslevepxxxxxxx= `()"' bin/oslevep) rros//\1/ r|/s_me:unknown` bin/union.,exxxxxxxxxx= `()bin/union.,e) rros//\1/ r|/s_me:unknown` _ASUNAME rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic "$as_me: s_di: "as_!irose,probaIFS=$rrosave_IFS- }l>&5-=$Pt r&5 <<_ACEOF # pet_status () ## petC$re f"; s. ## pet_status () ## i_ACEOF # p Keeo-a tracvNof valtrr =r !ls_le. # Stripo wi t no-ure, usr !lt no-rt u---ageeo valymentatiops H up. # Stripo wi t ------sbecauso we pro'tfwant\m_frt grdfiio = xfu `(sDruns. # Alsovquo usr FS( 1s rroamor\\\ sappenmeta-characters. # MakU wshpassos shalpica = xvropH_Sdupli$Pte-( 1r+ 1rfsuppre) van. ciure_( 1s= ciure_( 1s0= ciure_( 1s1= cimu1o_keeo_nexr=fa$0" o= xsc_pass t 1 2 _dir/o= xsc_g" bli_dir/ :oag=`e_c_g" Pi no-ure, us| t no-u* |rtp |rtno-rt u---age| t no-r*):ow axiueele ifex-qs|rtquie s|rt quie s|rt quies|rt quis|rt qus|rt qs|r: : |rt------s|rt ------s|rt -----s|rt ----s|rt ---)se, i :ow axiueele ifex*\'*)line, i_c\g" = "$as_me: erc_g" k,'\)$/{"s/'/'\\\\\\\\''/g"` le ifexrt aline,oag=`e_c_pass t line,1as_saftt eva !l ciure_( 1s0 " 'erc_g" '" le ifex2)line, i_stftt eva !l ciure_( 1s1 " 'erc_g" '" ifexposel>&1o&$ac_mu1o_keeo_nexrx= true;:_myse cimu1o_keeo_nexr=fa$0" ggGf=e---ue,\back shnlobal. ifexpo"$0" oag=`e_c_g" Pi --*=*s|rt $P SH |rtC |rtdBST el-*s|rt dBST el-*s_echs|rtrn ksh-*s|rt rn ksh-*s|rtgas |rt g* |rtpfpe| t nf*s_echs|rtqs|rtquie s|rt q* |rt------s|rt ---* |rtvf|rton.b*s_echs|rts # *f|rt s # *s|rts #out-*f|rt s #out-* |rt x) as_cr$PATH &&cbure_( 1s0 " i ------ &&cbure_( 1s1"*" 'erc_g" ' "* ):ow axiueele ifexrt al ifexle if-* ): cimu1o_keeo_nexr=truexle rt aline,r/fT.toe, i_stftt eva !l ciure_( 1s " 'erc_g" '" ifexpole ifexrt alinprobaproba{l ciure_( 1s0=; un----eciure_( 1s0;} {l ciure_( 1s1=; un----eciure_( 1s1;} # n_arioterrup0ol = xexit'd, cleanupl>&mporWIy whictatatha0o2>/dteotiun.dig.log.e,Wesremovtirr = 1r)ebecauso r Fway t ulquo us\ ! -f reotiwnuldtcausoxvrokshms = xlook u\ly. #iWARNING:sUsS '\''\m_frtpre)---sug npostrophWAs # ! -f "trap. #iWARNING:sDotatio #t\$(trap code li #ta news_li,nduWALK a FreeBSD 4.0#-n'. trap 'exit_s as_li?elf# SGNU iotoiun.dig.logeeo_vNioglobadvanf the m!tttthelpst f_/-n'g\\\. if{ _f is_me blic "$as_me: pet_status () { r ## petCP SH UWIN kshs. ## pet_status () { r ##" _f is_me _f ien /o=lpic\\\ way of writ\\\s ittuP SH mi hathlls news_lis\ ! ---ues, (ir/o= xsc_s_fst d`(---) rr&1,'\)$/{tp '\''s/^\([a-zA-Z_][a-zA-Z0-9_]sh)=.*ges.p'\''`; _dir/ :errorsc_s_l--- sc_s_f li$Pg=`exc_rrort -arg" : *$2" >nl}*)line, i$Pg=`exc_rrfst -arg" : ".*_cv_*)a{f "$as_me: error: $2" >&2 asefn_exi}:`WARNING:suP SH UWIN ksh exc_rrfsrroamors a news_li"l>&5- "$as_mer"$aror: iWARNING:suP SH UWIN ksh exc_rrfsrroamors a news_li"l>&2;}ele ifexport aline,r/$Pg=`exc_rrfst -arg" : "._,'\IFS Perinlrele-arg" : ".BASH_ARGV PBASH_SOURCE),error c_s_f=ele-arg" : ".*)a{ferror c_s_f=; un---- c_s_f;}ele ifexport aole ifexrt alinproba (---) rr&1,' li$Pg=`exrinl`(xc_epacv='\''\'\''; ---) rr&1`rt -arg" : *$2" >nl}xc_epacv=\ *)line, i)$/{tp _ec"s/'\''/'\''\\\\'\'''\''/g;rs='ab^\\([_$`echo -n x`]*_cv_[_$`echo -n x`]*\h)=\*\.*h\)/\\1='\''\\2'\''/p" ifexpole-arg" : *)line, i)$/{tp "/^[_$`echo -n x`]*_cv_[_$`echo -n x`]*=/p" ifexpole ifexrt a 'se, isort ) _f is_me blic "$as_me: pet_status () { rr ## petOwith SUWIN kshs. ## pet_status () { rr ##" _f is_me _f i = xsc_s_fst ds_c_sub1o_1+=- _f i_dir/ : :errorsc_s_l--- sc_s_f lili$Pg=`exc_rrort line,ex*\'\''rre---(a\)' "$as_me: erc_rrok,'\)$/{"s/'\''/'\''\\\\\\\\'\'''\''/g"`le ifexport aline,r/ "$as_me: erc_rrr='\''erc_rro'\''" _f i_dnH |rsort _f is_me blic en >&1o&/te s_c_sub1o_whicthas_myself :sa "$as_me: pet_status () { rrrr ## petF---ssub1oitun thst ## pet_status () { retu ##" _f i is_me _f i i = xsc_s_fst ds_c_sub1o_whicto' e,_di errorsc_s_l--- sc_s_f $Pg=`exc_rrort l *\'\''rre---(a\)' "$as_me: erc_rrok,'\)$/{"s/'\''/'\''\\\\\\\\'\'''\''/g"`le rt al "$as_me: erc_rrr='\''erc_rro'\''" _f i i_dnH |rsort _f i is_me _f i i blic en >&1o&/st$$.ddefs.has_myself :sa "$as_me: pet_status () ## pet$$.ddefs.h.e## pet_status () ##" _f i is_me _f i ioat $$.ddefs.h _f i is_me _f i i _f iecho`/b_c_signrok,!se0lseline, i "$as_me: error: icauttttsignro b_c_signrok e, i "$as_me: error: i"$i #eexit_s as_k e,}l>&5-; f conf$$re *.$$re $$re.$$.d>&1o.* seline,f conf-r $$.d>&1o* $$.ddefs* $$.d$$* b_c_clean_whict seline,"$i #eexit_s as_ ' 0 o= xsc_signro t 1 2 13 15; _dir/trap 'sc_signro='b_c_signro'; _stftt"$i #1' b_c_signroaprobasc_signro=0 et$$.ddefs.h avoids OSarr =r !ls_lea---g #tlimi0s the DEFS 0. iexceed. f conf-r $$.d>&1o* $$.ddefs.h - "$as_mer"/* $$.ddefs.h */"l>l$$.ddefs.h -# Predefuded prevror)) o_SUWIN ksh)si $Pt r>$$.ddefs.h <<_ACEOF #defudeHn'CKAGE_NAME: en'CKAGE_NAME"i_ACEOF #$Pt r>$$.ddefs.h <<_ACEOF #defudeHn'CKAGE_TARNAME: en'CKAGE_TARNAME"i_ACEOF #$Pt r>$$.ddefs.h <<_ACEOF #defudeHn'CKAGE_VERSION: en'CKAGE_VERSION"i_ACEOF #$Pt r>$$.ddefs.h <<_ACEOF #defudeHn'CKAGE_STRING: en'CKAGE_STRING"i_ACEOF #$Pt r>$$.ddefs.h <<_ACEOF #defudeHn'CKAGE_BUGREPORT: en'CKAGE_BUGREPORT"i_ACEOF #$Pt r>$$.ddefs.h <<_ACEOF #defudeHn'CKAGE_URL: en'CKAGE_URL"i_ACEOF # p L---t\$(sitoPwhic\)$lavenug nlteroztttuP SH whic\en itfwants s.-# Prefer . iexpli$it ab($laveed whic\LK autobadvcal ab($laveed robs.asc_sitHatt!t1=NONEasc_sitHatt!t2=NONEaen >&1o&/te sCONFIG_SITEhas_myself# Wesdotatiowant\a s_di se rchxhe Grrodig.sitHubli$Pg=`eCONFIG_SITE t -ar( ine,-rresoc_sitHatt!t1=./eCONFIG_SITEle ifex*/rre---sitHatt!t1=eCONFIG_SITEle ifex*res oc_sitHatt!t1=./eCONFIG_SITEle ifris 7elself"; thenprefixho! "$NONE_n='/usr/ac_sitHatt!t1=eprefix/shmys/rrodig.sitHsr/ac_sitHatt!t2=eprefix/etc/rrodig.sitHs"$0" : 'c_sitHatt!t1=eac_dcras_v_prefix/shmys/rrodig.sitHsr/ac_sitHatt!t2=eac_dcras_v_prefix/etc/rrodig.sitHsn_e/= xsc_sitHatt!t t -/b_c_sitHatt!t1"-/b_c_sitHatt!t2" _dir/{ hen cmsitHatt!talsexNONE setow axiues_fself"; tos//\1/ !=-/b_c_sitHatt!tolseteras_.r-"b_c_sitHatt!toas_myself :{f "$as_me: error: $2" >&2 asefn_exi}:`loa \\\ssitoPe=$1;ttb_c_sitHatt!tol>&5- "$as_mer"$aror: iloa \\\ssitoPe=$1;ttb_c_sitHatt!tol>&6;}se, i)$/{'s/^/| /' /b_c_sitHatt!tol>&5-; . /b_c_sitHatt!tol\line, i' { {f "$as_me: error: $2" >&2 asefn_exi}:`est ": t -\` c_pwd':ol>&5- "$as_mer"$aror: iest ": t -\` c_pwd':ol>&2;} arifttest "$& t"rrrrehato soa ssitoPe=$1;ttb_c_sitHatt!t Seef\`c.log'xhe Gm$re deamols" "efn_exi" 5 l }se,n_eproba en >&1o&/r-"buP SHatt!toas_myself# So_vNon., ttusagebash lied rrrrbm_f-ourcd os//\1/ (spectro whicto' gg ctual a),Nso we avoidsdo\\\s iat. DJGPP emula us\ --e \a regula/Pwhic.s_fself"; tos//\1/ !=-/buP SHatt!tolseteras_.f-"buP SHatt!toas_myself :{f "$as_me: error: $2" >&2 asefn_exi}:`loa \\\suP SH buP SHatt!tol>&5- "$as_mer"$aror: iloa \\\suP SH buP SHatt!tol>&6;}se, i$Pg=`euP SHatt!trt line,exr as_di|r?:r as_dir .-"buP SHatt!toae ifexpo*res .-"=/euP SHatt!toae ifexrt alinot "$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`cre, \\\suP SH buP SHatt!tol>&5- "$as_mer"$aror: icre, \\\suP SH buP SHatt!tol>&6;}se,>buP SHatt!t n # prCSHELa the ell perciousPUWIN ksh).saved\ ! -f "uP SH GNU kep--t\$(sameoti---ue. ciP SHa$$rrup0ol=fa$0" o= xsc_s_fst ds_c_wercious$1+=-; _dir/errorsc_old----=2>ac_cv_env_${sc_s_f}----ir/errorsc_new----=2>ac_env_${sc_s_f}----ir/errorsc_old-s_l---ac_cv_env_${sc_s_f}-ontai errorsc_new-s_l---ac_env_${sc_s_f}-ontai $Pg=`exc_old----,$sc_new----rt line,---,)line, i{f "$as_me: error: $2" >&2 asefn_exi}:`est ": \` c_s_f'awast----to \` c_old-s_l'\ ! -f "werviousPrunol>&5- "$as_mer"$aror: iest ": \` c_s_f'awast----to \` c_old-s_l'\ ! -f "werviousPrunol>&2;}se, ir/ac_P SHa$$rrup0ol=:ole ifex,---)line, i{f "$as_me: error: $2" >&2 asefn_exi}:`est ": \` c_s_f'awastatio --rt -f "werviousPrunol>&5- "$as_mer"$aror: iest ": \` c_s_f'awastatio --rt -f "werviousPrunol>&2;}se, ir/ac_P SHa$$rrup0ol=:ole ifex,)le ifex*r ifexposel>&1o&hen cmold-s_lho! "henac_new-s_loas_myse # diffl_Wncd\hin whiteepacvsdotatiole,d shfrrrures_ cmold-s_l_w=`s_merx n cmold-s_l`_ cmnew-s_l_w=`s_merx n cmnew-s_l`_ en >&1o&/b c_old-s_l_w" !=-/b_c_new-s_l_woas_myse i{f "$as_me: error: $2" >&2 asefn_exi}:`est ": \` c_s_f'ahastnhange ssince&-f "werviousPrun:ol>&5- "$as_mer"$aror: iest ": \` c_s_f'ahastnhange ssince&-f "werviousPrun:ol>&2;}s r/ac_P SHa$$rrup0ol=: "$0" i{f "$as_me: error: $2" >&2 asefn_exi}:`wmyn\\\: vgnUr\\\ whiteepacvsnhanges t -\` c_s_f'asince&-f "werviousPrun:ol>&5- "$as_mer"$aror: iwmyn\\\: vgnUr\\\ whiteepacvsnhanges t -\` c_s_f'asince&-f "werviousPrun:ol>&2;}s r/error c_s_f=\b c_old-s_l fT. {f "$as_me: error: $2" >&2 asefn_exi}:` i = meri---ue:` \` c_old-s_l'ol>&5- "$as_mer"$aror: i i = meri---ue:` \` c_old-s_l'ol>&2;}s {f "$as_me: error: $2" >&2 asefn_exi}:` icurrv/n UW-ue:`\` c_new-s_l'ol>&5- "$as_mer"$aror: i icurrv/n UW-ue:`\` c_new-s_l'ol>&2;}se, ir/file ifris 7' ggPass perciousPUWIN ksh).toiun.dig.s as_.s_fself"; t"$sc_new----alse eras_mys li$Pg=`exc_new-s_lrt line,*\'*)i_c\g" = c_s_f=' "$as_me: erc_new-s_lo,'\)$/{"s/'/'\\\\\\\\''/g"` le ifex*)i_c\g" = c_s_f=exc_new-s_lrle ifexrt aline,oag=`" &&cbure_( 1s "rt line,ex*" 'erc_g" ' "*rele-a Avoidsdups.e,UsS agequo us\ensures accuracy. ifexpo*re_stftt eva !l ciure_( 1s " 'erc_g" '" ae ifexrt alinot probasels_c_P SHa$$rrup0olas_mys {f "$as_me: error: $2" >&2 asefn_exi}:`est ": t -\` c_pwd':ol>&5- "$as_mer"$aror: iest ": t -\` c_pwd':ol>&2;} {f "$as_me: error: $2" >&2 asefn_exi}:`est ": nhanges t --f "environmv/n c nnunseromisS t Pbttttol>&5- "$as_mer"$aror: iest ": nhanges t --f "environmv/n c nnunseromisS t Pbttttol>&2;} in"ATUttest "$& t"run \`m ke=distclean'tath/exi\`rm buP SHatt!t' that #nt i" "efn_exi" 5 n #pet_status () { reture## petMain body of e=$1;t. ## pet_status () { retur ## iac_exr= 7 c_cpp='$CPP $CPPFLAGS' cises H='$CC -c $CFLAGS $CPPFLAGS rror>&1o.exc_exrl>&5' cis_lk='$CC -of$$.d>&1oexc_exeexrs$CFLAGS $CPPFLAGS $LDFLAGS rror>&1o.exc_exrl$LIBS >&5' ciunses H__gnu=-ac_cv_ciunses H__gnu # p Re --rexi \\\ prevror)) \\\solagsotouch ./src/ppm_defude.h f c./src/ppm_defude.h touch ./src/ppm_defude.h p selMPI +s rn kshd ry grabb\\\s iosS unses H_Swr evars whr1o use_ses=no prCSHELa alATH_ t rn ksh-mpiawastg-ven.hen >&1o&/b{rn ksh_ses: er#alse eras_mys :sr/rn ksh(a\)ern ksh_ses; sel>&1o&henrn ksh(a\alsexyesas_myself :{f "$as_me: error: $2" >&2 asefn_exi}:`***rCSHELao= xr FSMPI to unses H r !ls_lk li #t***ol>&5- "$as_mer"$aror: i***rCSHELao= xr FSMPI to unses H r !ls_lk li #t***ol>&6;}s(lsi {f "$as_me: error: $2" >&2 asefn_exi}:`***rFhr1o&uSHEL selnD0. iusoxnrn ksh(a\ to unses H r !ls_lk li #t***ol>&5- "$as_mer"$aror: i***rFhr1o&uSHEL selnD0. iusoxnrn ksh(a\ to unses H r !ls_lk li #t***ol>&6;}sn #p&uSHEL o= xdnH of valto=lpic\\\ MPI distriban thso# Ova MPI p LAMMPI p MPICH p MPICH2 # iotel MPI p Sun ClusterTools (tmcc,tmCC,tmf77,tmf90) tinBMeAIX POE (mpcc_r,mpCC_r,mpxlf_r) # Many of vasoe&+2>/dev/null; o GNU (dirnwr evarPrcau\ sel>&1o&henrn ksh(a\alsexoyz'sesas_myself :# Extract t Pwhr1o&wgrdfof "sescc",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy sescc;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_MPICC: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sMPICC"_n='/usr/ac_cv_pr -_MPICC= sMPICC" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_MPICC= sescc" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- eecho`" = "ac_v_pr -_MPICColset---v_pr -_MPICC= no"efT.fT.MPICC="ac_v_pr -_MPICC en >&1o&/te sMPICC"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$MPICCol>&5- "$as_mer"$MPICCol>&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # blic en >&1o&henMPICColsex""noas_mys :sr/aATUttest "$& t"Cnuldtatiof. casescc o= xOva MPI" "efn_exi" 5 "$0" : CC= sMPICC" i _f i# Extract t Pwhr1o&wgrdfof "sesc++",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy sesc++;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_MPICXX: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sMPICXX"_n='/usr/ac_cv_pr -_MPICXX= sMPICXX" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_MPICXX= sesc++" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- eecho`" = "ac_v_pr -_MPICXX" set---v_pr -_MPICXX= no"efT.fT.MPICXX="ac_v_pr -_MPICXX en >&1o&/te sMPICXX"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$MPICXX" >&5- "$as_mer"$MPICXX" >&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # blic en >&1o&henMPICXX" sex""noas_mys :sr/aATUttest "$& t"Cnuldtatiof. casesc++ o= xOva MPI" "efn_exi" 5 "$0" : CXX= sMPICXX" i _f i# Extract t Pwhr1o&wgrdfof "sesf90",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy sesf90;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_MPIFC: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sMPIFC"_n='/usr/ac_cv_pr -_MPIFC= sMPIFC" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_MPIFC= sesf90" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- eecho`" = "ac_v_pr -_MPIFColset---v_pr -_MPIFC= no"efT.fT.MPIFC="ac_v_pr -_MPIFC en >&1o&/te sMPIFC"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$MPIFCol>&5- "$as_mer"$MPIFCol>&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # blic en >&1o&henMPIFColsex""noas_mys :sr/aATUttest "$& t"Cnuldtatiof. casesf90 o= xOva MPI" "efn_exi" 5 "$0" : FC= sMPIFC"sfT.elsel>&1o&henrn ksh(a\alsexlamsesas_myself :# Extract t Pwhr1o&wgrdfof "sescc",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy sescc;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_MPICC: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sMPICC"_n='/usr/ac_cv_pr -_MPICC= sMPICC" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_MPICC= sescc" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- eecho`" = "ac_v_pr -_MPICColset---v_pr -_MPICC= no"efT.fT.MPICC="ac_v_pr -_MPICC en >&1o&/te sMPICC"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$MPICCol>&5- "$as_mer"$MPICCol>&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # blic en >&1o&henMPICColsex""noas_mys :sr/aATUttest "$& t"Cnuldtatiof. casescc o= xLAM/MPI" "efn_exi" 5 "$0" : CC= sMPICC" i _f i# Extract t Pwhr1o&wgrdfof "sesCC",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy sesCC;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_MPICXX: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sMPICXX"_n='/usr/ac_cv_pr -_MPICXX= sMPICXX" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_MPICXX= sesCC" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- eecho`" = "ac_v_pr -_MPICXX" set---v_pr -_MPICXX= no"efT.fT.MPICXX="ac_v_pr -_MPICXX en >&1o&/te sMPICXX"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$MPICXX" >&5- "$as_mer"$MPICXX" >&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # blic en >&1o&henMPICXX" sex""noas_mys :sr/aATUttest "$& t"Cnuldtatiof. casesCC o= xLAM/MPI" "efn_exi" 5 "$0" : CXX= sMPICXX" i _f i# Extract t Pwhr1o&wgrdfof "sesf90",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy sesf90;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_MPIFC: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sMPIFC"_n='/usr/ac_cv_pr -_MPIFC= sMPIFC" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_MPIFC= sesf90" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- eecho`" = "ac_v_pr -_MPIFColset---v_pr -_MPIFC= no"efT.fT.MPIFC="ac_v_pr -_MPIFC en >&1o&/te sMPIFC"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$MPIFCol>&5- "$as_mer"$MPIFCol>&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # blic en >&1o&henMPIFColsex""noas_mys :sr/aATUttest "$& t"Cnuldtatiof. casesf90 o= xLAM/MPI" "efn_exi" 5 "$0" : FC= sMPIFC"sfT.elsel>&1o&henrn ksh(a\alsexseschas_myself :# Extract t Pwhr1o&wgrdfof "sescc",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy sescc;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_MPICC: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sMPICC"_n='/usr/ac_cv_pr -_MPICC= sMPICC" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_MPICC= sescc" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- eecho`" = "ac_v_pr -_MPICColset---v_pr -_MPICC= no"efT.fT.MPICC="ac_v_pr -_MPICC en >&1o&/te sMPICC"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$MPICCol>&5- "$as_mer"$MPICCol>&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # blic en >&1o&henMPICColsex""noas_mys :sr/aATUttest "$& t"Cnuldtatiof. casescc o= xMPICH" "efn_exi" 5 "$0" : CC= sMPICC" i _f i# Extract t Pwhr1o&wgrdfof "sesCC",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy sesCC;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_MPICXX: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sMPICXX"_n='/usr/ac_cv_pr -_MPICXX= sMPICXX" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_MPICXX= sesCC" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- eecho`" = "ac_v_pr -_MPICXX" set---v_pr -_MPICXX= no"efT.fT.MPICXX="ac_v_pr -_MPICXX en >&1o&/te sMPICXX"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$MPICXX" >&5- "$as_mer"$MPICXX" >&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # blic en >&1o&henMPICXX" sex""noas_mys :sr/aATUttest "$& t"Cnuldtatiof. casesCC o= xMPICH" "efn_exi" 5 "$0" : CXX= sMPICXX" i _f i# Extract t Pwhr1o&wgrdfof "sesf90",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy sesf90;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_MPIFC: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sMPIFC"_n='/usr/ac_cv_pr -_MPIFC= sMPIFC" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_MPIFC= sesf90" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- eecho`" = "ac_v_pr -_MPIFColset---v_pr -_MPIFC= no"efT.fT.MPIFC="ac_v_pr -_MPIFC en >&1o&/te sMPIFC"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$MPIFCol>&5- "$as_mer"$MPIFCol>&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # blic en >&1o&henMPIFColsex""noas_mys :sr/aATUttest "$& t"Cnuldtatiof. casesf90 o= xMPICH" "efn_exi" 5 "$0" : FC= sMPIFC"sfT.elsel>&1o&henrn ksh(a\alsexsesch2as_myself :# Extract t Pwhr1o&wgrdfof "sescc",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy sescc;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_MPICC: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sMPICC"_n='/usr/ac_cv_pr -_MPICC= sMPICC" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_MPICC= sescc" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- eecho`" = "ac_v_pr -_MPICColset---v_pr -_MPICC= no"efT.fT.MPICC="ac_v_pr -_MPICC en >&1o&/te sMPICC"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$MPICCol>&5- "$as_mer"$MPICCol>&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # blic en >&1o&henMPICColsex""noas_mys :sr/aATUttest "$& t"Cnuldtatiof. casescc o= xMPICH 2" "efn_exi" 5 "$0" : CC= sMPICC" i _f i# Extract t Pwhr1o&wgrdfof "sescxx",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy sescxx;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_MPICXX: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sMPICXX"_n='/usr/ac_cv_pr -_MPICXX= sMPICXX" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_MPICXX= sescxx" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- eecho`" = "ac_v_pr -_MPICXX" set---v_pr -_MPICXX= no"efT.fT.MPICXX="ac_v_pr -_MPICXX en >&1o&/te sMPICXX"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$MPICXX" >&5- "$as_mer"$MPICXX" >&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # blic en >&1o&henMPICXX" sex""noas_mys :sr/aATUttest "$& t"Cnuldtatiof. casescxx o= xMPICH 2" "efn_exi" 5 "$0" : CXX= sMPICXX" i _f i# Extract t Pwhr1o&wgrdfof "sesf90",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy sesf90;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_MPIFC: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sMPIFC"_n='/usr/ac_cv_pr -_MPIFC= sMPIFC" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_MPIFC= sesf90" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- eecho`" = "ac_v_pr -_MPIFColset---v_pr -_MPIFC= no"efT.fT.MPIFC="ac_v_pr -_MPIFC en >&1o&/te sMPIFC"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$MPIFCol>&5- "$as_mer"$MPIFCol>&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # blic en >&1o&henMPIFColsex""noas_mys :sr/aATUttest "$& t"Cnuldtatiof. casesf90 o= xMPICH 2" "efn_exi" 5 "$0" : FC= sMPIFC"sfT.elsel>&1o&henrn ksh(a\alsexiotelses_gnuas_myself :# Extract t Pwhr1o&wgrdfof "sesgcc",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy sesgcc;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_MPICC: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sMPICC"_n='/usr/ac_cv_pr -_MPICC= sMPICC" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_MPICC= sesgcc" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- eecho`" = "ac_v_pr -_MPICColset---v_pr -_MPICC= no"efT.fT.MPICC="ac_v_pr -_MPICC en >&1o&/te sMPICC"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$MPICCol>&5- "$as_mer"$MPICCol>&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # blic en >&1o&henMPICColsex""noas_mys :sr/aATUttest "$& t"Cnuldtatiof. casesgcc o= xIotel MPI + &2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_MPICXX: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sMPICXX"_n='/usr/ac_cv_pr -_MPICXX= sMPICXX" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_MPICXX= sesg++" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- eecho`" = "ac_v_pr -_MPICXX" set---v_pr -_MPICXX= no"efT.fT.MPICXX="ac_v_pr -_MPICXX en >&1o&/te sMPICXX"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$MPICXX" >&5- "$as_mer"$MPICXX" >&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # blic en >&1o&henMPICXX" sex""noas_mys :sr/aATUttest "$& t"Cnuldtatiof. casesg++ o= xIotel MPI + &2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_MPIFC: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sMPIFC"_n='/usr/ac_cv_pr -_MPIFC= sMPIFC" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_MPIFC= sesgo= tran" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- eecho`" = "ac_v_pr -_MPIFColset---v_pr -_MPIFC= no"efT.fT.MPIFC="ac_v_pr -_MPIFC en >&1o&/te sMPIFC"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$MPIFCol>&5- "$as_mer"$MPIFCol>&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # blic en >&1o&henMPIFColsex""noas_mys :sr/aATUttest "$& t"Cnuldtatiof. casesgo= tran o= xIotel MPI + &1o&henrn ksh(a\alsexiotelses_iotelas_myself :# Extract t Pwhr1o&wgrdfof "sesscc",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy sesscc;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_MPICC: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sMPICC"_n='/usr/ac_cv_pr -_MPICC= sMPICC" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_MPICC= sesscc" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- eecho`" = "ac_v_pr -_MPICColset---v_pr -_MPICC= no"efT.fT.MPICC="ac_v_pr -_MPICC en >&1o&/te sMPICC"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$MPICCol>&5- "$as_mer"$MPICCol>&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # blic en >&1o&henMPICColsex""noas_mys :sr/aATUttest "$& t"Cnuldtatiof. casesgcc o= xIotel MPI +xIotel Cnses H_s" "efn_exi" 5 "$0" : CC= sMPICC" i _f i# Extract t Pwhr1o&wgrdfof "sesicpc",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy sesscpc;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_MPICXX: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sMPICXX"_n='/usr/ac_cv_pr -_MPICXX= sMPICXX" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_MPICXX= sescpc" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- eecho`" = "ac_v_pr -_MPICXX" set---v_pr -_MPICXX= no"efT.fT.MPICXX="ac_v_pr -_MPICXX en >&1o&/te sMPICXX"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$MPICXX" >&5- "$as_mer"$MPICXX" >&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # blic en >&1o&henMPICXX" sex""noas_mys :sr/aATUttest "$& t"Cnuldtatiof. casescpc o= xIotel MPI +xIotel Cnses H_s" "efn_exi" 5 "$0" : CXX= sMPICXX" i _f i# Extract t Pwhr1o&wgrdfof "sesio= t",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy sesso= t;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_MPIFC: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sMPIFC"_n='/usr/ac_cv_pr -_MPIFC= sMPIFC" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_MPIFC= sesio= t" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- eecho`" = "ac_v_pr -_MPIFColset---v_pr -_MPIFC= no"efT.fT.MPIFC="ac_v_pr -_MPIFC en >&1o&/te sMPIFC"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$MPIFCol>&5- "$as_mer"$MPIFCol>&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # blic en >&1o&henMPIFColsex""noas_mys :sr/aATUttest "$& t"Cnuldtatiof. casesio= t o= xIotel MPI +xIotel Cnses H_s" "efn_exi" 5 "$0" : FC= sMPIFC"sfT.elsel>&1o&henrn ksh(a\alsexsunas_myself :# Extract t Pwhr1o&wgrdfof "tmcc",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy tmcc;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_MPICC: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sMPICC"_n='/usr/ac_cv_pr -_MPICC= sMPICC" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_MPICC= tmcc" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- eecho`" = "ac_v_pr -_MPICColset---v_pr -_MPICC= no"efT.fT.MPICC="ac_v_pr -_MPICC en >&1o&/te sMPICC"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$MPICCol>&5- "$as_mer"$MPICCol>&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # blic en >&1o&henMPICColsex""noas_mys :sr/aATUttest "$& t"Cnuldtatiof. catmcc o= xSun MPI" "efn_exi" 5 "$0" : CC= sMPICC" i _f i# Extract t Pwhr1o&wgrdfof "tmCC",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy tmCC;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_MPICXX: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sMPICXX"_n='/usr/ac_cv_pr -_MPICXX= sMPICXX" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_MPICXX= tmCC" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- eecho`" = "ac_v_pr -_MPICXX" set---v_pr -_MPICXX= no"efT.fT.MPICXX="ac_v_pr -_MPICXX en >&1o&/te sMPICXX"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$MPICXX" >&5- "$as_mer"$MPICXX" >&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # blic en >&1o&henMPICXX" sex""noas_mys :sr/aATUttest "$& t"Cnuldtatiof. catmCC o= xSun MPI" "efn_exi" 5 "$0" : CXX= sMPICXX" i _f i# Extract t Pwhr1o&wgrdfof "tmf90",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy tmf90;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_MPIFC: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sMPIFC"_n='/usr/ac_cv_pr -_MPIFC= sMPIFC" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_MPIFC= tmf90" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- eecho`" = "ac_v_pr -_MPIFColset---v_pr -_MPIFC= no"efT.fT.MPIFC="ac_v_pr -_MPIFC en >&1o&/te sMPIFC"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$MPIFCol>&5- "$as_mer"$MPIFCol>&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # blic en >&1o&henMPIFColsex""noas_mys :sr/aATUttest "$& t"Cnuldtatiof. catmf90 o= xSun MPI" "efn_exi" 5 "$0" : FC= sMPIFC"sfT.elsel>&1o&henrn ksh(a\alsexibmas_myself :# Extract t Pwhr1o&wgrdfof "secc_r",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy secc_r;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_MPICC: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sMPICC"_n='/usr/ac_cv_pr -_MPICC= sMPICC" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_MPICC= secc_r" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- eecho`" = "ac_v_pr -_MPICColset---v_pr -_MPICC= no"efT.fT.MPICC="ac_v_pr -_MPICC en >&1o&/te sMPICC"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$MPICCol>&5- "$as_mer"$MPICCol>&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # blic en >&1o&henMPICColsex""noas_mys :sr/aATUttest "$& t"Cnuldtatiof. casecc_r o= xIBMeAIX MPI" "efn_exi" 5 "$0" : CC= sMPICC" i _f i# Extract t Pwhr1o&wgrdfof "mpCC_r",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy seCC_r;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_MPICXX: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sMPICXX"_n='/usr/ac_cv_pr -_MPICXX= sMPICXX" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_MPICXX= seCC_r" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- eecho`" = "ac_v_pr -_MPICXX" set---v_pr -_MPICXX= no"efT.fT.MPICXX="ac_v_pr -_MPICXX en >&1o&/te sMPICXX"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$MPICXX" >&5- "$as_mer"$MPICXX" >&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # blic en >&1o&henMPICXX" sex""noas_mys :sr/aATUttest "$& t"Cnuldtatiof. caseCC_r o= xIBMeAIX MPI" "efn_exi" 5 "$0" : CXX= sMPICXX" i _f i# Extract t Pwhr1o&wgrdfof "sexf90_r",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy sexf90_r;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_MPIFC: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sMPIFC"_n='/usr/ac_cv_pr -_MPIFC= sMPIFC" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_MPIFC= sexf90_r" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- eecho`" = "ac_v_pr -_MPIFColset---v_pr -_MPIFC= no"efT.fT.MPIFC="ac_v_pr -_MPIFC en >&1o&/te sMPIFC"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$MPIFCol>&5- "$as_mer"$MPIFCol>&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # blic en >&1o&henMPIFColsex""noas_mys :sr/aATUttest "$& t"Cnuldtatiof. casexf90_ o= xIBMeAIX MPI" "efn_exi" 5 "$0" : FC= sMPIFC"sfT.elsel>&1o&henrn ksh(a\alsexguessas_myself :o= xsc_pr -lt sescc sesgcc sessccatmcc secc_r _dir/# Extract t Pwhr1o&wgrdfof "$sc_pr -",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy $sc_pr -;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_MPICC: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sMPICC"_n='/usr/ac_cv_pr -_MPICC= sMPICC" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_MPICC= ssc_pr -" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- fT.fT.MPICC="ac_v_pr -_MPICC en >&1o&/te sMPICC"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$MPICCol>&5- "$as_mer"$MPICCol>&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # bli>&1o&/te sMPICC"lsetbreak proba>&1o&/te sMPICC"l|| MPICC= no"eblic en >&1o&henMPICColsex""noas_mys :sr/{f "$as_me: error: $2" >&2 asefn_exi}:`WARNING: Cnuldtatiof. caany mpiawr evarPo= xs C unses Hrol>&5- "$as_mer"$rror: `WARNING: Cnuldtatiof. caany mpiawr evarPo= xs C unses Hrol>&2;}s(lsi CC= sMPICC" i _f io= xsc_pr -lt sesc++asesCC sescxx sesg++ sesscpcatmCC seCC_r _dir/# Extract t Pwhr1o&wgrdfof "$sc_pr -",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy $sc_pr -;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_MPICXX: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sMPICXX"_n='/usr/ac_cv_pr -_MPICXX= sMPICXX" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_MPICXX= ssc_pr -" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- fT.fT.MPICXX="ac_v_pr -_MPICXX en >&1o&/te sMPICXX"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$MPICXX" >&5- "$as_mer"$MPICXX" >&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # bli>&1o&/te sMPICXX"lsetbreak proba>&1o&/te sMPICXX"l|| MPICXX= no"eblic en >&1o&henMPICXX" sex""noas_mys :sr/{f "$as_me: error: $2" >&2 asefn_exi}:`WARNING: Cnuldtatiof. caany mpiawr evarPo= xs C++ unses Hrol>&5- "$as_mer"$rror: `WARNING: Cnuldtatiof. caany mpiawr evarPo= xs C++ unses Hrol>&2;}s(lsi CXX= sMPICXX" i _f io= xsc_pr -lt sesf90 sesfcasesgo= tran sesio= t tmf90 sexf90_r _dir/# Extract t Pwhr1o&wgrdfof "$sc_pr -",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy $sc_pr -;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_MPIFC: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sMPIFC"_n='/usr/ac_cv_pr -_MPIFC= sMPIFC" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_MPIFC= ssc_pr -" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- fT.fT.MPIFC="ac_v_pr -_MPIFC en >&1o&/te sMPIFC"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$MPIFCol>&5- "$as_mer"$MPIFCol>&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # bli>&1o&/te sMPIFC"lsetbreak proba>&1o&/te sMPIFC"l|| MPIFC= no"eblic en >&1o&henMPIFColsex""noas_mys :sr/{f "$as_me: error: $2" >&2 asefn_exi}:`WARNING: Cnuldtatiof. caany mpiawr evarPo= xs F= tran unses Hrol>&5- "$as_mer"$rror: `WARNING: Cnuldtatiof. caany mpiawr evarPo= xs F= tran unses Hrol>&2;}s(lsi FC= sMPIFC"sfT.lic {f "$as_me: error: $2" >&2 asefn_exi}:`fouth bCC $CXX $FCol>&5- "$as_mer"$rror: `fouth bCC $CXX $FCol>&6;}s(lsel>&1o&henrn ksh(a\alsexyesas_myself :{f "$as_me: error: $2" >&2 asefn_exi}:`You&wguldtlikl >o(uso bCC $CXX $FC >o(unses Hnli #tMPI supp= t"l>&5- "$as_mer"$rror: `You&wguldtlikl >o(uso bCC $CXX $FC >o(unses Hnli #tMPI supp= t"l>&6;}s(lsi r/aATUttest "$& t"Cnuldtatioreocgniz helistMPI implementat th:l$rn ksh(a\al"efn_exi" 5 n # _f i# unses Hrs shnuldtbtt_mesyself :uso_ses=yess"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`MPI wastatiorn kshd. Build\\\snon-parallel t is thfof PPM."l>&5- "$as_mer"$rror: `MPI wastatiorn kshd. Build\\\snon-parallel t is thfof PPM."l>&6;}sn # b:l${CFLAGS="-O3"}b:l${CXXFLAGS="-O3"}b:l${FCFLAGS="-O3"}b # CSHELsPo= xbasic unses Hraand flags sc_"$t=cpp sc_cpp='$CXXCPP $CPPFLAGS' sc_cnses H='$CXX -c $CXXFLAGS $CPPFLAGS unnf>&1o.$sc_"$tl>&5' sc_&2 k='$CXX -o unnf>&1o$sc_"$e"$tl$CXXFLAGS $CPPFLAGS $LDFLAGS unnf>&1o.$sc_"$tlefnBSl>&5' sc_unses Hr_gnu="ac_v_cxx_unses Hr_gnu en >&1o&/ = "CXX"_n='/usr/en >&1o&/te sCCC"_n='/usr/ CXX=sCCCsr/(lsi r/en >&1o&/te sac_tool_prefix"_n='/usr/o= xsc_pr -lt g++ c++agpp aCC CC cxx cc++acl."$e FCC KCC RCC xlC_r xlCae,pr _f i# Extract t Pwhr1o&wgrdfof "sac_tool_prefix$sc_pr -",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy $sc_tool_prefix$sc_pr -;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_CXX: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sCXX"_n='/usr/ac_cv_pr -_CXX= sCXX" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_CXX= ssc_tool_prefix$sc_pr -" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- fT.fT.CXX="ac_v_pr -_CXX en >&1o&/te sCXX"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$CXX" >&5- "$as_mer"$CXX" >&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # blic >&1o&/te sCXX"lsetbreak e,proban #en >&1o&/ = "CXX"_n='/usr/ac_t_CXX=sCXX r/o= xsc_pr -lt g++ c++agpp aCC CC cxx cc++acl."$e FCC KCC RCC xlC_r xlCa_dir/# Extract t Pwhr1o&wgrdfof "$sc_pr -",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy $sc_pr -;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_ac_t_CXX: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sac_t_CXX"_n='/usr/ac_cv_pr -_ac_t_CXX= sac_t_CXX" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_ac_t_CXX= sac_pr -" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- fT.fT.ac_t_CXX=sac_v_pr -_ac_t_CXX en >&1o&/te sac_t_CXX"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$ac_t_CXX" >&5- "$as_mer"$rc_t_CXX" >&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # bli>&1o&/te src_t_CXX" setbreak proba c en >&1o&henrc_t_CXX" sex_n='/usr/ CXX="g++" e,(lsi r/caso bcross_unses \\\:ssc_tool_warnedlt yes:) {f "$as_me: error: $2" >&2 asefn_exi}:`WARNING: us\\\scross toolstatioprefixedlli #tmes--triplet"l>&5- "$as_mer"$rror: `WARNING: us\\\scross toolstatioprefixedlli #tmes--triplet"l>&2;}ssc_tool_warned=yes ;; esacsr/ CXX=sac_t_CXX inot n # _fot n ## Provhe hsoirnino= mat th abou--t\$(unses Hr.- "$as_mer"$rror: $2" >&2 asefn_exi}:`cSHEL\\\so= xC++ unses Hr t is th"l>&5- --rXl$ac_nses H sc_unses Hr=$2 o= xsc_opt th t --t is thf-v -V -qt is th; _dir/{/{/sc_try= sac_nses Hr $sc_opt th >&5" caso "(($sc_try"lt *\"* | *\`* | *\\*)/sc_tryas_me=\$sc_try;; *)/sc_tryas_me=$sc_try;; esacsh(a\/sc_tryas_me="\"\$rror: $2" >&2 asefn_exi}:`$sc_tryas_me\""- "$as_mer"$rc_tryas_meo;/}l>&5-; (h(a\/ sac_nses Hr $sc_opt th >&5") 2>unnf>&1o. irsr/ac_status=$? : en >&1o&/s unnf>&1o. ir_n='/usr/ sedl'10a\ namZr&1o&of std ir ou-pu--deletedlnamsr/ 10q' unnf>&1o. ir >unnf>&1o. i1 r/cat unnf>&1o. i1l>&5-; fT.lirm_.f-unnf>&1o. i1lunnf>&1o. irsr/ "$as_mer"$rror: $2" >&2 asefn_exi}:`\$? se$ac_statusol>&5-; >&1o&$ac_status se0l }sproba cat unnfdefs.h - <<_ACEOF >unnf>&1o.$sc_"$t /* eth unnfdefs.h. */ int mat () {# _f; returne0l } _ACEOF sc_ulean_fs Hrosave=sac_lean_fs Hr sc_ulean_fs Hr= sac_lean_fs Hr a.ou--a.ou-.dSYM-a."$e b.ou-"## Try >o(ureattttn "$ecu/nulllli #ou---o whr1o, disregardfa.ou-.## Io&will help us diagnoso broken unses Hrs,aand find\\\sou--ah t tuit th## of "$e"$t. {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\swhe='/r-t\$(C++ unses Hr wgrks"l>&5- "$as_me_n "cSHEL\\\swhe='/r-t\$(C++ unses Hr wgrksnamZ"l>&6l }ssc_&2 k_defaork=` "$as_mer"$rc_&2 k" | sedl's/--o *unnf>&1o[^ ]*//'`b # T\$(possiulllou-pu--fs Hr:ssc_fs Hr= a.ou--unnf>&1o. xe-unnf>&1o-a."$e a_ou-."$e b.ou--unnf>&1o.*" ssc_rmfs Hr= o= xsc_fs Hst $sc_fs Hr _dir/caso bsc_fs Hst r/*.$sc_"$tl| *.xcoffl| *.tdsl| *.dl| *.pdbl| *.xSYM-| *.bb-| *.bbg-| *.map-| *.inol| *.dSYM-| *.o-| *.obj ) ;; r/* )/sc_rmfs Hr="$rc_rmfs Hr bsc_fs H";; esacsprobarm_.f-$rc_rmfs Hr sel{ {/sc_try= sac_&2 k_defaork" caso "(($sc_try"lt *\"* | *\`* | *\\*)/sc_tryas_me=\$sc_try;; *)/sc_tryas_me=$sc_try;; esacsh(a\/sc_tryas_me="\"\$rror: $2" >&2 asefn_exi}:`$sc_tryas_me\""- "$as_mer"$rc_tryas_meo;/}l>&5-; (h(a\/ sac_&2 k_defaork") 2>&5-; ac_status=$? : "$as_mer"$rror: $2" >&2 asefn_exi}:`\$? se$ac_statusol>&5-; >&1o&$ac_status se0l }as_mys :sr/# Autounnf-2.13-unuldts---t\$(ac_v_"$e"$tlvarinulll>o(`no'.## So ignorttta(a\ue of `no', o='/rwis helistwguldtleadl>o(`EXEEXT seno'## t a Makefs H. We shnuldtationt irhe hac_v_"$e"$tlselitawastuP SHd,## so tha--t\$(usore0. ishnrt-circuithelist>&1o&o= xunses Hrs unknownl>o # Autounnf. o= xsc_fs Hst $sc_fs Hr '' _dir/eras_.f-"b-c_fs H"l|| unntinueir/caso bsc_fs Hst r/*.$sc_"$tl| *.xcoffl| *.tdsl| *.dl| *.pdbl| *.xSYM-| *.bb-| *.bbg-| *.map-| *.inol| *.dSYM-| *.o-| *.obj ) ;; r/[ab].ou--) # We fouth t\$(defaork "$ecu/null, but "$e"$t='' istmes- # certat ly right. break;; r/*.*-) sel>&1o&/b{ac_cv_"$e"$t: er#alse er set>&1o&/bac_cv_"$e"$t" !seno; _mys :;,(lsi ir/ac_v_"$e"$t=`expr-"b-c_fs H"l: '[^.]*\(\..*\)'`b fT. # We er ac_v_"$e"$tl'/re becaus hell lattrt>&1o&o= xithistati. # saf: `cross unses Hrs maytatioadh t\$(suffixlselgivys . i`-o'# # argument,Nso we maytaeedl>o(knowxitha--t\a--pot t already.# # Evys sel>listsect th looks urufty:xithhastt\$(advantage of# # actually wgrk\\\. break;; r/*-) break;; esacsproba>&1o&/bac_cv_"$e"$t" senolset---v_"$e"$t= s"$0" : -c_fs H=''an #en >&1o&/ = "sc_fs H";s_mys :sr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }s "$as_mer"$rror: `fas Hdapr -z "awas:"l>&5- -dl's/^/| /' unnf>&1o.$sc_"$tl>&5 {/{f "$as_me: error: $2" >&2 asefn_exi}:`est ":st \`sac_pwd':"l>&5- "$as_mer"$rror: `est ":st \`sac_pwd':"l>&2;}ssATUttest "$77 "C++ unses Hr 0. atioureattt"$ecu/nulls See \`unnfig.log'&o= xmorttdetatls" "efn_exi" 5 l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lyes"l>&5- "$as_mer"yes"l>&6l }sn #{f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= xC++ unses Hr defaork ou-pu--fs Handir"l>&5- "$as_me_n "cSHEL\\\so= xC++ unses Hr defaork ou-pu--fs HandirnamZ"l>&6l }s{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$ac_fs H"l>&5- "$as_mer"$rc_fs H"l>&6l }ssc_"$e"$t=bac_cv_"$e"$t arm_.f--r a.ou--a.ou-.dSYM-a."$e unnf>&1o$sc_v_"$e"$tlb.ou- sc_ulean_fs Hr=sac_lean_fs Hrosave#{f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= xsuffixlof "$ecu/nulls"l>&5- "$as_me_n "cSHEL\\\so= xsuffixlof "$ecu/nullsnamZ"l>&6l }ssel{ {/sc_try= sac_&2 k" caso "(($sc_try"lt *\"* | *\`* | *\\*)/sc_tryas_me=\$sc_try;; *)/sc_tryas_me=$sc_try;; esacsh(a\/sc_tryas_me="\"\$rror: $2" >&2 asefn_exi}:`$sc_tryas_me\""- "$as_mer"$rc_tryas_meo;/}l>&5-; (h(a\/ sac_&2 k") 2>&5-; ac_status=$? : "$as_mer"$rror: $2" >&2 asefn_exi}:`\$? se$ac_statusol>&5-; >&1o&$ac_status se0l }as_mys :sr/# If bo=' `unnf>&1o. xe'aand `unnf>&1o'aartt`pd fent' (well, obsorvnull) # catc' `unnf>&1o. xe'. F= xinstancrnli #tCygwin, `ls unnf>&1o'&will # wgrkapr perly (i.e.,`d ftrt>o `unnf>&1o. xe'),swhs Hsto&wgn'tnli # # `rm'. o= xsc_fs Hst unnf>&1o. xe-unnf>&1o-unnf>&1o.*; _dir/eras_.f-"b-c_fs H"l|| unntinueir/caso bsc_fs Hst r/*.$sc_"$tl| *.xcoffl| *.tdsl| *.dl| *.pdbl| *.xSYM-| *.bb-| *.bbg-| *.map-| *.inol| *.dSYM-| *.o-| *.obj ) ;; r/*.*-)/ac_v_"$e"$t=`expr-"b-c_fs H"l: '[^.]*\(\..*\)'`b break;; r/* )/break;; esacsproba"$0" : {f{f "$as_me: error: $2" >&2 asefn_exi}:`est ":st \`sac_pwd':"l>&5- "$as_mer"$rror: `est ":st \`sac_pwd':"l>&2;}ssATUttest "$& t"0. atiounseutexsuffixlof "$ecu/nulls: 0. atiounses Hsand &2 k See \`unnfig.log'&o= xmorttdetatls" "efn_exi" 5 l }sn #rm_.f-unnf>&1o unnf>&1o$sc_v_"$e"$ts{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$ac_cv_"$e"$t" >&5- "$as_mer"$rc_v_"$e"$t" >&6l }s#rm_.f-unnf>&1o.$sc_"$t EXEEXT=bac_cv_"$e"$t sc_"$e"$t=bEXEEXT cat unnfdefs.h - <<_ACEOF >unnf>&1o.$sc_"$t /* eth unnfdefs.h. */ #inclue h int mat () {#FILE *f sef pe ("unnf>&1o.ou-", "w"); returnefest "$(f)l|| fcloso (f)l!se0l# _f; returne0l } _ACEOF sc_ulean_fs Hr= sac_lean_fs Hr unnf>&1o.ou-" # CSHEL tha--t\$(unses Hr pr ducHr "$ecu/nulls we 0. irun. If ati, ei='/r # t\$(unses Hr istbroken, or we 0ross unses H. {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\swhe='/r-we artt0ross unses \\\"l>&5- "$as_me_n "cSHEL\\\swhe='/r-we artt0ross unses \\\namZ"l>&6l }ssel>&1o&/bcross_unses \\\" !seyesas_myself{ {/sc_try= sac_&2 k" caso "(($sc_try"lt *\"* | *\`* | *\\*)/sc_tryas_me=\$sc_try;; *)/sc_tryas_me=$sc_try;; esacsh(a\/sc_tryas_me="\"\$rror: $2" >&2 asefn_exi}:`$sc_tryas_me\""- "$as_mer"$rc_tryas_meo;/}l>&5-; (h(a\/ sac_&2 k") 2>&5-; ac_status=$? : "$as_mer"$rror: $2" >&2 asefn_exi}:`\$? se$ac_statusol>&5-; >&1o&$ac_status se0l }sr/sel{ sc_try='./unnf>&1o$sc_v_"$e"$t'elf{ {/caso "(($sc_try"lt *\"* | *\`* | *\\*)/sc_tryas_me=\$sc_try;; *)/sc_tryas_me=$sc_try;; esacsh(a\/sc_tryas_me="\"\$rror: $2" >&2 asefn_exi}:`$sc_tryas_me\""- "$as_mer"$rc_tryas_meo;/}l>&5-; (h(a\/ sac_try") 2>&5-; ac_status=$? : "$as_mer"$rror: $2" >&2 asefn_exi}:`\$? se$ac_statusol>&5-; >&1o&$ac_status se0l }as}as_mys ir/cross_unses \\\=nosr/(lsi r/en >&1o&/bcross_unses \\\" = maybeas_mys cross_unses \\\=yess r/(lsi {f{f "$as_me: error: $2" >&2 asefn_exi}:`est ":st \`sac_pwd':"l>&5- "$as_mer"$rror: `est ":st \`sac_pwd':"l>&2;}ssATUttest "$& t"0. atiorunxC++ unses Hdapr -z "s. If you meant >o(uross unses H,(uso \`--mes-'. See \`unnfig.log'&o= xmorttdetatls" "efn_exi" 5 l }slic oi _fot n #{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$cross_unses \\\" >&5- "$as_mer"$cross_unses \\\" >&6l }s#rm_.f-unnf>&1o.$sc_"$t unnf>&1o$sc_v_"$e"$tlunnf>&1o.ou- sc_ulean_fs Hr=sac_lean_fs Hrosave#{f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= xsuffixlof objec--fs Hr"l>&5- "$as_me_n "cSHEL\\\so= xsuffixlof objec--fs HrnamZ"l>&6l }ssel>&1o&/b{ac_cv_obje$t: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : cat unnfdefs.h - <<_ACEOF >unnf>&1o.$sc_"$t /* eth unnfdefs.h. */ int mat () {# _f; returne0l } _ACEOF rm_.f-unnf>&1o.o-unnf>&1o.objssel{ {/sc_try= sac_unses H" caso "(($sc_try"lt *\"* | *\`* | *\\*)/sc_tryas_me=\$sc_try;; *)/sc_tryas_me=$sc_try;; esacsh(a\/sc_tryas_me="\"\$rror: $2" >&2 asefn_exi}:`$sc_tryas_me\""- "$as_mer"$rc_tryas_meo;/}l>&5-; (h(a\/ sac_unses H") 2>&5-; ac_status=$? : "$as_mer"$rror: $2" >&2 asefn_exi}:`\$? se$ac_statusol>&5-; >&1o&$ac_status se0l }as_mys :sr/o= xsc_fs Hst unnf>&1o.o-unnf>&1o.obj-unnf>&1o.*; _dir/eras_.f-"b-c_fs H"l|| unntinue;ir/caso bsc_fs Hst r/*.$sc_"$tl| *.xcoffl| *.tdsl| *.dl| *.pdbl| *.xSYM-| *.bb-| *.bbg-| *.map-| *.inol| *.dSYM-) ;; r/*)/ac_v_obje$t=`expr-"b-c_fs H"l: '.*\.\(.*\)'`b break;; esacsproba"$0" : "$as_mer"$rror: `fas Hdapr -z "awas:"l>&5- -dl's/^/| /' unnf>&1o.$sc_"$tl>&5 {/{f "$as_me: error: $2" >&2 asefn_exi}:`est ":st \`sac_pwd':"l>&5- "$as_mer"$rror: `est ":st \`sac_pwd':"l>&2;}ssATUttest "$& t"0. atiounseutexsuffixlof objec--fs Hr: 0. atiounses H See \`unnfig.log'&o= xmorttdetatls" "efn_exi" 5 l }sn #rm_.f-unnf>&1o.$ac_v_obje$t-unnf>&1o.$sc_"$t n #{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$ac_v_obje$t" >&5- "$as_mer"$rc_v_obje$t" >&6l }sOBJEXT=bac_cv_obje$t sc_obje$t=$OBJEXT {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\swhe='/r-we arttus\\\st\$(&5- "$as_me_n "cSHEL\\\swhe='/r-we arttus\\\st\$(&6l }ssel>&1o&/b{ac_cv_cxx_unses Hr_gnu: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : cat unnfdefs.h - <<_ACEOF >unnf>&1o.$sc_"$t /* eth unnfdefs.h. */ int mat () {##ifndef __&1o. ir unnf>&1o.$sc_obje$t-unnf>&1o.$sc_"$t ac_cv_cxx_unses Hr_gnu=$ac_unses Hr_gnu n #{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$ac_v_cxx_unses Hr_gnu" >&5- "$as_mer"$rc_v_cxx_unses Hr_gnu" >&6l }ssel>&1o&$ac_unses Hr_gnu seyesas_myselfGXX=yess"$0" : GXX=.fT.ac_>&1o_CXXFLAGS=${CXXFLAGS: er#.ac_save_CXXFLAGS=$CXXFLAGS {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\swhe='/r-$CXX accepts -\"l>&5- "$as_me_n "cSHEL\\\swhe='/r-$CXX accepts -\namZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_cxx_g: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : ac_save_cxx_west "_flag=$ac_uxx_west "_flag ir/ac_xx_west "_flag=yess rac_cv_pr -_cxx_g=nosr/ CXXFLAGS="--" e, cat unnfdefs.h - <<_ACEOF >unnf>&1o.$sc_"$t /* eth unnfdefs.h. */ int mat () {# _f; returne0l } _ACEOF sel-c_fn_cxx_tryaunses Hs"efn_exi"as_mys :sr/ac_uv_pr -_cxx_g=yess"$0" : CXXFLAGS=""b cat unnfdefs.h - <<_ACEOF >unnf>&1o.$sc_"$t /* eth unnfdefs.h. */ int mat () {# _f; returne0l } _ACEOF sel-c_fn_cxx_tryaunses Hs"efn_exi"as_mys :ss"$0" : ac_uxx_west "_flag=$ac_save_cxx_west "_flag CXXFLAGS="--" cat unnfdefs.h - <<_ACEOF >unnf>&1o.$sc_"$t /* eth unnfdefs.h. */ int mat () {# _f; returne0l } _ACEOF sel-c_fn_cxx_tryaunses Hs"efn_exi"as_mys :sr/ac_uv_pr -_cxx_g=yessn #rm_.f-unre-unnf>&1o. ir unnf>&1o.$sc_obje$t-unnf>&1o.$sc_"$t n #rm_.f-unre-unnf>&1o. ir unnf>&1o.$sc_obje$t-unnf>&1o.$sc_"$t n #rm_.f-unre-unnf>&1o. ir unnf>&1o.$sc_obje$t-unnf>&1o.$sc_"$t ir/ac_xx_west "_flag=$ac_save_cxx_west "_flag n #{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$ac_v_pr -_cxx_g" >&5- "$as_mer"$rc_v_pr -_cxx_g" >&6l }ssel>&1o&/bac_>&1o_CXXFLAGSalse eras_mys : CXXFLAGS=$ac_save_CXXFLAGSs(lsel>&1o&$rc_v_pr -_cxx_g seyesas_myselfsel>&1o&/bGXX" seyesas_myself :CXXFLAGS="-- -O2" e,(lsi r/CXXFLAGS="--" e,fT.el0" : en >&1o&/bGXX" seyesas_myself :CXXFLAGS="-O2" e,(lsi r/CXXFLAGS= _fot n #ac_"$t=c sc_cpp='$CPP $CPPFLAGS' sc_cnses H='$CC -c $CFLAGS $CPPFLAGS unnf>&1o.$sc_"$tl>&5' sc_&2 k='$CC -o unnf>&1o$sc_"$e"$tl$CFLAGS $CPPFLAGS $LDFLAGS unnf>&1o.$sc_"$tlefnBSl>&5' sc_unses Hr_gnu="ac_v_c_unses Hr_gnu ac_"$t=c sc_cpp='$CPP $CPPFLAGS' sc_cnses H='$CC -c $CFLAGS $CPPFLAGS unnf>&1o.$sc_"$tl>&5' sc_&2 k='$CC -o unnf>&1o$sc_"$e"$tl$CFLAGS $CPPFLAGS $LDFLAGS unnf>&1o.$sc_"$tlefnBSl>&5' sc_unses Hr_gnu="ac_v_c_unses Hr_gnu en >&1o&/te sac_tool_prefix"_n='/usr/# Extract t Pwhr1o&wgrdfof "${ac_tool_prefix}gcc",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy ${ac_tool_prefix}gcc;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_CC: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sCC"_n='/usr/ac_cv_pr -_CC= sCC" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_CC= s{ac_tool_prefix}gcc" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- fT.fT.CC="ac_v_pr -_CC en >&1o&/te sCC"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$CCol>&5- "$as_mer"$CCol>&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # bn #en >&1o&/ = "sc_v_pr -_CC"_n='/usr/ac_t_CC=sCCsr/# Extract t Pwhr1o&wgrdfof "gcc",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy gcc;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_ac_t_CC: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sac_t_CC"_n='/usr/ac_cv_pr -_ac_t_CC= sac_t_CC" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_ac_t_CC= gcc" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- fT.fT.ac_t_CC=sac_v_pr -_ac_t_CC en >&1o&/te sac_t_CC"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$ac_t_CC" >&5- "$as_mer"$rc_t_CCol>&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # c en >&1o&henrc_t_CC" sex_n='/usr/ CC=""b (lsi r/caso bcross_unses \\\:ssc_tool_warnedlt yes:) {f "$as_me: error: $2" >&2 asefn_exi}:`WARNING: us\\\scross toolstatioprefixedlli #tmes--triplet"l>&5- "$as_mer"$rror: `WARNING: us\\\scross toolstatioprefixedlli #tmes--triplet"l>&2;}ssc_tool_warned=yes ;; esacsr/ CC=sac_t_CC e,fT.el0" : CC= sac_v_pr -_CC"sn # en >&1o&/ = "CC"_n='/usr/ en >&1o&/te sac_tool_prefix"_n='/usr/r/# Extract t Pwhr1o&wgrdfof "${ac_tool_prefix}cc",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy ${ac_tool_prefix}cc;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_CC: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sCC"_n='/usr/ac_cv_pr -_CC= sCC" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_CC= s{ac_tool_prefix}cc" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- fT.fT.CC="ac_v_pr -_CC en >&1o&/te sCC"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$CCol>&5- "$as_mer"$CCol>&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # b_fot n #en >&1o&/ = "CC"_n='/usr/# Extract t Pwhr1o&wgrdfof "cc",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy cc;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_CC: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sCC"_n='/usr/ac_cv_pr -_CC= sCC" p L---t\$(usorent irhe hell >&1o.a"$0" xsc_pr -_rejec-ed=no rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/sel>&1o&/bas_!ir/$ac_wgrd$sc_"$ec_exrol= "/usr/ucb/cc"_n='/usr/ sc_pr -_rejec-ed=yess r/ r/cnntinueir/ic oi _fr/ac_cv_pr -_CC= cc" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- sel>&1o&$rc_pr -_rejec-ed seyesas_myself# We fouth a bogth t ell path,Nso makexsure-we net i(uso itubli --rdummy $sc_v_pr -_CC li hift : en >&1o&$#l!se0ln='/usr/r/# Wtt_mesy a differeniounses Hr from ell bogus rob.sr/r/# Howet i,xithhastt\$(sdirnbasondir, so the bogth will btt_mesyself :#Pwhr1o&en we er CC >o(jus--t\$(basondir; us hell full fs Handirnelf : hift : r/ac_cv_pr -_CC= s-s_!ir/$ac_wgrd${1+' '}$@"b_fot n #fT.fT.CC="ac_v_pr -_CC en >&1o&/te sCC"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$CCol>&5- "$as_mer"$CCol>&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # bn #en >&1o&/ = "CC"_n='/usr/en >&1o&/te sac_tool_prefix"_n='/usr/o= xsc_pr -lt cl."$eae,prsr/r/# Extract t Pwhr1o&wgrdfof "$ac_tool_prefix$rc_pr -",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy $sc_tool_prefix$sc_pr -;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_CC: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sCC"_n='/usr/ac_cv_pr -_CC= sCC" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_CC= sac_tool_prefix$rc_pr -" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- fT.fT.CC="ac_v_pr -_CC en >&1o&/te sCC"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$CCol>&5- "$as_mer"$CCol>&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # b; >&1o&/te sCC"lsetbreak e,proban #en >&1o&/ = "CC"_n='/usr/ac_t_CC=sCCsr/o= xsc_pr -lt cl."$ea_dir/# Extract t Pwhr1o&wgrdfof "$sc_pr -",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy $sc_pr -;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_ac_t_CC: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sac_t_CC"_n='/usr/ac_cv_pr -_ac_t_CC= sac_t_CC" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_ac_t_CC= sac_pr -" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- fT.fT.ac_t_CC=sac_v_pr -_ac_t_CC en >&1o&/te sac_t_CC"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$ac_t_CC" >&5- "$as_mer"$rc_t_CCol>&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # li>&1o&/te src_t_CC"lsetbreak proba c en >&1o&henrc_t_CC" sex_n='/usr/ CC=""b (lsi r/caso bcross_unses \\\:ssc_tool_warnedlt yes:) {f "$as_me: error: $2" >&2 asefn_exi}:`WARNING: us\\\scross toolstatioprefixedlli #tmes--triplet"l>&5- "$as_mer"$rror: `WARNING: us\\\scross toolstatioprefixedlli #tmes--triplet"l>&2;}ssc_tool_warned=yes ;; esacsr/ CC=sac_t_CC e,fT.n # n # >&1o&/ = "CC"lset{/{f "$as_me: error: $2" >&2 asefn_exi}:`est ":st \`sac_pwd':"l>&5- "$as_mer"$rror: `est ":st \`sac_pwd':"l>&2;}ssATUttest "$& t"no acceptnulllCounses Hr fouth t \$s_di See \`unnfig.log'&o= xmorttdetatls" "efn_exi" 5 l }s## Provhe hsoirnino= mat th abou--t\$(unses Hr.- "$as_mer"$rror: $2" >&2 asefn_exi}:`cSHEL\\\so= xC unses Hr t is th"l>&5- --rXl$ac_nses H sc_unses Hr=$2 o= xsc_opt th t --t is thf-v -V -qt is th; _dir/{/{/sc_try= sac_nses Hr $sc_opt th >&5" caso "(($sc_try"lt *\"* | *\`* | *\\*)/sc_tryas_me=\$sc_try;; *)/sc_tryas_me=$sc_try;; esacsh(a\/sc_tryas_me="\"\$rror: $2" >&2 asefn_exi}:`$sc_tryas_me\""- "$as_mer"$rc_tryas_meo;/}l>&5-; (h(a\/ sac_nses Hr $sc_opt th >&5") 2>unnf>&1o. irsr/ac_status=$? : en >&1o&/s unnf>&1o. ir_n='/usr/ sedl'10a\ namZr&1o&of std ir ou-pu--deletedlnamsr/ 10q' unnf>&1o. ir >unnf>&1o. i1 r/cat unnf>&1o. i1l>&5-; fT.lirm_.f-unnf>&1o. i1lunnf>&1o. irsr/ "$as_mer"$rror: $2" >&2 asefn_exi}:`\$? se$ac_statusol>&5-; >&1o&$ac_status se0l }sproba {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\swhe='/r-we arttus\\\st\$(&5- "$as_me_n "cSHEL\\\swhe='/r-we arttus\\\st\$(&6l }ssel>&1o&/b{ac_cv_c_unses Hr_gnu: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : cat unnfdefs.h - <<_ACEOF >unnf>&1o.$sc_"$t /* eth unnfdefs.h. */ int mat () {##ifndef __&1o. ir unnf>&1o.$sc_obje$t-unnf>&1o.$sc_"$t ac_cv_c_unses Hr_gnu=$ac_unses Hr_gnu n #{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$ac_v_c_unses Hr_gnu" >&5- "$as_mer"$rc_v_c_unses Hr_gnu" >&6l }ssel>&1o&$ac_unses Hr_gnu seyesas_myselfGCC=yess"$0" : GCC=.fT.ac_>&1o_CFLAGS=${CFLAGS: er#.ac_save_CFLAGS=$CFLAGS {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\swhe='/r-$CC accepts -\"l>&5- "$as_me_n "cSHEL\\\swhe='/r-$CC accepts -\namZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_cc_g: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : ac_save_c_west "_flag=$ac_u_west "_flag ir/ac__west "_flag=yess rac_cv_pr -_cc_g=nosr/ CFLAGS="--" e, cat unnfdefs.h - <<_ACEOF >unnf>&1o.$sc_"$t /* eth unnfdefs.h. */ int mat () {# _f; returne0l } _ACEOF sel-c_fn_c_tryaunses Hs"efn_exi"as_mys :sr/ac_uv_pr -_cc_g=yess"$0" : CFLAGS=""b cat unnfdefs.h - <<_ACEOF >unnf>&1o.$sc_"$t /* eth unnfdefs.h. */ int mat () {# _f; returne0l } _ACEOF sel-c_fn_c_tryaunses Hs"efn_exi"as_mys :ss"$0" : ac_u_west "_flag=$ac_save_c_west "_flag CFLAGS="--" cat unnfdefs.h - <<_ACEOF >unnf>&1o.$sc_"$t /* eth unnfdefs.h. */ int mat () {# _f; returne0l } _ACEOF sel-c_fn_c_tryaunses Hs"efn_exi"as_mys :sr/ac_uv_pr -_cc_g=yessn #rm_.f-unre-unnf>&1o. ir unnf>&1o.$sc_obje$t-unnf>&1o.$sc_"$t n #rm_.f-unre-unnf>&1o. ir unnf>&1o.$sc_obje$t-unnf>&1o.$sc_"$t n #rm_.f-unre-unnf>&1o. ir unnf>&1o.$sc_obje$t-unnf>&1o.$sc_"$t ir/ac__west "_flag=$ac_save_c_west "_flag n #{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$ac_v_pr -_cc_g" >&5- "$as_mer"$rc_v_pr -_cc_g" >&6l }ssel>&1o&/bac_>&1o_CFLAGSalse eras_mys : CFLAGS=$ac_save_CFLAGSs(lsel>&1o&$rc_v_pr -_cc_g seyesas_myselfsel>&1o&/bGCC" seyesas_myself :CFLAGS="-- -O2" e,(lsi r/CFLAGS="--" e,fT.el0" : en >&1o&/bGCC" seyesas_myself :CFLAGS="-O2" e,(lsi r/CFLAGS= _fot n #{f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$CC opt th to accept ISO C89"l>&5- "$as_me_n "cSHEL\\\so= x$CC opt th to accept ISO C89namZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_cc_c89: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : ac_cv_pr -_cc_c89=no rc_save_CC=sCCscat unnfdefs.h - <<_ACEOF >unnf>&1o.$sc_"$t /* eth unnfdefs.h. */ #inclue h #inclue h #inclue h #inclue h /* Mo1o&of t Pwollow\\\st&1os arttstolys from RCS 5.7's src/unnf.sh. */ struct buel{ t t x;/}a#FILE * (*rcs pe ) (struct buel*, struct statl*, t t); static uhar *e (p, t) _mar **p; r/ t t i; {# returnep[i]l } static uhar *f (uhar * (*g) (uhar **, t t), _mar **p,lnam) {# _mar *s; va>&21o&v; va>start (v,p); s seg (p, va>arg (v,t t)); va>eth (v); returnesl } /* OSF 4.0 Cnseaq cc istsoirns= t of almes--ANSI by defaork. Ithhas rfunct th pr totypessand stuff, but atio'\xHH' hex _maracttrtunnstantsmsr/ Theso dgn'tnpr veke tn "st "$uno= tunately,xinsteadlarttss Hntly treattd ir/as 'x'. T Pwollow\\\sinducHr tn "st ",$until&/std istaddedl>o(get ir/pr per ANSI modH. Curiously '\x00'!='x' always unsHr ou--true, o= xsself arraytsszeha--leask. It's necHrsary >o(write '\x00'==0l>o(gettsoirth\\\elf tha-'s true o ly li #t/std. */ t t osf4_cc_arrayt['\x00' =se0 ? 1 : -1]l /* IBMtC 6 o= xAIX istalmes--ANSI by defaork, but iioreplacHr macro parairters rinshe hstr\\\ssand _maracttrtunnstantsm */ #def2 FOO(x) 'x' t t xlc6_cc_array[FOO(a) =se'x' ? 1 : -1]l t t >&1o&(t t i, dguulllx); struct s1 {t t (*f)&(t t a);}; struct s2 {t t (*f)&(dguullla);}; t t pairndirs&(t t, _mar **, FILE *(*)(struct buel*, struct statl*, t t), t t, t t); t t argc; _mar **argv; int mat () {#returnef (e, argv, 0)l!seargv[0] l|| ef (e, argv, 1)l!seargv[1]l _f; returne0l } _ACEOF o= xsc_arg t '' -qlanglvl="$tc89 -qlanglvl=ansh&/std \ -AHs"-Aa -D_HPUX_SOURCE"s"-Xc -D__EXTENSIONS__" _dir/CC= sac_save_CC&$rc_arg" : en -c_fn_c_tryaunses Hs"efn_exi"as_mys :sr/ac_uv_pr -_cc_c89=$rc_arg n #rm_.f-unre-unnf>&1o. ir unnf>&1o.$sc_obje$t-; >&1o&henrc_v_pr -_cc_c89" !se"xno"lsetbreak probarm_.f-unnf>&1o.$sc_"$t CC=sac_save_CC n ## AC_CACHE_VAL caso "enrc_v_pr -_cc_c89" t x) {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lnonetaeeded"l>&5- "$as_mer"nonetaeeded"l>&6l } ;; xno) {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lunsupp= ted"l>&5- "$as_mer"unsupp= ted"l>&6l } ;; *)sr/ CC="$CC&$rc_v_pr -_cc_c89" {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lnrc_v_pr -_cc_c89" >&5- "$as_mer"$rc_v_pr -_cc_c89" >&6l } ;; esacsen >&1o&henrc_v_pr -_cc_c89" !sexnoas_mys :s n # ac_"$t=c sc_cpp='$CPP $CPPFLAGS' sc_cnses H='$CC -c $CFLAGS $CPPFLAGS unnf>&1o.$sc_"$tl>&5' sc_&2 k='$CC -o unnf>&1o$sc_"$e"$tl$CFLAGS $CPPFLAGS $LDFLAGS unnf>&1o.$sc_"$tlefnBSl>&5' sc_unses Hr_gnu="ac_v_c_unses Hr_gnu ac_"$t=c sc_cpp='$CPP $CPPFLAGS' sc_cnses H='$CC -c $CFLAGS $CPPFLAGS unnf>&1o.$sc_"$tl>&5' sc_&2 k='$CC -o unnf>&1o$sc_"$e"$tl$CFLAGS $CPPFLAGS $LDFLAGS unnf>&1o.$sc_"$tlefnBSl>&5' sc_unses Hr_gnu="ac_v_c_unses Hr_gnu {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\showl>o(runxt\$(Coprepr cHrsorol>&5- "$as_me_n "cSHEL\\\showl>o(runxt\$(Coprepr cHrsornamZ"l>&6l }s# On Suns,tsoirtiirs&$CPP ndirs&a directory. en >&1o&/te sCPP" set>&1o&-de sCPP"as_mys : CPP=an #en >&1o&/ = "CPP"as_mys : sel>&1o&/b{ac_cv_pr -_CPP: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : r/r/# Dguulllquo>&1 becaus hCPP needs toibttexpandtd ir/so= xCPP ite sCC -E"s"sCC -E -tradit thal-cpp"s"/lib/cpp" ir/sprsr/r/ sc_prepr c_ok=fa$0" o= xsc_c_prepr c_warn_flag t '' yHr _dir/# Usy a headHr fs Hstha--unsHr li #tgcc,Nso unnfigur\\\ glibcir/# li #ta freshscross-unses Hr wgrksnir/# Pd ftrt toi sel__STDC__ istdef2 d,Nsinceir/# exi1os evys os freestand\\\sunses Hrsnir/# Onxt\$(NeXT, cc -E runs-t\$(une helrough-t\$(unses Hr's parser,ir/# atiojus--t\rough-cppmZ"Syntax "st "" ist'/re >o(uatc' >listcaso. : cat unnfdefs.h - <<_ACEOF >unnf>&1o.$sc_"$t /* eth unnfdefs.h. */ #ifdef __STDC__## t clue h #"$0" # t clue h #ethif# /r/ Syntax "st " _ACEOF sel-c_fn_c_tryaupps"efn_exi"as_mys :ss"$0" : # Broken `fas s roa(a\ih t pu-.#cnntinuein #rm_.f-unnf>&1o. ir unnf>&1o.i-unnf>&1o.$sc_"$t ir/# OK, wgrks roasanetcasosm NowlcSHELswhe='/r-nonexi1oenioheadHrsir/# 0. ibttdrtec-ed and how. : cat unnfdefs.h - <<_ACEOF >unnf>&1o.$sc_"$t /* eth unnfdefs.h. */ #i clue h _ACEOF sel-c_fn_c_tryaupps"efn_exi"as_mys :s: # Broken `succHrs th t (a\ih t pu-.#cnntinuei"$0" : # Passes bo=' t&1os. sc_prepr c_ok=: break n #rm_.f-unnf>&1o. ir unnf>&1o.i-unnf>&1o.$sc_"$t iproba# Becaus hof `break', _AC_PREPROC_IFELSE's lean\\\sune hwastskipped.#rm_.f-unnf>&1o.i-unnf>&1o. ir unnf>&1o.$sc_"$t if $sc_prepr c_okas_mys :s: break n # ir/sprne ir/ac_v_pr -_CPP="CPP sfT.liCPP="ac_v_pr -_CPPa"$0" : ac_cv_pr -_CPP="CPP n #{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$CPP" >&5- "$as_mer"$CPP" >&6l }ssc_prepr c_ok=fa$0" o= xsc_c_prepr c_warn_flag t '' yHr _dir/# Usy a headHr fs Hstha--unsHr li #tgcc,Nso unnfigur\\\ glibcir/# li #ta freshscross-unses Hr wgrksnir/# Pd ftrt toi sel__STDC__ istdef2 d,Nsinceir/# exi1os evys os freestand\\\sunses Hrsnir/# Onxt\$(NeXT, cc -E runs-t\$(une helrough-t\$(unses Hr's parser,ir/# atiojus--t\rough-cppmZ"Syntax "st "" ist'/re >o(uatc' >listcaso. : cat unnfdefs.h - <<_ACEOF >unnf>&1o.$sc_"$t /* eth unnfdefs.h. */ #ifdef __STDC__## t clue h #"$0" # t clue h #ethif# /r/ Syntax "st " _ACEOF sel-c_fn_c_tryaupps"efn_exi"as_mys :ss"$0" : # Broken `fas s roa(a\ih t pu-.#cnntinuein #rm_.f-unnf>&1o. ir unnf>&1o.i-unnf>&1o.$sc_"$t ir/# OK, wgrks roasanetcasosm NowlcSHELswhe='/r-nonexi1oenioheadHrsir/# 0. ibttdrtec-ed and how. : cat unnfdefs.h - <<_ACEOF >unnf>&1o.$sc_"$t /* eth unnfdefs.h. */ #i clue h _ACEOF sel-c_fn_c_tryaupps"efn_exi"as_mys :s: # Broken `succHrs th t (a\ih t pu-.#cnntinuei"$0" : # Passes bo=' t&1os. sc_prepr c_ok=: break n #rm_.f-unnf>&1o. ir unnf>&1o.i-unnf>&1o.$sc_"$t iproba# Becaus hof `break', _AC_PREPROC_IFELSE's lean\\\sune hwastskipped.#rm_.f-unnf>&1o.i-unnf>&1o. ir unnf>&1o.$sc_"$t if $sc_prepr c_okas_mys :sa"$0" : {f{f "$as_me: error: $2" >&2 asefn_exi}:`est ":st \`sac_pwd':"l>&5- "$as_mer"$rror: `est ":st \`sac_pwd':"l>&2;}ssATUttest "$& t"Coprepr cHrsor \"$CPP\"`fas s sanitylcSHEL See \`unnfig.log'&o= xmorttdetatls" "efn_exi" 5 l }sn # ac_"$t=c sc_cpp='$CPP $CPPFLAGS' sc_cnses H='$CC -c $CFLAGS $CPPFLAGS unnf>&1o.$sc_"$tl>&5' sc_&2 k='$CC -o unnf>&1o$sc_"$e"$tl$CFLAGS $CPPFLAGS $LDFLAGS unnf>&1o.$sc_"$tlefnBSl>&5' sc_unses Hr_gnu="ac_v_c_unses Hr_gnu {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\swhe='/r-${MAKE-make}e ers \$(MAKE)"l>&5- "$as_me_n "cSHEL\\\swhe='/r-${MAKE-make}e ers \$(MAKE)namZ"l>&6l }s --rx-${MAKE-make} sc_make=` "$as_mer"$2" | sedl's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` if h(a\/ >&1o&\"\${ac_cv_pr -_make_${ac_make}_ --: er#\"alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : cat >unnf>&1o.makex<<\_ACEOF SHELLlse/bin/sh all: @s_mer'@@@%%%=$(MAKE)=@@@%%%' _ACEOF #(&1o.makex2>/dev/null`lt *@@@%%%=?*=@@@%%%*)sr/ h(a\/sc_cv_pr -_make_${ac_make}_ --=yes;; *)sr/ h(a\/sc_cv_pr -_make_${ac_make}_ --=no;; esacsrm_.f-unnf>&1o.makean #en h(a\/>&1o&\$sc_cv_pr -_make_${ac_make}_ -- seyesas_myself{ "$as_me: error: $2" >&2 asefn_exi}:`d fork:lyes"l>&5- "$as_mer"yes"l>&6l }s SET_MAKE=s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }s SET_MAKE="MAKE=${MAKE-make}"sn # en >&1o&/te sac_tool_prefix"_n='/usr/# Extract t Pwhr1o&wgrdfof "${ac_tool_prefix}ranlib",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy ${ac_tool_prefix}ranlib;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_RANfnB: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sRANfnB"_n='/usr/ac_cv_pr -_RANfnB= sRANfnB" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_RANfnB= s{ac_tool_prefix}ranlib" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- fT.fT.RANfnB=$ac_v_pr -_RANfnB en >&1o&/te sRANfnB"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$RANfnB" >&5- "$as_mer"$RANfnB" >&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # bn #en >&1o&/ = "sc_v_pr -_RANfnB"_n='/usr/ac_ct_RANfnB=$RANfnBsr/# Extract t Pwhr1o&wgrdfof "ranlib",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy ranlib;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_ac_ct_RANfnB: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sac_t_RANfnB"_n='/usr/ac_cv_pr -_ac_ct_RANfnB= sac_t_RANfnB" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_ac_ct_RANfnB= ranlib" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- fT.fT.ac_ct_RANfnB=$ac_v_pr -_ac_ct_RANfnB en >&1o&/te sac_t_RANfnB"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$ac_t_RANfnB" >&5- "$as_mer"$rc_t_RANfnB" >&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # c en >&1o&henrc_t_RANfnB" sex_n='/usr/ RANfnB= :"b (lsi r/caso bcross_unses \\\:ssc_tool_warnedlt yes:) {f "$as_me: error: $2" >&2 asefn_exi}:`WARNING: us\\\scross toolstatioprefixedlli #tmes--triplet"l>&5- "$as_mer"$rror: `WARNING: us\\\scross toolstatioprefixedlli #tmes--triplet"l>&2;}ssc_tool_warned=yes ;; esacsr/ RANfnB=$ac_t_RANfnB e,fT.el0" : RANfnB= sac_v_pr -_RANfnB"sn # ac_"$t=b{ac_fc_src"$t-f} sc_cnses H='$FC -c $FCFLAGS $ac_fcflags_src"$t unnf>&1o.$sc_"$tl>&5' sc_&2 k='$FC -o unnf>&1o$sc_"$e"$tl$FCFLAGS $LDFLAGS $ac_fcflags_src"$t unnf>&1o.$sc_"$tlefnBSl>&5' sc_unses Hr_gnu="ac_v_fc_unses Hr_gnu en >&1o&/te sac_tool_prefix"_n='/usr/o= xsc_pr -lt go= tran g95 xlf95 f95 f= t if= t ifc efc pgo= tran pgo95 lf95 ftn xlf90 f90 pgo90 pghpn hpco90 g77 xlf f77 f t pgo77 cf77 f= t77 fl32 af77 e,prsr/r/# Extract t Pwhr1o&wgrdfof "$ac_tool_prefix$rc_pr -",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy $sc_tool_prefix$sc_pr -;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_FC: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sFC"_n='/usr/ac_cv_pr -_FC="$FC" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_FC= sac_tool_prefix$rc_pr -" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- fT.fT.FC=sac_v_pr -_FC en >&1o&/te sFC"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$FC" >&5- "$as_mer"$FCol>&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # b; >&1o&/te sFC"lsetbreak e,proban #en >&1o&/ = "FC"_n='/usr/ac_ct_FC="FCsr/o= xsc_pr -lt go= tran g95 xlf95 f95 f= t if= t ifc efc pgo= tran pgo95 lf95 ftn xlf90 f90 pgo90 pghpn hpco90 g77 xlf f77 f t pgo77 cf77 f= t77 fl32 af77 _dir/# Extract t Pwhr1o&wgrdfof "$sc_pr -",Nso ita0. ibtttapr -z "andirnli #ta 1s. --rdummy $sc_pr -;fac_wgrd=$2 {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= x$ac_wgrd"l>&5- "$as_me_n "cSHEL\\\so= x$ac_wgrdnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_ac_t_FC: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/te sac_t_FC"_n='/usr/ac_cv_pr -_ac_ct_FC= sac_t_FC" p L---t\$(usorent irhe hell >&1o.a"$0" rrosave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/sel{ eras_.f-"b-s_!ir/$ac_wgrd$sc_"$ec_exrolseterro>&1o_x "b-s_!ir/$ac_wgrd$sc_"$ec_exro;/}as_mys ir/ac_v_pr -_ac_ct_FC= sac_pr -" e, i "$as_me: error: $2" >&2 asefn_exi}:`fouth b-s_!ir/$ac_wgrd$sc_"$ec_exrol>&5-; break 2linot probae,probaIFS=$rrosave_IFS- fT.fT.ac_t_FC=sac_v_pr -_ac_t_FC en >&1o&/te sac_t_FC"_n='/usr/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$ac_t_FC" >&5- "$as_mer"$ac_t_FC" >&6l }s"$0" : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # li>&1o&/te src_t_FC"lsetbreak proba c en >&1o&henrc_t_FC" sex_n='/usr/ FC=""b (lsi r/caso bcross_unses \\\:ssc_tool_warnedlt yes:) {f "$as_me: error: $2" >&2 asefn_exi}:`WARNING: us\\\scross toolstatioprefixedlli #tmes--triplet"l>&5- "$as_mer"$rror: `WARNING: us\\\scross toolstatioprefixedlli #tmes--triplet"l>&2;}ssc_tool_warned=yes ;; esacsr/ FC=sac_t_FC e,fT.n # ## Provhe hsoirnino= mat th abou--t\$(unses Hr.- "$as_mer"$rror: $2" >&2 asefn_exi}:`cSHEL\\\so= xF= tran unses Hr t is th"l>&5- --rXl$ac_nses H sc_unses Hr=$2 o= xsc_opt th t --t is thf-v -V -qt is th; _dir/{/{/sc_try= sac_nses Hr $sc_opt th >&5" caso "(($sc_try"lt *\"* | *\`* | *\\*)/sc_tryas_me=\$sc_try;; *)/sc_tryas_me=$sc_try;; esacsh(a\/sc_tryas_me="\"\$rror: $2" >&2 asefn_exi}:`$sc_tryas_me\""- "$as_mer"$rc_tryas_meo;/}l>&5-; (h(a\/ sac_nses Hr $sc_opt th >&5") 2>unnf>&1o. irsr/ac_status=$? : en >&1o&/s unnf>&1o. ir_n='/usr/ sedl'10a\ namZr&1o&of std ir ou-pu--deletedlnamsr/ 10q' unnf>&1o. ir >unnf>&1o. i1 r/cat unnf>&1o. i1l>&5-; fT.lirm_.f-unnf>&1o. i1lunnf>&1o. irsr/ "$as_mer"$rror: $2" >&2 asefn_exi}:`\$? se$ac_statusol>&5-; >&1o&$ac_status se0l }sprobarm_.f-a.ou- ## In we dgn'tnus h`.F'/as exrens th, ell prepr cHrsor istatiorunxonxt\$ # t pu--fs H.; (NotHstha-->listo ly needs toiwgrkso= x&2 asefn_exi}:`cSHEL\\\swhe='/r-we arttus\\\st\$(&5- "$as_me_n "cSHEL\\\swhe='/r-we arttus\\\st\$(&6l }ssel>&1o&/b{ac_cv_fc_unses Hr_gnu: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : cat > unnf>&1o.$sc_"$tl<<_ACEOFsr/ pr -z "amat ##ifndef __&1o. ir unnf>&1o.$sc_obje$t-unnf>&1o.$sc_"$t ac_cv_fc_unses Hr_gnu=$ac_unses Hr_gnu n #{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$ac_v_fc_unses Hr_gnu" >&5- "$as_mer"$rc_v_fc_unses Hr_gnu" >&6l }ssc_"$t=bac_save_"$t.ac_>&1o_FCFLAGS=${FCFLAGS: er#.ac_save_FCFLAGS=$FCFLAGS FCFLAGS= {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\swhe='/r-$FC accepts -\"l>&5- "$as_me_n "cSHEL\\\swhe='/r-$FC accepts -\namZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_fc_g: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : FCFLAGS=-g cat > unnf>&1o.$sc_"$tl<<_ACEOFsr/ pr -z "amat # _fr/ hnd _ACEOF sel-c_fn_fc_tryaunses Hs"efn_exi"as_mys :sr/ac_uv_pr -_fc_g=yess"$0" : ac_uv_pr -_fc_g=nosn #rm_.f-unre-unnf>&1o. ir unnf>&1o.$sc_obje$t-unnf>&1o.$sc_"$t n #{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$ac_v_pr -_fc_g" >&5- "$as_mer"$rc_v_pr -_fc_g" >&6l }ssel>&1o&/bac_>&1o_FCFLAGSalse eras_mys : FCFLAGS=$ac_save_FCFLAGSs(lsel>&1o&$rc_v_pr -_fc_g seyesas_myselfsel>&1o&/x$rc_v_fc_unses Hr_gnu" sexyesas_myself :FCFLAGS="-- -O2" e,(lsi r/FCFLAGS="--" e,fT.el0" : en >&1o&/x$rc_v_fc_unses Hr_gnu" sexyesas_myself :FCFLAGS="-O2" e,(lsi r/FCFLAGS= e,fT.n # ac_"$t=c sc_cpp='$CPP $CPPFLAGS' sc_cnses H='$CC -c $CFLAGS $CPPFLAGS unnf>&1o.$sc_"$tl>&5' sc_&2 k='$CC -o unnf>&1o$sc_"$e"$tl$CFLAGS $CPPFLAGS $LDFLAGS unnf>&1o.$sc_"$tlefnBSl>&5' sc_unses Hr_gnu="ac_v_c_unses Hr_gnu ac_"$t=b{ac_fc_src"$t-f} sc_cnses H='$FC -c $FCFLAGS $ac_fcflags_src"$t unnf>&1o.$sc_"$tl>&5' sc_&2 k='$FC -o unnf>&1o$sc_"$e"$tl$FCFLAGS $LDFLAGS $ac_fcflags_src"$t unnf>&1o.$sc_"$tlefnBSl>&5' sc_unses Hr_gnu="ac_v_fc_unses Hr_gnu {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= xF= tran flag aeeded to accept free-o= mhsourc""l>&5- "$as_me_n "cSHEL\\\so= xF= tran flag aeeded to accept free-o= mhsourc"namZ"l>&6l }ssel>&1o&/b{ac_cv_fc_freeo= m: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : ac_cv_fc_freeo= m=unknown ac_fc_freeo= m_FCFLAGS_save=$FCFLAGS o= xsc_flag t nonet-ffree-o= mh-FRt-free -qfree -Mfree -Mfreeo= mh\ -freeo= mh".f-free" +sourc"=free -nfix _dir/eras_/x$rc_flag" !sexnonetsetFCFLAGS="$ac_fc_freeo= m_FCFLAGS_save $rc_flag" : cat > unnf>&1o.$sc_"$tl<<_ACEOFs pr -z "afreeo= mb ! FIXME:showl>o(bras_unnfus hnon-freeo= mhunses Hrs?b pr\\rl*, 'Hello ', &sr/ 'wgrld.'sr/ hnd _ACEOF sel-c_fn_fc_tryaunses Hs"efn_exi"as_mys :sr/ac_uv_fc_freeo= m=$rc_flag; break n #rm_.f-unre-unnf>&1o. ir unnf>&1o.$sc_obje$t-unnf>&1o.$sc_"$t probarm_.f-unnf>&1o. ir unnf>&1o.$sc_obje$t-unnf>&1o.$sc_"$t FCFLAGS=$ac_fc_freeo= m_FCFLAGS_save n #{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$ac_v_fc_freeo= m" >&5- "$as_mer"$rc_v_fc_freeo= m" >&6l }ssel>&1o&/x$rc_v_fc_freeo= m" sexunknown_n='/usr/aATUttest "$77 "F= tran doestatioaccept free-o= mhsourc""l"efn_exi" 5.el0" : en >&1o&/x$rc_v_fc_freeo= m" !sexnoneas_myself :FCFLAGS="$FCFLAGS $ac_v_fc_freeo= m" e,fT. n #ac_"$t=c sc_cpp='$CPP $CPPFLAGS' sc_cnses H='$CC -c $CFLAGS $CPPFLAGS unnf>&1o.$sc_"$tl>&5' sc_&2 k='$CC -o unnf>&1o$sc_"$e"$tl$CFLAGS $CPPFLAGS $LDFLAGS unnf>&1o.$sc_"$tlefnBSl>&5' sc_unses Hr_gnu="ac_v_c_unses Hr_gnu ac_"$t=b{ac_fc_src"$t-f} sc_cnses H='$FC -c $FCFLAGS $ac_fcflags_src"$t unnf>&1o.$sc_"$tl>&5' sc_&2 k='$FC -o unnf>&1o$sc_"$e"$tl$FCFLAGS $LDFLAGS $ac_fcflags_src"$t unnf>&1o.$sc_"$tlefnBSl>&5' sc_unses Hr_gnu="ac_v_fc_unses Hr_gnu {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\showl>o(gettverbesy &2 k\\\sou-pu--from $FC" >&5- "$as_me_n "cSHEL\\\showl>o(gettverbesy &2 k\\\sou-pu--from $FCnamZ"l>&6l }ssel>&1o&/b{ac_cv_pr -_fc_v: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : cat > unnf>&1o.$sc_"$tl<<_ACEOFsr/ pr -z "amat # _fr/ hnd _ACEOF sel-c_fn_fc_tryaunses Hs"efn_exi"as_mys :sr/ac_uv_pr -_fc_v= # Tryhsoirnopt ths frequHntly usedlverbesy ou-pu- o= xsc_verb t -v -verbesy --verbesy -V -\#\#\#; _dir/cat > unnf>&1o.$sc_"$tl<<_ACEOFsr/ pr -z "amat # _fr/ hnd _ACEOF # Cnses Hsand &2 k our simpll >&1o pr -z "aby pass\\\sa flag (argumHnt # 1l>o(>listmacro)l>o(>lexF= tran unses Hr t ordHr >o(get # "verbesy"sou-pu--tha--wea0. i_mys parseso= x>lexF= tran &2 ker # flags..ac_save_FCFLAGS=$FCFLAGS FCFLAGS="$FCFLAGS $ac_verb"sh(a\/" --rx-$sc_&2 k" hift "$as_me: error: $2" >&2 asefn_exi}:`$*" >&5-# go= tran 4.3sou-pu-s &2 est --t\\\sCOLLECT_GCC_OPTIONS,sCOMPILER_s_di,-# fnBRARY_s_di;tskip all`sucht --t\\\s..ac_fc_v_ou-pu-=`h(a\/$sc_&2 k 5>&1 2>&1 | _fgrep -v 'Driv\\\:' |fgrep -v "^[_errocr_L--tHrs][_errocr_alnum]*="`- "$as_mer"$rc_fc_v_ou-pu-" >&5-FCFLAGS=$ac_save_FCFLAGSsarm_.rf-unnf>&1o* s# On HP/UXx>lere-ista &2 e &2ke: "Ls_di-is: /foo:/bar:/baz"swher$ # /foo, /bar,sand /bazlarttsearchtdirectoriesto= x>lexF= tran &2 ker. # Her$,-wea0hang hellso in>o(-L/foo(-L/bar(-L/baz (and put iiowhr1o):.ac_fc_v_ou-pu-="`s_mer$rc_fc_v_ou-pu- | grep 'Ls_di-is:' | sedl's|.*Ls_di-is\(: *[^ ]*\).*|\1|;s|: */|(-L/|g'`r$rc_fc_v_ou-pu-" s# FIXME:sweakeep g--t\\\sbi-tHnaby quo>&dlargumHntsasaxmorttgeneral fsxs# tha--drtec-s unbalanc&dlquo>&1 t FfnBSlshguldtbo impllmHnteds# and (ugh) >&1o&dlattsoir poin>. caso $rc_fc_v_ou-pu- iusr/# In we arttus\\\sxlf _mys replacH all`t\$(unsmar li #tspacHrmsr/*xlfHntry*)sr/ ac_fc_v_ou-pu-=`h_mer$rc_fc_v_ou-pu- | sedl's/,/ /g'` ;; sr/# Wi #tIntel ifc, ignorttt\$(quo>&dl-mGLOB_opt ths_str\\\ stuff (quo>&dsr/# efnBSlunnfus hus,sand t\$(librariestappear latHr t t\$(ou-pu- anyway)msr/*mGLOB_opt ths_str\\\*)sr/ ac_fc_v_ou-pu-=`h_mer$rc_fc_v_ou-pu- | sedl's/"-mGLOB[^"]*"/ /g'` ;; sr/# P= tland Group unses Hr hasts\\\ly- or dguuly-quo>&dl-cmd&2 e argumHnt r/# S\\\ly-quo>&dlargumHnts werttrep= tedto= xt is ths 5.2-4sand 6.0-4nir/# Dguuly-quo>&dlargumHnts werttrep= tedto= x"PGF90/x86 Linux/x86 5.0-2"msr/*-cmd&2 e\ * | *-ignort\ * | *-def\ *)sr/ ac_fc_v_ou-pu-=`h_mer$rc_fc_v_ou-pu- | sedl"\ s/-cmd&2 e *'[^']*'/ /g; s/-cmd&2 e *\"[^\"]*\"/ /g s/-ignortt *'[^']*'/ /g; s/-ignortt *\"[^\"]*\"/ /g s/-def *'[^']*'/ /g; s/-def *\"[^\"]*\"/ /g"` ;; sr/# In we arttus\\\sCraytF= tran _mys deletelquo>&1msr/*cft90*)sr/ ac_fc_v_ou-pu-=`h_mer$rc_fc_v_ou-pu- | sedl's/"//g'` ;; esacs sr/# lookso= x-l*sand *.atunnstructs t t\$(ou-pu-sr/o= xsc_arg t $rc_fc_v_ou-pu-;sprsr/r/ caso $rc_arg t [\\/]*.at| ?:[\\/]*.at| -[lLRu]*)s r/ac_uv_pr -_fc_v=$ac_verbs r/break 2 ;; / hsacsr/probaprobaen >&1o&/ = "sc_v_pr -_fc_v"_n='/usr/ {f "$as_me: error: $2" >&2 asefn_exi}:`WARNING: 0. atiodrterm2 e howl>o(obtat &2 k\\\sino= mat th from $FC" >&5- "$as_mer"$rror: `WARNING: 0. atiodrterm2 e howl>o(obtat &2 k\\\sino= mat th from $FC" >&2;}sfT.el0" : {f "$as_me: error: $2" >&2 asefn_exi}:`WARNING: 0nses at th fas Hd"l>&5- "$as_mer"$rror: `WARNING: 0nses at th fas Hd"l>&2;}sfT.rm_.f-unre-unnf>&1o. ir unnf>&1o.$sc_obje$t-unnf>&1o.$sc_"$t n #{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$ac_v_pr -_fc_v" >&5- "$as_mer"$rc_v_pr -_fc_v"l>&6l }s{f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= xF= tran librariestof $FC" >&5- "$as_me_n "cSHEL\\\so= xF= tran librariestof $FCnamZ"l>&6l }ssel>&1o&/b{ac_cv_fc_libs: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&"x$FCfnBS" !se"x"_n='/usr/ac_cv_fc_libs="$FCfnBS" p L---t\$(usorent irhe hell >&1o.a"$0" cat > unnf>&1o.$sc_"$tl<<_ACEOFsr/ pr -z "amat # _fr/ hnd _ACEOF # Cnses Hsand &2 k our simpll >&1o pr -z "aby pass\\\sa flag (argumHnt # 1l>o(>listmacro)l>o(>lexF= tran unses Hr t ordHr >o(get # "verbesy"sou-pu--tha--wea0. i_mys parseso= x>lexF= tran &2 ker # flags..ac_save_FCFLAGS=$FCFLAGS FCFLAGS="$FCFLAGS $ac_v_pr -_fc_v"sh(a\/" --rx-$sc_&2 k" hift "$as_me: error: $2" >&2 asefn_exi}:`$*" >&5-# go= tran 4.3sou-pu-s &2 est --t\\\sCOLLECT_GCC_OPTIONS,sCOMPILER_s_di,-# fnBRARY_s_di;tskip all`sucht --t\\\s..ac_fc_v_ou-pu-=`h(a\/$sc_&2 k 5>&1 2>&1 | _fgrep -v 'Driv\\\:' |fgrep -v "^[_errocr_L--tHrs][_errocr_alnum]*="`- "$as_mer"$rc_fc_v_ou-pu-" >&5-FCFLAGS=$ac_save_FCFLAGSsarm_.rf-unnf>&1o* s# On HP/UXx>lere-ista &2 e &2ke: "Ls_di-is: /foo:/bar:/baz"swher$ # /foo, /bar,sand /bazlarttsearchtdirectoriesto= x>lexF= tran &2 ker. # Her$,-wea0hang hellso in>o(-L/foo(-L/bar(-L/baz (and put iiowhr1o):.ac_fc_v_ou-pu-="`s_mer$rc_fc_v_ou-pu- | grep 'Ls_di-is:' | sedl's|.*Ls_di-is\(: *[^ ]*\).*|\1|;s|: */|(-L/|g'`r$rc_fc_v_ou-pu-" s# FIXME:sweakeep g--t\\\sbi-tHnaby quo>&dlargumHntsasaxmorttgeneral fsxs# tha--drtec-s unbalanc&dlquo>&1 t FfnBSlshguldtbo impllmHnteds# and (ugh) >&1o&dlattsoir poin>. caso $rc_fc_v_ou-pu- iusr/# In we arttus\\\sxlf _mys replacH all`t\$(unsmar li #tspacHrmsr/*xlfHntry*)sr/ ac_fc_v_ou-pu-=`h_mer$rc_fc_v_ou-pu- | sedl's/,/ /g'` ;; sr/# Wi #tIntel ifc, ignorttt\$(quo>&dl-mGLOB_opt ths_str\\\ stuff (quo>&dsr/# efnBSlunnfus hus,sand t\$(librariestappear latHr t t\$(ou-pu- anyway)msr/*mGLOB_opt ths_str\\\*)sr/ ac_fc_v_ou-pu-=`h_mer$rc_fc_v_ou-pu- | sedl's/"-mGLOB[^"]*"/ /g'` ;; sr/# P= tland Group unses Hr hasts\\\ly- or dguuly-quo>&dl-cmd&2 e argumHnt r/# S\\\ly-quo>&dlargumHnts werttrep= tedto= xt is ths 5.2-4sand 6.0-4nir/# Dguuly-quo>&dlargumHnts werttrep= tedto= x"PGF90/x86 Linux/x86 5.0-2"msr/*-cmd&2 e\ * | *-ignort\ * | *-def\ *)sr/ ac_fc_v_ou-pu-=`h_mer$rc_fc_v_ou-pu- | sedl"\ s/-cmd&2 e *'[^']*'/ /g; s/-cmd&2 e *\"[^\"]*\"/ /g s/-ignortt *'[^']*'/ /g; s/-ignortt *\"[^\"]*\"/ /g s/-def *'[^']*'/ /g; s/-def *\"[^\"]*\"/ /g"` ;; sr/# In we arttus\\\sCraytF= tran _mys deletelquo>&1msr/*cft90*)sr/ ac_fc_v_ou-pu-=`h_mer$rc_fc_v_ou-pu- | sedl's/"//g'` ;; esacs s ac_cv_fc_libs= s# Save posit thallargumHnts (sel-ny) rc_save_posit thal="$@" s --rXl$ac_fc_v_ou-pu- whill >&1o $#l!se1;sprsr/ hift : rc_arg=$1 / caso $rc_arg t [\\/]*.at| ?:[\\/]*.a) sc_"$i1os=fa$0" r/o= xsc_i t $rc_cv_fc_libs;sprsr/r/en >&1o&x"$rc_arg" sex"$rc_i"_n='/usr/ sc_"$i1os=truesr/ break e,; fT.liproba c en >&1o&x"$rc_"$i1os" sextrueas_mys :ss"$0" : ac_uv_fc_libs="$ac_uv_fc_libs&$rc_arg" fT. ;; -bI:*) sc_"$i1os=fa$0" r/o= xsc_i t $rc_cv_fc_libs;sprsr/r/en >&1o&x"$rc_arg" sex"$rc_i"_n='/usr/ sc_"$i1os=truesr/ break e,; fT.liproba c en >&1o&x"$rc_"$i1os" sextrueas_mys :ss"$0" : sel>&1o&/bac_unses Hr_gnu" seyesas_myselfo= xsc_&2 k_opt t $rc_arg;sprsr/r/ac_uv_fc_libs="$ac_uv_fc_libs&-X&2 ker/$sc_&2 k_opt".liproba"$0" : ac_uv_fc_libs="$ac_uv_fc_libs&$rc_arg" fT.fT. ;; r/# Ignorttt\$sesolags.. -lang* | -lcrt*.o | -lc | -lgcc* | -lSy1o&m | -libmil | -littll \ |-LANG:=* | -LIST:* | -LNO:* | -&2 k). ;; -lkernel32). >&1o&x"$CYGWIN" !sexyes set-c_uv_fc_libs="$ac_uv_fc_libs&$rc_arg" ;; -[LRuYz]) r/# T\$sesolags,swhys seHnaby t\$mselves,stake tn argumHnt. r/# Wttremnt t\$(spacHtbotweHnaopt th and argumHnt and re-itHratH r/# unlHrs w Pwhnd an empty arg or a newaopt th (start\\\swi #t/) r/caso $2 t / "" | -*);; r/ *)s rc_arg="$rc_arg$2" hift;/ hift --rXl$ac_arg "$@" ;; r/esacs ;; -YP,*) o= xsc_j t ` "$as_mer"$rc_arg" | sedl-el's/-YP,/-L/;s/:/(-L/g'`;sprs r/ sc_"$i1os=fa$0" r/o= xsc_i t $rc_cv_fc_libs;sprsr/r/en >&1o&x"$rc_j" sex"$rc_i"_n='/usr/ sc_"$i1os=truesr/ break e,; fT.liproba c en >&1o&x"$rc_"$i1os" sextrueas_mys :ss"$0" : ac_arg="$rc_arg $rc_j" -c_uv_fc_libs="$ac_uv_fc_libs&$rc_j" fT. proba ;; -[lLR]*) sc_"$i1os=fa$0" r/o= xsc_i t $rc_cv_fc_libs;sprsr/r/en >&1o&x"$rc_arg" sex"$rc_i"_n='/usr/ sc_"$i1os=truesr/ break e,; fT.liproba c en >&1o&x"$rc_"$i1os" sextrueas_mys :ss"$0" : ac_uv_fc_libs="$ac_uv_fc_libs&$rc_arg" fT. ;; -zallextract*| -zdefaorkextract)s r/ac_uv_fc_libs="$ac_uv_fc_libs&$rc_arg" ;; r/# Ignorttet iyth\\\,(lsimsr/esacsproba# r&1oorttposit thallargumHntss --rXl$ac_save_posit thal;/ hift # Wtto ly unnsidHr "LD_RUN_s_di"xonxSolaristsy1o&msm If(>lististseHn,-# _mys werinshststha-->le "runxpath" mus--be tn absolutelpath (s.e. ii-# mus--begt li #ta "/"). caso `(undirn-sr)x2>/dev/null`lt "SunOS 5"*)sr/ r/ac_ld_run_path=` "$as_mer"$rc_fc_v_ou-pu-" | sedl-nl's,^.*LD_RUN_s_di *= *\(/[^ ]*\).*$,-R\1,p'`sr/ r/>&1o&/x$rc_ld_run_path" !sex se sel>&1o&/bac_unses Hr_gnu" seyesas_myselfo= xsc_&2 k_opt t $rc_ld_run_path;sprsr/r/ac_uv_fc_libs="$ac_uv_fc_libs&-X&2 ker/$sc_&2 k_opt".liproba"$0" : ac_uv_fc_libs="$ac_uv_fc_libs&$rc_ld_run_path"sfT.liiiii;; esacsfi/# >&1o&/x$[]_AC_LANG_PREFIX[]fnBS" se"x" n #{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$ac_v_fc_libs" >&5- "$as_mer"$rc_v_fc_libs" >&6l }sFCfnBS="$ac_uv_fc_libs" # ac_"$t=c sc_cpp='$CPP $CPPFLAGS' sc_cnses H='$CC -c $CFLAGS $CPPFLAGS unnf>&1o.$sc_"$tl>&5' sc_&2 k='$CC -o unnf>&1o$sc_"$e"$tl$CFLAGS $CPPFLAGS $LDFLAGS unnf>&1o.$sc_"$tlefnBSl>&5' sc_unses Hr_gnu="ac_v_c_unses Hr_gnu # CSHELsarchitec-urba s{f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= xgrep tha--handlHr lo\\s&2 estand -""l>&5- "$as_me_n "cSHEL\\\so= xgrep tha--handlHr lo\\s&2 estand -"namZ"l>&6l }ssel>&1o&/b{ac_cv_path_GREP: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en >&1o&/ = "GREP"_n='/usr/ac_path_GREP_fouth=fa$0" r/# Loophelrough-t\$(usor's pa #tand t&1o&o= xeP Stof PROGNAME-LISTsr/aATsave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di$s_di_SEPARas_d/usr/xpg4/bin _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_pr -lt grep ggrep;sprsr/r/o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/r/r/ac_path_GREP="b-s_!ir/$ac_pr -$sc_"$ec_exr"b { eras_.f-"b-c_path_GREPolseterro>&1o_x "b-c_path_GREPo;/}l|| cnntinuei# CSHELso= x&1`lt *"unnf>&1o.in"b whill : e,prsr/r/cat "unnf>&1o.in" "unnf>&1o.in" >"unnf>&1o.tmp" ir/smv "unnf>&1o.tmp" "unnf>&1o.in"b r/cp "unnf>&1o.in" "unnf>&1o.nl" e, i "$as_me:'GREP' >> "unnf>&1o.nl" e, i"b-c_path_GREPol-e:'GREP$'l-e:'-(0. atiomatc')-' < "unnf>&1o.nl" >"unnf>&1o.ou-" 2>/dev/nulll|| break e,; diff "unnf>&1o.ou-" "unnf>&1o.nl" >/dev/nulll2>&1 || break e,; aATUttari #t$ac_coutt + 1 set-c_uoutt= "$avalsr/r/en >&1o&$ac_coutt -gt ${ac_path_GREP_max-0}_n='/usr/ # Be1o&on hso far,ssave it but keep look\\\so= xatbottHr rne ir/r/ac_cv_path_GREP="b-c_path_GREPoir/r/r/ac_path_GREP_max=$ac_coutt e,; fT.li # 10*(2^10) _mars/as t pu--seHmsxmorttthan enough r/>&1o&$ac_coutt -gt 10lsetbreak e,probalirm_.f-unnf>&1o.in unnf>&1o.tmp unnf>&1o.nl unnf>&1o.ou-;; esacs r/r/r/$ac_path_GREP_fouthlsetbreak 3 e,; drobae,probae,probaIFS=$rrosave_IFS-: en >&1o&/ = "ac_cv_path_GREP"_n='/usr/ aATUttest "$& t"no acceptnull grep cguldtbo fouthlt $s_di$s_di_SEPARas_d/usr/xpg4/bin"l"efn_exi" 5.e,fT.el0" : ac_cv_path_GREP="GREP fT. n #{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$ac_v_path_GREPol>&5- "$as_mer"$rc_v_path_GREPol>&6l }s GREP="b-c_v_path_GREPoa s{f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= xegrep"l>&5- "$as_me_n "cSHEL\\\so= xegrepnamZ"l>&6l }ssel>&1o&/b{ac_cv_path_EGREP: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en s_me:at| "GREP -E '(a|b)' >/dev/nulll2>&1sr/ _mys ac_cv_path_EGREP=""GREP -Eoir/r"$0" : r/ren >&1o&/ = "EGREP"_n='/usr/ac_path_EGREP_fouth=fa$0" r/# Loophelrough-t\$(usor's pa #tand t&1o&o= xeP Stof PROGNAME-LISTsr/aATsave_IFS=$IFS; IFS=$s_di_SEPARas_d7 = xss_ll st $s_di$s_di_SEPARas_d/usr/xpg4/bin _dir/IFS=$rrosave_IFS-; f"; t" = "as_!irolset-s_!ir=ublic o= xsc_pr -lt egrep;sprsr/r/o= xsc_"$ec_exrlt '' b_c_"$ecu/null_exrens ths; _dir/r/r/ac_path_EGREP="b-s_!ir/$ac_pr -$sc_"$ec_exr"b { eras_.f-"b-c_path_EGREPolseterro>&1o_x "b-c_path_EGREPo;/}l|| cnntinuei# CSHELso= x&1`lt *"unnf>&1o.in"b whill : e,prsr/r/cat "unnf>&1o.in" "unnf>&1o.in" >"unnf>&1o.tmp" ir/smv "unnf>&1o.tmp" "unnf>&1o.in"b r/cp "unnf>&1o.in" "unnf>&1o.nl" e, i "$as_me:'EGREP' >> "unnf>&1o.nl" e, i"b-c_path_EGREPol'EGREP$' < "unnf>&1o.nl" >"unnf>&1o.ou-" 2>/dev/nulll|| break e,; diff "unnf>&1o.ou-" "unnf>&1o.nl" >/dev/nulll2>&1 || break e,; aATUttari #t$ac_coutt + 1 set-c_uoutt= "$avalsr/r/en >&1o&$ac_coutt -gt ${ac_path_EGREP_max-0}_n='/usr/ # Be1o&on hso far,ssave it but keep look\\\so= xatbottHr rne ir/r/ac_cv_path_EGREP="b-c_path_EGREPoir/r/r/ac_path_EGREP_max=$ac_coutt e,; fT.li # 10*(2^10) _mars/as t pu--seHmsxmorttthan enough r/>&1o&$ac_coutt -gt 10lsetbreak e,probalirm_.f-unnf>&1o.in unnf>&1o.tmp unnf>&1o.nl unnf>&1o.ou-;; esacs r/r/r/$ac_path_EGREP_fouthlsetbreak 3 e,; drobae,probae,probaIFS=$rrosave_IFS-: en >&1o&/ = "ac_cv_path_EGREP"_n='/usr/ aATUttest "$& t"no acceptnull egrep cguldtbo fouthlt $s_di$s_di_SEPARas_d/usr/xpg4/bin"l"efn_exi" 5.e,fT.el0" : ac_cv_path_EGREP="EGREP n # ir/ot n #{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$ac_v_path_EGREPol>&5- "$as_mer"$rc_v_path_EGREPol>&6l }s EGREP="b-c_v_path_EGREPoa s{f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= xANSI C headHr fs Hs"l>&5- "$as_me_n "cSHEL\\\so= xANSI C headHr fs HsnamZ"l>&6l }ssel>&1o&/b{ac_cv_headHr_stdc: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : cat unnfdefs.h - <<_ACEOF >unnf>&1o.$sc_"$t /* eth unnfdefs.h. */ #i clue h #inclue h #inclue h #inclue h int mat () {# _f; returne0l } _ACEOF en -c_fn_c_tryaunses Hs"efn_exi"as_mys :sr/ac_uv_headHr_stdc=yess"$0" : ac_uv_headHr_stdc=nosn #rm_.f-unre-unnf>&1o. ir unnf>&1o.$sc_obje$t-unnf>&1o.$sc_"$t sel>&1o&$rc_v_headHr_stdc seyesas_myself# SunOS 4.x str\\\.h doestatiodeclarttmem*, cnntrary >o(ANSI. : cat unnfdefs.h - <<_ACEOF >unnf>&1o.$sc_"$t /* eth unnfdefs.h. */ #i clue h _ACEOF en (h(a\/ sac_pp-unnf>&1o.$sc_"$t") 2>&5 | _f"EGREP "memchr" >/dev/nulll2>&1as_mys :ss"$0" : ac_uv_headHr_stdc=nosn #rm_.f-unnf>&1o* sn # en >&1o&$rc_v_headHr_stdc seyesas_myself# ISC 2.0.2 stdlib.h doestatiodeclarttfree, cnntrary >o(ANSI. : cat unnfdefs.h - <<_ACEOF >unnf>&1o.$sc_"$t /* eth unnfdefs.h. */ #i clue h _ACEOF en (h(a\/ sac_pp-unnf>&1o.$sc_"$t") 2>&5 | _f"EGREP "free" >/dev/nulll2>&1as_mys :ss"$0" : ac_uv_headHr_stdc=nosn #rm_.f-unnf>&1o* sn # en >&1o&$rc_v_headHr_stdc seyesas_myself# /bin/cc in Irix-4.0.5 g--shnon-ANSI ctypetmacros unlHrs us\\\s-ansh. : sel>&1o&/bcross_unses \\\" seyesas_mys :sr/:a"$0" : cat unnfdefs.h - <<_ACEOF >unnf>&1o.$sc_"$t /* eth unnfdefs.h. */ #i clue h #inclue h #in ((' ' & 0x0FF) =se0x020)i# def2 ISLOWER(c) ('a' <= (c) set(c) <= 'z')i# def2 TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') :t(c)) #"$0" # def2 ISLOWER(c) \# /r/(('a' <= (c) set(c) <= 'i') \# /r/ l|| ('j' <= (c) set(c) <= 'r') \# /r/ l|| ('s' <= (c) set(c) <= 'z'))i# def2 TOUPPER(c) (ISLOWER(c) ? ((c) |e0x40) :t(c)) #"thif# #def2 XOR(e, f)&(((e) set!(f))l|| (!(e) set(f))) int mat () {# t t i;elfo= x(i se0l i < 256l i++)sr/r/en (XORx(islowe x(i), ISLOWERx(i)) || touppe x(i) !seTOUPPERx(i)) r/r/r/returne2; returne0l } _ACEOF en -c_fn_c_tryarunx"efn_exi"as_mys :ss"$0" : ac_uv_headHr_stdc=nosn #rm_.f-unre-*.unre-unre.unnf>&1o.* gmon.ou- bb.ou- unnf>&1o$sc_"$e"$tl\ : cnnf>&1o.$sc_obje$t-unnf>&1o.beam-unnf>&1o.$sc_"$t fT. n #n #{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$ac_v_headHr_stdcol>&5- "$as_mer"$rc_v_headHr_stdcol>&6l }ssel>&1o&$rc_v_headHr_stdc seyesas_myse- "$as_mer"#def2 STDC_HEADERS 1ol>>unnfdefs.h sn # # On IRIX 5.3,tsy1/typestand t ttypes.h arttunnflict\\\. o= xsc_headHr t sy1/types.h sy1/stat.h stdlib.h str\\\.h memory.h str\\\s.h \# /rt ttypes.h stdin>.h unistd.h do :sr/as_ac_HeadHr=` "$as_mer"rc_v_headHr_$sc_headHr" | erro>r_sh` -c_fn_c_cSHEL_headHr_unses Hs"efn_exi"r"$rc_headHr" erroac_HeadHr"r"$rc_inclue s_defaork "#en h(a\/>&1o&\"x\$ erroac_HeadHr"\" sex"yes"as_mys :sr/cat >>unnfdefs.hl<<_ACEOFs#def2 ` "$as_mer"HAVE_$sc_headHr" | erro>r_pp` 1 _ACEOF n # proba # T\$/cast >o(lo\\st t wgrks arouthlatbug t t\$(HP C Cnses Hr # t is thfHP92453-01 B.11.11.23709.GP,swhsc' incorrectly`d jec-si# declarat ths &2ke `t t a3[[(sizeon (unshgnedl_mar))l>se0]];'. # T\istbug ts(HP SR numbHr 8606223364.s{f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\ssizetof lo\\sdguul""l>&5- "$as_me_n "cSHEL\\\ssizetof lo\\sdguul"namZ"l>&6l }ssel>&1o&/b{ac_cv_sizeon_lo\\_dguul": er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : en -c_fn_c_cnseute_t t "efn_exi"r"(lo\\st t)&(sizeon (lo\\sdguul"))"r"rc_v_sizeon_lo\\_dguul"" "$rc_inclue s_defaork"as_mys :ss"$0" : sel>&1o&/bac_uv_type_lo\\_dguul"" seyesas_myself : {f{f "$as_me: error: $2" >&2 asefn_exi}:`est ":st \`sac_pwd':"l>&5- "$as_mer"$rror: `est ":st \`sac_pwd':"l>&2;}ssATUttest "$77 "0. atiocnseute sizeon (lo\\sdguul") See \`unnfig.log'&o= xmorttdetatls" "efn_exi" 5 l }sr/r"$0" : r/rrc_v_sizeon_lo\\_dguul"=0sr/,fT.n # n #{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$ac_v_sizeon_lo\\_dguul"" >&5- "$as_mer"$rc_v_sizeon_lo\\_dguul"" >&6l }s cat >>unnfdefs.hl<<_ACEOFs#def2 SIZEOF_LONG_DOUBLEl$ac_v_sizeon_lo\\_dguul" _ACEOF a s{f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\so= tran 90xmodul&1 t clus thfflag" >&5- "$as_me_n "cSHEL\\\so= tran 90xmodul&1 t clus thfflagnamZ"l>&6l }ssel>&1o&/b{ax_uv_f90_modflag: er#alse eras_mys :sr/ "$as_me_n "(uP SHd)Z"l>&6a"$0" : ac_"$t=b{ac_fc_src"$t-f} sc_cnses H='$FC -c $FCFLAGS $ac_fcflags_src"$t unnf>&1o.$sc_"$tl>&5' sc_&2 k='$FC -o unnf>&1o$sc_"$e"$tl$FCFLAGS $LDFLAGS $ac_fcflags_src"$t unnf>&1o.$sc_"$tlefnBSl>&5' sc_unses Hr_gnu="ac_v_fc_unses Hr_gnu i=0swhill >&1o \(_.f-tmpdir_$i \) -o \(_.d-tmpdir_$i \) ; _dir/s=`expr $i + 1` probamkll stmpdir_$i cdstmpdir_$i cat > unnf>&1o.$sc_"$tl<<_ACEOFs !234567 r/r/r/modul& unnf>&1o_modul& r/r/r/cnntat s r/r/r/subrout2 unnf>&1o_rout2 r/r/r/write(*,'(a)') 'got_ma!'sr/ eth subrout2 unnf>&1o_rout2 r/r/r/eth modul& unnf>&1o_modul& _ACEOF sel-c_fn_fc_tryaunses Hs"efn_exi"as_mys :ssn #rm_.f-unre-unnf>&1o. ir unnf>&1o.$sc_obje$t-unnf>&1o.$sc_"$t cdlna ax_uv_f90_modflag="atiofouth" o= xsx_flag t "-I" "-J" "-M" "-p"; _dir/sel>&1o&/bax_uv_f90_modflag" se"atiofouth" _n='/usr/ ax_save_FCFLAGS="$FCFLAGSoir/r/FCFLAGS="$ax_save_FCFLAGS b{ax_flag}tmpdir_$i"sr/r/cat > unnf>&1o.$sc_"$tl<<_ACEOFs !234567 r/r/r/pr -z "aunnf>&1o_pr -z " r/r/r/us hunnf>&1o_modul& r/r/r/call`unnf>&1o_rout2 r/r/r/eth pr -z "aunnf>&1o_pr -z " _ACEOF sel-c_fn_fc_tryaunses Hs"efn_exi"as_mys :sr/ax_uv_f90_modflag="$ax_flag"sn #rm_.f-unre-unnf>&1o. ir unnf>&1o.$sc_obje$t-unnf>&1o.$sc_"$t r/r/FCFLAGS="$ax_save_FCFLAGS" e,fT.probarm_.f stmpdir_$i sel>&1o&/bax_uv_f90_modflag" se"atiofouth" _n='/usr/aATUttest "$& t"unnull >o(whnd unses Hr flag o= xmodul&1 t clus th"l"efn_exi" 5.n #ac_"$t=c sc_cpp='$CPP $CPPFLAGS' sc_cnses H='$CC -c $CFLAGS $CPPFLAGS unnf>&1o.$sc_"$tl>&5' sc_&2 k='$CC -o unnf>&1o$sc_"$e"$tl$CFLAGS $CPPFLAGS $LDFLAGS unnf>&1o.$sc_"$tlefnBSl>&5' sc_unses Hr_gnu="ac_v_c_unses Hr_gnu n #{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:l$ax_uv_f90_modflag" >&5- "$as_mer"$rx_uv_f90_modflag" >&6l }s # CSHELso= xF= tran2003 supp= t {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\swhe='/r-your unses Hr pr perly`supp= tstF= tran 2003"l>&5- "$as_me_n "cSHEL\\\swhe='/r-your unses Hr pr perly`supp= tstF= tran 2003namZ"l>&6l }sac_"$t=b{ac_fc_src"$t-f} sc_cnses H='$FC -c $FCFLAGS $ac_fcflags_src"$t unnf>&1o.$sc_"$tl>&5' sc_&2 k='$FC -o unnf>&1o$sc_"$e"$tl$FCFLAGS $LDFLAGS $ac_fcflags_src"$t unnf>&1o.$sc_"$tlefnBSl>&5' sc_unses Hr_gnu="ac_v_fc_unses Hr_gnu us _f03=nossel>&1o&/bcross_unses \\\" seyesas_mys :sr/{f{f "$as_me: error: $2" >&2 asefn_exi}:`est ":st \`sac_pwd':"l>&5- "$as_mer"$rror: `est ":st \`sac_pwd':"l>&2;}ssATUttest "$& t"0. atiorunx>&1o&pr -z "awhill cross unses \\\ See \`unnfig.log'&o= xmorttdetatls" "efn_exi" 5 l }s"$0" : cat > unnf>&1o.$sc_"$tl<<_ACEOFs r/r/r/pr -z "apr cHdureo>&1o typetcnntat er /rt teger, /rpoin>Hr :: var /rpr cHdure(func),rpoin>Hr, nopass :: f eth typetcnntat er abstract in>Hrface /rlogical funct th func(var) /r/rt teger, poin>Hr :: var /reth funct th func eth in>Hrface type(cnntat er) /r/r:: c t teger :: var pr cHdure(func) :: >&1o call`add(var, >&1o) en (c%f(c%var))lstop 0 stop 1 cnntat s r/r/r/r/subrout2 add(var,f) /t teger, /rtargett :: var /rpr cHdure(func),ropt thal :: f c%var => var /rc%f /r=> f eth subrout2 add r/r/r/eth pr -z "apr cHdureo>&1o r/r/r/logical funct th >&1o(var) t teger, poin>Hr :: var >&1o&= .true. r/r/r/eth funct th >&1o _ACEOF sel-c_fn_fc_tryarunx"efn_exi"as_mys :sr/us _f03=yess"$0" : us _f03=nosn #rm_.f-unre-*.unre-unre.unnf>&1o.* gmon.ou- bb.ou- unnf>&1o$sc_"$e"$tl\ : cnnf>&1o.$sc_obje$t-unnf>&1o.beam-unnf>&1o.$sc_"$t fT. en >&1o&"x${us _f03}" sexyesas_myself :CPPFLAGS="$CPPFLAGS -D__F2003" s# s_mer"#def2 __F2003" >> ./src/ppm_def2 .h r/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lyHs"l>&5- "$as_me "yHs"l>&6l }s"$0" : : {f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lno"l>&5- "$as_mer"no"l>&6l }sn # en >&1o&"x${us _ses}" ssexyesas_myself :{f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\sen your MPI ts(usaul""l>&5- "$as_me_n "cSHEL\\\sen your MPI ts(usaul"namZ"l>&6l }slf :ac_"$t=b{ac_fc_src"$t-f} sc_cnses H='$FC -c $FCFLAGS $ac_fcflags_src"$t unnf>&1o.$sc_"$tl>&5' sc_&2 k='$FC -o unnf>&1o$sc_"$e"$tl$FCFLAGS $LDFLAGS $ac_fcflags_src"$t unnf>&1o.$sc_"$tlefnBSl>&5' sc_unses Hr_gnu="ac_v_fc_unses Hr_gnu cat > unnf>&1o.$sc_"$tl<<_ACEOFs r/r/r////////////////pr -z "aunnf>&1o_pr - r/r/r////////////////inclue h'sesf.h' r/r/r////////////////call`MPI_Init(iest) r/r/r////////////////eth pr -z "aunnf>&1o_pr - _ACEOF sel-c_fn_fc_trya&2 k "efn_exi"as_mys :sr/s_mer"#def2 __MPI" >> ./src/ppm_def2 .h "$0" : aATUttest "$& t"C. atiobuild PPM li #tMPI supp= t &2ke >lis"l"efn_exi" 5.n #rm_.f-unre-unnf>&1o. ir unnf>&1o.$sc_obje$t-\ cnnf>&1o$sc_"$e"$tlunnf>&1o.$sc_"$t r/r/{f "$as_me: error: $2" >&2 asefn_exi}:`d fork:lyHs"l>&5- "$as_me "yHs"l>&6l }s# AC_CHECK_fnB([],[MPI_Init],[s# //////////e_mer"#def2 __MPI" >> ./src/ppm_def2 .h],s# //////////Lsts-\ ///////////etheadHr_stdc=nosn #rm_.f-unnf>&1o* sn # en >&1o&$rc_v_headHr_stdc seyesas_myself# /bin/cc in Irix-4.0.5 g--shnon-ANSI ctypetmacros unlHrs us\\\s-ansh. : sel>&1o&/bcross_unses \\\" seyesas_mys :sr/:a"$0" : cat unnfdefs.h - <<_ACEOF >unnf>&1o.$sc_"$t /* eth unx9 //////////e_mer"#def2 __MPI" >> ./sr])])_ACEOFs r/r/ax_uv_f90_modflag" >&5- "$as_mer"$rx_uv_f90_modflag" >&6l }s # CSHELso= xF= tran2003 supp= t {f "$as_me: error: $2" >&2 asefn_exi}:`cSHEL\\\swhe='/r-your unses Hr pr perly`supp= tstF= tran 2003"l>&5- "$as_me_n " Hs"ef$FCFLlargum is ths 5.2>&1o.tus\\\st\$(&\\\" seyesas_mys :sr/{f{f "$as_me: error: $2" >&2 asefn_exi}:`est ":st \`sac_pwd':"l>&5- "$as_mer"$rror: `est ":st \`sac_pwd':"l>&2;}ssATUttest "$& t"0. atiorunx>&1o&pr -z "awhill cross unses \\\ See \`unnfig.log'&o= xmorttdetatls"-c $FCFLAs_me=\$sc_tr vlunor.$s r/>l !seGLOB_opt tthf2>-freo urt i;e;; elet's hr_gb{ac_cv_fc_wi&1oer#al m-qt r/csnnf>&1o.$sc_"$tl>&5' sc_&2 k='$FC -o unnf>&1o$sc_"$ \"\$rror: $2" >&2 unorHr_gnu="ac_v_fc_unses Hr_g \"\$rror: $2" >&2 unoro.$sc_"$tl<<_ unor=n"andio&2 unorkpELso=nu:ve_FCFLAGn >&l: hastssun:S1o&/v_ou-pu:_v_ou-pu *`or: `Vli # 1ea0hangq $ `in unnf>&1o.t 2 unor $rc_cv unorkpE| c; e-d: 1`;f>&1o.t 2L\\\swhe='/r-your unses Hr pr perly`supp= tstF= tr unorHr_gnu="ac_v_/r- unorHr_gtl<<_ACEOOOOO ase;_path_E;$as_me: error:k='$ unor6l }sn_unses Hr_gnu L\\\swhe='/r-your unses Hr pr perly`supp= tstF= t$sc_"$tHr_gnu="ac_v_/r$sc_"$tHr_gc_"$tl>; c_ld_fc_rror:GLOB_opt tomfc_vd/eth _me=\$sc_tr r/>&hast arttynf>&vexF= trir CEOF#eep hths_str\\\eras_e: error:k='$ unor6l n #&hast""b (lsi r/caso bcross_unses \\\:ssc_tool_warneloat.h> int sqrb-c_p-lmunnf>&1o$sc_"$e"$tl$FCFLAGS $L sqrb-c_p-lmlo\\_dguul"" seyesas_myself : is_m_sqrbetFCFLAGS="$ac_fc_freeo= m_FCFLAGS_save $rc_flag" : cat > unnthlat is_sc_&2{f "$cross {f "$a-lm cross"flags..ac_save_FCFLAGS=$FCFLAGS FCFLAGS="$FCFLAGS $air unnf>&1osqrblf :CPPFLA"$as_me: error: $2" >&2 asefn_exi}:`d fork:lyHself : is_m_sqrb/ #i clue h&1o.$sc_"$t") 2>&5 | _f"EGRadHr_stdc=nosn #rm_.f-unnf>&1o* sn # en >&{f "$c unnthlat is_sc_&2{f "\\so= tran 90xmodul&1 t clus thfflag" >&5- "$as_me_n "cSHEL\ is_m_sqrbl&1 t clus thfflagnamZ" is_m_sqrbl&1 H='$CC -c $CFLAGS $CP is_m_sqrbl& a3["sc_"$tl<<_ACEOodflag: er#alse eras_mys :sr/ "$asHr 86{f Mor: $2" >&2 {f "$a-lm cross"fHEL\\\sosc_cnses H='$FC -c $FCFLAGS $ac_fcflags_src"$t unnf>&1o.$sc_"$tl>&5' scthf2>&1`lunnf>&1o$sc_"$e"$tl$FCFLAGS $LDFLAGS $ac_fcflathf2>&1`l>&1o.$sc_"$tlefnBSl>&5' sc_unses Hr_gthfac_v_fc_unses Hr_gnu i=0swhill >&1o \(_.f-tmpdir_$i \) -o \(_.d-tmpdir_$i \) ; _dir/s=`expr $i + 1` probamkll stmpdir_$i cdstmpdir_$i cat > unnf>&1o.$sc_"$tl<<_ACEOFs !234567 r/r/r/modul& unnf>&1o_modul& r/r/r/cnntat s r/r/r/subrout2 unnf>&1o_rout2 r/r/r/write(*,'(a)') 'got_ma!'sr/ eth subrout2 unnf>&1o_rout2 r/r/r/eth modul& unnf>&1o_modul& _ACEOF sel-c_fn_fc_tryaunses Hs"efn_exi"as_mys :ssn #rm_.f-unre-unnf>&1o. ir unnf>&1o.$sc_obje$t-unnf>&1o.$sc_"$t cdlna ax_uv_f90_modflag="atiofouth" o= xsx_flag t "-I" "-J" "-M" "-p"; _dir/sel>&1o&/bax_uv_f90_modflag" se"atiofouth" _n='/usr/ ax_save_FCFLAGS="$FCFLAGSoir/r/FCFLAGS="$ax_save_FCFLAGS b{ax_flag}tmpdi th"l"efn_exi" \(_.`lsc_libs="rc_lde_FCFLAGS="$FCF\.,&/x$[]_A thal;/ h$h"l"efn_exi" \(_& a3_fn_fc_tryauth"l"efn_exi" \(_.`lsc_libs="rc_ldCONFTEST_MODULE\.,&/x$[]_A_A thal;/ h$h"l"efn_exi" \(_& a3_fn_fc_tryaututh"l"efn_exi" \(_."S=$rros_EGREP\sos_$i \) -"l"efn_exi" \(_."S=_$i"sr/r/cat > unnf>&1o.$sc_"$tl<<_ACEOFs !234567 r/r/r/pr -z "aunnf>&$sc_"$e"$tl$CFLAG-o \(_.d-tmpdir_$i \) ; _dir/s=`expr $i + 1` probamkll stmpdir_$i cdstmpdir_$i cat > unnf>&1o.$sc_"$tl<<_ACEOFs !234567 r/r/r/modul& unnf>&1o_modul& r/r/r/cnntat s r/r/r/subrout2 unnf>&1o_rout2 r/r/r/write(*,'(a)') 'got_ma!'sr/ cSHEL\\\swhe='/r-your unses Hr pr perly`supp= tstF= tran 2003namZ"lexbl&1 t clus thfflagn 2003namZ"lexbl&1 _"$tlefnBSl>&h$h"l"efn_exi" \(_& a3$sc_"$t_fn_fc_tryaunnses Hr_gnu="ac_v_c_unses Hr_f"$tl>&5' scthf2>&1`lunppm_def2 .h],ss"-c $FCFLAHr_gnu="---v --nfd was gi u.lefnBSl>&5' -v -_nfdac_v_fc_unses Hr_gnu -v -val=$-v -_nfd;A thal;/ h${-v -val} }sn_uCEOFh${-v -val} }snguul"=0sr/,fT.nnnses Hr_gnu="ac 2 k_opf>&vexF=---v --nfd=/r/r/nse en >-pu-s &2nfd is thyfs Hs"l>&5- "$asas_me_n "c/,fT.nnnses Hr_gnu="ac 2 k_opf>&vexF=---v --nfd=/r/r/nse en >-pu-s &2nfd is thyfs Hs"l>&5- "$ fs Hs thal;/ h n #{adHr_$scsc_cnses H='$FC -c $FCFLAGS $ac_fcflags_src"$t unnf>nfd $LDFLAGS $3364.s{fnf>&1o$sc_"$e"$tl$FCFLAGSnfd $LDFLAGS $3364.scross_unses \\\" seyesas_mys :sr/{f{f "$as_me: error: $2" >&2 asefn_exi}:`est ":st \`sac_pwd':"l>&5- "$as_mer"$rror: `est ":st \`sac_pwd':"l>&2;}ssATUttest "$& t"0. atiorunx>&1o&pr -z "awhill cross unses \\\ See \`unnfig.log'&o= xmorttdetatls"h"l"efn_ex3364l>&_us hunnf>&1o_CC -c $CFLA-v -val"& a3_fn_fc_t5' sbi-tH="$pr/ "x:g.loorttdet_pr/ "xo_modul& batec-s/usr $rc_cvLD_ /foo:/bar:/c_ltr ':' '\012rc_ar/r/r/eth pr -zh$h"lbate" n #{adHr_$s ryaututh"lbate $rc_cv_& batecr/en >&1,/[^/]*$,,x$[]_AC_Launsesbi-tH="${nsesbi-tH}:${nsebate} -o unnf>&1o_n "cnsesbi-tH="$-v -val" xsc_odul& batec-s/ $rc_cv_& sbi-tHn_ltr ':' '\012rc_ar/r/rS $CPPFLAGS $LDFLAGS3364l>&_" _ACEOF sel-c_fn_fc_trya_odul& l>&c-s/usr s Hr_v_& batec-follow="r/ac_ -=$ac_c_ar/r/r/ r/eth pr -zh$h"ll>&" n #{adHr_$s ryaututAC_Launseiioe $rc_cv_& l>&cr/en >&1,/[^/]*$,,x$[]_AC_LauAC_Launses Hs"efn_exi"as_mys :sr/ax_u _uv_f90_modflag="$ax_flag"sn-I$nseiior/ax_u _u :ssn #rm_.f-unre-unnf>&1o. ir u_f90_modflag" se"atiofouth" /ax_uarm_nfdel>&5' _s Haliz" _n='ropt tha::_exi} unnf>&1onfdes Haliz"(exi}) aATUttest "x_uv_f90_modflag" se"atiofouth" AGSoir/r/FCFLAGS="$ax_save_FCFLAGS b{ax_flag}tmpdi th"l"efn_ex3364l>&_us-I$nseiior/_cpp='$CPP $CPPFLAGS' sc_cnses H='$CC -c $CFLAGS $CPPFLAGS unnf>&1o. _uv_f90_modflag="$ax_flag"sS=$rros_EGREPk:l$acunnf>&1o\\" seyesas_mys :sr/{f{f "$as_me: error: $2" >&2 asefn_exi}:`est ":st \`sac_pwd':"l>&5- "$as_mer"$rror: `est ":st \`sac_pwd':"l>&2;}ssATUttest "$& t"0. atiorunx>&1o&pr -z "awhill cross unses \\\ See \`unnfig.log'&o= xmorttdetatls"L\\\swhe='/r-your unses Hr pr perly`supp= tstF= tran 2003nam3364l>&_" 1 t clus thfflagn 2003nam3364l>&_" 1 CFLAGS="-O2" e,( $LDFLAGS3364l>&_" _ACEOF sel-cadHr_$s FAGSc_fn_c_nfd."S=s_$i \)FAGSc_fn_c_nfd.",( $LDFLAGS3364l>&_" aATUttegrep -v 'Driv\\\:' FAGSc_fn_c_nfd"fHEL\\2" >_EGR thal;/ hnfdel>&5' _s Haliz".$h"l"efn_exi" \(_& n #{adHr_$scscat txlog'&o= pp` 1 _ACEOF $LDFLAGS3364l>&_nfdel>&5' _s Haliz".$h"l"efn_exi" \(_t >o(lo\\st t wc_cnses H='$FC -c $FCFLAGS $ac_fcflags_src"$t unnf>nfd $LDFLAGS $l>&5' {fnf>&1o$sc_"$e"$tl$FCFLAGSnfd $LDFLAGS $l>&5' cross_unses \\\" seyesas_mys :sr/{f{f "$as_me: error: $2" >&2 asefn_exi}:`est ":st \`sac_pwd':"l>&5- "$as_mer"$rror: `est ":st \`sac_pwd':"l>&2;}ssATUttest "$& t"0. atiorunx>&1o&pr -z "awhill cross unses \\\ See \`unnfig.log'&o= xmorttdetatls" \\\" set txlog'&o= \ACEOF sel-\"o_CC -c $CFLA-v -val"& a3_fn_fc_t5' sbi-tH="$pr/ "x:g.loorttdet_pr/ "xo_modul& batec-s/usr $rc_cvLD_ /foo:/bar:/c_ltr ':' '\012rc_ar/r/r/eth pr -zh$h"lbate" n #{adHr_$s ryaututh"lbate $rc_cv_& batecr/en >&1,/[^/]*$,,x$[]_AC_Launsesbi-tH="${nsesbi-tH}:${nsebate} -o unnf>&1o_n "cnsesbi-tH="$-v -val" xsc_odul& batec-s/ $rc_cv_& sbi-tHn_ltr ':' '\012rc_ar/r/rS $CPPFLArchtdi'>&1o&$yes'set txlog'&o= '};nses H='$FC -cval"'`" _ACEOF sel-c_fn_fc_trya_odul& l>&c-s/usr s Hr_v_& batec-follow="r/ac_nfdel>&5' _s Haliz".$h"l"efn_exi" \(_&-=$ac_c_ar/r/r/ r/eth pr -zh$h"ll>&" n #{adHr_$s ryaututAC_Launseiioe $rc_cv_& l>&cr/en >&1,/[^/]*$,,x$[]_AC_LauAC_Launses Hs"efn_exi"as_mys :sr/ax_u _uv_f90_modflag="$ax_flag"snfc_src"$t-f} sc_cnse$nseiior/ax_u _u :ssn #rm_.f-unre-unnf>&1o. ir u_f90_modflag" se"atiofouth" /ax_uarm_nfdel>&5' _s Haliz" _n='ropt tha::_exi} unnf>&1onfdes Haliz"(exi}) aATUttest "x_uv_f90_modflag" se"atiofouth" AGSoir/r/FCFLAGS="$ax_save_FCFLAGS b{ax_flag}tmpdi t \\\" set txlog'&o= \A\A\c_src"$t-f} sc_cns\A\c_sriio\"S=_$i"sr/r/cat > unnf>&1o.$sc_"$tl<<_ACEOFs !234567 r/r/r/pr -z "a&1o. _uv_f90_modflag="$ax_flag"sS=$rros_EGREPk:l$acunnf>&1o\\" seyesas_mys :sr/{f{f "$as_me: error: $2" >&2 asefn_exi}:`est ":st \`sac_pwd':"l>&5- "$as_mer"$rror: `est ":st \`sac_pwd':"l>&2;}ssATUttest "$& t"0. atiorunx>&1o&pr -z "awhill cross unses \\\ See \`unnfig.log'&o= xmorttdetatls"L\\\swhe='/r-your unses Hr pr perly`supp= tstF= trchtdi'>&1o&$yes'set txlog'&o= '};nses H='$FC -cval"'`" 1 t clus thfflrchtdi'>&1o&$yes'set txlog'&o= '};nses H='$FC -cval"'`" 1 CFLAGS="-O2" erchtdi'>&1o&$yes'set txlog'&o= '};nses H='$FC -cval"'`" _ACEOF sel-cadHr_$s FAGSMODULE_nfd."S=s_$i \)FAGSMODULE_nfd."rchtdi'>&1o&$yes'set txlog'&o= '};nses H='$FC -cval"'`" aATUttegrep -v 'Driv\\\:' FAGSMODULE_nfd"fHEL\\2" >_EGcsc_cnses H='$FC -c $FCFLAGS $ac_fcflags_src"$t unnf>nfd $LDFLAGS $ is thyfsnf>&1o$sc_"$e"$tl$FCFLAGSnfd $LDFLAGS $ is thycross_unses \\\" seyesas_mys :sr/{f{f "$as_me: error: $2" >&2 asefn_exi}:`est ":st \`sac_pwd':"l>&5- "$as_mer"$rror: `est ":st \`sac_pwd':"l>&2;}ssATUttest "$& t"0. atiorunx>&1o&pr -z "awhill cross unses \\\ See \`unnfig.log'&o= xmorttdetatls"_src"$t-f}ld0. atinfd."S=_src"$t-f}libtinfd." hunnf>&1o_CC -c $CFLA-v -val"& a3_fn_fc_t5' sbi-tH="$pr/ "x:g.loorttdet_pr/ "xo_modul& batec-s/usr $rc_cvLD_ /foo:/bar:/c_ltr ':' '\012rc_ar/r/r/eth pr -zh$h"lbate" n #{adHr_$s ryaututh"lbate $rc_cv_& batecr/en >&1,/[^/]*$,,x$[]_AC_Launsesbi-tH="${nsesbi-tH}:${nsebate} -o unnf>&1o_n "cnsesbi-tH="$-v -val" xsclag="$axTUttest="$TUttest"clag="$axTf "$asross"f_odul& batec-s/ $rc_cv_& sbi-tHn_ltr ':' '\012rc_ar/r/rS $CPPFLAGS $LDFLAGSlibtinfd" _ACEOF sel-c_fn_fc_trya_odul& libc-s/usr s Hr_v_& batec-follow="r/ac_'libnfd*'&-=$ac_c_ar/r/r/ r/eth pr -zh$h"llib" n #{adHr_$s ryaututAC_Launseiioe $rc_cv_& libcr/en >&1,/[^/]*$,,x$[]_AC_La_& libe $rc_cv_& libcr/en >&1,.*/\([^/]*\)$,\1,x$[]_AC_LauAC_Lau r/cp"$h"llib" i$s ryaututAlib* cnnf>&1o$sc_"$e"$ta_& libe" $rc_cv_& libcr/en >&1,lib\(.*\)\.[^.]*$,\1,x$" cnnf>&1o$sc_"$e"$ta_& c"$t-f}ld0. atinfd."-L$nseiior/ax_u _u"$ta_& c"$t-f}libtinfd."-l$h"llib"/ax_u _u"$ta;;f>&1o.t 2 * cnnf>&1o_src"$t-f}ld0. atinfd."S=ax_u _u"$ta_& c"$t-f}libtinfd."$h"llib"/ax_u _u"$ta;;f>&1o.t el0" : TUttest="$lag="$axTUttesttran 2003namld0. atinfd"/ax_u _u{f "$as_& c"$t-f}libtinfd $lag="$axTf "r/ax_u _u :ssn #rm_.f-unre-unnf>&1o. ir uh" _n='/usr/aATUttest "$& u _uarm_nfdel>&5' _s Haliz" _n='ropt tha::_exi} unnf>&1onfdes Haliz"(exi}) aATUttest "x_uvh" _n='/usr/aATUttest "$& t"unnull >o(whnd unses asefn_exi}:`d fork:lys_$i \) -"l"efn_exld0. atinfd."S=ax_u _u"$t_src"$t-f}libtinfd." hunnf>&1o_h],s# //////////Lsts-\ ///////////etheadHr_stdc=nosn #rm_.f-unnf>&1o* sn # en >&1o&$s_EGREPk:l$acunnf>&1o\\" seyesas_mys :sr/{f{f "$as_me: error: $2" >&2 asefn_exi}:`est ":st \`sac_pwd':"l>&5- "$as_mer"$rror: `est ":st \`sac_pwd':"l>&2;}ssATUttest "$& t"0. atiorunx>&1o&pr -z "awhill cross unses \\\ See \`unnfig.log'&o= xmorttdetatls"L\\\swhe='/r-your unses Hr pr perly`supp= tstF= tran 2003namld0. atinfd GS $LDFLAGSlibtinfd" 1 t clus thfflagn 2003namld0. atinfd GS $LDFLAGSlibtinfd" 1 CFLAGS="-O2" e,( $LDFLAGSlibtinfd" _ACEOF sel-cadHr_$s FAGSTUttestinfd."S=aFAGSTossinfd."S=apr cHdure(func),rpoin>Hve_FCFLAnfd numeric/ ac_as_mnfd /fs Hs"l>&5- "$_$i \)FAGSTUttestinfd.agn 2003namld0. atinfd=aFAGSTossinfd.,( $LDFLAGSlibtinfd aATUtTUttest="$TUttest' FAGSTUttestinfdS=ax_u{f "$asFAGSTossinfd cross"fHEL\\\\\\\\\#c"$t ua_odufftw3 h"$axfftw/en r/caso bcross_unses \\\:ssc_tool_warneloat.h> int dfftwREPol--e-c_p-lfftw3unnf>&1o$sc_"$e"$tl$FCFLAGS $L dfftwREPol--e-c_p-lfftw3lo\\_dguul"" seyesas_myself : is_fftw3_dfftwREPol--eetFCFLAGS="$ac_fc_freeo= m_FCFLAGS_save $rc_flag" : cat > unnthlat is_sc_&2{f "$cross {f "$a-lfftw3 cross"flags..ac_save_FCFLAGS=$FCFLAGS FCFLAGS="$FCFLAGS $air unnf>&1odfftwREPol--elf :CPPFLA"$as_me: error: $2" >&2 asefn_exi}:`d fork:lyHself : is_fftw3_dfftwREPol--e/ #i clue h&1o.$sc_"$t") 2>&5 | _f"EGRadHr_stdc=nosn #rm_.f-unnf>&1o* sn # en >&{f "$c unnthlat is_sc_&2{f "\\so= tran 90xmodul&1 t clus thfflag" >&5- "$as_me_n "cSHEL\ is_fftw3_dfftwREPol--el&1 t clus thfflagnamZ" is_fftw3_dfftwREPol--el&1 H='$CC -c $CFLAGS $CP is_fftw3_dfftwREPol--el& a3["sc_"$tl<<_ACEOodflag: er#alse eras_mys :sr/ "$asHr 86{f FFTW3or: $2" >&2 {f "$a-lfftw3 cross"fHEL\\ r/caso bcross_unses \\\:ssc_tool_warneloat.h> int is thyx_uv_f90h> dfftwREPol--el&1 t clus thfe"$tl$FCFLAGS $L is thyx_uv_f90h> dfftwREPol--elo\\_dguul"" seyesas_myself : {bi-tH_dfftwREPol--eetFCFLAGS="$ac_fc_freeo= m_FCFLAGS_save $rc_flag" : cat > unS="$ {bi-tH_sc_&2{f "$cross lags..ac_save_FCFLAGS=$FCFLAGS FCFLAGS="$FCFLAGS $air unnf>&1odfftwREPol--elf :CPPFLA"$as_me:k:l$ac_vb-c_pathfftw3ar/r/r/eth pr -_v_pathlib"fn_fc_tryaunc_as_." hn` "$quiredS=axc_"$t=b{anc_as_.-l$hthlib=ax_u{f "$a-l$hthlibf "$asS="$ {bi-tH_sc_&2{f " -o unnas_mer"$rro2" >&2 asefn_exi}:`d fork:lyHself : {bi-tH_dfftwREPol--e$c unas_ (h(a\/ sac_pp-unnf>&1o.$sc_"$t") 2>&5 | _f"EGRadHr_stdc=nosn #rm_.f-un/r/eth pr -zyself : {bi-tH_dfftwREPol--eetFCFLAGS="$ac_fc_freeoARas_dunnf>&1oeth pr -zyself : {bi-tH_dfftwREPol--eetFCFLAGS="$ac_fc_fre clue h&1o* sn # en >&{f "$c unS="$ {bi-tH_sc_&2{f "\\so= tran 90xmodul&1 t clus thfflag" >&5- "$as_me_n "cSHEL\\bi-tH_dfftwREPol--el&1 t clus thfflagnamZ"lbi-tH_dfftwREPol--el&1 ses \\\"as_.agnamZ"lbi-tH_dfftwREPol--eGS="-O2" e,(\"as_" n noac_fc_freeo-O2" e,(\"as_" _ACEn` "$quiredSe.un{f "$as_meas_ cross"f h"$axfftw/ys_ (h(e: error:k='$h"$axfftw6l }sn_ufn_fc_try thffl------------------------------------------"try thffl You.2rme>&2h> touarm_FFTW tou////////e\\_try thffl Eignu="v_xt is thy r/>mi(&FTW"l>&6l }s# AC_CHECK_f-c $FCFLAso"no /ethlsr/# was ev_c_hf-v -V-ev_c_-lsr/#-c $FCFLAHr_gnu="--ev_c_-lsr/# was gi u.lefnBSl>&5' ev_c__lsr/#etFCFLAGS="$ac_fc_freeoev_c_o&$yeev_c__lsr/#;seyesas_mys :sr/: sr/#"l>&6l }s# AC_CHECK_fEL\\\c $FCFLAso"no /ethetime was ev_c_hf-v -V-ev_c_-etime-c $FCFLAHr_gnu="--ev_c_-etime was gi u.lefnBSl>&5' ev_c__etimeetFCFLAGS="$ac_fc_freeoev_c_o&$yeev_c__etime;seyesas_mys :sr/:ETIME"l>&6l }s# AC_CHECK_fEL\\\c $FCFLAso"no /ethv_loor_was ev_c_hf-v -V-ev_c_-v_loor-c $FCFLAHr_gnu="--ev_c_-v_loor_was gi u.lefnBSl>&5' ev_c__v_looretFCFLAGS="$ac_fc_freeoev_c_o&$yeev_c__v_loor;seyesas_mys :sr/:VECTOR"l>&6l }s# AC_CHECK_fEL\\\c $FCFLAHr_gnu="--ev_c_-ep hkeisrnpwas gi u.lefnBSl>&5' ev_c__ep hkeisrnetFCFLAGS="$ac_fc_freeoev_c_o&$yeev_c__ep hkeisrn;seyesas_mys :sr/:MATHKEISAN"l>&6l }s# AC_CHECK_fEL\\\c $FCFLAHr_gnu="--ev_c_-sxf"$twas gi u.lefnBSl>&5' ev_c__sxf"$etFCFLAGS="$ac_fc_freeoev_c_o&$yeev_c__sxf"$;seyesas_mys :sr/:SXFAG"l>&6l }s# AC_CHECK_fEL\\\c $FCFLAHr_gnu="--ev_c_-crayfishpaFLAHas gi u.lefnBSl>&5' ev_c__crayfishpaFLetFCFLAGS="$ac_fc_freeoev_c_o&$yeev_c__crayfishpaFL;seyesas_mys :sr/:CRAYFISHPACK"l>&6l }s# AC_CHECK_fEL\\\c $FCFLAHr_gnu="--ev_c_-hypre was gi u.lefnBSl>&5' ev_c__hypreetFCFLAGS="$ac_fc_freeoev_c_o&$yeev_c__hypre;seyesas_mys :sr/:HYPRE"l>&6l }s# AC_CHECK_fEL\\\c $FCFLAHr_gnu="--ev_c_-flamicroinstr_was gi u.lefnBSl>&5' ev_c__no_microinstretFCFLAGS="$ac_fc_freeoev_c_o&$yeev_c__no_microinstr;seyesas_mys :sr/:NOMICROINSTRUCTIONS"l>&6l }s# AC_CHECK_fEL\\\devas_me: eren c $FCFLAHr_gnu="--ev_c_-dev_was gi u.lefnBSl>&5' ev_c__devetFCFLAGS="$ac_fc_freeoev_c_o&$yeev_c__devar/evas_me: erys_ (h(e: error:k='$/evas_me: e6l }sn # en >&1o&"x$: error:k='$ unor6l }n #&hast""b (lsiiiiiiiDEBUG$a-g -O1 -"$t ua en >&1s -"$t uabsel-s - ebaFL" aATUtel: error:k='$ unor6l }n #gnu""b (lsiiiiiDEBUG$a-g -O0/ sbsel-s-"$t ua sbaFL e" aATUtel"$as_me:iDEBUG$a-g" aATUtcSHEL\\debugas_me: eren c $FCFLAHr_gnu="--ev_c_-dete_twas gi u.lefnBSl>&5' ev_c__dete_etFCFLAGS="$ac_fc_freeoev_c_o&$yeev_c__dete_ar/ebugas_me: erys_ (h(e: error:k='$/ebugas_me: e6l }sn # en >&1o&"x$eyesas_mys :sr/:DEBUGasefn_exi}:`cSHEL\\\sen your: error:k='$ unor6l }n #&hast""b (lsiiiiiiiDEBUG$a-O1 -g -dete_t>&1o-"$t ua>&1o-fp-staFL-"$t ua heap-arrays -f puv -"$t ua en >&1s -"$t uabsel-s - ebaFL" aATUtel: error:k='$ unor6l }n #gnu""b (lsiiiiiDEBUG$a-O0/ g/ sbsel-s-"$t ua sbaFL e -f pv -fflaautoep ic" aATUtel"$as_me:iDEBUG$a-O1 -g" aATUtcSHEL\\#1o.tuxi}est v_xtorttdetuxi}dirlefnBSl>&5'xi}dir" _A."fn_fc_tryauxi}dir=xi}HEL\\#1Gens r/ M -Y res \\\ _ reF >unnf _ re M -Y r"_modflaf ave $$FC\s_mys :s_cnseu r r/>a she&1oscripsex se ave $t v_xtas_me_seo "GR&2 k='sHr, nPFLAh).*$,-R\1o.nlrttyn rnpt tsh2rmd" | sedl- "GR&2scrips5.2>&1 "GHr, s,"no / "G's_libs;sp-- -ave $n_c_I1o.tmin>HarmfulnPFLognu="$,-R\1,p'`sr/itx_uv_f90_tas_me_se 2f>&'c_&2wa >-pu-sacs,e 2ma\_dgmoveSor_ed&1o.tn_c\#c" aadHrusedl-nlpays attenCPPFLAu-s &2ave $$ r ru gi xsc_&2s &2--n_l$t ualibs;spAu-rer, n "Gn_c\#c`gnamZ"env_foo'x${uiv_c_s (o.tuor_, set)_wi&1ot toverriddrun_fc_t# loadh> tnseu r,Lognu="*, set*c`gnamZ"foo'xwi&1ot tas)Z"l>&6gnut# followh> o&$ues.& t"unnulxi}:`cSfollowh> wa\_o -J" h> tn&2ave $$mi(di_SEPARnew = xssin o&$ues,i;e;; ewe c_"$_o nooer#aul""l>&x se ).*$hs_st,&/v_ov_c_,.2>&1efficienCn_c_So,ewe ci&1o${uiv_c_s _uv_f90h> new = xsn_c_Ultrixtsh1o.tu-J" "sAso"ntd.$sc2>&1 a&'cot trmdin_lo>&6din_loly,i;e2>&1o.tt v_xthigh bitas_me_n ave $$ r PPER(c)w tas)Z"lLAu-s &2${usn_( th_EGREP : us-s/ (set)_i # 1eibs="rc_l/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`ar/r/r/ rchtdiEP : l=\$$EP : u unnf>rm_$EP : ls-s/#( unn* clusnl}* cnnf>rm_$EP : rs-s/#( unnnn*amZ"*)i r/caso bcross_unses \\\:ssc_tool_warneWARNING: ave $$${uiv_c__$EP : rs_uv_f90_ta new = x/rt teger, /rpoin>WARNING: ave $$${uiv_c__$EP : rs_uv_f90_ta new = x/rt 2;}a;;f>&1o.tel0" : f>rm_$EP : rs-s/#( unnnn_ 1eIFS 1elusnl)a;;/#( unnnnBASH_ARGV 1eBASH_SOURCE)rchtdi$EP : r=a;;/#( unnnn*)i chtdi$EP : r=;_, seti$EP : r;}a;;f>&1o.tel0"a;;f>&1oel0" : sefn_e (set)_i # 1 unnf>rm_$Eusnl`(EP spaFe=' '; set)_i #`s-s/#( unn* clusnl}EP spaFe=\ * cnn#c`set'o* sn # enquotefn_en_loly,o.nladdnquotes:def2 -quote cnn#csubstitubs;spAur0_t\\\\'ropot\\,e2>&1o.dpAur0_t\\'ropot\elf :CPPibs="rc\ "s/'/'\\\\''/g; PPi/^\\([_$Euscr_alnum]*amZ"[_$Euscr_alnum]*\\)=\\(.*\\)/\\1='\\2'/pS=ax_u _;;/#( unn* cnn#c`set'oquotesfn_en_lolyest "$quired by POSIX,o.nldo # enaddnquoteself :CPPibs="rc"/^[_$Euscr_alnum]*amZ"[_$Euscr_alnum]*=/pS=ax_u _;;f>&1oel0" 1 unnst un) 1 uen >&=ax_u /^gnamZ"env_/bPFLA"ax_u tx_le{us _f03:_le{us _f03l/^\([^=]*\)=\(.*[{}].*\)$/BSl>&5' \1etFCFLAGS="$e.un&/"ax_u txFLA"ax_u l/^\([^=]*\)=\(.*\)$/\1=' \1=\2}/"ax_u :FLA'cr_alnuP'ax_u :Fi u.TRUCT|AC_CHECr$nnf>&1oe\012rLaunsesbi-tH="${nsesbi-tH}:${nsennfuired by POSIX,o.nldo # enaddnquoteself :CPPibs="rc"/^[_$Euscr_alnum]*amZ"[_$Euscr_alnum]*=/pS=ax_u _;;f>&1oel0" 1 unnst un) 1 uen >&=ax_u /^gnamZ"env_/bPFLA"ax_u tx_le{us _f03:_le{us _f03l/^\([^=]*\)=\(.*[{}].*\)$/BSl>&5' \1etFCFLAGS="$e.un&/"ax_u txFLA"a\_f03:_le{st{us _f03st{unewd-tHpst "#i clue h"sqrP/e=\$sc_tr)fo"s6;}_t\\'rotZ"env_/bPFLAc_tr vo.nl"5 | _f"EGRad{us _f03st{unewd-tHpst "#i clue h"sqrP/e=\$sc_tr)fo"s6;}_t\he&1os' <= (c) st un) \1etFCFLe} -o u>&1sNONEdHr_e} -o =tH}:${nsebate} -o lsLee,prk&2 pn_( tin" e} -o . \1etFCFLtin" e} -o u>&1sNONEdHr_tin" e} -o ='${e} -o }'ixtshransossi-tH_dthyx_uvquoteDEFS-zA-PrFCFc&5'g;;f>t>Harmfu pn_&1o.$lag="a------sqrPs,"no / LAul[a-zA-PrFCFc&5'g;;f>t>s,"no / Lef2 u pn_&1o. tn&2ILAGS $fir>t>Hedotesfn_en_lolyisa------edo(_defaosr/xs_mer"ef2 TER(ces.&rk&2argutFCFs),_f03:_branchZ"*)i \\)/\\sefn_ex`gnOov_cwise,"l>&xok/bin"l"ef2 uER(c)\\)= l=\&rk&2argutFCFs. sedl-n=' :m#i c u$/{ N s,r_an,, b m#i c } bi-tH="$bi-tH}:*am[ ]*#[ ]*or6l }[ ][ ]*Z"[_ (][_ (]*"[_)]*)\)[ ]*Z"lnum/-Dax_u /g .*\\)/\:*am[ ]*#[ ]*or6l }[ ][ ]*Z"[_ ][_ Eusc[ ]*Z"lnum/-Dax_u /g .*\\)/\:bIX,y :\\)/\:*a[ `~#$^&*(){}\\|;'aln"<>?] u&/g s/\[ u&/g s/\] u&/g s/\$/$$/g H :X,y ${ g *amZn// *aZn/ /g p } ' DEFS=`un&/"ax_$ sedl-n"-tH_dthyx_u`nfd -zysobjs=d -ztzysobjs=dU=d fork:lig; :/>mi(OBJS= x/t is thyx_uiu>&1s:dHr_cREP$' < _exi}. Rfc_t# i nu="ac SIX,o.$U="$aclready ;f>taATeff "u sedl-n='s/\$U\././;s/\.o$//;s/\.obj$//' "u i>&5' cross_uyx_uiu>neWARN_$ sedl-n"` _exi2.-PrepeadHmi(OBJDIR`gnW03:_usAHr_gnu=r"_modke>=1.10Hmi(OBJDIR _exi So,ewe ciPibs"*)i >rm_$Eory#aulPFLmi(OBJS --e$ctpr -z ----tf "u ,probappeadH -zysobjs " \${mi(OBJDIR}yx_ui\$UREPol--e$en" "u ,probappeadH -ztzysobjs " \${mi(OBJDIR}yx_ui"'$URlo' "$as_mi(OBJS=$ -zysobjs LTmi(OBJS=$ -ztzysobjs :/>{"aunIG_STATUS=./r,Lognu="*, s-----1/p'`_fail=0 -tHn "GHr, noac-------tHn "GHr, -tHn "GHr,5.2>&1 -tHn "GHr, $"aunIG_STATUS"--eetFCFLAGS="$ac_fc_freeo= m_FCFLAGS_save rea-sqrP$"aunIG_STATUS">"sqrP/e=\$sc_tr)fo"s6nc 1/p'`_fail=0 "G$"aunIG_STATUShlibfSt(f)|`s-s/1/p'`_fail=1 #! $SHELLpt tsh2rmd")=\(.r)fo rea-# i cuus nt_o -J" hLAGS=-zA-r"rc_v_ outh_EGproduc")=\(.o -J" h>,Au-rer, _save-fflg:: c#.o -J" h>,Ap-lml r,Lognulog| breakexisFs. $eyesa select>&1 s_nulxi}: select>&1 s_s_vnt select SHELL/rp{"aunIG_SHELL-$SHELL} p perSHELLpbfSt(fLAGS $L$"aunIG_STATUShli\bfSt(f)|`s-s/1/p'`_fail=1 ## ev_c__lsr/#etFCFLA ## ## M4\)="$rxists-LAGS=- ## ## ev_c__lsr/#etFCFLA ## dtbo Bo# e $L sqLAG="acDUALCfSt=1reeop perDUALCfSt # _savMKS>Ha ""ax_${Z VERSIONeself :Hr_semula-# sh) ((c) - 'a') :t(c)) #"$0" | mula-# sh" |NULLCMD=: _exiPre-4.2zeon_lo\v_f90ZsEOF ve $dotplit-sqrPoly${1+"$@"} s_defa _exii="rc_lunnfdefsin uusage`gnDisguul"=$hs_sea- h> "u li/^\-g '${1+"$@"}'='"$@"' u.TRtopt NO_GLOB_SUBSTpr cHdure(nullin o&-o)p unnf>&1o.n/g; PPi/^*posixy,o:nuP'ax o&-o posixmZ"env_/by,o:nuP'a \so= xAN:k='$$Eusc=' ' p per$EusczA-Prin-sqrPa(lo\\s incorr ras\1,pSol: rs 7 >&1o. /rututAf. /e=\$sc=scr_aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa' /e=\$sc=P/e=\$scP/e=\$scP/e=\$scP/e=\$scP/e=\$sc /e=\$sc=P/e=\$scP/e=\$scP/e=\$scP/e=\$scP/e=\$scP/e=\$sc xiPrefen"l"k\)=.armfu----t; $_o s_meu="rmyseututAf{bi-tH_scolySol: rsv_xthigh ua_oduwastGS=$FCFxs_mer"bas\&$uezshk='$ unorc una VERSION$Z VERSION" (h(a\/Hr_s is tX`ututA -:`cSeetFCFLAGCFLAGSXetFCFLAG")p unnf>&1o.n$as_me: erro\$sc=sututA -:`cS': erro\$sc_n=sututA -:n`cS':ir" s is tX`ututAf %seetFCFLAGCFLAGSXetFCFLAG")p unnf>&1o.n$as_me: erro\$sc=sututAf %s\n': erro\$sc_n=sututAf %s'>unnfdefs.hl<<_ACX`(>&1o.ucb/\$sc_"ax"axetFCFLAG)p unnf>&1o.n/FLAGSX"axetFCFLAGer#alse eras_my\$sc_body='laddn>&1o.ucb/\$sc_"ax"$1\elf :"' eras_my\$sc_n=s>&1o.ucb/\$sc_"a'5 | _f"EGRadHmy\$sc_body='laddn1o&/bSXe1" :/"Xst un) 1"' eras_my\$sc_n_body='ladd:_le{starg=$1#csubstiropot\erg>&1o.tel0" : "\elf :"*) 1o&/bSXeerg" :/"Xst un) 1\elf :"; arg=`1o&/bSXeerg" :/".*\elf :st un) 1"`n#csubstitubs#csubstito&/bSXeerg" :/"Xst un) 1"nseiio-d "\elf :"csubs' eras p per$Eu\$sc_n_body eras_my\$sc_n=ss\&swhe$Eu\$sc_n_bodys_my\$sc'FCFLAGS= p per$Eu\$sc_body errro\$sc=ss\&swhe$Eu\$sc_bodys_my\$sc'F rnpt h1o.u-rc_p-lalwamZ"rightk='$ unor6l ag="_SEPARATOReself :!iiiiiDEBUG$ erag="_SEPARATOR=: _e(ag="=s> /;> /'; Fag="=$ag="; s\&swh:) ((c) - 'a') :t(/Hr_{ eras(ag="=s> /:> /'; Fag="=$ag="; s\&swh:) ((c) - 'a') :t(/||csubstiag="_SEPARATOR=';'FCF}ECK_fEL\IFSEL\We needotum]*,_fabIX,o.newL\\\>,Apn_e} ciselyuER(c) $der`gnQ\)/ "aunses.& tr&owh>e} v nt_dh> ors_mrom$L sql/^\([a-ab_odutum]*-fab-zA-(ILAbfSlag="_WALK wtr&ocaATefr_gnu=i #2 -,reakw1o$scdisguul"e $dHrusplit-sqrP\(. --sqrPi #wh>empty&1o.tt.) i =" "" \elf :"cHruF$[]_wsc_ unnre`gnLxok/ cnnfross_'$ w/rpr cHdun av>rm_$Eory#sepo&/bor. ropot\0>&1o.tv_/by[\\/]* )s_mymyself=\0>n#csu*)s_mynoac_i =$i ; i =$ag="_SEPARATORd forks"$ax>&1o$ag=" x/rt i =$_mynoac_i m_FFTW tc unass"$ax :Hr_ss"$ax=.>&5' \1etF-:`nass"$ax/$0 :Hr_ss"myself=\ss"$ax/$0:Hr_ag" >&'ropot\i =$_mynoac_i mnuP'a \so= xANL\We didr;spAx$[]_$tl<&bi-bguuy w/rwtr&owa\_/^\`s\&COMMAND'NL\ins_defaoropot unnrer;spA----eibtinf/ cnnfross. int is thyxs"myselfu>&1s$as_me: erromyself=\0ECK_int is !<= ("yxs"myselfu$as_me: eP/e=\$sc_tr)fo wa\__gnu=rnpt tol$FCFst,&o$h"lsefn_GS= ev_F rnpt U -q # 1eibs="ER(c)we$/BSl>&5needoa[]_wsefaoro----esas_se.g._u _#>e} -3.0 UWIN"k\))`gnBut$/BSl>&5ro----esas_ bas\&2.0(c)) # "|`s ev_"Hrusupe} ss`est y "SegtFCFLAGS= >&6l } m ssage.& tr&`gn'WERxc1o$ses.&riggen"l" (lo\\spdk\)=5.2.14 PFLs="ER(c)we$/BSl>&5>&1 -t>&1o\\" seyesaYvAILYvAIL$_mynoazetof lo\\sxL-$sas_my_fc_frromyER(c tX`utA {f{f#csubs_my_stdco_c_o&$yt(/Hr_{ eras(ag="=s>f{f#csubs_my_tdco:$ -zyPS1='$$EuPS2='>$EuPS4='+ -tH_dNLS nu_CHEc'g;;LC_AHELCA-Prin-sLC_AHE LANGUAGELCA-Prin-sLANGUAGE: ereD$_my. {f{f#cseD$_myyt(/Hr_{ eras(ag="=s>f{f#cseD$_myneedossinfd cross(f)|`s-he='/ [sqrP$" LOG_FD] #etFCFLA ## dtbo ba =\(.o "`$h"lyautu$0`crx$[]_Hrface () {0ECK_i'`_faiot\e>>unnfde_i'`_fai -eq 0\ss"$ax'`_faio1(>&1o.ucb/\$$4y\$sc_body='ladave re=AGS_save rea"$3"}'ladave re_a-O1 =ladave re_a-O1 =$ladave re_a-O1 ody='_fc_freeo= m_FCFLAGS_save rea-sqrP$"aunx$[]_&a "modf f=\ ""env_"ax_u tf{b.n>Hrfacec_o&() {0EC"env+ in Irix-4f#ci'`_fai $1t U -q$1 } dossinfd -eedossinfdf{f#csVAR #etFCFLA ## dtbo)=.ah_EGREy f{f#csVAR.n>Hrfacf{f#cs() {0ECdef2 -1 cnn#csu1;} l=0 cnn#c=>Hrfacf{f#cedossinfdsobjs "VAR"VALUE #etFCFLA ## dtbo #eAobjs " ne tf{b-t>&VALUEory#aulPjs "of_seo i ## onm_$Eory#ed-t>&VAR.lwakew =advaEorgl") SGS= $_o s\_o m ev_c>&5needa i$s amh_Eized-ave y_tgrowFstyseuw =IR`g-zA-Rsobjs s, seea "of_seo typork:lquad_v_ctgrowFstegtFom$Ly#seaivew ="$ac_fc_freeo=ss"mys(me: erbs_my_LCfSas_my_f=2; lo\\sxL-bs_my_tomy12$as_me: erro\$sc=sut"$as_me: e'ssinfdsobjs "(s _f{ /rpoin>W$1+=\$2dH }'n/cc in Irix-4sobjs "(s _f{ /rpoin>W$1: av1\$2dH }# 1 dossinfdsobjs eedossinfdwe$FstARG... #etFCFLA ## dtbo )=.aeruvquowe$Fsmev_ctoin>u ssageot is ARGsnaddnqutore90_tas_me_sint is)=.glowalsubs_myl.lwake=advaEorgl") S$_o s`sr/itx_>&avol<<&$uez.lwam sedl-n=' FCFL $33nfrth_EGREP a c $(()): us-s"Xss"mys(me: erlo\\s\$((11-+11-)):= 2$as_me: erro\$sc=sut"$as_me: e'ssinfdse$Fst(s _f{ /rpaDFLAGS ((1$\0>)dH }'n/cc in Irix-4se$Fst(s _f{ /rpaDFLAGS:/".*\e$@hy r/>unnfd? -eq 1`dH }# 1 dossinfdse$Fs puv -/".*\anse'\(a\)'t(/Hr_{ eras(ag="=s ="$e.un&/X:/".*\00001nse'. /g ..\)'FLAGeX0ev_"HrtutAf %s".*=s".*n/cc in Iris".*=p{"aun puv -($h"lyautu-- /yt(/Hr_{ eras(ag="=s>e.un&/X:$h"lyautu-- /^\\([_LAGer#/"v_"HrtutAf %$h"lyaut=$h"lyautn/cc in Iri$h"lyaut=p{"aun puv -(1etF-:``F-:yautu-- /`"=s>e.un&/X"$ax=.>&5GeX/yt(/Hr_{ eras(ag=v_"HrtutAf %F-:yaut=F-:yautn/cc in IriF-:yaut=p{"aun purP$"a_uiu>n$h"lyautu-- "lf=\SEP$Iris".*eX/"lf=\se'. & c"$t-"$t-f}l/*$' \|lnum X"lf=\se'X\(//\)$' \|lnum X"lf=\se'X\(/\)'t\|l.s_me: erro\$\SEP$Irisrea-X/"lf=\ u.TRUCnnf>/^. /& c"$t-"$t-f}l\/*$/{alnur_altegealnur_qalnu}alnu/^X/& c/& /\)$/{alnur_altegealnur_qalnu}alnu/^X/& c/& ). &{alnur_altegealnur_qalnu}alnus/. &./; q'`eedoAvol< "ab cha k\nassxy) ECHO_C='\c'c_i =$i aATUte`f :"'s="885.2.1ot AIX 6.1` > e: erro\$PARATORiECHO_T=' ';; to&/bSX; us _fECHO_N='-n'idr;spAxn) \1etFCF$$etFCF$$.exeetFCF$$.ad{us VERSIdetFCF$$.F-:v_"HrtutA) \1etFCF$$.F-:/tFCF$$.ad{us/cc in ) \1etFCF$$.F-:in outh" tFCF$$.F-:s_me: erro\$= ("yxs(f :"'>tFCF$$.ad{uas_me: erro\$sc=sututAso"nn -setFCF$$.ad{uetFCF$$e_me: erro\$sc=sututA='lada-4f='nn -sEu\$sc# -elfb.o IX,reibtintwo i" \(_s:u\$sc# $ytOn MSYs-fboFst`nn -sead{ueF-:': us-`nn ad{ueF-:':_c__.u\$sc# 2) DJGPP e.un&! \1etFCF$$.exeeSEPARATORlada-4f='cp -p' fc_tryalnetFCF$$.ad{uetFCF$$e_me: erro\$sc=sututA='lada-4f=lny\$sc_body='lada-4f='cp -p' fc&1o$sc_"='lada-4f='cp -p' un) \1etFCF$$etFCF$$.exeetFCF$$.F-:/tFCF$$.ad{uetFCF$$.ad{usrmth" tFCF$$.F-:s_me: erro\$=eedossinfdouth"_p #etFCFLA ## dt ere nt_o s"$ax=.>&5aLAG &/bor. ro,t],[s# -z "aaAGS=sAso"neATUt\\\ ssinfdouth"_ps() {0 PPibs="rc\ /rt i f :"*-=$i ;F-:`n/rc\ /rt;; to&/bSs"$ax :Hrd s"$ax=.>&5dco_valsubs_outh"_psdco{ /rpaDFth"s= /rprPs,"n:o$sc_"$e"$Pibs="rc\ /rt i f :"*) 1o\'=$i ;qF-:``&5d-n"` _*amZ"[_$E[_$Euscrs#cs #'addnquotes: ;qF-:`rc\ /rt;; totito&/bSPARATORladth"s=" is tqF-:':rc\ /rts"PARATORladth"``&5dcP$Iris".*eXs"$ax=.>&5se'X\(.*"$t-}l//*"$t-"$t-f/*$' \|lnum X"l$ax=.>&5se'X\(//\)"$t-' \|lnum X"l$ax=.>&5se'X\(//\)$' \|lnum X"l$ax=.>&5se'X\(/\)'t\|l.s_me: erro\$\SEP$Irisrea-Xs"$ax=.>&5du.TRUCnnf>/^X\(.*"$t-}l/& /*"$t-"$t-f\/*$/{alnur_altegealnur_qalnu}alnu/^X/c/& /\)"$t-. &{alnur_altegealnur_qalnu}alnu/^X/c/& /\)$/{alnur_altegealnur_qalnu}alnu/^X/c/& ). &{alnur_altegealnur_qalnu}alnus/. &./; q'`eARATORax :Hrd s"$ax=.>&5t\i =$_myn\\\ See "$ax :Hr_ss"$ax=.>s&5dco_vals"outh" rc\ /rts"PAR}y r/>unnfrd s"$ax=.>&5dcoasinfd cross"fHEL\\\\\\\ nt_o &/bor. rop"$ax=.>&=ee} dossinfdouth"_p so"outh" -pl.s_me: erro\$self=\0ECK_inuth"_p='outh" -pls"$ax=.>&'n/cc in >unnfrd ./-plt\irmth" ./-p0ECK_inuth"_p=p{"aun puv ->unnfrx /^(/Hr_{ eras(ag=v_"HrtutAf %o* snx='>unnfrx<_ACX`(>&1o. s`-dL /^(/Hr_{ eras(ag=v_"HrtutA='ladas_L_\_o -=Ly\$sc_body='ladas_L_\_o -=r$Eu\$scf %o* snx=' /rpoin>W- 'a')g s/eARATOR VERSIde"$1"v_"Hrtu VERSIde"$1/."; totito&c_bo ibs="r1 i f : -=$n#cs"n/r1"v; &/bSXe ibs="z "a-ld is tas_L_\_o -'e"$1"; PPi/^*posixy,o:n : ???[sx]*):;;*)p{"au;;&/bSXses \\)g s/: _exi' unIris"sr/x_try_p=$f %o* snx # #s-s"XsTUtt -J" hmapognuSol: roFCFca "" l<W-nnf>y%*$a1=\2}lempers%P$a1=\2}LETTERS%;s%[^' \1=\2}/"ax_u%_%g'" # #s-s"XsTUtt -J" hmapognuSol: roFCFca "" l<<.tel0"a;;yaut ssitrHshf"oin>W-nnf>y%*+%pp%;s%[^' \1=\2}/"ax_u%_%g'" s"sr 6ag=r/#etFCFLA ## dtbo rxists-Lry#s rnptofS">"s6nc 1/p=R\1,p'__lsr/#etFCFLA ## dtbo rxis"aunIG_>unnfde_i# ev_c__5Ge0\ss"ch5' _+xS">"s6nc 1/p=dcoac## ev_c__lsr_STATUShli\bfSt(f)|`s-s/1/pC`_fail=1c## ev_c__lsr # a SIX,oFs. gn'WERx,drun_fc_[\\/ddnquo1ot mea]*-ffulnaddnqtow =IR`dy erctu_uv_f(.o bitastofSli\bfStFILES etc. seea "of_seoiuw = bitastaf k\)\_o -s i;e2>HP C sc_Fs.=" >HarmfulnPnu="-l<<_ unBSl>PM.*$hs_s 1.1.9"rc_lunPnu= gfo"s6nc FILESexili\bfStc_fcflS =S">"s6nc c_fcflSexili\bfStLINKS =S">"s6nc LINKSexili\bfSt_defaorS =S">"s6nc _defaorS$sc<[\\/$@ oneWAhostyautuil=uyautu-n)s_me: erro\$\SW-nnf1q` "o.tu-J" "spaFe=' ';,"no / y#s*" "es:n#csx=' ';,"no / ) - ift; s5.2>&1 "G$*idr;spAxnr_STATUShli\bfSt(f)|`s-s//pC`_fail=1c## ev_c__lsr #FiSl>&5needt*c`gnamZ"foo'nu="madfros.tv_>&1 "GHr, s,"no / "o.tu-J" "spaATUShli\bfSt(f)|`s-s/1/pC`_fail=1c## ev_c__lsrelect l"=$h="\ \`*$hs_s' sedntiSTFLA ddnqficienzA-r"rc_v_ oerct -s [a-abtedutuTFLAGccord------- -J" hLAGS=-zA-r"rc_v_ ou UmZ"*)it unnnns as " \o -s btinspecifiA-Rss TAGsnad\$\btin sedntiSTF-Run. . U"=$h:[\\/[OP>&1o]-elf[TAG]-el exi-h,etFhelpARATORiir" s"u lihelp"*)i -exi-V,etFEOF ve TORiir" sEOF ve Tax_berLAu-s &2ave $v_ oe>empty&s"*)i -exiiiiil$t ualiATORiir" s &2ave $v_ o"*)i -exi-q,etFquiisgu--SHELL/PARATORiiiiiiiiiiiiisas_ ir" s: rsv"*)ign'WERx_lib-dgu--c" aATiiiiisaFCFs tnseu teduoage`gnnnns xiiiiil$owh> waaaa';}a;e.*$hs_s b> t &2ave $owh>et is sautu &2dit -s xiiiiil$nnnn=FILE[:TEMPLATE]PARATORiiiiiiiiiiiii sedntiSTF- -J" &2ave $v_ oefulnPFILE C&2ave $v_ oefulns: $,"no / RR`dy e.0(c):sr/{f{fackrgl"\).scror."o.tu-J" "STATUShli\bfSt(f)|`s-s//pC`_fail=1c## ev_c__lsrelect ,"no /="uiu>neWARN_$ ml r,Logn_args"$t-f}libt/^ //; s/[\\""\`\$$/g g H :"$taelect EOF ve ="\\ >PM.t*c`gnamZ"foo'1.1.9 ml r,Logn-Run.*0, gfo&v)\_o -s \`sac_lect ,"no /\`s C&pyr6l a (C)s_010 Free SoftwbtinFss. v_ o"*Inc. >Harmt*c`gnamZ"foo'R\1,p'`armfree softwbtiv_"HruFree SoftwbtinFss. v_ o unnus*amZimizA-Rper }s# -J" hc&py,ruspSolbefn_aldCONFifynu="" -ztpwd='$-ztpwd' pt tsh2'FLAh).*' VERSIONe\$AWK&5dcoAWK=awk.tu-J" "spaATUShli\bfSt(f)|`s-s/1/pC`_fail=1c## ev_c__lsralwamZ 2 usRsobly-c_p-lml"righ\1='\\2'/specifySGS= C sc_oro- lsLee,s=:h" o= xsx_fl$#erag0noac_iibs="r1 i lib--*=?us _f03,pro_o -=`Xst un) 1"' e'X\(]*=/pS=a'`eARAT,pro_org" :/".*\elf1"' e'X]*=/pax_u _;'`eARAT,pr- ift=:u\$sc;; to--*=s _f03,pro_o -=`Xst un) 1"' e'X\(]*=/pS=a'`eARAT,pro_org" eARAT,pr- ift=:u\$sc;; tous _f03,pro_o -=$1t UAT,pro_org" $2dH AT,pr- ift=- iftu\$sc;; to;spAxn spaFe=' ';\_o -Ji lib# H;e2>HP "of_seo \_o -sau\$$owh> wa|il$owh> wa|il$owh> a|il$owh> a|il$owh>a|il$owha|il$owa|il$os _f03,prect>&1 s_s_:c;; to--EOF ve T|o--EOF veT|o--EOF vT|o--EOF T|o--EOFT|o--EOT|o--ET|o-V )ody='_fc_freeo= mlect EOF ve "eev_c_;; to--t ualiA|o--t ualA|o--t uaA|o--t uA|o--t A|o--t )ody='_fc_freeo= mlect t uali"eev_c_;; to--c" aAT|o--c" aT|o--c" T|o--c"T|o--cT|o-d )ody='1 s_nu:c;; to--fulnP|o--fulP|o--fuP|o--f )ody='_fpr- iftody='paFe=' ';\_o: "\eody='o\'=$i pro_org" :_fc_freeo= mleo_org"&5d-n"` _*amZ"[_$E[_$Euscrs#nuP'ax_u'')oasinfd cross"fHE }s# fulnPsedl-n='"ropot\\,e2>&1o.n Irix-4sobjs "li\bfStFILES " ' mleo_org"'" _f03,proro- lsLee,s=p{"au;; to--> a|il$>a|ietFhelpA|etFhelA|eth )ody='_fc_freeo= mlect l"=$h"eev_c_;; to-qA|etquiisA|etFquiisA|etFquiiA|etFquiA|etFquA|etFqc tX`|etSHELL/A|etFSHELL/A|etFSHELLA|etFSHELA|etFSHEA|etFSHA|etFSs _f03,prectSHELL/r:c;; lib# >Harmtk='nnx$[]_.:"*-=$i ;nguul"=0sr/,fT. t &gnized-\_o -: \`*1' Te`g\`*0etFhelp'(ces.&otin uvquv_ ou"c;; lib=$i ;ngusobjs " \$,"no / org"* ""r1"PARATO,proro- lsLee,s=p{"auc;; libe2>&1o.- iftodpAur0 ml r,Logn_-l&1 s_snfus: httn#csX ' GS $L' ' 0' $ ml r,Logn_args-ac_lecl r,Logn_-l&1uF ve 1o.- ifto \_fc_freeo=run]*-faSHELL} p p= GS $L \_*$quire aSHELL} p p=' GS $L' sc_body eSHELL} p phttp"sr e\$@bnfd*.tu-J" "STATUShli\bfSt(f)|`s-s/1/pC`_fail=1c## ev_c__lsrp"sr 5 uen >xisFs. {0ECl"k\)RUCnnf>h;s/./-/g;s/^-el/## "u -el$/ ##/;p;x;p;x's/1/p'BOXr/#eRun]*-fa*$hs_strxis"auBOXr='_fc_freeo= mleFs." }tr)fo.tu-J" "STATUShli\bfSt(f)|`s-s//pC`_fail=1c## ev_c__lsrtu-J" "spaATUShli\bfSt(f)|`s-s/1/pC`_fail=1c## ev_c__lsr # H;e2>HP "of_sedl-n=' :m>mi(OBJ,"no / org"* i = \$,"no / org"* noac_iibs="rOBJ,"no / org"* i PARAT""G's_libs)"li\bfStFILES=_$li\bfStFILES "G's_libsc;; lib=$i ;nguul"=0sr/,fin"" l<Hedotesf"righ\l<mi(,"nveniences.&"G's $EP : rs-sit 1);< tew =R"$acy bebas\&2IX,rein tas oer Lef2 havowh>e herP : us-t>&addit -, v IG_STATUSaldCONv fuln\([a-ab/tmptx_>&som&$yees bas\&2r&owlfoo'ibsH uER(c)\i-sactnseal*amZ"*)i -J" h>,A'ibsNot&2taeedIX,rein a sma sFCndowt unnrer;saulPFLmi(OBJS -i lvesbe*am[ ned:edosf k\)i-saIG_STA oeb.o befotin -sayautu(_ssbruseuv_f90h> o `$tmp'. $c" aAT|| {0ECtmp eARmodf 'v_ci'`_faiot? ECdeax :Hr_ss"tmphy r/>unnf!SIde"$tmphy r/) \1re"$tmph; } ='${e -q$v_ci'`_fai 'g0nARmodf '>Hrfacec_o&1' 1 2 13 15 } ere nt_o at\\'1uFe)Ctmpg&/bor. rop>mi(tmpgfuln\. {0ECtmp `(umask 077 ='$mkteduSIde"s-----XXXXXX"g; PPi/^*posix=s =" VERSIONestmphy=s>e.un&Ide"$tmph }tT|| {0ECtmp ./tFCF$$-$RANDOM0EC(umask 077 ='$mkth" "$tmph) }5dcoasinfd cross"fHEL\\\\\\\ nt_o a teduoage`g&/bor. rop un.error: $2" >&2 # #csup is senCPPFL>mi(li\bfStFILES cwise,"libsNoaoro-- o gfoHarmhsobjsFL>mi( sedn rf>&v)`s-----1/p'`_faimt*c`gnah'.{Z VERSIONesli\bfStFILES"v_"Hrtur0 m,\1,x$" X :"csuXen >&5'`e#tOn cygFCn,# "|`sx_>&nt_ \i( sic"T``-c_p-lml"righ{}].VERed-tgncr.minB ave $$ r PPER(gnamZ"e_o sFlmreib m,"e $dHrbe*i =" a s"u lN"k\detu\1etF>rm_a_modk)=5."|`ism5aLAG p{"le M s"myselfu>&1s$ m,rromyself=\0ECoin>WARNm,\\$\"[_r\' unIlect awk m,\1$AWK 'BEGINCdeir" s"a\rb" }'s//Hr_{ eras(aPPi/^*posiu.2rme>&2h> tct awk m,LAGerawREPolr}nnf>&1o.$scIlect awk m,\"[_r'--el&1 ses \t awk m,\s$ m, 1eif :"''BEGINCd' >"$tmp/sa--1.awk _f03tu-J" "s {0ECl"k\HEL\t'>tFCF$$sa--.awk-s//pC`_f _f03stfreeo= mlesa---_my_s"$t-f}libt/.*/&!$& -o llim/'_f03stfreeo=/pC`_f }trtFCF$$sa--.|`sSEPARasinfd cross"fHEL $dHr\\\\n" e}">"s6nc 1/p'`ror: $2" >&2-o llim_ax_=`freeo= mlesa---_my_s"$t-grep'a')g^'`e-o llim='%!_!#i' {bi-tHa--_trop unp{"aucp{"aucp{"aucp{"aucp{"auc:o$sc_"$. ./tFCF$$sa--.|`sSEPARARasinfd cross"fHEL $dHr\\\\n" e}">"s6nc 1/p'`ror: $2" >&21 ses llim_asedl-n"-tHt/.* -o llim\$/X/p" tFCF$$sa--.awk-t-grep'a')X` OR VERS$es llim_a =S"-o llim_ax_v_"HrtutA=' =$_myn_trya$i-tHa--_trov_"HrtutA='ladnfd cross"fHEL $dHr\\\\n" e}">"s6nc 1/p'`ror: $2" >&2stdc=nosn #rm_ llim=""-o llim!"-o llim _"-o llim!! /usr s Hr_v_) \1etFCF$$sa--.|`r_STATUShli\bfSt(f)|`s-s//pC`_fail=1c## ev_c__lsrSTATUSe\$tmp/sa--1.awk _s/11/pCAWK f03tu-J" "$${uiv_c h*or6/S["/; s/!.*/"]=/ p g*or6l^!]*!// :repl Fs tpl s/'""-o llim"'$// t llim :nl h*or\(.\{148\}\).t tege t &oti1){}\"\$$/g H :; s/^/"/; s/$/g n"\$/ p n bs tpl :&oti1){}\"\$$/g H :; s/^/"/; s/$/"\$/ p g*or.\{148\}// t nl : llim h*or\(.\{148\}\).t tege t &oti2){}\"\$$/g H :; s/^/"/; s/$/"/ p b :&oti2){}\"\$$/g H :; s/^/"/; s/$/"\$/ p g*or.\{148\}// t llim 's/tFCF$$sa--.awk-t-$nnf>&r6l^""], bb m# ' DEF//"axTUShli\bfSt(f)|`s-il=1c## ev_c__lsr) \1etFCF$$sa--.awk.STATUShli\bfSt(f)|`s-s//pC`_fail=1c## ev_c__lsrtu-AWKrSTATUSe\$tmp/sa--1.awk _s//pCAWK f03\:ssc_(keop unS) S_is4f#c[keo] =S1t UFS =S"" /"a bbave P=S"g0nARc`gelds[_$E--sq(selyuE`geld, "@"s _fsa---nnf=g0nARELLA=RELLgth(`geld[1])3\:ssc_(i:= 2; i e: erro\$s(ag=v_"HrtutAn"` _*as$ m,\$//; s/s$ m,/> tct awk m,/g"in o&-o)p t# 1 < "$tmp/sa--1.awk _> "$tmp/sa--.awk _ tX`|coasinfd cross"fHEL $dHr\\\\f#cup t ualiAfuln\(machbi-"$& ror: $2" >&2tu-J" "sAsV="$TUdh> bas\&2Irt'oqurf>&v)som&\n" es\1etF>rm tnseu soa;;f(LAh).*), v ${LAh).*}SaldC@LAh).*@Pjstrin\([a-abV="$TUyxsnAh).*in ".",nuSolp EL&/v_ovald(lo\\c__l: rsol -s bs " nens tnseu tlmlwhoa;;ave PyxsV="$TUbeboees i =""_WArctu_u_/^\`sEL& San*i =" ave P ors_mrigv;;ave Pax_bers)s"myselfu>&1sLAh).*$,-Rx.f>&1o.$scIlevpsa-='r6l }[ V="$Tl }[ =l }[ , h*orF//s/^/:/){}\\|]*$/:/){}:\f(LAh).*):/:/g){}:\f{LAh).*}:/:/g){}:@LAh).*@:/:/g){}^:*F//s/:*$// x*or\(=l }[ ). &ege G ' DEF//or6l^=[ =l }[ $// }rc_p-lSTATUShli\bfSt(f)|`s-s/1/pC`_fail=1c## ev_c__lsr 1 do VERSIONesli\bfStFILES" sin>W-ncsX " :FS">"s6nc FILESu r " - ifto {bi-ttagnoac_iibs="rOBJtag i PAR:[FHLC]$i prmodHr, tag;}. Rfc_t#;; to&/bSs"$ibs="rOBJmodHrOBJtag i PAR:[FHL]*:*);; to:L*-t-:C*:*)i ;nguul"=0sr/,fin"" l<mi(seo fulnPn_en_l : rs-sit 1);< te"*)i et is sourcn;< tew b#o(c_p-lmlcHdun '\\2'/$h"lsefn5ro-wam sh"lsefn_cHdunL\\\\\\be*DOS-stoEL,w b#obebas\&2rc-tf1L\\\\\\\\Eory#s`:'.{ o VERSIfo= mlef&5dcP "$Pibs="rc-tf1o.t "$Pself$]*)bp{"au;; ito*)b VERSIfo= LAh).*/ mlef&5ss"$-tf="$LAh).*/ mlef&;; ito :Fi cP "$P ;nguul"=0s1HEL\\\\\\ wa\__f(.o fuln: \`*OBJf'r/caso bcrossc;; tot\\,e2>&1o.n $Pibs="rc-tf1o.'o\'=$i prf :_fc_freeo= mlef&5d-n"` _*amZ"[_$E[_$Euscrs#cs &/bSPARATORladngusobjs " \$nnnn__f(.os " ' mlef'" _f03dpAur0_tib# Let'snuSi s_m<<_ $EP s ` gi xsc_&nnrer;s sedntiSTFLA(i.e.,&1ot to_tib# use.*$hs_s), peopt-sqr$dHrbe*surir"so-- o ff ":u\$sc# /*mt*c`gnahro-)fo"ef&5"a\_ffo"ef&5"a\_ffo_/bPFLAcs \\)g # Neuc__///epecifyW-na k\nas>terf m<<_ dwh>empt>&adpl :acc_freSol: ro_u txFLs="rc-_*$quires"fHEosuscr_alnum]*\&t-:C*\|t-:C*\\* _u :ssn tsoued"no /"fHEosefc_freeo= ml_*$quires"fHEosA ARATORla}libt/.*[g H :|g g H :"$tau tx_le{us _ tsoued"no /"fHEosel_*$quires"fHEosot\\,e2>&1o.y='paFe=' ';\_g i PAR:[us :-:t-:C*:bi-ATUShtmp/st/v_";;tX`utut|coasinfd cross"fHEL $dHr\\\\f#nt_o a "ef&5"a\_fso bcrossc;;pot\\,e2>&1o.n Ir to;spAxn spa ll``&5d-n"` _*\nu}\.lf=\0||'Hmi(OBA.",."mi(seehbi/bor. rop un.e$ ll``_sufxts/\$U\./gopl 1);<:`na---=fc_freeo= mlef&>&5_sufxtsd-n"` _*\nu/[^f=\0>|/..|g;s|/||'Hmi(Fe=' ';\_gopl 1);<:`na--- PAR:["")-ttagopl 1);<:`na---=.-ttagopl 1);< }'ixtsh us=$i aAttagopl 1);< }'ixtsh';\_gopl 1);<:`na---/r to;spAxndr;spAx$[;\_"ls_gopl 1);<:`n=ztpwd' [;\_"ls_ 1);<:`n=ztpwd' lef&>&5_sufxts #k='$ uckwardCfSt=1reel: ty: ;\_gopl 1);<:`nh';\_gopl 1);et i :acc.f03,prnn tsh2'F.f03,prnngopl tsh2'F';\_gopl 1);<:`na---f03,prnn"ls_gopl tsh2'F';\_d' r to;slf=\0>n| ?:lf=\0>n#c(OBAlsefn_cHut ss03,prnn tsh2'F'h).*inlef&>&5_sufxts;f03,prnngopl tsh2'F'R&2 k='03,prnn"ls_gopl tsh2'F'h).*in us=$i a# Rel1revcHut ss03,prnn tsh2'F';\_gopl 1);&5_sufxtsf03,prnngopl tsh2'F';\_gopl 1);&5_sufxtsf"$ibs="rOBJmodH i PAR:L)F_fEC#mi(OBs6nc FILESufEC#mu-J" "spaATUShli\bfSt(f)|`s-s/1/pC`_fail=1c## ev_c__lsralwaotesf"rdutuTFLA1='\\2'/sp r PzA-(ILdataroov_"r,-o . \1e"*, s FIXME:Harmhsobck ifdHrbe*sunseu td p{"ew yearaf k\)\_2.60sc_ordataroov_"r_obck=s5.2>dataroov_"r_seenU=d fued"dataroov=' /dataroov_"r/ /rpsopaq } /@data*@://p /@doc*@://p /@uvqu*@://p /@locale*@://p /@dnqa@://p'/by[`f :ls"oucr_alnumc_lectued"dataroov\" "ef&5"a\f(.os ""o.t 2*dataroov_"r _ tsodataroov_"r_seenU us @data*@:/*|*@doc*@:/*|*@uvqu*@:/*|*@locale*@:/*|*@dnqa@:/ _fECunnnn_ 1eIFS 1elusnl)a;;/#( unnnnBASH_ARGV 1eBASH"ef&5"a\f(.os " P : sgne90_tas_--dataroov_"rempty&s"htdi$EP : r=;_, seti$EP : r;}a;;f"ef&5"a\f(.os " P : sgne90_tas_--dataroov_"rempty&s"htdi2/bP-J" "STATUShli\bfSt(f)|`s-s//pC`_fail=1c## ev_c__lsrtu tsodataroov_"r_obck=OB_SU&@data*@:/&$data*@:&gB_SU&@doc*@:/&$doc*@:&gB_SU&@uvqu*@:/&$uvqu*@:&gB_SU&@locale*@:/&$locale*@:&gB_SU&@dnqa@:/&$dnqa@:&gB_SU& H ${dataroov_"r}&$dataroov_"r&g' uspAx$[-J" "sAsV=Neuc__///ep"$TUbe$hs_ `Ah).*' = `.' # 1e sFlcH i PAr, _save-f.xndm a (Ccsx"rm tns_/^\`sddrun_f_mery#s`: li/^\-g '${?TATUShli\bfSt(f)|`s-s//pC`_fail=1c## ev_c__lsrelectued"W-nnf>ymc_lectued"Ap/sa-(ILX`|coasinfd cross"fHEL $dHr\\\\f#nt_o a "ef&5"a\_fso bcrossc;u>&1sNOss"$axsodataroov_"r_obckaxsodataroov_"r_seenf03stfr{pro_oosef{uiv_c h/ ${dataroov_"r}/p' LAp/saoos"`;VERSIONesliro_oos } ='${tfr{pro_oosef{uiv_c h/ }[ V=dataroov_"r}[ V=:FLA'' LAp/saoos"`;VERSIONzsliro_oos } ='${tfr{pnnn_ 1eIFS 1elusnl)a;;/#( unnnnBASH_ARGV 1eBASH"ef&5"a\ : sefn_e (fu-enctyecross_unses"a;;ya\`dataroov_"r' er;s P : bamZ""[_ ] #Pley[`f e}">sureEP s ` "[_ ] htdi$EP : r=;_, seti$EP : r;}a;;f"ef&5"a\ : sefn_e (fu-enctyecross_unses"a;;ya\`dataroov_"r' er;s P : bamZ""[_ ] #Pley[`f e}">sureEP s ` "[_ ] htdi2/bP ) \1etFtmp/st/v_";;$ibs="rOBJmo&$ues.ib--*i-ATUSLAp/saoos"\irmth1etFtmp/stoos }us=$i ath1etFtmef&5"a\_f$mktvSLAp/saoos"\tmef&5"a\_ to;spAxndX`|coasinfd cross"fHEL $dHr\\\\f#nt_o a "ef&5"a\_fso bcrossc;u; libibe2>&1o.r_v_) ""Jtag _i Hrfacec_o&()0u-J" "STa>&1 -tHn "GHr,$"aunIG_STATUS"tc un ERS$es l ev_c__5Ge0\ssPARasinfd cross"fHEL ev_c__.uureE_STATUS">"s6nc 1/p'`_fso bcrossc;u>lml r,Lognuls ` mdin_lo>&oakexisFs. $,s " nens t2 t*c`gnamZ"foo'R.et*c`gnamZ"foo'xw='\\2sayaown$EP : ls-lreadypnW;/e=\p&oakexisFs. $/\1/pvqutuno a unnonOS-s: li/^\_.uad\$sakexisFs. $&2${n s_kept ops_st,rer, _save-fflso*c`gnamZ"foo'xwwonf>rm_$> "u ohtdiEP: st;2sayst,\(.o IX2${usn_(&/boscardu #c>rm tsr 5 ruFreD: erro\$\Sv ${effls-lvnQ\)clos rsol xisFs. $,sso_c_s _c\#c"propsrQ\)(re)ops_---esaosf pnW;/- o ff.----1/p'`_fairo-* "_modfSt #whbck &oakexisFe-fflw =R"o-- o gf e}">ruFreD:av_.uEP a cef2 "_SEPARATOReno_nt_o a_f03: ebaFL" aaectSHEucUt\\httn#a,"no / or_fairorgs=puvEPARATORlELL/bnf 3: 03st{unea,"no / or_fairorgs=pu, s,"no / _fairorgs=pFquiisA|;$ibsr 5 ue erro\$PAR S $L \_i\bfSt(f)|`s-s/ s,"no / _fairorgs=pF=1c## tSHEucUt\\h"aun ibsr 5 uen >xisFs. {0i(OBUsil=u,\\\f#&&run_fol<<&$_o&( fulabtedhyxsV=&v)soHEL=,RELlunnfdefsi$dHrbe e}"> r,Lognuls__5Gep-lmlmtk='nm as\al : rstrue,"libs ,prectSHEucUt\\coasinfd cr-q # 1eib VERSIONeslirec t &gnized-\_orgs=s>e.un&Id"fp-staFLo -: _s_snf&s"ht03:no ebaFL" a{pnnn_ 1eIFS 1elusnl)a;;/#( unnnnBASH_ARGV 1eBASH t &gnized-\_o -: s;f"ef& t &gnized-\_orgs=sdi$EP : r=;_, seti$EP : r;}a;;f t &gnized-\_o -: s;f"ef& t &gnized-\_orgs=sdi2/bP-lSTlibppmnumerics-r1036/'s_libsc.in001n644001175000117500010011035011616214646015411 0u_far omaromar#CFLA ## dtbo rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx=R"iSl>& : 's_libsc.in #CFLA ## dtbo rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx=R=R"iPurp&2ta : 's_libscrdutuTFLA=R=R"iRemarksa :=R=R"iRe-enctyes :=R=R"iRevie $dot :=RCFLA ## dtbo rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx=R"iPar -liPartinIG Mesh Libe`g&/(PPM)=R"iETH ZurnnfdR"iCH-8092 Zurnnf, S&v)zsrQesaosCFLA ## dtbo rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx=lwamZ sewe$/BSl>&5ninspercht_modfS,Lognuls ` rant tsh2'L=,@h).*@:/ &2 pnL=,@&2 pn@ } -o }'ixtsL=,@} -o }'ixts@ libh2'L=,@libh2'@ [s# -zeh2'L=,@[s# -zeh2'@ 1);<:`nL=,@ 1);<:`n@objs=S"@bjs=@obDFLAG=S"@bDFLAG=@ CFLAG=S"@CFLAG=@ FCbjs=S"@FCbjs=@ FCFLAG=S"@FCFLAG=@ FCS"@FC@ CCS"@CC@ CXXS"@CXX@ DEBUGS"@DEBUG@ MODFLAGS"@axnsesf90odH flag@=lwamZ sewe$/BSl>&5ninspetesaardobjs_M.t*:= libppmnumerics.a TARGET *:= $( 1);<:`n)/lib/$(bjs_M.t)_SHELL*:= \$sc=sh Llya:= cpp=lwamZ sewin sm_EGRE beb1);< bor. ropies SRC_DIR*:= $(h).*):/ OBJ_DIR*:= $( 1);<:`n)/tf "u , MODULES_DIR*:= $( 1);<:`n)/[s# -ze/ppm=lwamZ sewin dunL5needt* i PA# -zeh dowh>et)`gnproUt\\Ap-lLly"$TUbe:= $(SRC_DIR):lLly"$TUbe+= $(MODULES_DIR):lLlyINCLSe:= $(dun---nn %,-I%, $(h--nn :, ,$(Lly"$TUb)))=lwamZ sewin dunL5needt* i PA# -zeh dowh>etcroduc_ o un"$TUbe:= $(dun---nn %,-I%, $(h--nn :, ,$(SRC_DIR))):l"$TUbe+= $(dun---nn %,$(MODFLAG)%, $(h--nn :, ,$(MODULES_DIR))):lINCLSe:= $(h--nn :, ,$("$TUb))=lwamZ sewin unnnns aneedt* i o=1dowh>etcroduc_ o un# enquSe:= $(nov_"re$(w);@ o @$(Lly) -trat -, al-cpp -P $(LlyINCLS) $< >c\(OBJ_DIR)/__$*.f @ep'a'"INCLUDEn"c\(OBJ_DIR)/__$*.f |tX`utut|ca}libt-e 's#^[ \t]*##'tX`utut|ca}}}}}-e '/^!/d'tX`utut|ca}}}}}-e '/oduf.h/d'tX`utut|ca}}}}}-e '/fftw3.f/d'tX`utut|ca}}}}}-e 's#INCLUDEn#$(SRC_DIR)/#'tX`utut|ca}}}}}-e 's#$$# \\#'tX`utut|ca}}}}}-e "s#'##"htd>@ o @:"''BE#s "of_seurcn;< :gnW;/cty&ey.o -.o1 " n.dnnns a'td>@ o @:"''BE'$(OBJ_DIR)/$*.o': \'td>@ o @ep'a'"USEp"c\(OBJ_DIR)/__$*.f |tX`utut|ca}libt-e 's#^[ \t]*##'tX`utut|ca}}}}}-e '/^!/d'tX`utut|ca}}}}}-e 's#,.*##'tX`utut|ca}}}}}-e 's#USEp#$(OBJ_DIR)/#'tX`utut|ca}}}}}-e 's#$$#.o1\\#'t>>@ o @:"''BE#s "of_sedH uaF :gnW;/cty&ey.o -.o1nns 't>>@ o @rmc\(OBJ_DIR)/__$*.f n>HarmhsobndlAG dhyx)`gnproUt\\Ap-1 " n='\\2m sedu_uv_fcroducAp-l$(OBJ_DIR)/%.o: $(SRC_DIR)/%.f $(Lly) -trat -, al-cpp -P $(LlyINCLS) $< >c\(OBJ_DIR)/__$*.f $(FC) $(INCLS) $(bDFLAG=) $(FCFLAG=) $(bjs=) $(DEBUG) -Llibc-c/by,t@c\(OBJ_DIR)/__$*.f @mvc\( 1);<:`n)/*.dH $$(MODULES_DIR)o @rmc\(OBJ_DIR)/__$*.f n>Harmhs=odkeu &oakIG_Sx is senns an_STFLAdht_modn]*-faSH e}" kIG_S: th1etRc\(OBJ_DIR) th1etRc\(MODULES_DIR)o th1etRc\( 1);<:`n)/librlwamZisG_opi\\2m seM.t*libe`g&>tero libh2' sedl-n=:\$\bo @:"''BE[ :gnloye=\p&oa'\(libh2')']'o @cpf"(TARGET)c\(libh2')o @ranlibc\(libh2')/$(bjs_M.t)_ @:"''BE[ :gnloye=\pdH uaFsp&oa'\([s# -zeh2')/ppm']'o @th" rc-p$$([s# -zeh2')/ppmo @cpf"(MODULES_DIR)/*$$([s# -zeh2')/ppmolwamZisG_ooduc"addnqut_opi\\2m seM.t*libe`g& cis:\$\btsedl-n=olwamZisGensuream-n= nW;/ctyyulnPs5ninspup-to-dat =R": r;}a;;fTPFLmi(OBJevcHbes am lv__5GeELL/bnlt],[sbs="rOof&owlfoo'i=IR`deu tlmlwh&/v_ovals:xse# -ze $(DEPENDENCIES) sse# -ze $(DEPENDENCIES) libppmnumerics-r1036/, _save-f.xn001n644001175000117500010011762211616214646015643 0u_far omaromar#CFLA ## dtbo rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx=R"iSl>& : , _save-f.xn #CFLA ## dtbo rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx=R=R"iPurp&2ta : Croduc_ o unR=R"iRemarksa :=R=R"iRe-enctyes :=R=R"iRevie $dot :amZisGaotFCFs ="matdiEtmodby Jubas\iPark 8.17.2009 # Revie dwh>eOmar AwusrmRCFLA ## dtbo rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx=R"iPar -liPartinIG Mesh Libe`g&/(PPM)=R"iETH ZurnnfdR"iCH-8092 Zurnnf, S&v)zsrQesaosCFLA ## dtbo rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx=lwaI# on_///_ o unAC_PREREQ(2.61) m4_paers%n_i$s a([AS_TR_Ss _fnAC_INIT(PPM,.1.9 m)rlwaRecsx"[AS_HELP_STR}a;([--enSl>&-odu[[=sn_(.]]]opf>[&2taMPI ( r/\\2'/),aotesf"rMPI ic_fc_freeo=ssOof&yrcn "''ic\).scror.xiiii_ooduc"rsobjrfas_ edatinf/s\iPATH,ao_>&sometism-c_nu=rnp, iiii_ho&2t: gut\\c(Im lv_ho&2tis senn_l : c_fc_freeo=ssOo_>&soa\__),aops_odu, iiiilamodu, odunf, odunf2,>terflodu_gnuc(Ierfl'srMPI &v)soGNUiiiiCooduc"rs),>terflodu_terflc(Ierfl'srMPI &v)soIerfliCooduc"rs),>sun (Sun MPI),>tbmiiii(IBMIX 6.POE). Elsfflse"u liheolag &v)sono itaAuAnquo1seD$C, CXXSnquoFCow =iiim sedpproprTF- -_ooduc"rrsobjrfas_(safest)])]opf>[PPM_CHECK_MPI([fp-staFita _f03,p#-_ooduc"rs ifdHrbe*suc\&2tAR:[uskeu_odu=yes]opf>[AC_MSG_NOTICE([MPI &a\2'/spenSl>&<. Bpeadh>etnon-par -liF ve T|oof&PPM.])])rl: ${CFLAG=="-O3"}l: ${CXXFLAG=="-O3"}l: ${FCFLAG=="-O3"}lre n_snfsk='$ usic-_ooduc"rrnquoolags AC_PROG_CXX AC_PROG_CPP AC_PROG_MAKE_SET AC_PROG_RANbjs AC_PROG_FC AC_FC_FREEFORM AC_FC_bjsRARY_bDFLAG=re n_snfGarchutOBJe-f AC_CHECK_SIZEOF([\1,uvdoqurf _fnAX_F90_MODULE_FLAG AC_SUBST([axnsesf90odH flag])lre n_snfk='$ Fortran2003"Segtort AC_MSG_CHECK}a;([t_mmZ"e_yrcn "ooduc"rrpropsrQ\)Segtorts Fortran 2003])lAC_NGUA([Fortran])lkeu_f03=no nAC_RUN_IFELSE([`utut|crsv"*am proUtdres"un&I typ\ : sefn_er`utut|ca}}}}terfger,ut|ca}}}}etu\1"rr ::we$/`utut|ca}}}}proUtdres(func peotu\1"r,\\\pa\\c::wf`utut|ca} " neyp\ : sefn_er`utut|c`utut|ca}a-r(sdu_>terf rt`utut|ca}}}}logk:lqufunc oefulunc(_std`utut|ca}}}}}}terfger,uetu\1"rr::we$/`utut|ca}}}} " nfunc oefulunc`utut|ca} " nterf rt`utut|c typ\(: sefn_er)tut|ca}}}}}}::wc`utut|ca}terfger ::we$/`utut|ca}proUtdres(func ::wun&I `utut|ca}c$\btidd(_st,wun&Id`utut|ca}s(S_c%f_c%_std)torepnARELLLLLLLorepn1 res \\_*$efn_eRELLLLLLLoubrout Paxidd(_st,fd`utut|ca}}}terfger,ut|ca}}}}g"* i ::we$/`utut|ca}}}proUtdres(func peo -: lquc::wf`utut|ca}\\_%_tomy>we$/`utut|ca}}}c%f}}}y>wf`utut|ca} " noubrout Paxidd ut|ca} " nrsv"*am proUtdres"un&I logk:lqufunc oefuun&I(_std`utut|ca}terfger,uetu\1"rr::we$/`utut|ca}un&Id= .tru ss03,p}} " nfunc oefuun&I]opf>>>>>>>>>>>>>>[keu_f03=yes]opf>>>>>>>>>>>>>>[keu_f03=no])lselfu>&1sLA{keu_f03[_$Eux ebaFL" a AC_SUBST(CPPFLAG=,["$CPPFLAG= -D__F2003"]) # r=;_, #"[_ ] __F2003"t>>@./src/ppmo"[_ ].h a AC_MSG_RESULT([yes]) nseu r AC_MSG_RESULT([no])lpuv ->unnfrxsLA{keu_odu[_$EEux ebaFL" a AC_MSG_CHECK}a;([if&yrcn MPI isGusaurf _f a AC_NGUA([Fortran])l a AC_NINK_IFELSE([`utut|ccccccccccccccccrsv"*am CFs snx rsv"`utut|ccccccccccccccccse# -ze 'oduf.h'`utut|ccccccccccccccccc$\btMPI_I# o(iertd`utut|ca}}}}}}}}}}}}}} " nrsv"*am CFs snx rsv"]opf>>>>>>>>>>>>>>>>>>>>[r=;_, #"[_ ] __MPI"t>>@./src/ppmo"[_ ].h]opf>>>>>>>>>>>>>>>>>>>>[AC_MSG_ERROR([C\\\\be*1);< M.t*&v)soMPI Segtort li}">ruis])])r a AC_MSG_RESULT([yes]) # a AC_CHECK_bjs([],[MPI_I# o],[ # r=;_, #"[_ ] __MPI"t>>@./src/ppmo"[_ ].h]op# [AC_MSG_ERROR([C\\\\be*1);< M.t*&v)soMPI Segtort li}">ruis])])r a AC_NGUA([C])lpuv e n_snfsk='$ libe`gi ddnqfi1seD)`gproUt\\&s".olags v e Me}">sureEeedIX,re libe`gi ddnr -_ooduc"d*&v)soFortranlAC_NGUA([Fortran])lre n_snfkJ" &2aoduc"rrv " or..u lihe usR ifdHrbe*su<<_ unBSotFCFurs =R"o bel'snuShopsEeedIX,r ` m lvwork s\imost&/v_ei AC_MSG_CHECK}a;([yrcn Fortran 2aoduc"rrv " or])lv " or=none {bi-v " orkp s\ignu:gfortran terfl:Ierflisun:Sun tortQesa:PortQesasc_"$e"$Pr(sfreeo= $v " orkp | cuIde": -f2ARAT,pif&`$FCo-Vag="=sgrep'a')q $r(s`=sut"$apf>>>>>>>v " or=reeo= $v " orkp | cuIde": -f1`;pf>>>>>>>AC_MSG_RESULT([$v " or])lf>>>>>>>=$_my;pf>>>fi; r_v_) ->unnfrxsLA{v " or[_$Euxnone ebaFL" a AC_MSG_RESULT([un r n])lpu; nt_n='nmesR ifdHrbe*suomiEtmd_p-lml"r2aoduc"rris>terfl,lml"ya.scror.eoiuw aownFL $un '\c_fc_freeo=ss ->unnfrxsLA{v " or[_$03:xterfl ebaFL" aAC_CHECK_bjs([m],[sqrt])lpuv AX_F90_MODULE_EXTENSION ->unnfrxx$axnsesf90odH <<_$Euxun r n ebaFL" a AC_MSG_ERROR([un> "u oha\__ff90pdH uaFsp<<_ e T|])lpuv AX_F90_bjsRARY_SETUP(ppm,[],ppmodH uaFLa\__///e.$axnsesf90odH <<_,libppm*,[R:[uskeu ppmodH uaFLa\__///eRAT,pierfger :: uvquRAT,pc$\btppmoa\__///e(uvqu)lf>>])lret*c_snfk='$ fftw3 rnor_fftw=no AC_CHECK_bjs([fftw3],[dfftw"sr/x_te])lAC_SEARCH_bjsS([dfftw"sr/x_te],[fftw3],[rnor_fftw=yes]) ->unnfrxsLA{rnor_fftw[_$Euxnolf=\0ECoin=;_, rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"Coin=;_, Youwin rye=\p&oakeu FFTWo ff.1);< M.t. "Coin=;_, EimZ"e_,re libe`gyris>s# fu( secor(OBJQ\)cooduc"d/iks;&<."Coin=;_, I_s _c\#c"dr nloaunBSat: http://www.fftw.org/dr nloau.html"Coin=;_, rxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"Coi(r-q # )v_c_;;1;lpuvr=;_, #"[_ ] __FFTW"t>>@./src/ppmo"[_ ].h re n_snfkJo o. s`inuxu="-l&< &v)so-enSl>&-`inuxnAC_ARG_ENABLE([`inux],[AS_HELP_STR}a;([--enSl>&-`inux],pf>[_ooduc"r='$ linuxu( r/\\2'/)])]o[r=;_, #"[_ ] __Linux"t>>@./src/ppmo"[_ ].h]) re n_snfkJo o. syees u="-l&< &v)so-enSl>&-yees nAC_ARG_ENABLE([yees ],[AS_HELP_STR}a;([--enSl>&-yees ],pf>[&2tayees u( r/\\2'/)])]o[r=;_, #"[_ ] __ETIME"t>>@./src/ppmo"[_ ].h]) re n_snfkJo o. sv. ropu="-l&< &v)so-enSl>&-v. ropnAC_ARG_ENABLE([v. rop],[AS_HELP_STR}a;([--enSl>&-v. rop],pf>[enSl>& __VECTORu( r/\\2'/)])]o >>[r=;_, #"[_ ] __VECTOR"t>>@./src/ppmo"[_ ].h]) rAC_ARG_ENABLE([oun keisan],[AS_HELP_STR}a;([--enSl>&-oun keisan],pf>[enSl>& __MATHKEISANu( r/\\2'/)])]o >>[r=;_, #"[_ ] __MATHKEISAN"t>>@./src/ppmo"[_ ].h]) rAC_ARG_ENABLE([sxf90],[AS_HELP_STR}a;([--enSl>&-sxf90],pf>[enSl>& __MATHKEISANu( r/\\2'/)])]o >>[r=;_, #"[_ ] __SXF90"t>>@./src/ppmo"[_ ].h]) rAC_ARG_ENABLE([crayfishckrg],[AS_HELP_STR}a;([--enSl>&-crayfishckrg],pf>[enSl>& __CRAYFISHPACKu( r/\\2'/)])]o >>[r=;_, #"[_ ] __CRAYFISHPACK"t>>@./src/ppmo"[_ ].h]) rAC_ARG_ENABLE([hy)`g],[AS_HELP_STR}a;([--enSl>&-hy)`g],pf>[enSl>& __HYPREu( r/\\2'/)])]o >>[r=;_, #"[_ ] __HYPRE"t>>@./src/ppmo"[_ ].h]) rAC_ARG_ENABLE([no-micro rstr],[AS_HELP_STR}a;([--enSl>&-no-micro rstr],pf>[enSl>& __NOMICROINSTRUC1o]-Su( r/\\2'/)])]o >>[r=;_, #"[_ ] __NOMICROINSTRUC1o]-S"t>>@./src/ppmo"[_ ].h]) rdev__ooduc"=no AC_ARG_ENABLE([dev],[AS_HELP_STR}a;([--enSl>&-dev],pf>[enSl>& develop_freSdH i ( r/\\2'/)])]o[dev__ooduc"=yes]) ->unnfrxsLA{dev__ooduc"[_$Eux ebaFL" a ->unnfrxsLA{v " or[_$E3:xterfl ebaFL" a>>>>>>AC_SUBST(DEBUG,["-g -O1 -c_snfketu\1"rs -c_snfkb. vs -tracehbck"])lf>>>rya$innfrxsLA{v " or[_$E3:xgnu ebaFL" a>>>>AC_SUBST(DEBUG,["-g -O0 -fb. vs-c_snfk-fbbcktrace"])lf>>>ryeu r ELAC_SUBST(DEBUG,["-g"])lf>>>puvpuv aAT|__ooduc"=no AC_ARG_ENABLE([deAT|],[AS_HELP_STR}a;([--enSl>&-deAT|],pf>[enSl>& deAT||dH i ( r/\\2'/)])]o[deAT|__ooduc"=yes]) ->unnfrxsLA{deAT|__ooduc"[_$Eux ebaFL" a r=;_, #"[_ ] __DEBUG"t>>@./src/ppmo"[_ ].h a ->unnfrxsLA{v " or[_$E3:xterfl ebaFL" a>>>>>>AC_SUBST(DEBUG,["-O1 -g -deAT||$\bt-c_snfk$\bt-fp-stbck-c_snfk-heap-arrays -fdf 'uv -c_snfketu\1"rs -c_snfkb. vs -tracehbck"])lf>>>rya$innfrxsLA{v " or[_$E3:xgnu ebaFL" a>>>>AC_SUBST(DEBUG,["-O0 -g -fb. vs-c_snfk-fbbcktrace -fdf 'v -fno-aotFv_ oc"])lf>>>ryeu r ELAC_SUBST(DEBUG,["-O1 -g"])lf>>>puvpuv #i1seDsrcede o r/h).*infSEPARATOReh).*$,-Rx."." ebaFL" a>> tsh2'F tsvpuv #i fulnPns 's_libsci AC_s6nc FILESu (['s_libsc])lAC_OUTPUT libppmnumerics-r1036/COPY}a;001n644001175000117500010010451311616214646014404 0u_far omaromar NU AuGENERAL PUBLIC LICENSEpf>>>>>>>>>>>>>>>>>>>> V ve T|o3, 29 Ju ] 2007 pyr6l a (C)s_01007ree SoftwbtinFss. v_ o"*Inc. > Everyv_) \\2r }s#Etmd_hc&py,r1 " n=Solbefn_alverb_ omt_opi\\ _seo ihe ucensc"drcn=' P,"o bechangh>e he\\2'/$h"$s a&<. pf>>>>>>>>>>>>>>>>>>>> Preaml>& pf>TPFLU AuGfulnPl Pub uc Lucensc" a smfe"*)ipy,rlefte ucensc"='$ ftwbtiv_dnqficienzAkivs _seworks. pf>TPFL ucenscses.&otisR itwbtiv_dnqficienzApsdu_k:lquworkswin de90h> rosse}">away&yrcn fe"*dbtedo hiv_dnqfichangtlmlwhoorks. B----1a_a-t, tPFLU AuGfulnPl Pub uc Lucensc" a u\1";/- o ffguara\1"e&yrcn fe"*dbtedo hiv_dnqfichangtl$\btF ve T|s _seanrsv"*am-- gf e}">sureEP sremfn_e fe"* ftwbtiv_d ""J\btstodkeuro-* "*)i ree SoftwbtinFss. v_ o"*In&2tam a U AuGfulnPl Pub uc Lucensc"s.&otisR _sercn ftwbtiv_"HP sbly-i ddnlsoedo = cienzAwork reley[`dX,r ` may&bytstodaothoro-* Youw _c\bly-c_prun_ yrcn rsv"*am*)i oo. pf>"_modwepeciak _seee softwbtiv_,rm tare(fu-enre=\p&oafe"*dbt,\\\f pric\-* Ocn GfulnPl Pub uc Lucenscswin de90h> gf e}">sureEeedIXyrc rnoris sene"*dbtedo =Solbefn_al_opi\\2_seee softwbtiv_ (nqfichargc"='$ sm-c_p-lyrc &vsh),EeedIXyrct &2eivsourcn;< cH i (,"n_c\ i Pt_p-lyrc sddruit,EeedIXyrctn_c\changtlmlwhftwbtiv_ (,"keu piec\\2_seP : rsnew ee sorsv"*am*)i " nendIXyrct r Pyrctn_c\doss_u2tam ro_u pf>Ts_mrotOBJ&yrcn l a (s,rm to-- o gf)`gvfreScienz[a-abV=denye=\pyrc s_u2tal a (s (,"aske=\pyrcedo AGS=-d"e_,re l a (s-wam srotin ,pyrcernor cery#s`:respT|seel: ties_p-lyrce=Solbefn_al_opi\\2_semlwhftwbtiv_,u( sf yrcNFifynu=""::respT|seel: ties_ ff "eciftis sene"*dbte_serienz[u pf>F(seexac_fc,_p-lyrce=Solbefn_al_opi\\2_sesuch anrsv"*amELlummZ"e gv_ os (," ""J fe ,pyrcemu_f pa\\cJ" hc&,re lecipi\ P : esautu ne"*dbtsEeedIXyrct &2eivsd-* Youwmu_f me}">sureEeedIX,rey)i oo,t &2eivs (,"n_c\ i s sourcn;< cH i-* A" nyrcemu_f shr Psm-c_s_u2tam }sssso_,rey r Poiuw al a (s- pf>Developfas_ edat&2tam asU AuGPL_mrotOBJ&yrcn l a (s &v)sotwo teps: (1 ;neurtipy,rl a (Conemlwhftwbtiv_,u " n(2)2_sf"e_yrcX,r ` Lucenscnnuse=\pyrcelegPl r }s# -J" hc&py,ruspSolbefn_aldCO/.&otifynu="" pf>F(seo velopfas'u " naothoro'_mrotOBJo"*Inm asUPL_kIG_rQ\)explfn_eReedIX,rein a no marra\1>mi(tmphmfree softwbtiv_.f>F(sebriedkeuro'u " aothoro'_se}"Inm asUPL_].VEir aneedt*tifyni- oF ve T|s b`f erknBSas changtd,sso_,rdIX,reir&owlfoo'ii lvesbe*amatlbefn_ad$[]_.neous1thoo aothoroOof&oweviousoF ve T|s pf>S&\n" viccswin de90h> gfdenydkeuro acUt\\c sedntn= _rdn]* tifyni- oF ve T|s _semlwhftwbtiv_ sic"T``sm-c,u lthougaulPFLmanufaBJe-fr n_c\dosso-wam mhs=odf v__free/^\`secot=1reerf>&v)som sedite_s mrotOBJo=\pkeuro'une"*dbtedo changtlmlwhftwbtiv_-wam shsy tev_ oc paers%n2_sesuch ab&2) ScF vep is soiv_aOof&owlduct>mi( sedusedunlshoo usffler;s ss&owecisnQ\)mreib he\\2tisR unacUtptSl>&-wam srotin ,pwe rnoride90h> mhsF ve T|oof&m asUPL_ gf)`oheelt dhyx)`du_k:emi(tmphoscnowlduct>-waIsesuch owlfoo'iiaso--a---nntiSTF/^\`se cienzAdbtfn_e,pwe etesaf ":uthoou<<_ u mhs.scro -J" hc&&\&2tadbtfn_eunp{"uJe-foF ve T|s of&m asUPLd\$sao-- - o gf)`otOBJ&s sene"*dbte_sekeuro- pf>F\__/lt],everynrsv"*am ='nm STFLA> --1nntiSly&bytftwbtiv_ pFLA>(s- StFLAG ifdHrbe'/$h"$s a pFLA>(s_ ff "elbect develop_freS " nke>e_s ftwbtiv_ (n o(s_bly-i o gfsmfe"*nrsv"*am CFHrb ms $EP :effls-lvnQ\)proprTefary.f>Ts_mrgvfreS mhInm asUPL_;neur aneedt pFLA>(s_\\\\\be*DOu-- o ff "-d"e_,re rsv"*am non-fe"*. pf>TPFLowecisnam }sssnqut_ont -, smi(,"nvpye=\uspSolbefn_-J" " tifyniceo=ssOfo$s a. pf>>>>>>>>>>>>>>>>>>>> TERMS ANDBs6nDI1o]-S pf>0.>Defin -, s. pf>"Tr ` Lucensc"(fu-ens_ ffF ve T|o3oof&m asU AuGfulnPl Pub uc Lucensc. pf>"pyr6l a ("dnlsoemeansipy,rl a (-li}">laws_ edatily-c_toicienzAkivs _s oorks,esuch a" mi_ontu ropusk 0s. pf>"Tre Prv"*am"(fu-ens_ ff= py,rl a (Sl>& work ucenscdmZ""[tmphmf Lucensc. Ehbi/ ucenscc" a sddr asnBSas "yrc". "Lucensces" " "lecipi\ P "h> babe sedusedunlshopuorgan//_ o u_u pf>Ts_"tifynu" work meansihc&py,r1-abV= ""Jdapt tn= _rdpartoof&m aswork &add f`ismon_].VEirh>etcr,rl a (Cr }s# -J",icienzA ednulPFLmak "of_sedn exactipy,r-wam shr aulJo=\pwork sspc$\btd p{"tifyni- oF ve T|"oof&m a G_rQinzAwork ""J work "by[`dXT|"olPFLG_rQinzAworku pf>AL $dF v&< &ork" meansieimZ"e_,re untifyni- oPrv"*am ""J work by[`d onemlwhPrv"*amu pf>Ts_"propago a_f work meansihc&dff= m ro>&v)solt dhat,E&v)sout p }s# -J",i$dHrbe e}">yrce=S(OBJQ\)oremp_ontasolave Sl>& ='$ infrh>ec_freSZ""[tmbly-icSl>& cr,rl a (Claw,-o Utpt sr/x_th>e heJ" cot=u1"r .&otifynuAp-1 r" vF- -_o,r-waPropago mon_se# -zey"nvpye=\u pSolbefn_-J" (&v)soopu=v)sout tifyniceo=ss),Emak "ofav_.uEP a hc&,re pub uc us-t>&adm&\n"CFHrin\([acienzAdu_kv ties_"matellu pf>Ts_"nveniu" work meansi= kivOof&owlpago mon_ edatenSl>&[acienz parties_ ff e}">_rdn&2eivso_opi\\&"G'eib \1"rac oefu&v)soarigh{}m Souga aacot=u1"rao-twork, &v)sono transf"e__seanpy,rus\\2'/$hnveniuA'ibspf>An \1"rac ov"righ{}terf rtkpSoplfys "ApproprTF- -LegPl No_k:es" hc&,re <<_ t dhateP : r# -zey"a"nvenienceeS " nprom#( JQ\)ro -l>& \-g '${ dhate(1 pSoplfys _c\blyroprTF- -_o,rl a (Cno_k:e,u " n(2) te t*tl"righ{}eedIX,rein a no marra\1>mi(tmph& work (o Utpt hc&,re <<_ t dhatemarra\1i ddnr -.scror.d),EeedIX ucensccsh> basveniu&,re work Z""[tmphmf Lucensc,u " nhr PsffFieweanpy,r _seo iheLucensc. If dhyxserf rtkmrigv>(s_be usR _sekeur$mmddavs _r_o -: s,esuch a" a _fru, anrsvm#( J_fooPp is so usR meeP : eisG_Sfoor"libspf>1.>S&cn;< CH i- pf>TPFL"urcn;< cH i"" ""J work meansihPFLowe-enrsGSouo>mof&m aswork s.&otak "oftifyniceo=ss\c st. "Of "u cH i""meansi= non-urcn;< ouo>mof&aAworku pf>AL StesaardoIerf rt""meansi= xserf rtk edateimZ"e_isi= x_sfifyW- etesaard "[_ ] &byt (fugnized-\_etesaards bodunnor,p is sos="rOof serf rtshfcifyni- o ""J particulan rsv"*amt #wlanguag_,u(ntk eda ` m dnQ\)u-- oam1,uvdevelopfas_workh>et ieedIX anguag_- pf>TPFL"Sy tev Libe`gies" _sedn sr/x_tSl>& work se# -ze = m ro,icienz ednulPFLwork de (oa;;a,EeedIX(a)" a u\# -zeh is sonuo>lqufuo>mof ckrgagAp-1 rMaj(li\ot=on' P,"o beer;s ss&'/$hpartoof&m dIXMaj(l \ot=on' P," " n(b) gv;;a\cJ"-c_toienSl>& ke>e_sulPFLwork &v)som da Maj(li\ot=on' P,"s : LO\c_fc_fre1 rStesaardoIerf rto ""er;s dn c_fc_freeo=ssOisi=v_.uEP a hc&,re pub uc>&adm&cn;< cH i fuo>-* A "Maj(li\ot=on' P",p is isG_oerfxP,"meansi=otaj(li asniSTF/acot=on' P (ks%nfl,lwivr Psy tev," " nsoess) _semlwhfcifynicaopsrATUS">sy tev _p-l= )eJ" er;s ,re <& work n]*s, ""J 2aoduc"rru-- o fnowlductlmlwhoork, ""Jn_of "u lcH i PArf m<<_ rOu-- o ff un="" pf>TPFL"Cor(OspT|dh>etS&cn;<"" ""J work in_of "u lcH i fuo>mmeansi=ll s sourcn;< cH iao-- - o gfo& work)f un=t \_of "u cH ia " neootifynu=mlwhoork, u\# -zUS">s_Sfp(s_ f --1a_olis &2tadu_kv ties-* However,eP :='\\2'/spse# -ze mlwhoork's Sy tev Libe`gies, ""oe=\p&\&2tadu_kv ties_o b er;s drDO'/$hpartoof&m whoork.f>F(seexac_fc,_Cor(OspT|dh>etS&cn;< r# -zey"terf rtkpefin -, ulnPs5nissociFLAdhtv)som&cn;< lnPs5n='$ sm-hoork, " nensdm&cn;< cH i fuo hiv_d libe`gi ddnqfidynamk:lqly iks;& gf].VEir , such a" b&>terimFLA1=ata$mmdduniceo=ssO(,"nv1a_olifs a b-twee is &2t ---rsv"*am*"nqficienzAparts of&m whoork. pf>TPFLCor(OspT|dh>etS&cn; edat&2trs n_c\reoe S&cn;<. pf>TPFLCor(OspT|dh>etS&cn; ='nm da utu hoork. pf>2. Busic-P }s# -J"_u pf>An= l a (s gra\1"d Z""[tmphmf Lucensc drDOgra\1"d i(tmph& m }smof py,rl a (ConemlwhPsv"*amEL " nain r(OvocSl>& .scror.dnensdmtFLAd _ont -, smain met-wam mhsLucensc explifyJQ\)asfi}sssyrcn unlimiLAd r }s# -J" hc& un=t \_untifyni- oPrv"*am-wam sh\(.o IX-abV=n]*-faSH coF v&< &ork sspcoF v&< bymphmf Lucensc J"-c_p-lml"r\(.o I, gov"n2says_oerf P,"--1nnitutey"a"nvF v&< &ork-wam mhsLucensc krgnowbtdgessyrcn l a (s (fv__5,"keu _r_oienzA.VEival' P," s .scror.dnby cr,rl a (Clawu pf>Youwm bame}"In un= " npropago a"nvF v&< &orksEeedIXyrctdff\\f sveniu,E&v)soutt_ont -, smsoe\1,uvassyrcn ucensc"oienzwisnaremfn_e &adi(tc\-* Youwm basveniu&nvF v&< &orksEeoScienz[a-(tmph& a;;f(purp&2t of&hav ro> e-c_ne}">tifyniceo=ss\co UluslvnQ\)-(tmyrc, "".scror.eyrc sv)so rl: ties_f_rdn]*ne=\p&\&2taoorks,e.scror.dnendIXyrctnon_(&/sv)s ph& m }ss _seo iheLucensc PAr, _niuA'i tn= mFLArilqufuo"er;s yrctdf \\\\Eory_olicr,rl a (-wam &2taeeusLmak "of_rdn]*ne=\p&\a"nvF v&< &orks -(tmyrcemu_f dossoco UluslvnQ\)J" yrcn behanp, Z""[tmyrcn : ls-lre nqut_ony_olnnonOm }ss eedatp`oheelt dhymX-abV=mak "ofa py,i\\2_s yrcn "o,rl a (ed mFLArilquoutsor.eoiuw arec_ o ushiphtv)soyrcu pf>C _niuA'i Z""[tmb cienzAcircumetesrtsh\\2r }s#Etmd_a;;fQ\)u""[t &\a"nvnt -, smstA-Run.es a #cub uc e nge\\2'/$h"$s a&<;emp_o=ssO10 ms $\2sa)u"nec\\sary. pf>3.oPrvtOBJo=\pUeuro'uLegPl R a (s FabV=Aeri-Circumvfre=ssOLawu pf>No"nvF v&< &ork hin= #c"dec_fdhpartoof&Jn_& law fullnP: rsoob ugeo=ss\cZ""[tmbrtinIG 11 of&m whWIPO cr,rl a (CtSTFL bdo `dXT| 20 Dec\ers) 1996, " similan laws_p`oheelt "of_rdn"elbecth>etcircumvfre=ssO_sesuch _fasures. pf>"_modyrctnoeniu&a"nvF v&< &ork,pyrcewaiSan*iyelegPl r a& : LOaorbid _ircumvfre=ssO_sem chnologk:lq _fasures hc&,re <<_ t such _ircumvfre=ss ` 4.>C _niuA'i Verb_ omtCopi\\& pf>Youwm banoeniu&verb_ omt_opi\\O_sulPFLPrv"*amnuSi&cn;< cH i assyrc n&2eivsoit,E&addiye_fdium,e.scror.dnendIXyrctnonspicuous1th " alyroprTF- Q\)pub ushXT| ehbi/py,r1 "\blyroprTF- -_o,rl a (Cno_k:e; keep s\tactia lvesbiccswstA- ro> edatphmf Lucensc d" nany non-p }s# -vnam }sssndzeh iaccordhtv)somp_o=ssO7tily-c_toi&\a"nvde; keep s\tactia lvesbiccsw_sulPFLabsctyecof&Jny marra\1>; d" ngiSan*ll lecipi\ P :anpy,r _seo iheLucenscn*loro>&v)somlwhPrv"*amu pf>Youwm banhargc"Jny pric\ (tmno pric\ i(seehbi/py,r endIXyrctnonniu, " nyrcem ba_sf"e_Segtort opu="rra\1>mmrotOBJo"*" ""J fe u pf>5.>C _niuA'i Mifyni- oS&cn;Youwm banoeniu&J work by[`dConemlwhPsv"*amEL(tmph& tifyniceo=ss\c nowlductlitulabtedhyxPsv"*amEL is soouo>mof&i&cn;< cH i Z""[tmphe m }ss _semp_o=ssO4,e.scror.dnendIXyrctnlsoemeetm-n= _seo \sa"nvnt -, s: pf>>>a)am shwork must&/vrrynrsvm#( J_esbiccswstA- ro> edatyrcNFifyni- a -P," " nnuse=\pa relevddrudat . pf>>>b)am shwork must&/vrrynrsvm#( J_esbiccswstA- ro> edat he\\pf>>>reley[`dXZ""[tmphmf Lucensc d" nany"nvnt -, smndzeh Z""[tmmp_o=sspf>>>7-wam mhs].VEir _freSdH yni-sihPFL].VEir _freSin_mp_o=ssO4ow =iii "keep s\tactia lvesbiccs". pf>>>c) Youwmu_f ucensc",re >>Lucensc ff= (ntkoa;tnoney"tero possese T|oof&aipy,r-wam mf f>>>Lucensc lvt srotin tily-c,n*loro>&v)sob bly-icSl>& mp_o=ssO7pf>>>adt -, alam }ss,_toi&\a"oa;;aO_sulPFLworkEL " na\btstodparts,pf>>>regardlAGs _sehr Psm-ywin durgagsd-* m mhsLucensc gus*amn =iii r }s# -J" hc& ucensc",re work in_= cienzAway,"o be :='\\2'/sRAT,pievalidat esuch o }s# -J" p-lyrcernorisepar - Q\) &2eivsd="" pf> d)aotesf"rwork has \1"rac ov"righ{}terf rts,_ehbi/mu_f dSoplfy" a ApproprTF- -LegPl No_k:es;ehr ever,ePsulPFLPrv"*am has \1"rac ov"RAT,pierf rtsheedatdo2'/$hdSoplfy ApproprTF- -LegPl No_k:es,myrcnRAT,pwork o-- o'/sp e}">ruFm\dosso- pf>ALcroduc_ o uoof&aipyF v&< &ork &v)sooienzAsepar - us-t>&a nW;/ctt oorks,eer;s drDO'/$hbymphuw ang '${ <<_ e T|sw_sulPFLnvF v&< &orkE " ner;s drDO'/$hcrob ] &&v)solt such a" LOaorm_be argcn rsv"*am, &ad_r_oadd volumecof&JLorerags -Joolbefn_-J" _fdium,esspc$\btd pn "aggrega a_fp-lml"r2aoduca_-J" " tstodr aulJo=\p_o,rl a (CdrDO'/$ u-- o fflimiLalPFLacUt\\c'$ legPl l a (s o-lml"r2aoduca_-J"'odkeuro be (n nerdIX,re sedusedunl &orksEr }s#E. InUlusl uoof&aipyF v&< &ork &addaddggrega a:='\\2'/spca&2tam mhsLucensc ff=ly-c_toi&\a"cienz partsw_sulPFLaggrega a- pf>6.>C _niuA'i Non-S&cn;Youwm banoeniu&J coF v&< &ork sn_of "u lcH i fuo>mZ""[tmpheam }ss _semp_o=sssO4o " t5,e.scror.dnendIXyrctnlsoesveniu&,re mhbi ]- ":uSl>& Cor(OspT|dh>etS&cn;>>a)aCveniu&,re_of "u lcH i PAEL(tm\erH yeh , anrhysk:lq owlductpf>>>(u\# -zUS">anrhysk:lq Joolbefn_-J" _fdium),iaccompani&< bymph"RAT,pCor(OspT|dh>etS&cn;& .hysk:lq _fdiumpf>>>cu_fomariQ\)u-- ofuo twbtiv_ sim }changt. pf>>>b)aCveniu&,re_of "u lcH i PAEL(tm\erH yeh , anrhysk:lq owlductpf>>>(u\# -zUS">anrhysk:lq Joolbefn_-J" _fdium),iaccompani&< bymaRAT,pwdiEtmod_sf"e, valid" ""Jbel'asIX,re"*nyearaf " tvalid" ""Jf f>>>\1,uvassyrca_sf"e_Spin dur(s (,"cu_fom"e_Segtort -(tmphdatp`oductpf>>>dH il,_toigiSan*iy(ntkoa;tpossese-sihPFLof "u lcH i eimZ"e_(1 ;pf>>>cy,r _seo FLCor(OspT|dh>etS&cn; edat spcoF v&< bymphmf Lucensc,Conea1dowSl>& .hysk:lqpf>>>dfdium>cu_fomariQ\)u-- ofuo twbtiv_ sim }changt,o ""J pric\ n =iii me90_taa" yrcn ":sonSl>& crsR _se.hysk:lqQ\)pf uo>e=\p&\mf f>>>, _niuA'i of&i&cn;etS&cn;>>c) Cveniu&sedusedunl _opi\\O_sulPFLof "u lcH i &v)soarcy,r _seo FRAT,pwdiEtmod_sf"eo gf)`oror.eoiupCor(OspT|dh>etS&cn;<-wam mf f>>>alrs%na ov"rish"$s a&< J"-c_occas-, al1th " nonmmdd/rci_/lt], " f>>>J"-c_p-lyrct &2eivsdulPFLof "u lcH i &v)sosuch aod_sf"e, iaccordRAT,pwv)sosubmp_o=ssO6b pf> d)aCveniu&,re_of "u lcH i bba_sf"eUS">acUt\\c abteaade90h>FLAd AT,ppl rtk(gv_ os (," ""J nhargc)EL " n_sf"eo.VEival' P2acUt\\c en"RAT,pCor(OspT|dh>etS&cn;>>purienzAchargc.f>Youwo-- o'/sp].VEir lecipi\ P : py,r en"RAT,pCor(OspT|dh>etS&cn;&v)somlwhof "u lcH i-waIse,re pl rtkw =iii py,r en"_of "u lcH i Pseaao-twork gv;;a",eoiupCor(OspT|dh>etS&cn;<=iii m babe onea1dif-enctt gv;;a""(opsrAT&< bymyrca_""J phmrdhparty)lf>>> edatSegtorts .VEival' P2nvpye=\o rl: ties,e.scror.dnyrcem ery#s`=iii pIG_r : ls-lresao-xt_toi&\a"cf "u lcH i saye=\omreib LOa\__fdhyRAT,pCor(OspT|dh>etS&cn;<. RegardlAGs _seerdIXgv;;a""hrsRsfdhyRAT,pCor(OspT|dh>etS&cn;<,lyrct &m eroob ugeo- o ffensure> edat he\\pf>>>=v_.uEP a f ""Jf>\1,uvasso-- - o gfs_ osnu=mlwsFL].VEir _fres pf> e)aCveniu&,re_of "u lcH i ue ngepeer-to-peer transs# -J",i.scror.dpf> yrctuvqurV= ienzApefas_wreib \_of "u cH ia " nCor(OspT|dh>e f> S&cn;Jbenolf>>>nhargc"Z""[tmmubmp_o=ssO6d- pf>ALsepar l>& .ort=ssO_sulPFLof "u cH i,eer&2tai&cn;< cH i i\co Ulur.dplabtedhyxCor(OspT|dh>etS&cn;AL UeurLPrvduct" i\coimZ"e_(1 ;_"nvesumerpp`oduct",eer;s meansi= tanghl>& .fas, alapropsrtyeer;s ss&'/o>lqQ\)u-- ofuo .fas, al,o amiQ\, (,"hou--a;;d(purp&2tsEL(tm(2)2a m ro>de90h> uo tldmi( secor.oreo=ss -n gfsmdtellA'ib In>dem }sine=\omremZ"e_app`oduct>iy"a"nvesumerpp`oduct, doqutful&/v_ei hin= #c"(Osolved PArfavorSotFCF;a"ag_.f>F(seJ particulannowlductt &2eivsdubyt (particulan keur, "'/o>lqQ\)u-- "(fu-ens_ ff= typk:lq or$mmddssOke>e_sulPJbeclassOof&owlduct,>regardlAGs _seensdmtFLus of&m asparticulan keur orSotFlPFLwa\`se er;s ,re particulan keur du_uv_Q\)u--sEL(tmexp"u ,por i\co pls-.dn&oakeu,eoiupowlduct-* Atp`oductpiy"a"nvesumerpp`oduct>regardlAGs _semremZ"e_oiupowlduct has ---nntiSTF/ mmdd/rci_/, duolbelq or$non-nvesumerpu--sELunlAGs such u--s `gprigv>( &\a"J"-c_90h>ynicereSdH i _sekeuSotFlPFLowlduct- pf>"Iedntn=eo=ssOovqurVeo=ss"" ""J UeurLPrvduct"meansi= memZods, proUtdres*)i othor//_ o u keysEL(tm ienzAivqurVeo=ssL].VEir dc sedntn= " nsr/x_te*tifyni- oF ve T|s of&aipyF v&< &ork ieedIXUeurLPrvduct"labt a*tifyni- oF ve T|2_seP spCor(OspT|dh>etS&cn;<-wam eAivqurVeo=ssLmu_f susfifeo ffensure> edat&\a"nvntinue nfunc oefA'i of&ph& tifyni uf "u cH i i\c rsnoos="rOmrgvfre uo ierf v&< &v)som&;fQ\)beca&2t tifyniceo=ssOhas bee ima i- pf>Ifdyrctnoeniu&anLof "u lcH i &orkXZ""[tmphmf mp_o=ssOPAEL(tm&v)s, " scifynicAl-c_f(,"keu , anUeurLPrvduct, " nensd, _niuA'i ocF vepJf partoof&J transa_o=ssOPA er;s ,re l a (Cof possese T|o " nke>e_sfdhyRUeurLPrvduct"='nmransf"ev&< toi&\a"lecipi\ Po i f petuity (," ""J ix`dCm }sm(regardlAGs _sehr Psm- transa_o=ssOPs>nhara_o"eUz.d),Eeeea` set> edat he\\pf>lcH i &oigh{}be Joolbefn_-J _fdiu uSotFlPFLowlduct- pf>"Ie_dnqu lvesbiEir _freSdH &ork &adca&2tede nf>AL UeOhasnonologk(opsrAT&< biEiLLLLL s\tact.VEiyzAivqurVeo=se nfunc oefA'i edIXyrcCor(Osese T|o " nke"Ie_kv ties-* Howevera Eir _freSdH o Ffeo ffen o FRAT,pwdiin dur(. RroprTem ba_sfXZ""[up :=*ne=\p|s pf>u_f s)beca&2t t nfunc oer qurVeo=&/v _fdiu ='nmransf,ecipi\ r(Osese T|o " nkepartoof&Ji s)beca&2t t nfunc oer qurVeo=&/.dn& " n_sf"ea en"_of (OspT|dden_-J"x is`dConemlwhPsv"*a a*telf\\2_s yrcdnendIXydvduceam mhs du_us sucyeu\1";t-Jvntinu en"_of v " iol\(OBJECTSrun> ndIXe_Seoc ""f"(fu-en b&>terimFacrossntinu en"_ofarec_ onhara_o"eUz.d),Eeeea` set> keu uSotFlPFLowlduct- pf>"Ie_to-peer am }s# -vnam }ss\\pf>lcH i &oigh{}be = _rdp- pf>iv_ simphff v&<2tepi\\ _s-J"pi\\2 srotinm lv_ho&2tis s dn c_fc_freeo=ssOisi=v_. tS&cn;& mp_Te _niuA'i"AicSl>& mp_sRAT,pievaBSasrels-lre nqut_in li\ot=ospT|dh>etS&cn;e reabt a*timphmf Luce. AicSl>& mp_sRAT,pievaB xiiii_oodily-c,n*lor chnologYouwmuk:es;ehroduct a& of&m bi/ ucwbtiv_ sicghl>_rdn&(oa;;a,EeedI> edat spcoF chnologk:lq asUPL_kIG>regarl'asIXSl>& ='$ infrh>ec.screo=ssaicSl>& mp_sRAT,pievaB ca&2taon' P," ies_o b er;s nowlduct<&$mlwhrt (OspT|drtyee }s# -J" dat he\\_sulsRAT,pievaB work nologYouwmuk:es;ehr"*am-- ggfyni_sfify /rcie ngel a (s Zrctd (," F chnoloaicSl>& mp_sRAT,pievaBre=ssO_sesuch _fasures. pLof "us. pf>"_modyrctnoeni(Ospa&2tam aR _sek [sbs="rin tiicSl>& mp_sRAT,pievaB cn;< cHat &v)soncipii bbamu pes_o b sedu(AicSl>& mp_sRAT,pievaB (OspT|dv)soarcyfcifynicAlorks,eel,lm[sbs=al],o--am srotmerpp`w_sesuch \_of "u cH ia.)'i Non-S&chof " iicSl>& mp_sRAT,pievaB &oi2_s yrc,nsc d" nctt gvdmi( '${ <<_ e T|s _niuA'i tn= much odIX,rey)`oduc ushXT| ehbi/py,r1 "\sRAT,pievaAeri-Cit(s Z_ ] p`oheelts.&otisR":uthoou&cn;etS&cn;et, &ad_ne _DvF v&< dtellm ba_sf"&-`inm " sim(OBJ.VEiyz&cn;<=iiireoF(seo typk:lqupCor(O_s yrcney[tmphmf f>>>Luasursowldu\2_s yrc (th>e hePL_].VEir ane s- ro> e) (s Z"changtUt\\Apmrgvm\1ecisnATUmnct.VEiyzAivdiu ='nmransf,ef]F- -LeanyUmnct.VEiyzAUPL_kIGctnlsongtUt\\Apmrgvm\1ecisn -J",i$d opcoF myrca_"opcomn =iiad$[f>F(seo f>2. Busis.&otitphmf Lucensc d-icSl>& mp_o=ssOureEeed T|s <<_ "Lutu hp n laws_p`vaBSa(s ZpCor(Oss"" uo>e=\p&e nge\\2'o>&v)somlwk:es;ehrPrv"*amnuSi&cnd> edaonologkies_o b i.o I, LLLLL ainvde; vrrynrsvm#( J_esbicgfyni_sfify lecipi\ P :anpy,r _seo apetuitv_ simpha Lutu hp n laws_p`va|noeni(Osp[sbs="rOoPL_keb uc>=ssarb_ omt_opi\\ _s I, LLLLL a Lutu hp n laws_p`vawork X,re sbiEi, smstA-RuLA1=atushiphtv)soyr;lcH i &tnoen os (,of "ctlitulab a -P,"lnPs5nissoci,, &ad\__fINCCof poss-icSl>& mp_o=ssOusipy,rl a (-li_"opcossoci,,=\p|snvde; vhargcynrsv \a"cf "u lcH i sadily-c,n*lor e _niuA'iAicSl>& mp_o=ssO7pf Lucensc dotitphmf Lucensc , (OspT|d)u""[t t ""J "meansi= }s# -J" pv)soarcylat spcoF rd)u""[t asharra\1ecis; s\tacts="r- - o gfs_ o,rl a (f>AL Uew\-iuA'i8._Te _inf>"Ie_uA'i Non-S&ckv tiouwm bame&py,ruspSo( '${ <<_ e Tuarra\1>asharsELus" _semp_o=dat he\\pf>>>reley_c\ spa&__fptoe\1,uvassyo FRATwm bame&p ,ruspSolbimphaeedv_ os ,r-wat&2trs n_c\reote _inf>e2tam asU AuGPsh\\2r }ecipi\ P :anrhysk:lq owogkie:lq _ivs _sew -J"_u pf>An= lek(opsrnsd,a -phe=\p&e nge\\21)whCorHrTF- -LegPluch _ ro>btedo iol\(hoou&cn;ett_ont -, smsf&m dIXMajf LuanvcHbes affdiu i/py,r1 " , aledaLmi(e nminvdefctt gv;ffdiu iol\(hooum STFmern =iii me90s"" enrem da M60 d\-g 'ftAn= lek_o=ss>"Ie_uA'iM reo- -Le_ont -, smsoei bba_FlPFLwa\`sei/py,r1 "\, aled sb EiqurVes-J"f LuanvcHbe affdiu i/py,r1 "\, aled nvdefiestt gv;ffdiu iol\(hooum STFmern =iii me90s"" ,n;&e l a (s-nuSi&cnd>nvde; v;ff iol\(hoou&cn;"Ie f"rMPI iffls-.dnby <e2diu ivs _sewssOPn_ edatf>>>uch onuSi&cnd>>c) Cven iffls-.dcn;< &\a"sh\\2r }ecipi\ P :.eo=ssOha iffls-.duch oa&2t te _inf>ed a&< J"t"f LuanvcHbe EiqurVes-J,o a"nvF v&< q\\Aof "uoenz partinewkivs _seworksis soutu \2_s yrc nany"nvnt -,\2'ohCor9.n& " p""[tmelfy_R aswoyeer;s Hmph& a4.>C _niuA'i VeF v&< &oL(tm ienzAivQ\)mren;>b)am meansi= ksEr }s#E. InUlusct, ork & uo iapowlduct(tma lvesbiveniu&,re_of "u lcH i ue ngepee o Fnz parti lcH i dnlsvassykv ties-*fynicAloa " p""[tm1a_olis &2tAril(purpcr,rl a (Cr }sm-ywin dur -J"stt gvsLucensc gus*aRATwm bame&p ,ruspSo""[tmprf P,"--1nnituteni- o "[s T|ontaso i/py,r1 "\enz[u pfLArilqQ\)mren;A&2trs n_""[tmphuo>e=\pDowa;([eehrRYouwo-- o- o'/mZ""[nSl>&e l _fasures. pf>"_modyrctnuct"='nmransf"t&2trs n_c\re-nuSi&cnssarb_ omt_ocn;< cH iZodginadomn =iiad$,n unlim,y,ruspSo(dIXe_Swm bame(o UtpyrctnsufA'i e-li_"tZ""[tmphehe\i VeF v&< &oL( sf yrl"rrv "PFLwork drks,e.i"[tmubgk(opsrAT&< edatf }ss\\pf> asU AuGfulnAn "gYouiyzAegardlAGs "impha regardlAGs _sfdhyRUeuk drksuo"er;cienzA> babe sedusoF rd)esuch owlfoo'wun&Isse=ly-c_hmfoF rd)esrgc. lq owoA> babe sedusoF rdmerg" cobabe sedusedeo=ss)am meansi= ksEr }s#E. i ddnls2aodcH i bban gYouiyzAegardlAGs ac ov"rT&< bit`f erk regardlAGs _f>>>nuSi&cnssarcH i eimZ"e_h>e f>5,e.nuSi&cnss&cn;s &2 ivs _sewf>>>adt pf>u_otFlPFy'edunldp_o=s r,pCosnoos haduLA1=a o g)`odupf>An= lekneous1thosd,a -ph7pflussarIG 11 off= (ntkoa;tnonssOPs>nhara_o"eUz.d),EeeeeimZ"e_h>e fcn;< cH iunldp_o=s r,pCosnoos s af cH iunldp_o=s r, evertrct &2eivsourcn(s Z""[=iii me90ef {bis_uA'i Non-S&ckv t opco""[tLutu hp n laws_p`vasrcCor(Osfre=ss (Cof possc-P }s# -J"_u -zA-hsLuc_o=dat he\\pf>>>reley_c\/$hpartoof&m oeni(Os kv t opco"rb_ omt_ocmZ"eroyalsfXZ""[ou hpl rtkJb"Jny pre=ss (Cofsc-P }s# -J"_u sh> basveniu&,re work Z"yNon-S&ckv t xxxxxtcomntl>& law nrhysk:lq owlcross- v&< &LA1=a Q\)u-v&< &= _rders)u e) eo=&grsvm#( wogkie:lq _-v&< &=s T|ontasodv _fdatp`o,iveniuiii(cor.o,niu&,re_ofe"*)iall_opi\\mssO6dsimcH ieimZ"e_,re uogkisO6d- pf>Arisepar11. P1nntiSlyT|"olPFLnwlfoo'or"ne=\omrepy,r1 "\, aled f>>>amemZods&(s o-tv)soyr;sy tev Po- pf>F\__Youwmhe\\2t pf>u_us= py,rl -Joolbefn_usfifeo lfoo'or'edPFLnwlfoo'or sspc$\bt- o'/sp eo lfoo'or'edPoerfxP,"meie:lq _-v&< BSasrelpierfe:lq _-v&< B owaedFLA1=ata$mm=&/v _fdiu eo lfoo'or,llA'ib InlenzAdbactm ienz"*)2tis'ftAn=actm ien,e(o Utpy)lpu; T|ontasodv _fTFmeruannn&I(_enzAcirc oduct> edat spcoF ffdatp`o,iveniuii)i . bly-a*timphwlfoo'or sspc$\b, ork vF v&< However-v&< Be(o Utpy)lpu; T|ontasodvon' Pavs duct(tma lvesbiLutu hp hc&limiLaopsrATUssO(mphwlfoo'or sspc$\b_c\/$h o amiQ\,e shct> e;< r# -ze,dPFLnwlol" hc&,re << transa_o=datpba_sInm asUd)esivs _sew= _rduannn&eed T|s asUdspT|dh>et- - o gfs_ o,]_asUpf> asU AuGfulnEric\ (hwlfoo'or r -J"stt gvaitphmks -(tmyrat,Erldlang"eroyalsf-puoAn= lek eo lfoo'or'edoerfxP,"meie:lq _-v&< B,n u l a (Cu ,po. ,niu&,rfdium>all_o\mssO6wee is &2tvassyrim,y,ruspSo(dIXe_Swm bame(oek eo s_ o,]_-a*timphwlfoo'or sspc$\bniceo=itulabtef f>dsimcHpFLA>d,a -phi,, &"-e:lq _ivs _s"ne=\onyharsELus a e_fINCCo(fu-enit _seoprTF- -ddeno_inf>ed,ies-*to"PFLworeba_Fl:lq a($mmddavsnharsELusvsLucensc gus*aRAUPL_ gfa_Fl:lq Co(fu-venaork muguarauuGfulnsl:lq Cp_ontasolave)ffls-l"r -J""ce=Solbefe:lq _ivs _suf"ea T&< biTs_"propact &2eiPFLof a e_fINCCo(fu-enit _sies-*to"PFLworebas-e:lq _ (meansi_sueT&< bniceo=ssOhas bee ima. pf>"_modyrctn&orktas" p-llJ" cnlbefe:lq _ivs _s|sw_sucH i i\co Ulur.dplabtedhyeimZ"e_h>e fn.es a nsure> edat hemphmf pyrcelegPtpFLA #c"hPrv"*amd& Cor(OspT|dh>etS&cn; edpT|dh>etS&cn;AL UeurLPdaddggre i i\co Ulur.dplabtedhyn ulPF nsure> e (,"hou--a ba_geoopaget=u1e2tam telf\eimZ"e_ben< CCof possfe:lq _ivs _suX,rein aFlPFLwa\`serru-- o f(3--a ba_ge,w= _rduannn& ed T|s asUdspT|dh>et- - o gfs_ o,]_edI> edat spcoF ch_e,pwe et --1nnti l[tmpheoopagowa;([eehr>Youwo-- o"oftKorktas" p-llJ" >AL Stese l a (s-tUt\\Ap&ork-wam c&dff=ork orksis sfe:lq _ivs _s| =mak "oo'/spb< r# '${ <<_ e Tu }s#1=a Q\rfXZ""[ric\ n Suwo-- (s o-huw ang '${ <<_ e T }s#1=a Q\rfXZpy)lpuT|ontaso -ne_th>e reaizAselimmp_o=sm asUPLT|s of& =a Q\rf sssO4o " uch onu=iiiyn ulieveregarl'asIniceo=s,zo asuadH o F r,pCo"ooneso_opi\\&"G'eeniulm(regardlAGs _$h a ba_ge _seoc\ i(seehbi co Ulu meanmubgkct"muuk drksuehb"[tmu&c, sh\(.o IX-abV=,styrcNba_samemZodsh& a;;f(pxp"u ,poUlu meanm,y,ruspS LA1=atushG'eev," " nscH i eimZ"e_ pf>"_modyrctnuctnsis sfe:lq _ivs _s_semlNba_s"_m pf> os ,nerdIYouwm banriseparAefe:lq _ivs _suisa"nvF ri_inf>oryspc$\du_kv ties-* However(s ZpCu lcH ctFCF]_-a*timpOsolve, 1996, "sor(Osfre=ss (Cof_opi\\s>& .scror.wm banoenitphmkse=ss (Cof -ne_th>e reabt transa_oB xiiii_oop_o=ssOPAEL(tm -J"_u sh> basveniu&,re w.'i Non-S&ckv t bee ima. pf>"_m pf>enz[u psrelprT&< bit`fof a ba_ge _s _seo apeopsrAT&< biv_ simp litulabbveni"J ix`(u\# -zUS"k & rtipy,rlsh> bauA'i tn= mct &2paymlq aso= lek(opsrAT&< biYouwm banoenigk:lq _f"rMPI i o i fy= #c"(o'/spb bauA'i t lek(opsrAT&< bir -J"s,f>"Tre Pof possfe_ edatf>>>py)lpunz partieusLmak "of_rdn]>cn;< &\a,etS&cF ri_inf>orysfe:lq _ivs _suwork Co"ooneso_opi\\&"G>c) Cveniu&sed'${ <<_ e T a` set> enctt gv(m }sssiscrord_ocn;< cHwbtiv_sisc)- o f(Majfri_k:lqpne=\p|ndk Co"ooneso_opi\\&"Gev," " nsScF vep o(fu-eegPl l ass of& =a LLLLmZ"e_ pf>"_modyrctnor$non-t gvenoos dsc ffxiiii_oba_ge _se (,"cu_foe:lq _ivs _su_snf -J"_u,unrem da M28 Mari t 200Aeri-Cithiam1,uvdetZ""[tmpheooduct, doI, goru[t asharrsk:lq o&-`inm " si wogk lPL_] -, smsoe"[ou hpl;< s _sewf>>p_ontasolave k:lq i2S L &2tvassybe Jdn c_fc_fre&\a"sh\\2dily-c,n*loroe:lq _iV=Aeri-12.-CirS (s (,"asniuO &2ts'\btstdomniceo=ss& .scror.dnensd opcdmu_f do (lA'ib IEivalu" nyrledfti e_fINCCo( L &2tvass) cHat &vongtdic susfifeoscror.dn&cn;\1,usimultaesbe*amatam aRcSl>& law fullnP:;& law tnuctnsapowlduct(tma lveoeni(Os kv t bee imtisRsO4ow_c\/$hpartoof&m enz[u ps e_wf>>>=ssOusipy,>etS&cn;reScieyrcem=&ssO4eroyalsf(uvqu)utu hpl oo'/spb< cn;< cHwbtieyrf>>moc\ i(seehb er;s nowlduct<&such u-in de91=a o "Jf>\1,ufree cHwbtiefe"*. pf>;ets_ fAu&,roffF ve T|o3oof&m asU AuGfulnCit(s Z_ ] p`oheelts.&otisR":uthoou&cn;etS&cn;& .fas,Z"e_ pf>"_modyrct ork nolorm t&vsh- - o gfs_ o,]_edIens_ fAu&,roffF ve T|o3oof&m asU Au, vnt -,\23o I, cerLa (Cl&2eivso_opi&cn;et,r-wata&2tam mhsL rkE "2tis s n-nves*loro14. Re:ut_moVetn= _rdn]* tpf> asU AuGfulnor(Obtstodkeuro-* "*)i reen-S&ch1th " re:ut_mo" hc&pynewk.VEir ane s-dIens_ f v_ o"*In&2tam a U AuGfn;< cSl>&m mhSl>vnt .fnewk.VEir ane,r-w a& 20 Dec\yni-pirii pIG_r sELunlA sspc$\b,=ork -S&c&cn;<=\ynidiLLLls &2tc. EhfnewkscnowlducLA1=atcerLo- o'/mZ""[ ` Lucenpf>c J"-ctS&cFexacu " a (C ` LucennuFL o>&v)soml k:es;ehrosos="rOB xiiii_--am srotnuFL LPrvduct"labt dIens_ f v_ o" In&2tam a U AuG"re uogkl\(Or sspc$\btsR _sercnotak aGe l a (ssoml R _sekesbiLef f>dsimcHon-fe"*. pf>TPFLowecisnf>AL Ue fua\1i nuFL LP vduct"labtwork,ogkl\(Or sspc$\bch1th " &/v _fdiu btstodkeuro-* "*)i reeo>&v)somlwk:es;ehrkv ties-*osos="ima. ` LucennuFL Pof posss_ f v_ o"*In&2tam a U Autnoeni(Ospchoopco""[t ` LucenF- -dh1th " &/ _fdiu btstodkeuro-* "*)i reeniceo=ssomlwk:es;ehrosos="rOB xiiii_-scnxyi " neos=ver(>& .f" hc&& vetn= _rdn]* tifs_ f v_ o"*In&2tam a U AuG " nT|drtyect<&$mlwcnxy's ff v&<&ad\__fINCCof a " p""[tmu&cna. ` Lucenf LuanvcHbe amemZods&(seScieyrchoopco<&$ml ` Lucenorksis sucenscn*loroL\(Or -, smsovetn= _rd(Ospgu1e2tamd-icSl>& mp_orS&cn;<=iii sRAT,pievaBrorHrTF- -Lenod-icSl>& mp_ocSl>& law fensd opcdmu_fp`odamemZorosei/py,r1 "\, aled apowlsedn e_f"rMPI ichoopa (CdatLef f>ma l\(Or sspc$\b*loro15._DvF v&< Pof Wm ba_sfGfulnoHERE IS NO WARRANTY FORnoHE PROGRAM, TOnoHE EXTENT PERMITTED BY APPLIC|__o LAWscdmXCEPT WHEN OoHERWISE STATED IN WRITINGnoHE libRIGHT HOLDER>>>>>/ORnOoHER PARTIES PROVIDEnoHE PROGRAM "AS IS" WITHOUT WARRANTY OF>>>Y KIND, EIoHER EXPRESSED ORnIMPLIED, INCLUDING, BUT NOT LIMITED TO, oHE IMPLIED WARRANTIES OF>MERCHANTABILITY >>>>FITNESS FORnA PARTICULAR PURPOSE. noHE ENTIRE RISK AS TOnoHE QUALITY >>>>PERFORMANCE OF>oHE PROGRAM IS WITH YOUvnt HOULDnoHE PROGRAM PROVE DEFECTIVE, YOU ASSUMEnoHE lST OF ALL NECESSARY SERVICING, REPAIR ORnCORRECTION*loro16.e nm "LaopsrATULnct.VEiyniceo=N NO EVENT UNLESS REQUIRED BY APPLIC|__o LAW ORnAGREED TO IN WRITING WILL >>Y libRIGHT HOLDER, ORnA>Y OoHER PARTY WHO MODIFIES >>>/ORnCONVEYS oHE PROGRAM AS PERMITTED ABOVE, Bo LI|__o TO YOU FORnDAMAGES, INCLUDINGnA>Y , SPECI , INCIDENTAL ORnCONSEQUENTIAL DAMAGES ARISINGnOUT OF>oHE USE ORnINABILITY TO USE oHE PROGRAM (INCLUDINGnBUT NOT LIMITED TO LOSS OF DATA ORnDATA BEINGnRENDERED INACCURATE ORnLOSSES SUSTAINED BY YOU ORnoHIRD PARTIES ORnA FAILURE OF>oHE PROGRAM TO OPERATE WITH A>Y OoHER PROGRAMS), EVEN IF SUCH HOLDER ORnOoHER PARTY HAS BEEN ADVISED OF>oHE POSSIBILITY OF SUCH DAMAGES*loro17.LO\c_f""JnLaopsrATUSi Z""[s 15_ os 16niceo=ssomlwdvF v&< Pof lm ba_sf" os lnm "LaopsrATUmnct.VEiyzto-peer tcts="r_;neur anec J"-clou-- fflimisuch _s# -vna (Cdattks,eeo=ssO7 re:uewk drksuhparoduct,ta&2talou-- faw k:lq itaa"cloceam mheedx.VEirs of absol dc u&a"ntwork,-wafivilUmnct.VEiyz Co"ooneso_opi\\&"Goml k:es;eh1tor$non-e_sf"&-`inm " bV=( pf>lcH i &; T|onz parti&p lawu l "e_,r " cem ba_sf"e_SegttttttttttttttttttttATATY HAiceo=ssOfo$s a. pf>>>>>>>>>>>>>>>HsveniuAwk dr""[tmpTphniceo=Yed aNdiL lawu ls_ (meansi_swlangual&2eiwac_fc,_p-lh> basve &2eivsi\co Ulparti&pguk:essSl>o[ou hplusv_ho&2tis s dn ,get=u1est en"RAeF vh uch rn =iii muf"ea Tit rnoris sene"*d_-scnx`otOBenitn;\adm&\n"C&cn;<,e\\paom&cn;Youiy"ctlitulab _<n;<. Ru_fp`oda(C) tt<"=\pfo<_ e T|>SegtttTcienzAdfynATUS"rnoris sene"*: : rsnew o-nscnnuse=\pit-S&ch1thxp"u ,p hePL_PtpFLA #c"hPrv"*amd& Chc&& vetn= _rdn]* tifs_ f v_asrk,ogkl\(Or sn -J",- -dh1th " &/ _fdiu btsto,fe"*. pf ff= py,rl dat (_enzAcircivdiu (>"_modyrctnoen)L LP vduct"labtwo.SegtttTcienzAdfynATUS"nscnnuse=\ulPFLworkhowevL ainvdei&cn;In&2tafuri&\a"o sEHE PROGRAM TAM "AS I;_sfify /rph& Lworkq o&-`in k:es;eh1te hePLIED WARRANTIES 1thERCHANTABILITY >>>>FITNE S FORnA PASesercno hePewk.VEir ane s-dIens_ f v_ phmkse=s=ork -,uvasso-> ba --1nnR _sesOPn_ edalAGs _f>>>nuSiewk.VEir ane s-dIens_ f vgf)`oro : py,r eienzAdfynAdkeurofrev&< e uvaArcH tush ve T|2_seP ierfsveniufu-ee pf>De,re <>etSronork nby apuct(k -USi Z""[s 15p)i reeo>&v iffls-l -,\23o I, ,f"ea Tit -J" hcaa -rt freSinlnsc. eienl],o-&< &talid"rksEr Q\) &2eivsdsuche ngel . Ru_fp`oda(C) tt<"=\pfo<_ e T|>SgtttTcienzAdfynAT;a,EZ" py,rABSOLUTELY ba_sfGfulno;_ phm=ork -, tywev`,"n_cw'.SgtttTcienUS"rnoris sene"*-lh> basvee"*d_el;a,EtZrk nscnnuse=\pitSgttttpFLA s,eel,lm[dsimcHon-; tywev`,"n_cc'_ phm=ork -,USi]* thypit(ssemlN If dhyxse`,"n_cw'lh> b`,"n_cc'_ --1nn,"n_c\ = much odIX,pca&2tam mhsLupT|dh>ets_ fAu&,roffF v Of,eeo=rksis sfec\awu l's If dhyxs mp`oda_sf"tamd-icS;em ba_sGUI ever,ePsuasures.--1nnu U Au "mnc hcbox"""[=iii m --1nnarcH =s rs sfee o&oy t_s4ow_c\/c&limiLaopof serf er)oF ffpowlri&soess)k(ops--sEi &orku_fp`oda_ os 16nic"&ork-wam h& tifynidH e\\2'/$h"Fpy)lpuT|ove T|2_seP ierEP :efh> basveniuewk drh> b"rMPI inuSiewk.V&\&2< e uvadn]* tewk.VEir ane s-dIens_ f v_eo>&v)somodv _f2tsEL(tm(2)2: s sfec\awu l m ropmfe"*nrsv"ec\awu ls"sh\\2r }eczAdfynATUS"aa_o=robvene sm-hooynam }ssf>6.>C>& mp-&< lpuT|2tafurharsEdv _f2a (s;f mp fe"*nrsv"e c_fc_ftSl>vnt p&\&2tasm-hooydkeuro-*ienUS"wPLT|s ofwl'asInizAl- os (f>ewk.L= lerrvduct"labt dIens_ f v_FLwoeadcn;< cH ifeoscror.dLowls"" kneoorHrT>etS uvsm-ppmntiSTics-r1036/N WR OF.niceER0000644000175000017500000001674311616214646015407 0u&tal sc,Csc,Ctttttttttttttttttttewk.LiceER GES, IN S BLIC LICENSEegtttttttttttttttttttt ves*loro 3, 29 June unrevad Ru_fp`oda(C) unre -dh1th " &/ _fdiu btsto,fInc. SgEotOBenit>C _niuA'i Z"chargc.f " nescnnuse=\piuA'i Verb_ omt cn;< cH i l"u lcH i fua\1i sEom sep`o,iv\a"nvnt -, smsuva ttTcien_--am srotnuFL LPrL= lerrvduct"lns_ fAu&,roffF ve EL(tm(2)mt _sekesbiLef f>dsimcHon-f(s-nff= py,rl dat he `vduct"lns_ fAuatushiphtv[]_asUPL_P(Or sspc$\a.)'i Non-S&chof " iicSesuce}s#Etmd_a tt0o'im }sssnqutD o amiQ\,>Arisepsuct<&$p",i=ssO" cH ifeoscroivsdubyt (panff= py,rl dat he `L= ler nnuFL Pof posss_ f v_ lbefe:lq"ewk.V&\ivsdubyt (panff= py,rl dat he nnuFL Pof posss_ f v7. AicTat (_-hooyivsdubyt (parmnnk o(fu-e "rrynrsvm#( J_esbicgfyni, a_olis &2tA2tAAc_fc_ftSl>ucen eC Au tldmW&limiLa rtk edaEtmd_a ttss\\Ac_fc_ftSl>,, &"-e:lXZ""[up :#cub u"[ric\ &aAworku pf>ALaopsrATU sspc$\abtedhyxC>lqufuo>mof ckrgantasolave ko= lek(opsrAabtedhy. D o ammntl>_o=u-ens_ ffafu-ens_ rtk edatepsrAabtedhyTUS"nfre=ssaipyFF v&ALaopsrATdatepsrAabtedhyAriseparC Au tldmW&lilyT|"olXZ""[Conemlwv__5,"kAu tI, goru[tny_olnno Ac_fc_ftSl>ucenscn*loLm-hooydkeThparticulan ke_--am srotnuFL Lm-hooyo=ss\cv)som&cn;u_us= p"L i fu Vor'edPFLnwlfThpa"M tI (ocH i PArf m<<_ rOu-- o ff unC Au tldmW&lim;< CH i- ff= (ntkoa;tnonssOPs>ork-wam C Au tldmW&li,uct, doI, g-e:lc_freeo=ssO)- o cH ieim\reo& mp_o=;< csiso &\a,abt ko= lek(opsrAAc_fc_ftSl>,ch oa&2t k(opsrAabi fuoVlabtwo.SegtThpa"f= (ntkoa;tnoAc_fc_ftSl>uCr"libspf>1.C Au tldmW&lim;< CH i- fr.dpf> yrctuvqh1thhtv)som&cn;< lnPpsrAAc_fc_ftSl>,ch\\2r }ecipi\ de90nlbefbvelnm "Laoo=ssO(> edat )-(tmeConemlml R _seC Au tldmW&limJ.VEiyz&cAc_fc_ftSl>,c>lquct, doI, g _se However,eP :='\reo6.>C _niuA'i Non-S&cn;5eansi_s&ckv tiouwm _f>>>nuSiabtedhyxClberu-- r }eceniu&J work buuk ty)lf>>yvsdubyt (parmu_f susfgu1e2e90h\co Uluupo&-`inpk:lqAAc_fc_ftSl> pT|dh>eti me90sy)lf>>yv(a_olis &2tA2sz[u psguc>=sschar en"_of (Os ty)lf>>yv wogvokAGs _sehn o"*In&2taevaBre=ssO_sesucme90/vrrynrsv_--am se ngela)(Cofsc-P }s# -J"_u suo>mZ""[tmpheam }s"ea Ta"rrodiu is\crcn(s *loro>&S&cn;<-wam i &tnoen ph& tA2tAAc_fc_ftSl>ueo>&v)somlut adpcno heu_f susfgu1e2e90, me90sy)lf>>yvst&cn;S&cn;<=:efh> b_taa" ylyrcth>e f>5,nuSi&cnd> es iuAuGfu nologYou_p`vaBSfuris*)i . b)PtpFLA #c"hewk.V&\&2=ss\cncn; Cr"lfIncL(tm(2)2: M m }ss _s.VEiabtedhyTHetSLA Fpy,r.SegtThparms pf>Youwm banc\ &aAAc_fc_ftSl>ummtFLuEL(tm(2)mh& m }ss _s of&aihetSLA lab _6.>C _ni&< bi\a"nvntinue tpFLA #rv"*amd&led apowAT,pwuo>mZ""[tmphem dIXMajfLuEL(tm(2)mdvs _seworkf ckrgawam mhsy,r1 tiSTico lfo=ssmi( :ef2e90h[tmpc " nelayfa fullnPcos sfyhnam\ms ph& & lai &ta ( fu_f susf\1,ufree o&2)mt (FLof A lewis sun_sInm length)uanvcHbe de91ca&2taoa (ssoml e ngela)(Givsdlevddrudat . pf>2=ss\cYouwm banhmT,p--sEms pf>Youwpi\\ _sngelabtedhyTUS"ct<&$inpit-S&cwpi\\ _slabtedhyTc$\btd pu_u pf>ngelvt s twbtiv_ simph"RAT.i . b)PAf>lcH is_ osnu=mlwsFL].VEniu&sedusedunl _ophewk.V&\1,ufree crctnuctnsinad i fua\dtcircumvfAu tldmW&liggrega a- pf>6.>C _niuAC Au tldmW&limtpFLA #rv"*amd&led apowAT,tmphem tea d (pgd o,s_bly-i o gfoo'or s opco"t(tma lvesbiLutu hp cH ieim\reo2=ss\cYouwm banhmT,p--s-RAu tldmW&lims-tU -J",- abtedhyTUS"ct<&$inpit-S&cwpi\\ _slabtedhyTc$\btd pu_u pf>ngelvt s twbtiv_ simph"RAT.i . b)PAf>lcH is_ osnC Au tldmW&limciu&sedusedunl _ophewk.V&\1,ufree crctnuctnsinad i fua\dtcirLLLLFpf>1.C Au tldmW&limFLPrv"$hdSo-scdmu_fp`odaofn =iiido Uluro>&SenzAiSl>,ch\\2r datf>>>pu_fp`odaofn =i< lnPpsrAabtedhyTcmoluro>&#c"o nsheedatd2sz90h>osei/py,md-iccerl: ties;f mp twbtr ""J nhargc Co"ooneso_opiewk.V&\1,ufree crctnuctnad i fua\dtcirLd) Do&cn;uCr"l\pf>lcH i ngelllll Q\)e_h>e fnc"(o'/spbmciu&sedpyF v&< &ork ieedngelllllpsrAabi fuoVlabtwo-J"stt emlwhedpyF v&< &C Au tldmW&li,uor(OspT|dh> sUd)esik &sELunrvpy)lO\c_f"p6neso_opiewk.V&\1f='\\2'/Ei, sT|dh> srLPrvduct"labt a*tify ngelllll1) r# ual Q\)e_h>eshar`inm tedhyTmeom sism1f='\[tny_olnVEiyz Co"gellllls_-hooydkeAl Q\)e_h>emeom sism1>acUnuwpi\\ orys>eti \\ bd_s U A"gelllllouwm _f>>>nuSiabtedhyeo lfoo'oc\yni-pik(opsrAwbtr's If punremgelllll Howevinf>ett_onw&cn;S&cn;<=oduct",*ne=\p&sedpyF v&< &ork imgelllll>>>nuSiabtedhye->lcH tu hplcenscn*loLmi fu ttttt ves*loroy ngeleLLa (pEir _freSdH o FRAT,pwdiuSotF,c>lquccas-, al1th.--1nnntasolave . b ed T|s ad_freSdH o Ffeo>mofve T|2_seP sis soutu \2_s6neso_op tttewk.V&\&2rfdiunr-wafeo ffT&< biY,pievaB>mofve T|2_seP orngel e\\2'/$EiLLLLL s\t (tm ienzAivqaipyF v&< &ork ieedI_op tttC Au tldmW&limConemlwv__5, tiensc i Dec\ers[tny_oln_op tttAc_fc_ftSl>mciu&sedpyF v&< &ork ieedopsrAabi fuoVlabtwo. (Idngelssybe[ricoF rd 4d0, mp t,Eeeea` set> keu uSotFle90s"pf>lcH iy -J",- M tI (ocH i PArf m<<_ rOu--PuvqurV= ienzApefaAAc_fc_ftSl> tttC OspTeansi_se[ricoF rd 4d1, n_ime90s" &v)soarcy,r,Eeeea` set> tttkeu uSotFl n laws_d)esik &sELunrvpy)lO\c_f"p6neso_opiewk.V&\o heu,re sbiEi, smrLPrvduct"labt a*tify)Segtort oAu tldmr,eP :='\grega a- pf>6cn;>> e l>& mp_sRAni- oS&cn;& mvpy)li"l\pf>lco"oonesm tedhyT(pgd odosso- pf>ALm tedhy ty)lf>>> e l>& mp_sRor sAc_fc_ftSl>vnullnP_ e T|sw s twbtiv_ s s_ f v_ lbef.>C _ni&< biaucensc ginm tedhyTtpFLA #rv"*amd&led powAT,pwT|ontaso de91ca&2taoa (ssoml e ngela)(Af>lcH is_ osncensc ginm tedhyTciu&sedusedunl _oph\c e- oS&cn;>> e,argc Cara_o"eUz.d),Ee"hPrv"*amd& Cor(OspT|dh.i . b)PGivsdlevddrudat . pf>2=ss\c osncensc ginm tedhyTs_o b er;snd> e . T|"olXZ""[ko= lek(opsrAabtedhy, (tm iecn;secor.ores-lresao-xt_toi&\apf>lcH iy, smstcensc ginm banc\ _oph\c e- o=ly-c_tos s n-nves*loro14. Re:L LPrL= lerrvduct"lns_ fAu&,roffF _rdn]* tpf> asU AuGfulnor(Obtstodkeuro-* "*)i reen-S&ch1th " re:ut_mo . Re:L LPrL= lerrvduct"lns_ fAu&,roffF _ o"*In&2tam a U AuGn;< cSl>eos=ver(>&i&cn;In&wk.VEir ane,r-w a& 20 Dec\yni-pirii pIG_r sELun A sspc$\b,=ork -S&c cn;<=\ynidiLLLls &2tc. EhfnewkscnowlducLA1=atcerLo- o'/mZ""[ ` Lucenpf>c J"-ctS&cFexacu " a(C ` Luabtedhyeosal1th " nonmmit o>&v)soml k:es;ehrosos="rOB xiiii_--am s . Re:L LPrL= lerrvduct"lns_ fAu&,roffF _ o" In&2tam a U AuG"re uogkl\(Or sspc$\btsR _sercn tak aGe l a (ssoml R _sekesbiLef >dsimcHon-fe"*. pf>TPFLowek,ogkl\(OrUe fua\1i nuFL LP vduct"labtwo k,ogkl\(Or sspc$\bch1th " &/v _fdiu btstodZ""[s 15abtedhyeosal1tsomlwk:es;eheeo>&v)somlwk:es;ehrkv ties-*osos="ima. ` he `L= ler nnuFL Pof posss_ f v_ o"*In&2tam a U Autnoeni(Ospima. ` he `L= ler nnuFL Pof posss_ f vpchoopco""[t ` r sspc$\bch1th " &/v _fdiu btstodSi Z""[s 15abtedhyeosal1th " nonmmit o>&v)soml k:es;ehrosos="rOB xiii nsd opyi " nwork &e}"Inm e:L LPrL= lerrvduct"lns_ fAu&,roffF _nologYaipy,r- U AuG " nT| rtyect<&$mlwcnxy's ff v&<&ad\__fINCutnoeni(Osp s ""[tmu&cnurLPrvduct"meanf e Tu Hbe amemZods&(seScieyrchoopco< abtedhyArsm-ppmntiSTics-r1036/NOTICE0000644000175000017500000000114211616214646014247 0u&tal sc,Csc,CERMINTIES NOTICE srATULnct.VESHASSURTICUTHAS PERMITTED AAM TCH HOL, Bo ICING>Y ICING>YUDINGnA> , ,SPECI , INCIDENTAL ORnCO TO YOU FORnLE, YPROFITO TSEQUENTIAL DAMAGES ARISIMAGEIS SOFTWARE=ssOfITO DOCUM ,. pf, Y OoHER RTICUTHADER ORnOoHER PARTY AS BEEN ADVISED OF oHE POSSIBI. RTICUTHAUDINGFICASSYo ISCLAIeo=ssYTED TO, oHE> SED ORnIMPLIED, INCLUDING, UT NOT LIMITED TO, oHE IMPLIED WARRANTIES OF> ERCHANTABILITY >>>>FITNE S FORnA PUT NSOFTWARE=>/ORnOoD PofUTA O Wm OOoHNPROV DEnoBASIO TSND RTICUTHADER TULOBLIG,. pf noHE>/ORnOoHMAINTENQUAL>YUUPPORT, UPDATCO TENHQUALM S,SPEC>Y OoHC,. pf uvsm-ppmntiSTics-r1036/acksuhp.m40000644000175000017500000000161611616214646015211 0u&tal sc,Csc,C#cn;dsf -*- #d Ru_fp`oda(C) 1996, 1997, 1998, 1999, unr0, unr1, unr2, unr3, unr4, #dunr5, unr6, unr7, unr8, unr9 -dh1th " &/ _fdiu btsto,fInc. #dTcienlab _US"rnoris sene"*;spc$\bch1th " &/v _fdiu btsto #dgmZ"e_unwam mhsy""[tmpheaGe l rgc.f " /u1e2tcnnuse=\pit, #dosso- r_sfify /reniu&J work buuko ffensure Cor(freSinlthop twbtimsuva#tTcienzAdfynATUS"nscnnuse=\ulPFLworkhowevL ainvdei&cn;In&2tafuri&#o sEHE PROGRAM TAM "AS I;;a,EeedI> edat _niuA'i Z"bLP vw;_sfify /&#oph& Lworkq o&-`in k:es;eh1tePLIED WARRANTIES 1thERCHANTABILIT&#o >>>>FITNE S FORnA m4_h\\2r d([m4/ax_f90_hetSLA.m4]) m4_h\\2r d([m4/ax_f90_workunal_hetSeni.m4]) m4_h\\2r d([m4/ax_f90_sm-hooydm4]) m4_h\\2r d([m4/ax_f90_sm-hooy_setupdm4]) m4_h\\2r d([m4/ax_f90_eniuledm4]) m4_h\\2r d([m4/ax_f90_eniule_> edabtwo.m4]) m4_h\\2r d([m4/ax_f90_eniule_flag.m4]) m4_h\\2r d([m4/ppm_check_mpi.m4]) sm-ppmntiSTics-r1036/>dsfig.cucLe0000644000175000017500000000000011616214646015565 0u&tal sc,Csc,Csm-ppmntiSTics-r1036/m4/0000755000175000017500000000000011616214771013664 5u&tal sc,Csc,Csm-ppmntiSTics-r1036/m4/ax_f90_sm-hooy_setupdm40000644000175000017500000000705011616214646020163 0u&tal sc,Csc,C# ===========================================================================&#oooooohttp://www.nfennu.org/aoop>dsf-J"_umZ"/ax_f90_sm-hooy_setupdhtml # ===========================================================================&# # SYNOPSIO&# # AX_F90_LIBRARY_SETUP(LIBRARY, PAA O-REGEXP,C>Y ULE-REGEXP,CLIB-REGEXP,CFUNNG, R-BODY)&# # DESCRIPG, R&# # o gfniiccer& & l(ops-et up>lcH io_op 90nm tedhyTpf>lco" o&-f-`in ky. # LIBRARYtam mhsL"=\pfo<_t2tasm-hooydk PAA O-REGEXP T|"olregan k # Fl:lq aeaGe(ct<&$bLPao-x)h& mc ` r sspc$\hetSLA lab _Y ULE-REGEXP T|"olregan k Fl:lq aeaGe(ct<&$bLPao-x)h& mc ` r s # 2taoaab "=\pfo<_t2taeniulep(otitph Fmpty).CLIB-REGEXP T|"olregan k # Fl:lq aeaGe(ct<&$bLPao-x)h& mc ` r sspc$\aab "=\pfo<_t2tasm-hooynav_ s #. T|"2tafurhe"*. pfi<_t2tasm-hooy\aab "=\pfeo>&v)som"rMPI inuSiL &2ti Non- #. sm-xxx.agoru[t-xxx.spievtrkun "sor(y*tifek Co"oonesfve T|2_seP orn# Fmbeddctnor$non-sL"=\p,lnsc. ," " ner&2tam anfbugep`o,atatus ...). # FUNNG, R-BODYtam mhsLbodsesuch u_f susfgxxxxxtcomntmhsL'2ta'<&$mlwcnxyrn# lbefe:lqmlNb (parmu_f susfg rtk edatepsrAsm-hooy). #n# Tcien& & l(US"aa_ _s-J wrappuctardiu tAX_F90_>Y ULE lbefAX_F90_LIBRARY # 2t|dh>eti me90fo=ssmi( :ALaopsrATdatepsrAI> ewbtr "rLa (Cl&2--sfif-xxx # ooF rd (pa-et up>_oph\eJ"_u,evth. Bou&sedpyFulepullnP m tedhyTcicn;In # 2estam a Uph\c evthei&cn;In&2tat )-(t de91=estbuusfeo ffene91am }ss\ # -et up>ciu&sedusmm" p"ai me9l: tieorsesuc de91=atasm-hooy\aab lbefe:l # pyFulepaab .n]* t& & l($T_sehs _s_semlNba_updtinu en"_FCFLAGS,CLDFLAGSn# lbefLIBS var-ne_td"rksE.)'i No_freSdH o omntmhsLF90_ PAA O_xxx, # F90_>Y ULE_xxx, F90_LDFLAGS_xxx lbefF90_LIBS_xxx -J" hcvar-ne_td. #n# EimtisR:mlut ostZ"isowldu /hife/nosL &2aam /eso_sewc/sm-/sm-alc `my.an# lbef/hife/nosL &2aam /eso_sewc/pyF/alc `my.pyFcv)som&LaopsrAsarmu_f susf # 2eniu&e=\_woro_golLuanvcH="rO os (f>a (ssoml RisRAT,pievfigure.ac: #n# tAX_F90_>Y ULE_HE PRS, R&# ti<_test x$ax_cv_f90_eni> e = xuntesen ;spc$n&#oooooo AC_MSG_ERROR([unvaB xiiiao-xtf90 pyFules > edabtwo]) #ooooofin# tAX_F90_LIBRARY_SETUP(alc `my,[],alc `my.$ax_cv_f90_eni> e,sm-alc `my*,[&#oooooo pu_u plc `my&#oooooo pmlNb (eniu&e=\_woro_golL('letS')&#oooooo ]) #n# lbefe:lqwbtr ct<&suievfigure2r }eczackaeditsomntl>&f dhyxlnsc. eie: #n# t./ievfigure2--sfif-plc `my=$HOME/eso_sewc #n# LICENSEe#n# Mniu&J work bdateOc,C Awab (oawab @fve.ethz.ch)&# # ou_fp`oda(c) unr9 Luc MaisonoIn&&# # ou_}ecipi nescnnuse=(Ospima. ienlab ,dosso- r_sfify /reniu&J work ,abt # _niuA'i Z"rksEryTmedium_sfify /rcreScieyuo>mZ""[tmp>>>pu_fp`odaofn =in# lbefe:or(freSinl/v _p twbtimsudTcienlab _US"u l aheood- :efsfify /r iy # w15._DvF v&#ssework8 AC_DEFUN([AX_F90_LIBRARY_SETUP],[& AC_ARG_HE P([$1],[AS_ PLP_STRING([--sfif-$1=ene9],[-et o ffene91 20 Decperb_rtasm-hooy\-AGEIS FLAG Wm MANDATORY])],argc[i<_test x${sfifval} = xno -o x${sfifval} = xyes;spc$n&oooo AC_MSG_ERROR([n_ime90s" &v)soar--sfif-$1=ene9 -ph7ina& 20 De$1asm-hooy]) oooofi],[& ooo AC_MSG_ERROR([n_ime90s" &v)soar--sfif-$1=ene9 -ph7ina& 20 De$1asm-hooy]) oooo]) oi<_test x$2 != x ;spc$n&oooAX_F90_ PAA O([$1],[$2],[$5],$sfifval,[& ooo _FCFLAGS="$FCFLAGS $AS_TR_SH(F90_ PAA O_$1)"& ooo ],[]) ofinoi<_test x$3 != x ;spc$n&oooAX_F90_>Y ULE([$1],[$3],[$5],$sfifval,[& ooo _FCFLAGS="$FCFLAGS $AS_TR_SH(F90_>Y ULE_$1)"& ooo ],[]) ofinoAX_F90_LIBRARY([$1],[$4],[$5],$sfifval,[& oooLDFLAGS="$LDFLAGS $AS_TR_SH(F90_LDFLAGS_$1)"& oooLIBS="$AS_TR_SH(F90_LIBS_$1) $LIBS"& oo],[AC_MSG_ERROR([Z""[tmphe " neecperntiSTicsfsfify /rcperb_rt])]) ]) sm-ppmntiSTics-r1036/m4/ax_f90_eniule_> edabtwo.m40000644000175000017500000000322711616214646020662 0u&tal sc,Csc,C# ===========================================================================&#ooooohttp://www.nfennu.org/aoop>dsf-J"_umZ"/ax_f90_eniule_> edabtwo.html # ===========================================================================&# # SYNOPSIO&# # AX_F90_>Y ULE_HE PRS, R&# # DESCRIPG, R&# # Fo-xtF io_op 90npyFules lab _> edabtwo.n]* t&yFulep> edabtwo _iseored #. TPl l asac ` rvar-ne_t ax_f90_eni> e,- r_"untesen"fi<_t2ta> edabtwo #. Eiyzto-peeudiu _S#n# LICENSEe#n# ou_fp`oda(c) unr9 Luc MaisonoIn&&# ou_fp`oda(c) unr9 Alexaz.d),Pletzd),&# # ou_}ecipi nescnnuse=(Ospima. ienlab ,dosso- r_sfify /reniu&J work ,abt # _niuA'i Z"rksEryTmedium_sfify /rcreScieyuo>mZ""[tmp>>>pu_fp`odaofn =in# lbefe:or(freSinl/v _p twbtimsudTcienlab _US"u l aheood- :efsfify /r iy # w15._DvF v&#ssework10 AC_DEFUN([AX_F90_>Y ULE_HE PRS, R],[&AC_CACHE_CHECK([f io_op 90npyFules > edabtwo], ax_cv_f90_eni> e, [AC_LANG_PUSH(F io_op) i=0 v)sB xiest \( -ma.mpdir_$i \) -o \( -da.mpdir_$i \) ;so i T=`Fl:l $i + 1` da nmkd _s#mpdir_$i cda.mpdir_$i&AC_COMPILE_IFELSE([ !234567& ooo _&yFulep>dsfiest_eniule& ooo _fu-eegPrngellll_o=robvene >dsfiest_robvenengellllwrite(*,'(a)') 'gotcha!'ngellllI> e_o=robvene >dsfiest_robvenengellllI> e&yFulep>dsfiest_eniule& o],arg[ax_cv_f90_eni> e=`ls | tat -n 's,>dsfiest_eniule\.,,p'` ti<_test x$ax_cv_f90_eni> e = x ;spc$n&dnl SifekF90 ," " ner| rtt pyFulepaab "=\pfrksuppuccrHrTleti( :ngelllax_cv_f90_eni> e=`ls | tat -n 's,CONFTEST_>Y ULE\.,,p'` t ti<_test x$ax_cv_f90_eni> e = x ;spc$n&oooooo ax_cv_f90_eni> e=""& ooo finoo finoo],arg[ax_cv_f90_eni> e=""]) cda.. rm -mra.mpdir_$i&AC_LANG_POP(F io_op) ])]) sm-ppmntiSTics-r1036/m4/ax_f90_workunal_hetSeni.m40000644000175000017500000000405511616214646020576 0u&tal sc,Csc,C# ===========================================================================&#ooooohttp://www.nfennu.org/aoop>dsf-J"_umZ"/ax_f90_workunal_hetSeni.html # ===========================================================================&# # SYNOPSIO&# # AX_F90_INTERNAL_ PAA>Y (MoHE GE, FILE-REGEXP,CFLAG,CFUNNG, R-BODY,IAL PUT-VAR[, SEARCH-PATH [, ANG, R-IF-FOUND[, ANG, R-IF-NOT-FOUND]]])&# # DESCRIPG, R&# # Iorkunalt& & l(ct<&$bLPAX_F90_ PAA O lbefAX_F90_>Y ULE_S#n# LICENSEe#n# ou_fp`oda(c) unr9 Luc MaisonoIn&&# # ou_}ecipi nescnnuse=(Ospima. ienlab ,dosso- r_sfify /reniu&J work ,abt # _niuA'i Z"rksEryTmedium_sfify /rcreScieyuo>mZ""[tmp>>>pu_fp`odaofn =in# lbefe:or(freSinl/v _p twbtimsudTcienlab _US"u l aheood- :efsfify /r iy # w15._DvF v&#ssework8 AC_DEFUN([AX_F90_INTERNAL_ PAA>Y ],[&AS_VAR_PUSHDEF([ax_h\\2r d],[ax_cv_f90_hetSeni_$2])&AC_MSG_CHECKING([$1])&AC_LANG_PUSH(F io_op) AS_VAR_SET(ax_h\\2r d,")som"riu ") i<_test "x$6" = x ;spc$n&ax_\eJ"_u="$p tfix:$ac_default_p tfix")- o fx_ko= "rks"" `echo $LD_LIBRARY_PATH | tr ':' '\012'` ;so i T<_test "x$fx_ko= " != x ;spc$n&ooosom sedquote(,)dnl ooo ax_ko= =`echo $fx_ko= "| tat 's,/[^/]*$,,'` t om sedquote([,])dnl ooo ax_\eJ"_u="${ax_\eJ"_u}:${ax_ko= }"& ofinda nelse&ax_\eJ"_u="$6")-i)- o fx_ko= "rks`echo $fx_\eJ"_u,| tr ':' '\012'` ;so i T<_test "AS_VAR_GET(ax_h\\2r d)" = ")som"riu " ;spc$n&ooo- o fx_pyFcrks"" `ao-xt$fx_ko= "-"rMPI i-"=\pf$2 -prwor` ;so i T<_test "x$fx_pyF" != x ;spc$n&ooosoosom sedquote(,)dnl ooo oo ax_dir=`echo $fx_pyFc| tat 's,/[^/]*$,,'` t t om sedquote([,])dnl ooo oo ax_\ave_FCFLAGS="$FCFLAGS" ooo oo FCFLAGS="$ax_\ave_FCFLAGS $3$ax_dir" ooo oo AC_COMPILE_IFELSE([_o=robvene >dsfiest_robvenen$4egtttttttttI> e_o=robvene >dsfiest_robvenengellll oo],AS_VAR_SET(ax_h\\2r d,"$3$ax_dir"),[]) ooo oo FCFLAGS="$ax_\ave_FCFLAGS"& ooo finoo da nofinda nAC_LANG_POP(F io_op) AC_MSG_RESULT([AS_VAR_GET(ax_h\\2r d)]) i<_test "AS_VAR_GET(ax_h\\2r d)" = ")som"riu ";spc$n&o$5=""& $8nelse&o$5="AS_VAR_GET(ax_h\\2r d)"&o$7)-i)AC_SUBST($5) AS_VAR_POPDEF([ax_h\\2r d]) ]) sm-ppmntiSTics-r1036/m4/ppm_check_mpi.m40000644000175000017500000001217611616214646016734 0u&tal sc,Csc,C# SYNOPSIO&# # PPM_CHECK_MPI(mpikq o&wcnxywork )&# # mp>>valuv_ o"*In&cn;1.C ," " ner])],[CC="$MPICC"]) ooo AC_CHECK_ATE S(MPICXX,[mpic++tmpiCCompicxxompig++ompiicpcttmCCompCC_r],[no]) ooo AS_VAR_IF(MPICXX,[no],[AC_MSG_WARN([Ct<&su)som"o-xtEryTmpi erappuctspf>1.C++o," " ner])],[CXX="$MPICXX"]) ooo AC_CHECK_ATE S(MPIFC,[mpif90tmpifctmpigf io_opompiif iootmf90ompxf90_r],[no]) ooo AS_VAR_IF(MPIFC,[no],[AC_MSG_WARN([Ct<&su)som"o-xtEryTmpi erappuctspf>1.F io_op ," " ner])],[FC="$MPIFC"]) ooooAC_MSG_NOTICE(["riu $CCo$CXX $FC]) eli<_test "x$1" = xyes;spc$n&ooooAC_MSG_NOTICE([Y1th.--1nnnsc. oO os$CCo$CXX $FCe l rg " neeciu&sMPI lut oio]) else&ooooAC_MSG_ERROR([Ct<&su)somreocgniz. eienMPI q o&wcnxywork : $1])&fi ]) sm-ppmntiSTics-r1036/m4/ax_f90_eniule.m40000644000175000017500000000353611616214646016571 0u&tal sc,Csc,C# ===========================================================================&#oooooooooohttp://www.nfennu.org/aoop>dsf-J"_umZ"/ax_f90_eniule.html # ===========================================================================&# # SYNOPSIO&# # AX_F90_>Y ULE(>Y ULE,C>Y ULE-REGEXP,CFUNNG, R-BODYt[, SEARCH-PATH [, ANG, R-IF-FOUND [, ANG, R-IF-NOT-FOUND]]])&# # DESCRIPG, R&# # Set up>_oph," " ner&flags oO osa o'/mZ"f io_op 90npyFuleC>Y ULEtam mhs # "=\pfo<_t2taeniule.C>Y ULE-REGEXP T|"olregan k Fl:lq aeaGe(ct<&$bLPao-x) #. m mc ` r sspc$\aab "=\pfo<_t2taeniule.CFUNNG, R-BODYtam mhsLbodsesuch #. u_f susfgxxxxxtcomntmhsL'2ta'<&$mlwcnxy lbefe:lqmlNb (parmu_f susf #. rtk edatepsrAeniule) SEARCH-PATH T|"olcolon-sefo=stginm st_oph\eJ"_u,evthsi&cn;In&," "o= lekf $p tfix, $ac_default_p tfix,n# lbeflNb l: tieorsomlexact gfenitae o *above*>_ophl: tieorsomlif #. $LD_LIBRARY_PATH (_ophrai Non-etam mh:esiehn l,eP :='\r/v _putlif #. /tife/evth/sm-,epsrAeniule\r/v _ofFLofputlif""[ ` tieorsensc. #. /tife/evth/h\\2r da-(t/tife/evth/pyFc1thhtmet>c J"wk.VEir).tss\ -J" h #. var-ne_t "=\pd F90_>Y ULE_xxx&i&cn;In&wet up>ciu&s0 Dec\oper&flag )-( # -ubstituSotFl n Makelab s (xxx&am builtmJ.VEiyz&ls"" psguc>=sefsfifn# loop>dsf L &2ti Non- escapes)_S#n# LICENSEe#n# ou_fp`oda(c) unr9 Luc MaisonoIn&&# # ou_}ecipi nescnnuse=(Ospima. ienlab ,dosso- r_sfify /reniu&J work ,abt # _niuA'i Z"rksEryTmedium_sfify /rcreScieyuo>mZ""[tmp>>>pu_fp`odaofn =in# lbefe:or(freSinl/v _p twbtimsudTcienlab _US"u l aheood- :efsfify /r iy # w15._DvF v&#ssework8 AC_DEFUN([AX_F90_>Y ULE],[& AC_REQUIRE([AX_F90_>Y ULE_FLAG]) oAX_F90_INTERNAL_ PAA>Y ([$1"f io_op 90npyFule],[$2],"$ax_cv_f90_eniflag",egtttttttttttttttttttttttt[$3],AS_TR_SH(F90_>Y ULE_$1),[$4],[$5],[$6]) ]) sm-ppmntiSTics-r1036/m4/ax_f90_sm-hooy.m40000644000175000017500000000737311616214646016753 0u&tal sc,Csc,C# ===========================================================================&#ooooooooohttp://www.nfennu.org/aoop>dsf-J"_umZ"/ax_f90_sm-hooydhtml # ===========================================================================&# # SYNOPSIO&# # AX_F90_LIBRARY(LIBRARY, LIB-REGEXP,CFUNNG, R-BODYt[, SEARCH-PATH [, ANG, R-IF-FOUND [, ANG, R-IF-NOT-FOUND]]])&# # DESCRIPG, R&# # Set up>_oph," " ner&flags oOnsnima o'/mZ"f io_op 90nsm-hooy\LIBRARYtam # mp>>"=\pfo<_t2tasm-hooydkLIB-REGEXP T|"olregan k Fl:lq aeaGe(ct<&$bL #. uo-x)h& mc ` r sspc$\aab "=\pfo<_t2tasm-hooynav_ s T|"2tafurhe"*. pfi< # mp>>sm-hooy\aab "=\pfeo>&v)som"rMPI inuSiL &2ti Non- sm-xxx.agor #. sm-xxx.spievtrkun "sor(y*tifek Co"oonesfve T|2_seP or Fmbeddctnor$non-s # "=\p,lnsc. ," " ner&2tam anfbugep`o,atatus ...).CFUNNG, R-BODYtam mhs # bodsesuch u_f susfgxxxxxtcomntmhsL'2ta'<&$mlwcnxyr lbefe:lqmlNb (par #. u_f susfg rtk edatepsrAsm-hooy) SEARCH-PATH T|"olcolon-sefo=stginm st # of l: tieorsoml k:esi&cn;In&ct<&$am mhsLbo= "l: tieorss )-(t'uo-x' ""n#. sfokchoopmp>>sm-hooy\aab dZ""[Fmpty,>_oph\eJ"_u,evthsi&cn;In&," "o= lekf #. $p tfix/sm-,e$ac_default_p tfix/sm-,elbef$LD_LIBRARY_PATHudTwo\ -J" h #. var-ne_ts "=\pd F90_LDFLAGS_xxx lbefF90_LIBS_xxx i&cn;In&wet up>ciu&s0 D # _\oper&flag )-( -ubstituSotFl n Makelab s (xxx&am builtmJ.VEiyz&ls"" n# lsguc>=sefsfif loop>dsf L &2ti Non- escapes)_S#n# LICENSEe#n# ou_fp`oda(c) unr9 Luc MaisonoIn&&# # ou_}ecipi nescnnuse=(Ospima. ienlab ,dosso- r_sfify /reniu&J work ,abt # _niuA'i Z"rksEryTmedium_sfify /rcreScieyuo>mZ""[tmp>>>pu_fp`odaofn =in# lbefe:or(freSinl/v _p twbtimsudTcienlab _US"u l aheood- :efsfify /r iy # w15._DvF v&#ssework8 AC_DEFUN([AX_F90_LIBRARY],[&AS_VAR_PUSHDEF([ax_liflags],[ax_cv_f90_liflags_$1])&AS_VAR_PUSHDEF([ax_libs],[ax_cv_f90_libs_$1])&AC_MSG_CHECKING([$1"f io_op 90nsm-hooy])&AC_LANG_PUSH(F io_op) AS_VAR_SET([ax_liflags],"") AS_VAR_SET([ax_libs],")som"riu ") i<_test "x$4" = x ;spc$n&ax_\eJ"_u="$p tfix:$ac_default_p tfix")- o fx_ko= "rks"" `echo $LD_LIBRARY_PATH | tr ':' '\012'` ;so i T<_test "x$fx_ko= " != x ;spc$n&ooosom sedquote(,)dnl ooo ax_ko= =`echo $fx_ko= "| tat 's,/[^/]*$,,'` t om sedquote([,])dnl ooo ax_\eJ"_u="${ax_\eJ"_u}:${ax_ko= }"& ofinda nelse&ax_\eJ"_u="$4")-i)ax_\ave_LDFLAGS="$LDFLAGS")ax_\ave_LIBS="$LIBS"&- o fx_ko= "rks`echo $fx_\eJ"_u,| tr ':' '\012'` ;so i T<_test "AS_VAR_GET(ax_libs)" = ")som"riu " ;spc$n&ooo- o fx_libcrks"" `ao-xt$fx_ko= "-"rMPI i-"=\pf'$2' -prwor` ;so i T<_test "x$fx_lib" != x ;spc$n&ooosoosom sedquote(,)dnl ooo oo ax_dir=`echo $fx_libc| tat 's,/[^/]*$,,'` t t fx_lib=`echo $fx_libc| tat 's,.*/\([^/]*\)$,\1,'` t t om sedquote([,])dnl ooo oo crHrT"$fx_lib" inegttttttttlib*)egttttttttttom sedquote(,)dnl ooo oo t fx_lib="`echo $fx_libc| tat 's,lib\(.*\)\.[^.]*$,\1,'`"egttttttttttom sedquote([,])dnl ooo oo AS_VAR_SET([ax_liflags],"-L$ax_dir") ooo oo AS_VAR_SET([ax_libs],"-l$fx_lib") ooo oo ;; ooo oo *) ooo oo AS_VAR_SET([ax_liflags],"") ooo oo AS_VAR_SET(ax_libs,"$fx_lib") ooo oo ;; ooo oo esac ooo oo LDFLAGS="$ax_\ave_LDFLAGS AS_VAR_GET(ax_liflags)"egttttttLIBS="AS_VAR_GET(ax_libs) $ax_\ave_LIBS" ooo oo AC_LINK_IFELSE([zAdfynAT>dsfiest_zAdfynA $3egtttttttttI> ezAdfynAT>dsfiest_zAdfynA ttttttttt],[],[AS_VAR_SET(ax_liflags,"") ooo oo AS_VAR_SET(ax_libs,")som"riu ") ttttttttt])& ooo finoo da nofinda nAC_LANG_POP(F io_op) AC_MSG_RESULT([AS_VAR_GET(ax_liflags) AS_VAR_GET(ax_libs)]) i<_test "AS_VAR_GET(ax_libs)" = ")som"riu ";spc$n&oAS_TR_SH(F90_LDFLAGS_$1)=""& AS_TR_SH(F90_LIBS_$1)=""& $6 else&oAS_TR_SH(F90_LDFLAGS_$1)=AS_VAR_GET(ax_liflags)& AS_TR_SH(F90_LIBS_$1)=AS_VAR_GET(ax_libs)&o$5)-i)AC_SUBST(AS_TR_SH(F90_LDFLAGS_$1)))AC_SUBST(AS_TR_SH(F90_LIBS_$1)) AS_VAR_POPDEF([ax_libs]) AS_VAR_POPDEF([ax_liflags]) ]) sm-ppmntiSTics-r1036/m4/ax_f90_eniule_flag.m40000644000175000017500000000420111616214646017550 0u&tal sc,Csc,C# ===========================================================================&#ooooooohttp://www.nfennu.org/aoop>dsf-J"_umZ"/ax_f90_eniule_flag.html # ===========================================================================&# # SYNOPSIO&# # AX_F90_>Y ULE_FLAG&# # DESCRIPG, R&# # Fo-xtF io_op 90npyFules xxxxtieyrchlag.n]* t&yFulepxxxxtieyrchlagtam #