diff --git a/Sources/blocktridiagonalsolver_s.f90 b/Sources/blocktridiagonalsolver_s.f90 index 2991284..3c171f1 100644 --- a/Sources/blocktridiagonalsolver_s.f90 +++ b/Sources/blocktridiagonalsolver_s.f90 @@ -2229,7 +2229,7 @@ END SUBROUTINE GetRanks !! To be invoked, before solve, after initialize, by user, to set up the matrix !< !------------------------------------------------------------------------------- -SUBROUTINE SetMatrixRow( globrow, L, D, U ) +SUBROUTINE SetMatrixRow(globrow, L, D, U) !----------------------------------------------------------------------------- ! Formal arguments !----------------------------------------------------------------------------- @@ -2244,13 +2244,19 @@ SUBROUTINE SetMatrixRow( globrow, L, D, U ) !------------------------------------------- ! Sanity checks on globrow !------------------------------------------- - IF ( (globrow .LT. 1) .OR. (globrow .GT. N) ) THEN - IF(KPDBG) WRITE(OFU,*) 'SetMatrixRow: Bad input globrow ',globrow; CALL FL(OFU) - CALL ASSERT(.FALSE.,'blocktri #14') + IF ((globrow .LT. 1) .OR. (globrow .GT. N)) THEN + IF (KPDBG) THEN + WRITE (OFU,*) 'SetMatrixRow: Bad input globrow ',globrow + CALL FL(OFU) + END IF + CALL ASSERT(.FALSE.,'blocktri #14') END IF - IF ( (globrow .LT. startglobrow) .OR. (globrow .GT. endglobrow) ) THEN - IF(KPDBG) WRITE(OFU,*) 'SetMatrixRow: Non-local globrow ',globrow; CALL FL(OFU) - CALL ASSERT(.FALSE.,'blocktri #15') + IF ((globrow .LT. startglobrow) .OR. (globrow .GT. endglobrow)) THEN + IF (KPDBG) THEN + WRITE (OFU,*) 'SetMatrixRow: Non-local globrow ',globrow + CALL FL(OFU) + END IF + CALL ASSERT(.FALSE.,'blocktri #15') END IF globrowoff = globrow-startglobrow+1 @@ -2258,25 +2264,25 @@ SUBROUTINE SetMatrixRow( globrow, L, D, U ) !------------------------------------------- ! Copy given blocks into allocated matrix !------------------------------------------- - DO i = 1, M - DO j = 1, M - IF ( globrow .EQ. 1 ) THEN - val = 0 - ELSE - val = L(i,j) - END IF - lelement(1, globrowoff)%L(i,j) = val + DO j = 1, M + DO i = 1, M + IF (globrow .EQ. 1) THEN + val = 0 + ELSE + val = L(i,j) + END IF + lelement(1, globrowoff)%L(i,j) = val - val = D(i,j) - lelement(1, globrowoff)%D(i,j) = val + val = D(i,j) + lelement(1, globrowoff)%D(i,j) = val - IF ( globrow .EQ. N ) THEN - val = 0 - ELSE - val = U(i,j) - END IF - lelement(1, globrowoff)%U(i,j) = val - END DO + IF (globrow .EQ. N) THEN + val = 0 + ELSE + val = U(i,j) + END IF + lelement(1, globrowoff)%U(i,j) = val + END DO END DO !------------------------------------------- @@ -2296,7 +2302,7 @@ END SUBROUTINE SetMatrixRow !! To be invoked, before solve, after initialize, by user, to set up the matrix !< !------------------------------------------------------------------------------- -SUBROUTINE SetMatrixRowL( globrow, L ) +SUBROUTINE SetMatrixRowL(globrow, L) !----------------------------------------------------------------------------- ! Formal arguments !----------------------------------------------------------------------------- @@ -2311,29 +2317,35 @@ SUBROUTINE SetMatrixRowL( globrow, L ) !------------------------------------------- ! Sanity checks on globrow !------------------------------------------- - IF ( (globrow .LT. 1) .OR. (globrow .GT. N) ) THEN - IF(KPDBG) WRITE(OFU,*) 'SetMatrixRowL: Bad input globrow ',globrow; CALL FL(OFU) - CALL ASSERT(.FALSE.,'blocktri #16') + IF ((globrow .LT. 1) .OR. (globrow .GT. N)) THEN + IF (KPDBG) THEN + WRITE(OFU,*) 'SetMatrixRowL: Bad input globrow ',globrow + CALL FL(OFU) + END IF + CALL ASSERT(.FALSE.,'blocktri #16') END IF - IF ( (globrow .LT. startglobrow) .OR. (globrow .GT. endglobrow) ) THEN - IF(KPDBG) WRITE(OFU,*) 'SetMatrixRowL: Non-local globrow ',globrow; CALL FL(OFU) - CALL ASSERT(.FALSE.,'blocktri #17') + IF ((globrow .LT. startglobrow) .OR. (globrow .GT. endglobrow)) THEN + IF (KPDBG) THEN + WRITE(OFU,*) 'SetMatrixRowL: Non-local globrow ',globrow + CALL FL(OFU) + END IF + CALL ASSERT(.FALSE.,'blocktri #17') END IF - globrowoff = globrow-startglobrow+1 + globrowoff = globrow - startglobrow + 1 !------------------------------------------- ! Copy given L block into allocated matrix !------------------------------------------- - DO i = 1, M - DO j = 1, M - IF ( globrow .EQ. 1 ) THEN - val = 0 - ELSE - val = L(i,j) - END IF - lelement(1, globrowoff)%L(i,j) = val - END DO + DO j = 1, M + DO i = 1, M + IF (globrow .EQ. 1) THEN + val = 0 + ELSE + val = L(i,j) + END IF + lelement(1, globrowoff)%L(i,j) = val + END DO END DO !------------------------------------------- @@ -2351,7 +2363,7 @@ END SUBROUTINE SetMatrixRowL !! To be invoked, before solve, after initialize, by user, to set up the matrix !< !------------------------------------------------------------------------------- -SUBROUTINE SetMatrixRowD( globrow, D ) +SUBROUTINE SetMatrixRowD(globrow, D) !----------------------------------------------------------------------------- ! Formal arguments !----------------------------------------------------------------------------- @@ -2366,25 +2378,31 @@ SUBROUTINE SetMatrixRowD( globrow, D ) !------------------------------------------- ! Sanity checks on globrow !------------------------------------------- - IF ( (globrow .LT. 1) .OR. (globrow .GT. N) ) THEN - IF(KPDBG) WRITE(OFU,*) 'SetMatrixRowD: Bad input globrow ',globrow; CALL FL(OFU) - CALL ASSERT(.FALSE.,'blocktri #18') + IF ((globrow .LT. 1) .OR. (globrow .GT. N)) THEN + IF (KPDBG) THEN + WRITE(OFU,*) 'SetMatrixRowD: Bad input globrow ',globrow + CALL FL(OFU) + END IF + CALL ASSERT(.FALSE.,'blocktri #18') END IF - IF ( (globrow .LT. startglobrow) .OR. (globrow .GT. endglobrow) ) THEN - IF(KPDBG) WRITE(OFU,*) 'SetMatrixRowD: Non-local globrow ',globrow; CALL FL(OFU) - CALL ASSERT(.FALSE.,'blocktri #19') + IF ((globrow .LT. startglobrow) .OR. (globrow .GT. endglobrow)) THEN + IF (KPDBG) THEN + WRITE(OFU,*) 'SetMatrixRowD: Non-local globrow ',globrow + CALL FL(OFU) + END IF + CALL ASSERT(.FALSE.,'blocktri #19') END IF - globrowoff = globrow-startglobrow+1 + globrowoff = globrow - startglobrow + 1 !------------------------------------------- ! Copy given D block into allocated matrix !------------------------------------------- - DO i = 1, M - DO j = 1, M - val = D(i,j) - lelement(1, globrowoff)%D(i,j) = val - END DO + DO j = 1, M + DO i = 1, M + val = D(i,j) + lelement(1, globrowoff)%D(i,j) = val + END DO END DO !------------------------------------------- @@ -2402,7 +2420,7 @@ END SUBROUTINE SetMatrixRowD !! To be invoked, before solve, after initialize, by user, to set up the matrix !< !------------------------------------------------------------------------------- -SUBROUTINE SetMatrixRowU( globrow, U ) +SUBROUTINE SetMatrixRowU(globrow, U) !----------------------------------------------------------------------------- ! Formal arguments !----------------------------------------------------------------------------- @@ -2417,29 +2435,35 @@ SUBROUTINE SetMatrixRowU( globrow, U ) !------------------------------------------- ! Sanity checks on globrow !------------------------------------------- - IF ( (globrow .LT. 1) .OR. (globrow .GT. N) ) THEN - IF(KPDBG) WRITE(OFU,*) 'SetMatrixRowU: Bad input globrow ',globrow; CALL FL(OFU) - CALL ASSERT(.FALSE.,'blocktri #20') + IF ((globrow .LT. 1) .OR. (globrow .GT. N)) THEN + IF (KPDBG) THEN + WRITE(OFU,*) 'SetMatrixRowU: Bad input globrow ',globrow + CALL FL(OFU) + END IF + CALL ASSERT(.FALSE.,'blocktri #20') END IF - IF ( (globrow .LT. startglobrow) .OR. (globrow .GT. endglobrow) ) THEN - IF(KPDBG) WRITE(OFU,*) 'SetMatrixRowU: Non-local globrow ',globrow; CALL FL(OFU) - CALL ASSERT(.FALSE.,'blocktri #21') + IF ((globrow .LT. startglobrow) .OR. (globrow .GT. endglobrow)) THEN + IF (KPDBG) THEN + WRITE(OFU,*) 'SetMatrixRowU: Non-local globrow ',globrow + CALL FL(OFU) + END IF + CALL ASSERT(.FALSE.,'blocktri #21') END IF - globrowoff = globrow-startglobrow+1 + globrowoff = globrow - startglobrow + 1 !------------------------------------------- ! Copy given U block into allocated matrix !------------------------------------------- - DO i = 1, M - DO j = 1, M - IF ( globrow .EQ. N ) THEN - val = 0 - ELSE - val = U(i,j) - END IF - lelement(1, globrowoff)%U(i,j) = val - END DO + DO j = 1, M + DO i = 1, M + IF (globrow .EQ. N) THEN + val = 0 + ELSE + val = U(i,j) + END IF + lelement(1, globrowoff)%U(i,j) = val + END DO END DO !------------------------------------------- @@ -2457,7 +2481,7 @@ END SUBROUTINE SetMatrixRowU !! To be invoked, before solve, after initialize, by user, to set up the matrix !< !------------------------------------------------------------------------------- -SUBROUTINE SetMatrixRowColL( globrow, Lj, j ) +SUBROUTINE SetMatrixRowColL(globrow, Lj, j) !----------------------------------------------------------------------------- ! Formal arguments !----------------------------------------------------------------------------- @@ -2473,31 +2497,40 @@ SUBROUTINE SetMatrixRowColL( globrow, Lj, j ) !------------------------------------------- ! Sanity checks on globrow !------------------------------------------- - IF ( (globrow .LT. 1) .OR. (globrow .GT. N) ) THEN - IF(KPDBG) WRITE(OFU,*) 'SetMatrixRowColL: Bad input globrow ',globrow; CALL FL(OFU) - CALL ASSERT(.FALSE.,'blocktri #22') + IF ((globrow .LT. 1) .OR. (globrow .GT. N) ) THEN + IF (KPDBG) THEN + WRITE (OFU,*) 'SetMatrixRowColL: Bad input globrow ',globrow + CALL FL(OFU) + END IF + CALL ASSERT(.FALSE.,'blocktri #22') END IF - IF ( (globrow .LT. startglobrow) .OR. (globrow .GT. endglobrow) ) THEN - IF(KPDBG) WRITE(OFU,*) 'SetMatrixRowColL: Non-local globrow ',globrow; CALL FL(OFU) - CALL ASSERT(.FALSE.,'blocktri #23') + IF ((globrow .LT. startglobrow) .OR. (globrow .GT. endglobrow)) THEN + IF (KPDBG) THEN + WRITE (OFU,*) 'SetMatrixRowColL: Non-local globrow ',globrow + CALL FL(OFU) + END IF + CALL ASSERT(.FALSE.,'blocktri #23') END IF - IF ( .NOT. ((1 .LE. j) .AND. (j .LE. M)) ) THEN - IF(KPDBG) WRITE(OFU,*) 'SetMatrixRowColL: Bad j column ',j; CALL FL(OFU) - CALL ASSERT(.FALSE.,'blocktri #24') + IF (.NOT.((1 .LE. j) .AND. (j .LE. M))) THEN + IF (KPDBG) THEN + WRITE(OFU,*) 'SetMatrixRowColL: Bad j column ',j + CALL FL(OFU) + END IF + CALL ASSERT(.FALSE.,'blocktri #24') END IF - globrowoff = globrow-startglobrow+1 + globrowoff = globrow - startglobrow + 1 !------------------------------------------- ! Copy given L column into allocated matrix !------------------------------------------- DO i = 1, M - IF ( globrow .EQ. 1 ) THEN - val = 0 - ELSE - val = Lj(i) - END IF - lelement(1, globrowoff)%L(i,j) = val + IF (globrow .EQ. 1) THEN + val = 0 + ELSE + val = Lj(i) + END IF + lelement(1, globrowoff)%L(i,j) = val END DO !------------------------------------------- @@ -2515,7 +2548,7 @@ END SUBROUTINE SetMatrixRowColL !! To be invoked, before solve, after initialize, by user, to set up the matrix !< !------------------------------------------------------------------------------- -SUBROUTINE SetMatrixRowColD( globrow, Dj, j ) +SUBROUTINE SetMatrixRowColD(globrow, Dj, j) !----------------------------------------------------------------------------- ! Formal arguments !----------------------------------------------------------------------------- @@ -2569,13 +2602,14 @@ END SUBROUTINE SetMatrixRowColD !! To be invoked, before solve, after initialize, by user, to set up the matrix !< !------------------------------------------------------------------------------- -SUBROUTINE SetMatrixRowColU( globrow, Uj, j ) +SUBROUTINE SetMatrixRowColU(globrow, Uj, j) +USE descriptor_mod, ONLY: iam !----------------------------------------------------------------------------- ! Formal arguments !----------------------------------------------------------------------------- - INTEGER, INTENT(IN) :: globrow !1 !dblk(js) DataItem = gc(:,js)/eps - IF (m.eq.0 .and. n.lt.0) DataItem = 0 - IF (ALL(DataItem .EQ. zero)) DataItem(icol) = one - + IF (m.eq.0 .and. n.lt.0) THEN + DataItem = 0 + END IF + IF (ALL(DataItem .EQ. zero)) THEN + DataItem(icol) = one + END IF IF (l_diagonal_only) THEN temp=DataItem(icol) DataItem=0 DataItem(icol)=temp END IF - SavedDiag=DataItem; istat=4 + SavedDiag = DataItem CALL receive(PROBEFLAG) - CALL send(SavedDiag,js,istat,icol,procID) + CALL send(SavedDiag, js, SAVEDIAG, icol, procID) IF(procID-1.NE.iam) sendCount(procID) = sendCount(procID)+1 CALL receive(PROBEFLAG) ! Boundary condition at js=1 and ns (CATCH ALL OF THEM HERE) ! and m=0,n<0: NEED THIS to avoid (near) singular Hessian ! ASSUMES DIAGONALS ARE ALL NEGATIVE - istat = 2; js1 = js + js1 = js CALL receive(PROBEFLAG) - CALL send(DataItem,js1,istat,icol,procID) + CALL send(DataItem, js1, DIAG, icol, procID) IF(procID-1.NE.iam) sendCount(procID) = sendCount(procID)+1 CALL receive(PROBEFLAG) @@ -603,9 +614,8 @@ SUBROUTINE Compute_Hessian_Blocks_With_Col_Redist (xc, gc, func) DataItem=0 DataItem(icol)=temp END IF - istat = 3 CALL receive(PROBEFLAG) - CALL send(DataItem,js1,istat,icol,procID) + CALL send(DataItem, js1, LOWER, icol, procID) IF(procID-1.NE.iam) sendCount(procID) = sendCount(procID)+1 CALL receive(PROBEFLAG) END IF !JS < NS diff --git a/Sources/nscalingtools.f90 b/Sources/nscalingtools.f90 index 987de88..d6989fa 100644 --- a/Sources/nscalingtools.f90 +++ b/Sources/nscalingtools.f90 @@ -41,7 +41,11 @@ MODULE nscalingtools INTEGER :: TOFU INTEGER :: OpenStatus, nargs INTEGER, PRIVATE :: N, M, K, KSQR -INTEGER, PARAMETER :: SAVEDIAG=4, LOWER=3,DIAG=2,UPPER=1 + +INTEGER, PARAMETER :: SAVEDIAG = 4 +INTEGER, PARAMETER :: LOWER = 3 +INTEGER, PARAMETER :: DIAG = 2 +INTEGER, PARAMETER :: UPPER = 1 !This is to stitch to blocktri variables of !same name. Just USE nscalingtools. @@ -74,7 +78,7 @@ SUBROUTINE MyEnvVariables !-------------------------------------------------------------------------- ! Default values of environment values that users are allowed to change !-------------------------------------------------------------------------- -PARSOLVER=.FALSE. +PARSOLVER=.TRUE. PARFUNCTISL=.TRUE. !-------------------------------------------------------------------------- @@ -343,144 +347,131 @@ END SUBROUTINE computeAllGatherParameters !------------------------------------------------ ! A generic binary search routine !------------------------------------------------ -SUBROUTINE search(query,FOUND,location) +SUBROUTINE search(query, FOUND, location) -!INTEGER, DIMENSION(:), INTENT(IN) :: qarray -INTEGER, INTENT(IN) :: query +INTEGER, INTENT(IN) :: query LOGICAL, INTENT(OUT) :: FOUND INTEGER, INTENT(OUT) :: location -INTEGER :: p +INTEGER :: p CALL assert(MAPPINGDONE, 'search') ! To account for P>N -activeranks=activeranks -IF (activeranks.GT.N) activeranks=N +activeranks = activeranks +IF (activeranks.GT.N) THEN + activeranks = N +END IF ! Dumb search algorithm -FOUND=.FALSE. -DO p=1,activeranks - IF ((bcyclicStartBlockProc(p).LE.query).AND.(query.LE.bcyclicEndBlockProc(p))) THEN - FOUND=.TRUE. - location=p - EXIT - END IF +FOUND = .FALSE. +DO p = 1, activeranks + IF ((bcyclicStartBlockProc(p) .LE. query) .AND. (query .LE. bcyclicEndBlockProc(p))) THEN + FOUND = .TRUE. + location = p + EXIT + END IF END DO END SUBROUTINE search !------------------------------------------------ !------------------------------------------------ -SUBROUTINE SetBlockTriDataStruct(it, br, ic, coldata) - -REAL(dp), DIMENSION(M), INTENT(IN) :: coldata -INTEGER, INTENT(IN) :: br, ic, it - -IF (it.EQ.UPPER) THEN !UPPER DIAGONAL - CALL SetBlockRowCol(br,ic,coldata,UPPER) -ELSE IF (it.EQ.DIAG) THEN !MAIN DIAGONAL - CALL SetBlockRowCol(br,ic,coldata,DIAG) -ELSE IF (it.EQ.LOWER) THEN !LOWER DIAGONAL - CALL SetBlockRowCol(br,ic,coldata,LOWER) -ELSE IF (it.EQ.SAVEDIAG) THEN !SAVED DIAGONAL - CALL StoreDiagonal(br,ic,coldata) -ELSE - WRITE(*,*)'Something wrong in ', rank, siesta_MPI_Status(MPI_TAG),br,ic,it - CALL ASSERT(.FALSE., 'IT wrong SetBlockTriDataStruct:') -END IF -END SUBROUTINE SetBlockTriDataStruct -!------------------------------------------------ - -!------------------------------------------------ -SUBROUTINE send(columnData,blockRowNum,blockRowType,columnNum, procNum) +SUBROUTINE send(columnData, blockRowNum, blockRowType, columnNum, procNum) REAL(dp), DIMENSION(1:M), INTENT(IN) :: columnData -INTEGER, INTENT(IN) :: blockRowNum, blockRowType, columnNum -INTEGER, INTENT(OUT) :: procNum +INTEGER, INTENT(IN) :: blockRowNum +INTEGER, INTENT(IN) :: blockRowType +INTEGER, INTENT(IN) :: columnNum +INTEGER, INTENT(OUT) :: procNum -CHARACTER, DIMENSION(PACKSIZE) :: sendbuf -INTEGER :: positn -LOGICAL :: FOUND +CHARACTER, DIMENSION(PACKSIZE) :: sendbuf +INTEGER :: positn +LOGICAL :: FOUND positn=0 -CALL MPI_Pack(blockRowNum,1,MPI_INTEGER,sendBuf,PACKSIZE,positn,SIESTA_COMM,MPI_ERR) -CALL MPI_Pack(columnNum,1,MPI_INTEGER,sendBuf,PACKSIZE,positn,SIESTA_COMM,MPI_ERR) -CALL MPI_Pack(columnData,M,MPI_REAL8,sendBuf,PACKSIZE,positn,SIESTA_COMM,MPI_ERR) +CALL MPI_Pack(blockRowNum, 1, MPI_INTEGER, sendBuf, PACKSIZE, positn, SIESTA_COMM, MPI_ERR) +CALL MPI_Pack(columnNum, 1, MPI_INTEGER, sendBuf, PACKSIZE, positn, SIESTA_COMM, MPI_ERR) +CALL MPI_Pack(columnData, M, MPI_REAL8, sendBuf, PACKSIZE, positn, SIESTA_COMM, MPI_ERR) -FOUND=.FALSE. -CALL search(blockRowNum,FOUND,procNum) +FOUND = .FALSE. +CALL search(blockRowNum, FOUND, procNum) IF (FOUND) THEN - IF(procNum-1.EQ.rank) THEN - IF (blockRowType.EQ.UPPER) THEN - CALL SetBlockTriDataStruct(UPPER,blockRowNum,columnNum,columnData) - ELSE IF (blockRowType.EQ.SAVEDIAG) THEN - CALL SetBlockTriDataStruct(SAVEDIAG,blockRowNum,columnNum,columnData) - ELSE IF (blockRowType.EQ.DIAG) THEN - CALL SetBlockTriDataStruct(DIAG,blockRowNum,columnNum,columnData) - ELSE IF (blockRowType.EQ.LOWER) THEN - CALL SetBlockTriDataStruct(LOWER,blockRowNum,columnNum,columnData) - ELSE - CALL ASSERT(.FALSE.,'send error, blockRowType:') - END IF - ELSE - IF (BUFFERED) THEN - CALL MPI_BSend(sendbuf,positn,MPI_PACKED,procNum-1,blockRowType,SIESTA_COMM,MPI_ERR) - ELSE - CALL MPI_Send(sendbuf,positn,MPI_PACKED,procNum-1,blockRowType,SIESTA_COMM,MPI_ERR) - END IF - END IF -ELSE - CALL assert(MAPPINGDONE, 'send') + IF (procNum-1 .EQ. rank) THEN + IF (blockRowType .EQ. UPPER) THEN + CALL SetMatrixRowColU(blockRowNum, columnData, columnNum) + ELSE IF (blockRowType .EQ. SAVEDIAG) THEN + CALL StoreDiagonal(blockRowNum, columnNum, columnData) + ELSE IF (blockRowType .EQ. DIAG) THEN + CALL SetMatrixRowColD(blockRowNum, columnData, columnNum) + ELSE IF (blockRowType .EQ. LOWER) THEN + CALL SetMatrixRowColL(blockRowNum, columnData, columnNum) + ELSE + CALL ASSERT(.FALSE., 'send error, blockRowType:') + END IF + ELSE + IF (BUFFERED) THEN + CALL MPI_BSend(sendbuf, positn, MPI_PACKED, procNum-1, blockRowType, SIESTA_COMM, MPI_ERR) + ELSE + CALL MPI_Send(sendbuf, positn, MPI_PACKED, procNum-1, blockRowType, SIESTA_COMM, MPI_ERR) + END IF + END IF +ELSE + CALL assert(MAPPINGDONE, 'send') END IF END SUBROUTINE send !------------------------------------------------ !------------------------------------------------ -SUBROUTINE receive (IPROBEFLAG) +SUBROUTINE receive(IPROBEFLAG) +USE blocktridiagonalsolver_s, ONLY: & +& SetMatrixRowColL, SetMatrixRowColD, SetMatrixRowColU -LOGICAL, INTENT(IN) :: IPROBEFLAG -LOGICAL :: FLAG -REAL(dp), DIMENSION(M) :: coldata +LOGICAL, INTENT(IN) :: IPROBEFLAG +LOGICAL :: FLAG +REAL(dp), DIMENSION(M) :: coldata CHARACTER, DIMENSION(PACKSIZE) :: recvbuf -INTEGER :: br, ic, it -INTEGER :: positn - -FLAG=.TRUE. -IF(IPROBEFLAG) CALL MPI_Iprobe (MPI_ANY_SOURCE,MPI_ANY_TAG,SIESTA_COMM,FLAG,siesta_MPI_Status,MPI_ERR) +INTEGER :: br +INTEGER :: ic +INTEGER :: it +INTEGER :: positn + +FLAG = .TRUE. +IF (IPROBEFLAG) THEN + CALL MPI_Iprobe(MPI_ANY_SOURCE, MPI_ANY_TAG, SIESTA_COMM, FLAG, siesta_MPI_Status, MPI_ERR) +END IF IF (FLAG) THEN - CALL MPI_Recv(recvbuf,PACKSIZE,MPI_PACKED,MPI_ANY_SOURCE,& - &MPI_ANY_TAG,SIESTA_COMM,siesta_MPI_Status,MPI_ERR) - nrecd=nrecd+1 - - it=siesta_MPI_Status(MPI_TAG) - IF (it.NE.1.AND.it.NE.2.AND.it.NE.3.AND.it.NE.4) THEN - WRITE(TOFU,*) 'MPI_TAG:',it; FLUSH(TOFU) - CALL ASSERT(.FALSE.,'receive 1 error') - END IF - positn=0 - CALL MPI_Unpack(recvbuf,PACKSIZE,positn,br,1,MPI_INTEGER,SIESTA_COMM,MPI_ERR) - CALL MPI_Unpack(recvbuf,PACKSIZE,positn,ic,1,MPI_INTEGER,SIESTA_COMM,MPI_ERR) - CALL MPI_Unpack(recvbuf,PACKSIZE,positn,coldata,M,MPI_REAL8,SIESTA_COMM,MPI_ERR) - localbrow=br-bcyclicStartBlockProc(rank+1)+1 - - IF (localbrow.LT.1.OR.localbrow.GT.numBlocks) THEN - WRITE(TOFU,*) 'localbrow:',localbrow; FLUSH(TOFU) - CALL ASSERT(.FALSE.,'receive 2 error') - END IF - - IF (it.EQ.1) THEN !UPPER DIAGONAL - CALL SetBlockRowCol(br,ic,coldata,1) - ELSE IF (it.EQ.2) THEN !MAIN DIAGONAL - CALL SetBlockRowCol(br,ic,coldata,2) - ELSE IF (it.EQ.3) THEN !LOWER DIAGONAL - CALL SetBlockRowCol(br,ic,coldata,3) - ELSE IF (it.EQ.4) THEN !SAVED DIAGONAL - CALL StoreDiagonal(br,ic,coldata) - ELSE - WRITE(*,*)'Something wrong in ', rank,siesta_MPI_Status(MPI_TAG),br,ic,it - CALL ASSERT(.FALSE.,'receive 3 error') - END IF + CALL MPI_Recv(recvbuf, PACKSIZE, MPI_PACKED, MPI_ANY_SOURCE, MPI_ANY_TAG, SIESTA_COMM, siesta_MPI_Status, MPI_ERR) + nrecd = nrecd + 1 + + it = siesta_MPI_Status(MPI_TAG) + IF (it .NE. 1 .AND. it .NE. 2 .AND. it .NE. 3 .AND. it .NE. 4) THEN + WRITE(TOFU,*) 'MPI_TAG:',it; FLUSH(TOFU) + CALL ASSERT(.FALSE.,'receive 1 error') + END IF + positn = 0 + CALL MPI_Unpack(recvbuf, PACKSIZE, positn, br, 1, MPI_INTEGER, SIESTA_COMM, MPI_ERR) + CALL MPI_Unpack(recvbuf, PACKSIZE, positn, ic, 1, MPI_INTEGER, SIESTA_COMM, MPI_ERR) + CALL MPI_Unpack(recvbuf, PACKSIZE, positn, coldata, M, MPI_REAL8, SIESTA_COMM, MPI_ERR) + localbrow = br - bcyclicStartBlockProc(rank + 1) + 1 + + IF (localbrow .LT. 1 .OR. localbrow .GT. numBlocks) THEN + WRITE(TOFU,*) 'localbrow:',localbrow; FLUSH(TOFU) + CALL ASSERT(.FALSE.,'receive 2 error') + END IF + + IF (it .EQ. UPPER) THEN + CALL SetMatrixRowColU(br, coldata, ic) + ELSE IF (it .EQ. DIAG) THEN + CALL SetMatrixRowColD(br, coldata, ic) + ELSE IF (it .EQ. LOWER) THEN + CALL SetMatrixRowColL(br, coldata, ic) + ELSE IF (it .EQ. SAVEDIAG) THEN + CALL StoreDiagonal(br, ic, coldata) + ELSE + WRITE(*,*)'Something wrong in ', rank,siesta_MPI_Status(MPI_TAG),br,ic,it + CALL ASSERT(.FALSE.,'receive 3 error') + END IF END IF END SUBROUTINE receive @@ -511,23 +502,6 @@ SUBROUTINE GetFullSolution(invec,outvec) END SUBROUTINE GetFullSolution !------------------------------------------------ -!------------------------------------------------ -SUBROUTINE SetBlockRowCol( globrow, colnum, buf, opt) - INTEGER :: globrow - REAL(dp), INTENT(IN), DIMENSION(M) :: buf - INTEGER :: colnum, opt - IF (opt.EQ.1) THEN - CALL SetMatrixRowColU( globrow, buf, colnum ) - ELSE IF (opt.EQ.2) THEN - CALL SetMatrixRowColD( globrow, buf, colnum ) - ELSE IF (opt.EQ.3) THEN - CALL SetMatrixRowColL( globrow, buf, colnum ) - ELSE - WRITE(*,*) 'Error in diagonal type option' - END IF -END SUBROUTINE SetBlockRowCol -!------------------------------------------------ - !------------------------------------------------------------------------------- SUBROUTINE CheckPoint(ckpt, infname) diff --git a/Sources/restart_mod.f90 b/Sources/restart_mod.f90 index 645e315..0225040 100644 --- a/Sources/restart_mod.f90 +++ b/Sources/restart_mod.f90 @@ -10,7 +10,6 @@ MODULE restart_mod USE ezcdf USE stel_kinds - USE utilities, ONLY: GradientFull USE metrics, ONLY: tolowerh USE descriptor_mod, ONLY: iam USE shared_data, ONLY: lasym, unit_out diff --git a/Sources/siesta_currents.f90 b/Sources/siesta_currents.f90 index cc7958c..6176f78 100644 --- a/Sources/siesta_currents.f90 +++ b/Sources/siesta_currents.f90 @@ -230,17 +230,23 @@ SUBROUTINE cv_currents(bsupsijh, bsupuijh, bsupvijh, & END IF temp(1) = SUM(wint(:,:,nmin:nmax) * & - (bs_filter - bsubsijh(:,:,nmin:nmax))**2) + (bs_filter(:,:,nmin:nmax) - & + bsubsijh(:,:,nmin:nmax))**2) temp(2) = SUM(wint(:,:,nmin:nmax) * & - (bs_filter + bsubsijh(:,:,nmin:nmax))**2) + (bs_filter(:,:,nmin:nmax) + & + bsubsijh(:,:,nmin:nmax))**2) temp(3) = SUM(wint(:,:,nmin:nmax) * & - (bu_filter - bsubuijh(:,:,nmin:nmax))**2) + (bu_filter(:,:,nmin:nmax) - & + bsubuijh(:,:,nmin:nmax))**2) temp(4) = SUM(wint(:,:,nmin:nmax) * & - (bu_filter + bsubuijh(:,:,nmin:nmax))**2) + (bu_filter(:,:,nmin:nmax) + & + bsubuijh(:,:,nmin:nmax))**2) temp(5) = SUM(wint(:,:,nmin:nmax) * & - (bv_filter - bsubvijh(:,:,nmin:nmax))**2) + (bv_filter(:,:,nmin:nmax) - & + bsubvijh(:,:,nmin:nmax))**2) temp(6) = SUM(wint(:,:,nmin:nmax) * & - (bv_filter + bsubvijh(:,:,nmin:nmax))**2) + (bv_filter(:,:,nmin:nmax) + & + bsubvijh(:,:,nmin:nmax))**2) #if defined(MPI_OPT) IF (PARSOLVER) THEN CALL MPI_ALLREDUCE(MPI_IN_PLACE, temp, 6, MPI_REAL8, MPI_SUM, & diff --git a/Sources/siesta_force.f90 b/Sources/siesta_force.f90 index 200df34..a246201 100644 --- a/Sources/siesta_force.f90 +++ b/Sources/siesta_force.f90 @@ -84,7 +84,7 @@ SUBROUTINE update_force REAL (dp), DIMENSION(:,:,:), ALLOCATABLE :: KxBuij REAL (dp), DIMENSION(:,:,:), ALLOCATABLE :: KxBvij REAL (dp), DIMENSION(:,:), ALLOCATABLE :: pardamp - INTEGER :: istat + INTEGER :: istat ,m,n INTEGER :: n1 INTEGER :: n2 REAL (dp) :: ton @@ -118,6 +118,16 @@ SUBROUTINE update_force bsupsijh, bsupuijh, bsupvijh, pijh, f_cos) END IF +! IF (nsmin .le. 5 .and. nsmax .ge. 5) THEN +! DO n = -ntor, ntor +! DO m = 0, mpol +! IF (jpmnch(m,n,5) .gt. 0.0 .or. djpmnch(m,n,6) .gt. 0.0) THEN +! WRITE (*,*) iam, n, m, nsmin, nsmax, jpmnch(m,n,6), djpmnch(m,n,6) +! END IF +! END DO +! END DO +! END IF + ! Update thermal energy (pressure based). pijh contains the jacobian term at ! this point. WPRES: IF (l_getwmhd) THEN @@ -191,7 +201,7 @@ SUBROUTINE update_force END IF CALL Apply_ColScale(gc, col_scale, nsmin, nsmax) - + DEALLOCATE(pijf1, KxBsij, KxBuij, KxBvij, pijh, stat=istat) IF (ALLOCATED(pardamp)) THEN DEALLOCATE(pardamp) @@ -504,7 +514,7 @@ SUBROUTINE GetMHDForce(fsubsmnf, fsubumnf, fsubvmnf, pijh, & END IF ! Add pressure gradient to the lorentz force. - fsubsmnf(:,:,nsmin:nsmax) = fsubsmnf(:,:,nsmin:nsmax) - pmnf_ds + fsubsmnf(:,:,nsmin:nsmax) = fsubsmnf(:,:,nsmin:nsmax) - pmnf_ds(:,:,nsmin:nsmax) DO m = 0, mpol moff = m + LBOUND(fsubumnf, 1) fsubumnf(moff,:,nsmin:nsmax) = fsubumnf(moff,:,nsmin:nsmax) & diff --git a/Sources/utilities.f90 b/Sources/utilities.f90 index 27fecfe..5a7dc8c 100644 --- a/Sources/utilities.f90 +++ b/Sources/utilities.f90 @@ -131,12 +131,16 @@ SUBROUTINE GradientHalf_p(gradienth, vecf) !> @brief Calculate the gradient to the full mesh from a half mesh quantity. !> !> The arrays must be passed in as ALLOCATABLE to preserve the array bounds. +!> There are three scenarios we need to anticipate for the radial dimension. +!> The easiest is when the upper bound of gradientf matches vech. Otherwise +!> vech can be the full ns range of one more than the gradientf. To handle this +!> an extra is calculated which can be a maximum of one. !> !> @param[inout] gradientf Gradient on the full grid. !> @param[in] vech Half grid quantity. !------------------------------------------------------------------------------- SUBROUTINE GradientFull(gradientf, vech) - +USE descriptor_mod, ONLY: iam IMPLICIT NONE ! Declare Arguments @@ -146,15 +150,18 @@ SUBROUTINE GradientFull(gradientf, vech) ! local variables INTEGER :: nsmin INTEGER :: nsmax + INTEGER :: extra ! Start of executable code nsmin = LBOUND(gradientf,3) nsmax = UBOUND(gradientf,3) + extra = MIN(UBOUND(vech,3) - nsmax, 1) - gradientf(:,:,nsmin:nsmax - 1) = ohs*(vech(:,:,nsmin + 1:nsmax) & - - vech(:,:,nsmin:nsmax - 1)) + gradientf(:,:,nsmin:nsmax + extra - 1) = & + ohs*(vech(:,:,nsmin + 1:nsmax + extra) - & + vech(:,:,nsmin:nsmax + extra - 1)) - IF (UBOUND(gradientf,3) .ge. nsmax) THEN + IF (UBOUND(gradientf,3) .ge. nsmax + extra) THEN gradientf(:,:,nsmax:) = 0 END IF @@ -463,6 +470,7 @@ SUBROUTINE curl_ftoh(asubsmnf, asubumnf, asubvmnf, & SUBROUTINE curl_htof(bsubsmnh, bsubumnh, bsubvmnh, & jksupsmnf, jksupumnf, jksupvmnf, parity, & nsmin, nsmax, nsend, curtor) +USE descriptor_mod, ONLY: iam USE stel_constants IMPLICIT NONE diff --git a/Testing/tests/CMakeLists.txt b/Testing/tests/CMakeLists.txt index 1ed16e8..1c46dfb 100644 --- a/Testing/tests/CMakeLists.txt +++ b/Testing/tests/CMakeLists.txt @@ -2,4 +2,5 @@ add_subdirectory (siesta_init_test) add_subdirectory (siesta_final_test) add_subdirectory (siesta_unit_tests) add_subdirectory (siesta_sparse_test) +add_subdirectory (siesta_mpi_test) diff --git a/Testing/tests/siesta_mpi_test/CMakeLists.txt b/Testing/tests/siesta_mpi_test/CMakeLists.txt new file mode 100644 index 0000000..085e696 --- /dev/null +++ b/Testing/tests/siesta_mpi_test/CMakeLists.txt @@ -0,0 +1,192 @@ +# Copy input file from the source to the build directory. +configure_file (${CMAKE_CURRENT_SOURCE_DIR}/siesta.jcf + ${CMAKE_CURRENT_BINARY_DIR}/siesta.jcf + COPYONLY) +configure_file (${CMAKE_CURRENT_SOURCE_DIR}/input.test.vmec + ${CMAKE_CURRENT_BINARY_DIR}/input.test.vmec + COPYONLY) + +# Run VMEC and SIESTA the compare the results. +add_test (NAME siesta_mpi_vmec_test + COMMAND $ $ $ $/xvmec input.test.vmec) +set_tests_properties (siesta_mpi_vmec_test + PROPERTIES + PROCESSORS $) + +macro (siesta_mpi_tests nproc) + math (EXPR last_nproc "${nproc} - 1") + + add_test (NAME siesta_mpi_siesta_${nproc}_test + COMMAND $ $ ${nproc} $/xsiesta) + set_tests_properties (siesta_mpi_siesta_${nproc}_test + PROPERTIES + DEPENDS $,"siesta_mpi_vmec_test;siesta_mpi_${last_nproc}_test;siesta_mpi_${last_nproc}_curtor_test;siesta_mpi_${last_nproc}_chipf_test;siesta_mpi_${last_nproc}_phipf_test;siesta_mpi_${last_nproc}_r_1_test;siesta_mpi_${last_nproc}_r_2_test;siesta_mpi_${last_nproc}_r_3_test;siesta_mpi_${last_nproc}_r_4_test;siesta_mpi_${last_nproc}_drdu_1_test;siesta_mpi_${last_nproc}_drdu_2_test;siesta_mpi_${last_nproc}_drdu_3_test;siesta_mpi_${last_nproc}_drdu_4_test;siesta_mpi_${last_nproc}_drdv_test;siesta_mpi_${last_nproc}_z_1_test;siesta_mpi_${last_nproc}_z_2_test;siesta_mpi_${last_nproc}_z_3_test;siesta_mpi_${last_nproc}_z_4_test;siesta_mpi_${last_nproc}_dzdu_1_test;siesta_mpi_${last_nproc}_dzdu_2_test;siesta_mpi_${last_nproc}_dzdu_3_test;siesta_mpi_${last_nproc}_dzdu_4_test;siesta_mpi_${last_nproc}_dzdv_test;siesta_mpi_${last_nproc}_jacobian_test;siesta_mpi_${last_nproc}_jbsups_test;siesta_mpi_${last_nproc}_jbsupu_test;siesta_mpi_${last_nproc}_jbsupv_test;siesta_mpi_${last_nproc}_siesta_pressure_test;siesta_mpi_${last_nproc}_jksups_test;siesta_mpi_${last_nproc}_jksupu_test;siesta_mpi_${last_nproc}_jksupv_test","siesta_mpi_vmec_test"> + PROCESSORS ${nproc}) + + add_test (NAME siesta_mpi_${nproc}_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=test -min=0.0 -max=1.0 -tol=5.0E-5) + set_tests_properties (siesta_mpi_${nproc}_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + + add_test (NAME siesta_mpi_${nproc}_curtor_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=curtor -tol=0.69) + set_tests_properties (siesta_mpi_${nproc}_curtor_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + + add_test (NAME siesta_mpi_${nproc}_chipf_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=chipf -min=0.0 -max=1.0 -tol=1.2E-6) + set_tests_properties (siesta_mpi_${nproc}_chipf_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + add_test (NAME siesta_mpi_${nproc}_phipf_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=phipf -min=0.0 -max=1.0 -tol=1.1E-17) + set_tests_properties (siesta_mpi_${nproc}_phipf_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + + add_test (NAME siesta_mpi_${nproc}_r_1_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=r -min=0.0 -max=0.01 -tol=5.1E-3) + set_tests_properties (siesta_mpi_${nproc}_r_1_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + add_test (NAME siesta_mpi_${nproc}_r_2_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=r -min=0.01 -max=0.04 -tol=3.7E-4) + set_tests_properties (siesta_mpi_${nproc}_r_2_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + add_test (NAME siesta_mpi_${nproc}_r_3_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=r -min=0.04 -max=0.2 -tol=6.7E-5) + set_tests_properties (siesta_mpi_${nproc}_r_3_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + add_test (NAME siesta_mpi_${nproc}_r_4_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=r -min=0.2 -max=1.0 -tol=6.9E-6) + set_tests_properties (siesta_mpi_${nproc}_r_4_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + + add_test (NAME siesta_mpi_${nproc}_drdu_1_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=drdu -min=0.0 -max=0.01 -tol=5.1E-3) + set_tests_properties (siesta_mpi_${nproc}_drdu_1_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + add_test (NAME siesta_mpi_${nproc}_drdu_2_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=drdu -min=0.01 -max=0.04 -tol=3.6E-4) + set_tests_properties (siesta_mpi_${nproc}_drdu_2_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + add_test (NAME siesta_mpi_${nproc}_drdu_3_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=drdu -min=0.04 -max=0.2 -tol=6.7E-5) + set_tests_properties (siesta_mpi_${nproc}_drdu_3_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + add_test (NAME siesta_mpi_${nproc}_drdu_4_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=drdu -min=0.2 -max=1.0 -tol=6.9E-6) + set_tests_properties (siesta_mpi_${nproc}_drdu_4_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + + add_test (NAME siesta_mpi_${nproc}_drdv_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=drdv -min=0.0 -max=1.0 -tol=1.0E-20) + set_tests_properties (siesta_mpi_${nproc}_drdv_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + + add_test (NAME siesta_mpi_${nproc}_z_1_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=z -min=0.0 -max=0.01 -tol=5.2E-3) + set_tests_properties (siesta_mpi_${nproc}_z_1_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + add_test (NAME siesta_mpi_${nproc}_z_2_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=z -min=0.01 -max=0.04 -tol=3.7E-4) + set_tests_properties (siesta_mpi_${nproc}_z_2_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + add_test (NAME siesta_mpi_${nproc}_z_3_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=z -min=0.04 -max=0.2 -tol=6.8E-5) + set_tests_properties (siesta_mpi_${nproc}_z_3_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + add_test (NAME siesta_mpi_${nproc}_z_4_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=z -min=0.2 -max=1.0 -tol=7.0E-6) + set_tests_properties (siesta_mpi_${nproc}_z_4_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + + add_test (NAME siesta_mpi_${nproc}_dzdu_1_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=dzdu -min=0.0 -max=0.01 -tol=5.2E-3) + set_tests_properties (siesta_mpi_${nproc}_dzdu_1_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + add_test (NAME siesta_mpi_${nproc}_dzdu_2_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=dzdu -min=0.01 -max=0.04 -tol=3.7E-4) + set_tests_properties (siesta_mpi_${nproc}_dzdu_2_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + add_test (NAME siesta_mpi_${nproc}_dzdu_3_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=dzdu -min=0.04 -max=0.2 -tol=6.8E-5) + set_tests_properties (siesta_mpi_${nproc}_dzdu_3_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + add_test (NAME siesta_mpi_${nproc}_dzdu_4_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=dzdu -min=0.2 -max=1.0 -tol=7.0E-6) + set_tests_properties (siesta_mpi_${nproc}_dzdu_4_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + + add_test (NAME siesta_mpi_${nproc}_dzdv_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=dzdv -min=0.0 -max=1.0 -tol=1.0E-20) + set_tests_properties (siesta_mpi_${nproc}_dzdv_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + + add_test (NAME siesta_mpi_${nproc}_jacobian_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=jacobian -min=0.0 -max=1.0 -tol=6.0E-5) + set_tests_properties (siesta_mpi_${nproc}_jacobian_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + + add_test (NAME siesta_mpi_${nproc}_jbsups_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=jbsups -min=0.0 -max=1.0 -tol=1.2E-6) + set_tests_properties (siesta_mpi_${nproc}_jbsups_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + add_test (NAME siesta_mpi_${nproc}_jbsupu_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=jbsupu -min=0.0 -max=1.0 -tol=5.2E-5) + set_tests_properties (siesta_mpi_${nproc}_jbsupu_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + add_test (NAME siesta_mpi_${nproc}_jbsupv_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=jbsupv -min=0.0 -max=1.0 -tol=1.8E-4) + set_tests_properties (siesta_mpi_${nproc}_jbsupv_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + + add_test (NAME siesta_mpi_${nproc}_siesta_pressure_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=pressure -min=0.0 -max=1.0 -tol=0.57) + set_tests_properties (siesta_mpi_${nproc}_siesta_pressure_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + + add_test (NAME siesta_mpi_${nproc}_jksups_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=jbsups -min=0.0 -max=1.0 -tol=1.2E-6) + set_tests_properties (siesta_mpi_${nproc}_jksups_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + add_test (NAME siesta_mpi_${nproc}_jksupu_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=jbsupu -min=0.0 -max=1.0 -tol=0.99 -relative) + set_tests_properties (siesta_mpi_${nproc}_jksupu_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") + add_test (NAME siesta_mpi_${nproc}_jksupv_test + COMMAND $/xsiesta_test -wout_file=${CMAKE_CURRENT_BINARY_DIR}/wout_test.vmec.nc -restart_file=${CMAKE_CURRENT_BINARY_DIR}/siesta_restart_w7x.nc -test_name=jbsupv -min=0.0 -max=1.0 -tol=0.99 -relative) + set_tests_properties (siesta_mpi_${nproc}_jksupv_test + PROPERTIES + DEPENDS "siesta_mpi_vmec_test;siesta_mpi_siesta_${nproc}_test") +endmacro () + +foreach (i RANGE 1 ${MPIEXEC_MAX_NUMPROCS}) + siesta_mpi_tests(${i}) +endforeach () diff --git a/Testing/tests/siesta_mpi_test/input.test.vmec b/Testing/tests/siesta_mpi_test/input.test.vmec new file mode 100644 index 0000000..85e62c4 --- /dev/null +++ b/Testing/tests/siesta_mpi_test/input.test.vmec @@ -0,0 +1,45 @@ +&INDATA + +! VMEC execution parameters. +LFORBAL = F, +LFREEB = F, +DELT = 1.0, +TCON0 = 2.0, +NFP = 1, +NS_ARRAY = 100, +FTOL_ARRAY = 1.0E-20, +NITER = 25000, +NSTEP = 200, +NTOR = 0, +MPOL = 4, +NVACSKIP = 9, +LASYM = F, +LNYQUIST = T, + +! Fitting parameters. +GAMMA = 0.0, +PHIEDGE = -0.05, +BLOAT = 1.0, + +! Initial Position. +RAXIS(0) = 0.75, +ZAXIS(0) = 0.0, +RBC(0,0) = 0.70, +RBC(0,1) = 0.2, +ZBS(0,0) = 0.0, +ZBS(0,1) = 0.2, +RBC(1,1) = 0.01 + +! Plasma current parameters. +NCURR = 1, +CURTOR = 40000.0, +AC = 1.0, 5.0, 10.0 +PCURR_TYPE = 'two_power', + +! Plasma pressure parameters. +SPRES_PED = 1.0, +PRES_SCALE = 400.0, +am = 1.0, 5.0, 10.0 +pmass_type = 'two_power', +/ +&END diff --git a/Testing/tests/siesta_mpi_test/siesta.jcf b/Testing/tests/siesta_mpi_test/siesta.jcf new file mode 100755 index 0000000..1d76a14 --- /dev/null +++ b/Testing/tests/siesta_mpi_test/siesta.jcf @@ -0,0 +1,26 @@ + &SIESTA_INFO + ETA_FACTOR = 1.E-4 + LCOLSCALE = T + LADD_PERT = F + LRESISTIVE = F + LRESTART = F + LRECON = T + lasym = F + NITER = 1000 + NSIN = 100 + MPOLIN = 3 + NTORIN = 0 + NFPIN = 1 + FTOL = 1.E-20, + levmarq_param = 1.0E-1, + MUPAR = 0.0 + WOUT_FILE = 'wout_test.vmec.nc', + RESTART_EXT = 'restart_w7x', + MRES = 2, + HELPERT = 5.0E-4, + L_TRACING = F + NVS = 100 + NUS = 101 + NSS = 101 + NPHIS = 2 + /