test fBase variable
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| class(t_fBase), | intent(inout) | :: | sf |
self |
SUBROUTINE fBase_test( sf) ! MODULES USE MODgvec_GLobals, ONLY: testdbg,testlevel,nfailedMsg,nTestCalled,testUnit IMPLICIT NONE ! INPUT VARIABLES -------------------------! CLASS(t_fBase), INTENT(INOUT) :: sf !! self ! LOCAL VARIABLES -------------------------! INTEGER :: iTest,iMode,jMode,ncoszero,nsinzero,i_mn REAL(wp) :: checkreal,refreal REAL(wp),PARAMETER :: realtol=1.0E-11_wp CHARACTER(LEN=10) :: fail REAL(wp) :: dofs(1:sf%modes),tmpdofs(1:sf%modes),dangle(2) REAL(wp) :: g_IP(1:sf%mn_IP) TYPE(t_fbase) :: testfBase LOGICAL :: check(5) REAL(wp),ALLOCATABLE :: oldDOF(:,:),newDOF(:,:) ! CODE --------------------------------------------------------------------------------------------------------------------------! test_called=.TRUE. !avoid infinite loop if init is called here IF(testlevel.LE.0) RETURN IF(.NOT.MPIroot) RETURN IF(testdbg) THEN Fail=" DEBUG !!" ELSE Fail=" FAILED !!" END IF SWRITE(UNIT_stdOut,'(A,I4,A)')'>>>>>>>>> RUN FBASE TEST ID',nTestCalled,' >>>>>>>>>' ASSOCIATE(& m_max => sf%mn_max(1) & , n_max => sf%mn_max(2) & , m_nyq => sf%mn_nyq(1) & , n_nyq => sf%mn_nyq(2) & , mn_IP => sf%mn_IP & , nfp => sf%nfp & , sin_cos => sf%sin_cos & , sin_range => sf%sin_range & , cos_range => sf%cos_range & , modes => sf%modes & , Xmn => sf%Xmn & ) IF(testlevel.GE.1)THEN iTest=101 ; IF(testdbg)WRITE(*,*)'iTest=',iTest checkreal =SUM(sf%x_IP(1,:)*sf%x_IP(2,:))*sf%d_thet*sf%d_zeta refreal =(0.5_wp*(TWOPI)**2)*REAL(nfp,wp)*(0.5_wp*(TWOPI/REAL(nfp,wp))**2) IF(testdbg.OR.(.NOT.( ABS(checkreal-refreal).LT. realtol))) THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,2(A,I4),2(A,E11.3))') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : ', sin_cos, & '\n => should be ', refreal,' : nfp*int(int(theta*zeta, 0, 2pi),0,2pi/nfp)= ', checkreal END IF !TEST ! check off-diagonals of mass matrix =0 iTest=102 ; IF(testdbg)WRITE(*,*)'iTest=',iTest checkreal=0.0_wp DO iMode=1,modes DO jMode=1,modes IF(iMode.NE.jMode)THEN checkreal=MAX(checkreal,ABS((sf%d_thet*sf%d_zeta)*SUM(sf%base_IP(:,iMode)*sf%base_IP(:,jMode)))) END IF !iMode /=jMode END DO END DO refreal=0.0_wp IF(testdbg.OR.(.NOT.( ABS(checkreal-refreal).LT. realtol))) THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,2(A,E11.3))') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be ', refreal,' : OFF-DIAGONALS of mass matrix 0=:int(int(base(imode)*base(jmode), 0, 2pi),0,2pi/nfp)= ', checkreal END IF !TEST ! check off-diagonals of mass matrix =0 iTest=1021 ; IF(testdbg)WRITE(*,*)'iTest=',iTest checkreal=0.0_wp DO iMode=1,modes !DIAGONAL checkreal=MAX(checkreal,ABS(1.0_wp-sf%snorm_base(iMode)*(sf%d_thet*sf%d_zeta)*SUM(sf%base_IP(:,iMode)*sf%base_IP(:,iMode)))) END DO refreal=0.0_wp IF(testdbg.OR.(.NOT.( ABS(checkreal-refreal).LT. realtol))) THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,2(A,E11.3))') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be ', refreal,' : DIAGONAL OF MASS MATRIX 0=:1-snorm(iMode)*int(int(base(imode)*base(imode), 0, 2pi),0,2pi/nfp)= ', checkreal END IF !TEST iTest=103 ; IF(testdbg)WRITE(*,*)'iTest=',iTest checkreal=0.0_wp nsinzero=0 DO iMode=sin_range(1)+1,sin_range(2) checkreal=checkreal+ ((sf%d_thet*sf%d_zeta)*SUM(sf%base_IP(:,iMode)*sf%base_IP(:,iMode))) IF(sf%zero_odd_even(iMode).EQ.MN_ZERO) nsinzero=nsinzero+1 END DO ncoszero=0 DO iMode=cos_range(1)+1,cos_range(2) checkreal=checkreal+ ((sf%d_thet*sf%d_zeta)*SUM(sf%base_IP(:,iMode)*sf%base_IP(:,iMode))) IF(sf%zero_odd_even(iMode).EQ.MN_ZERO) ncoszero=ncoszero+1 END DO checkreal=checkreal/REAL(modes,wp) refreal=(TWOPI)**2 *( 0.5*(REAL(cos_range(2)-cos_range(1)-ncoszero,wp) + REAL(sin_range(2)-sin_range(1),wp)) & +REAL(ncoszero,wp) )/REAL(modes,wp) IF(testdbg.OR.(.NOT.( (ABS(checkreal-refreal).LT. realtol).AND. & (nsinzero .EQ. 0 ) ))) THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,(A,I4),2(A,E11.3))') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be 0 : nsinzero = ', nsinzero, & '\n => should be ', refreal,' : nfp*int(int(base(imode)*base(imode), 0, 2pi),0,2pi/nfp)= ', checkreal END IF !TEST !test mass matrix of base iTest=104 ; IF(testdbg)WRITE(*,*)'iTest=',iTest checkreal=0.0_wp DO iMode=sin_range(1)+1,sin_range(2) DO jMode=sin_range(1)+1,sin_range(2) checkreal=MAX(checkreal,ABS((sf%d_thet*sf%d_zeta)*SUM(sf%base_IP(:,iMode)*sf%base_dthet_IP(:,jMode)))/REAL(1+ABS(sf%Xmn(1,jmode)),wp)) checkreal=MAX(checkreal,ABS((sf%d_thet*sf%d_zeta)*SUM(sf%base_IP(:,iMode)*sf%base_dzeta_IP(:,jMode)))/REAL(1+ABS(sf%Xmn(2,jmode)),wp)) END DO END DO DO iMode=cos_range(1)+1,cos_range(2) DO jMode=cos_range(1)+1,cos_range(2) checkreal=MAX(checkreal,ABS((sf%d_thet*sf%d_zeta)*SUM(sf%base_IP(:,iMode)*sf%base_dthet_IP(:,jMode)))/REAL(1+ABS(sf%Xmn(1,jmode)),wp)) checkreal=MAX(checkreal,ABS((sf%d_thet*sf%d_zeta)*SUM(sf%base_IP(:,iMode)*sf%base_dzeta_IP(:,jMode)))/REAL(1+ABS(sf%Xmn(2,jmode)),wp)) END DO END DO refreal=0.0_wp IF(testdbg.OR.(.NOT.( ABS(checkreal-refreal).LT. realtol))) THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,2(A,E11.3))') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be ', refreal,' : nfp*int(int(base(imode)*base_dthet/dzeta(jmode), 0, 2pi),0,2pi/nfp)= ', checkreal END IF !TEST !get new fbase and check compare iTest=111 ; IF(testdbg)WRITE(*,*)'iTest=',iTest testfBase = t_fBase(sf%mn_max,sf%mn_nyq,sf%nfp,sin_cos_map(sf%sin_cos),sf%exclude_mn_zero) CALL testfBase%compare(sf,is_same=check(1)) IF(.NOT.check(1))THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,A)') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be true' END IF !TEST !get new fbase and check compare iTest=112 ; IF(testdbg)WRITE(*,*)'iTest=',iTest testfBase = t_fBase(sf%mn_max,sf%mn_nyq,sf%nfp+1,sin_cos_map(sf%sin_cos),(.NOT.sf%exclude_mn_zero)) CALL testfBase%compare(sf,cond_out=check(1:5)) IF(ALL(check))THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,A)') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be false' END IF !TEST !get new fbase and check compare iTest=113 ; IF(testdbg)WRITE(*,*)'iTest=',iTest testfBase = t_fBase(2*sf%mn_max,2*sf%mn_nyq,sf%nfp,sin_cos_map(sf%sin_cos),sf%exclude_mn_zero) CALL testfBase%compare(sf,cond_out=check) IF(ALL(check))THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,A)') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be false' END IF !TEST !get new fbase and check change_base execution (can fail by abort) iTest=121 ; IF(testdbg)WRITE(*,*)'iTest=',iTest testfBase = t_fBase(2*sf%mn_max,2*sf%mn_nyq,sf%nfp,sin_cos_map(sf%sin_cos),sf%exclude_mn_zero) ALLOCATE(oldDOF(1:sf%modes,2),newDOF(1:testfBase%modes,2)) oldDOF(:,1)=1.1_wp oldDOF(:,2)=2.2_wp CALL testfBase%change_base(sf,2,oldDOF,newDOF) checkreal=SUM(newDOF) refreal =SUM(oldDOF) DEALLOCATE(oldDOF,newDOF) IF(testdbg.OR.(.NOT.( (ABS(checkreal-refreal).LT. realtol) ))) THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,2(A,E11.3))') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be ', refreal,' : ', checkreal END IF !TEST IF(sf%mn_max(1).GT.1)THEN !get new fbase and check change_base execution only (can only fail by abort) iTest=122 ; IF(testdbg)WRITE(*,*)'iTest=',iTest testfBase = t_fBase((/sf%mn_max(1)/2,sf%mn_max(2)/),(/sf%mn_nyq(1)/2+1,sf%mn_nyq(2)/),sf%nfp,sin_cos_map(sf%sin_cos),.TRUE.) ALLOCATE(oldDOF(3,1:sf%modes),newDOF(3,1:testfBase%modes)) oldDOF(1,:)=-1.1_wp oldDOF(2,:)=-2.2_wp oldDOF(3,:)=-3.3_wp CALL testfBase%change_base(sf,1,oldDOF,newDOF) checkreal=SUM(newDOF)/REAL(testfBase%modes,wp) refreal =-6.6_wp DEALLOCATE(oldDOF,newDOF) IF(testdbg.OR.(.NOT.( (ABS(checkreal-refreal).LT. realtol) ))) THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,2(A,E11.3))') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be ', refreal,' : ', checkreal END IF !TEST END IF !sf%mn_max>1 iTest=201 ; IF(testdbg)WRITE(*,*)'iTest=',iTest g_IP=0. DO iMode=sin_range(1)+1,sin_range(2) dofs(iMode)=0.1_wp*(REAL(iMode-modes/2,wp)/REAL(modes,wp)) g_IP(:) =g_IP(:)+dofs(iMode)*SIN(REAL(Xmn(1,iMode),wp)*sf%x_IP(1,:)-REAL(Xmn(2,iMode),wp)*sf%x_IP(2,:)) END DO !iMode DO iMode=cos_range(1)+1,cos_range(2) dofs(iMode)=0.1_wp*(REAL(iMode-modes/2,wp)/REAL(modes,wp)) g_IP(:) =g_IP(:)+dofs(iMode)*COS(REAL(Xmn(1,iMode),wp)*sf%x_IP(1,:)-REAL(Xmn(2,iMode),wp)*sf%x_IP(2,:)) END DO !iMode checkreal=MAXVAL(ABS(g_IP-sf%evalDOF_IP(0,dofs))) refreal=0.0_wp IF(testdbg.OR.(.NOT.( ABS(checkreal-refreal).LT. realtol))) THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,2(A,E11.3))') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be ', refreal,' : MAX(|g_IP-evalDOF(dofs)|) ', checkreal END IF !TEST iTest=iTest+1 ; IF(testdbg)WRITE(*,*)'iTest=',iTest checkreal=MAXVAL(ABS(g_IP-sf%evalDOF_xn_tens(sf%mn_nyq(1),sf%mn_nyq(2),sf%X_IP(1,1:sf%mn_nyq(1)),sf%X_IP(2,1:PRODUCT(sf%mn_nyq(1:2)):sf%mn_nyq(1)),0,dofs))) refreal=0.0_wp IF(testdbg.OR.(.NOT.( ABS(checkreal-refreal).LT. realtol))) THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,2(A,E11.3))') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be ', refreal,' : MAX(|g_IP-evalDOF_xn_tens(dofs)|) ', checkreal END IF !TEST iTest=iTest+1 ; IF(testdbg)WRITE(*,*)'iTest=',iTest !use g_IP /dofs from test 201 checkreal=0.0_wp DO i_mn=1,sf%mn_IP checkreal=MAX(checkreal, ABS(g_IP(i_mn)-sf%evalDOF_x(sf%X_IP(:,i_mn),0,dofs))) END DO refreal=0.0_wp IF(testdbg.OR.(.NOT.( ABS(checkreal-refreal).LT. realtol))) THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,2(A,E11.3))') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be ', refreal,' : MAX(|g_IP(:)-evalDOF_x(x,(:),dofs)|) ', checkreal END IF !TEST iTest=iTest+1 ; IF(testdbg)WRITE(*,*)'iTest=',iTest !use g_IP /dofs from test 201 tmpdofs=sf%initDOF(g_IP) checkreal=MAXVAL(ABS(tmpdofs-dofs)) refreal=0.0_wp IF(testdbg.OR.(.NOT.( ABS(checkreal-refreal).LT. realtol))) THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,2(A,E11.3))') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be ', refreal,' : MAX(|initDOF(g_IP)-dofs|) ', checkreal END IF !TEST iTest=iTest+1 ; IF(testdbg)WRITE(*,*)'iTest=',iTest !use g_IP /dofs from test 201 tmpdofs=sf%initDOF(g_IP,thet_zeta_start=(/sf%thet_IP(1),sf%zeta_IP(1)/)) checkreal=MAXVAL(ABS(tmpdofs-dofs)) refreal=0.0_wp IF(testdbg.OR.(.NOT.( ABS(checkreal-refreal).LT. realtol))) THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,2(A,E11.3))') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be ', refreal,' : MAX(|initDOF(g_IP)-initDOF(g_IP,x_IP)|) ', checkreal END IF !TEST iTest=iTest+1 ; IF(testdbg)WRITE(*,*)'iTest=',iTest !use g_IP from test 201 IF(sin_cos.EQ.3)THEN dangle=(/0.333_wp,-0.222_wp/) ELSE dangle=(/TWOPI,-2*TWOPI/) END IF tmpdofs=sf%initDOF(g_IP,thet_zeta_start=(/sf%x_IP(1,1),sf%x_IP(2,1)/)+dangle) checkreal=0.0_wp DO i_mn=1,sf%mn_IP checkreal=MAX(checkreal, ABS(g_IP(i_mn)-sf%evalDOF_x((sf%X_IP(:,i_mn)+dangle),0,tmpdofs))) END DO refreal=0.0_wp IF(testdbg.OR.(.NOT.( ABS(checkreal-refreal).LT. realtol))) THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,2(A,E11.3))') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be ', refreal,' : MAX(|g_IP(:)-evalDOF_x(x+delta,initdof(g_IP,xIP+delta)|)', checkreal END IF !TEST END IF !testlevel <=1 IF (testlevel .GE.2)THEN iTest=2031 ; IF(testdbg)WRITE(*,*)'iTest=',iTest !use g_IP /dofs from test 201 tmpdofs=sf%initDOF(g_IP,thet_zeta_start=(/sf%thet_IP(1),sf%zeta_IP(1)/)) checkreal=MAXVAL(ABS(tmpdofs-dofs)) refreal=0.0_wp IF(testdbg.OR.(.NOT.( ABS(checkreal-refreal).LT. realtol))) THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,2(A,E11.3))') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be ', refreal,' : MAX(|initDOF(g_IP)-initDOF(g_IP,x_IP)|) ', checkreal END IF !TEST iTest=2032 ; IF(testdbg)WRITE(*,*)'iTest=',iTest !use g_IP from test 201 IF(sin_cos.EQ.3)THEN dangle=(/0.333_wp,-0.222_wp/) ELSE dangle=(/TWOPI,-2*TWOPI/) END IF tmpdofs=sf%initDOF(g_IP,thet_zeta_start=(/sf%x_IP(1,1),sf%x_IP(2,1)/)+dangle) checkreal=0.0_wp DO i_mn=1,sf%mn_IP checkreal=MAX(checkreal, ABS(g_IP(i_mn)-sf%evalDOF_x((sf%X_IP(:,i_mn)+dangle),0,tmpdofs))) END DO refreal=0.0_wp IF(testdbg.OR.(.NOT.( ABS(checkreal-refreal).LT. realtol))) THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,2(A,E11.3))') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be ', refreal,' : MAX(|g_IP(:)-evalDOF_x(x+delta,initdof(g_IP,xIP+delta)|)', checkreal END IF !TEST END IF !testlevel <=1 IF (testlevel .GE.2)THEN iTest=iTest+1 ; IF(testdbg)WRITE(*,*)'iTest=',iTest g_IP=0. DO iMode=sin_range(1)+1,sin_range(2) dofs(iMode)=0.1_wp*(REAL(iMode-modes/2,wp)/REAL(modes,wp)) g_IP(:) =g_IP(:)+dofs(iMode)*REAL( Xmn(1,iMode),wp)*COS(REAL(Xmn(1,iMode),wp)*sf%x_IP(1,:)-REAL(Xmn(2,iMode),wp)*sf%x_IP(2,:)) END DO !iMode DO iMode=cos_range(1)+1,cos_range(2) dofs(iMode)=0.1_wp*(REAL(iMode-modes/2,wp)/REAL(modes,wp)) g_IP(:) =g_IP(:)+dofs(iMode)*REAL(-Xmn(1,iMode),wp)*SIN(REAL(Xmn(1,iMode),wp)*sf%x_IP(1,:)-REAL(Xmn(2,iMode),wp)*sf%x_IP(2,:)) END DO !iMode checkreal=MAXVAL(ABS(g_IP-sf%evalDOF_IP(DERIV_THET,dofs))) refreal=0.0_wp IF(testdbg.OR.(.NOT.( ABS(checkreal-refreal).LT. realtol))) THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,2(A,E11.3))') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be ', refreal,' : MAX(|g_IP-evalDOF_dthet(dofs)|) ', checkreal END IF !TEST iTest=iTest+1 ; IF(testdbg)WRITE(*,*)'iTest=',iTest checkreal=MAXVAL(ABS(g_IP-sf%evalDOF_xn_tens(sf%mn_nyq(1),sf%mn_nyq(2),sf%X_IP(1,1:sf%mn_nyq(1)),sf%X_IP(2,1:PRODUCT(sf%mn_nyq(1:2)):sf%mn_nyq(1)),DERIV_THET,dofs))) refreal=0.0_wp IF(testdbg.OR.(.NOT.( ABS(checkreal-refreal).LT. realtol))) THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,2(A,E11.3))') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be ', refreal,' : MAX(|g_IP-evalDOF_xn_tens_dthet(dofs)|) ', checkreal END IF !TEST iTest=iTest+1 ; IF(testdbg)WRITE(*,*)'iTest=',iTest ! use g_IP and dofs from test 204 checkreal=0.0_wp DO i_mn=1,sf%mn_IP checkreal=MAX(checkreal,ABS(g_IP(i_mn)-sf%evalDOF_x(sf%x_IP(:,i_mn),DERIV_THET,dofs))) END DO refreal=0.0_wp IF(testdbg.OR.(.NOT.( ABS(checkreal-refreal).LT. realtol))) THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,2(A,E11.3))') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be ', refreal,' : MAX(|g_IP(:)-evalDOF_x(dthet,x(:),dofs)|) ', checkreal END IF !TEST iTest=206 ; IF(testdbg)WRITE(*,*)'iTest=',iTest g_IP=0. DO iMode=sin_range(1)+1,sin_range(2) dofs(iMode)=0.1_wp*(REAL(iMode-modes/2,wp)/REAL(modes,wp)) g_IP(:) =g_IP(:)+dofs(iMode)*REAL(-Xmn(2,iMode),wp)*COS(REAL(Xmn(1,iMode),wp)*sf%x_IP(1,:)-REAL(Xmn(2,iMode),wp)*sf%x_IP(2,:)) END DO !iMode DO iMode=cos_range(1)+1,cos_range(2) dofs(iMode)=0.1_wp*(REAL(iMode-modes/2,wp)/REAL(modes,wp)) g_IP(:) =g_IP(:)+dofs(iMode)*REAL( Xmn(2,iMode),wp)*SIN(REAL(Xmn(1,iMode),wp)*sf%x_IP(1,:)-REAL(Xmn(2,iMode),wp)*sf%x_IP(2,:)) END DO !iMode checkreal=MAXVAL(ABS(g_IP-sf%evalDOF_IP(DERIV_ZETA,dofs))) refreal=0.0_wp IF(testdbg.OR.(.NOT.( ABS(checkreal-refreal).LT. realtol))) THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,2(A,E11.3))') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be ', refreal,' : MAX(|g_IP-evalDOF_dzeta(dofs)|) ', checkreal END IF !TEST iTest=iTest+1 ; IF(testdbg)WRITE(*,*)'iTest=',iTest checkreal=MAXVAL(ABS(g_IP-sf%evalDOF_xn_tens(sf%mn_nyq(1),sf%mn_nyq(2),sf%X_IP(1,1:sf%mn_nyq(1)),sf%X_IP(2,1:PRODUCT(sf%mn_nyq(1:2)):sf%mn_nyq(1)),DERIV_ZETA,dofs))) refreal=0.0_wp IF(testdbg.OR.(.NOT.( ABS(checkreal-refreal).LT. realtol))) THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,2(A,E11.3))') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be ', refreal,' : MAX(|g_IP-evalDOF_xn_tens_dzeta(dofs)|) ', checkreal END IF !TEST iTest=iTest+1 ; IF(testdbg)WRITE(*,*)'iTest=',iTest !use g_IP / dofs from test 206 checkreal=0.0_wp DO i_mn=1,sf%mn_IP checkreal=MAX(checkreal,ABS(g_IP(i_mn)-sf%evalDOF_x(sf%x_IP(:,i_mn),DERIV_ZETA,dofs))) END DO refreal=0.0_wp IF(testdbg.OR.(.NOT.( ABS(checkreal-refreal).LT. realtol))) THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,2(A,E11.3))') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be ', refreal,' : MAX(|g_IP(:)-evalDOF_x(dzeta,x(:),dofs)|) ', checkreal END IF !TEST iTest=iTest+1 ; IF(testdbg)WRITE(*,*)'iTest=',iTest g_IP=0. DO iMode=sin_range(1)+1,sin_range(2) dofs(iMode)=0.1_wp*(REAL(iMode-modes/2,wp)/REAL(modes,wp)) g_IP(:) =g_IP(:)+dofs(iMode)*REAL(-Xmn(1,iMode)**2,wp)*SIN(REAL(Xmn(1,iMode),wp)*sf%x_IP(1,:)-REAL(Xmn(2,iMode),wp)*sf%x_IP(2,:)) END DO !iMode DO iMode=cos_range(1)+1,cos_range(2) dofs(iMode)=0.1_wp*(REAL(iMode-modes/2,wp)/REAL(modes,wp)) g_IP(:) =g_IP(:)+dofs(iMode)*REAL(-Xmn(1,iMode)**2,wp)*COS(REAL(Xmn(1,iMode),wp)*sf%x_IP(1,:)-REAL(Xmn(2,iMode),wp)*sf%x_IP(2,:)) END DO !iMode checkreal=MAXVAL(ABS(g_IP-sf%evalDOF_IP(DERIV_THET_THET,dofs))) refreal=0.0_wp IF(testdbg.OR.(.NOT.( ABS(checkreal-refreal).LT. realtol))) THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,2(A,E11.3))') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be ', refreal,' : MAX(|g_IP-evalDOF_dthet_dthet(dofs)|) ', checkreal END IF !TEST iTest=iTest+1 ; IF(testdbg)WRITE(*,*)'iTest=',iTest !use g_IP / dofs from test 208 checkreal=0.0_wp DO i_mn=1,sf%mn_IP checkreal=MAX(checkreal,ABS(g_IP(i_mn)-sf%evalDOF_x(sf%x_IP(:,i_mn),DERIV_THET_THET,dofs))) END DO refreal=0.0_wp IF(testdbg.OR.(.NOT.( ABS(checkreal-refreal).LT. realtol))) THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,2(A,E11.3))') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be ', refreal,' : MAX(|g_IP(:)-evalDOF_x(dthet_dthet,x(:),dofs)|) ', checkreal END IF !TEST iTest=iTest+1 ; IF(testdbg)WRITE(*,*)'iTest=',iTest g_IP=0. DO iMode=sin_range(1)+1,sin_range(2) dofs(iMode)=0.1_wp*(REAL(iMode-modes/2,wp)/REAL(modes,wp)) g_IP(:) =g_IP(:)+dofs(iMode)*REAL(Xmn(1,iMode)*Xmn(2,iMode),wp)*SIN(REAL(Xmn(1,iMode),wp)*sf%x_IP(1,:)-REAL(Xmn(2,iMode),wp)*sf%x_IP(2,:)) END DO !iMode DO iMode=cos_range(1)+1,cos_range(2) dofs(iMode)=0.1_wp*(REAL(iMode-modes/2,wp)/REAL(modes,wp)) g_IP(:) =g_IP(:)+dofs(iMode)*REAL(Xmn(1,iMode)*Xmn(2,iMode),wp)*COS(REAL(Xmn(1,iMode),wp)*sf%x_IP(1,:)-REAL(Xmn(2,iMode),wp)*sf%x_IP(2,:)) END DO !iMode checkreal=MAXVAL(ABS(g_IP-sf%evalDOF_IP(DERIV_THET_ZETA,dofs))) refreal=0.0_wp IF(testdbg.OR.(.NOT.( ABS(checkreal-refreal).LT. realtol))) THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,2(A,E11.3))') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be ', refreal,' : MAX(|g_IP-evalDOF_dthet_dzeta(dofs)|) ', checkreal END IF !TEST iTest=iTest+1 ; IF(testdbg)WRITE(*,*)'iTest=',iTest !use g_IP / dofs from test 210 checkreal=0.0_wp DO i_mn=1,sf%mn_IP checkreal=MAX(checkreal,ABS(g_IP(i_mn)-sf%evalDOF_x(sf%x_IP(:,i_mn),DERIV_THET_ZETA,dofs))) END DO refreal=0.0_wp IF(testdbg.OR.(.NOT.( ABS(checkreal-refreal).LT. realtol))) THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,2(A,E11.3))') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be ', refreal,' : MAX(|g_IP(:)-evalDOF_x(dthet_dzeta,x(:),dofs)|) ', checkreal END IF !TEST iTest=iTest+1 ; IF(testdbg)WRITE(*,*)'iTest=',iTest g_IP=0. DO iMode=sin_range(1)+1,sin_range(2) dofs(iMode)=0.1_wp*(REAL(iMode-modes/2,wp)/REAL(modes,wp))/(1.0_wp+SQRT(REAL(Xmn(1,iMode)**2+Xmn(2,iMode)**2,wp))) g_IP(:) =g_IP(:)+dofs(iMode)*REAL(-Xmn(2,iMode)**2,wp)*SIN(REAL(Xmn(1,iMode),wp)*sf%x_IP(1,:)-REAL(Xmn(2,iMode),wp)*sf%x_IP(2,:)) END DO !iMode DO iMode=cos_range(1)+1,cos_range(2) dofs(iMode)=0.2_wp*(REAL(iMode-modes/2,wp)/REAL(modes,wp))/(1.0_wp+SQRT(REAL(Xmn(1,iMode)**2+Xmn(2,iMode)**2,wp))) g_IP(:) =g_IP(:)+dofs(iMode)*REAL(-Xmn(2,iMode)**2,wp)*COS(REAL(Xmn(1,iMode),wp)*sf%x_IP(1,:)-REAL(Xmn(2,iMode),wp)*sf%x_IP(2,:)) END DO !iMode checkreal=MAXVAL(ABS(g_IP-sf%evalDOF_IP(DERIV_ZETA_ZETA,dofs))) refreal=0.0_wp IF(testdbg.OR.(.NOT.( ABS(checkreal-refreal).LT. realtol))) THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,2(A,E11.3))') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be ', refreal,' : MAX(|g_IP-evalDOF_dzeta_dzeta(dofs)|) ', checkreal END IF !TEST iTest=iTest+1 ; IF(testdbg)WRITE(*,*)'iTest=',iTest !use g_IP / dofs from test 212 checkreal=0.0_wp DO i_mn=1,sf%mn_IP checkreal=MAX(checkreal,ABS(g_IP(i_mn)-sf%evalDOF_x(sf%x_IP(:,i_mn),DERIV_ZETA_ZETA,dofs))) END DO refreal=0.0_wp IF(testdbg.OR.(.NOT.( ABS(checkreal-refreal).LT. realtol))) THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,2(A,E11.3))') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be ', refreal,' : MAX(|g_IP(:)-evalDOF_x(dzeta_dzeta,x(:),dofs)|) ', checkreal END IF !TEST iTest=iTest+1 ; IF(testdbg)WRITE(*,*)'iTest=',iTest !use g_IP / dofs from test 212, test evalDOF_xn checkreal=MAXVAL(ABS(g_IP(1:sf%mn_IP/2)-sf%evalDOF_xn(sf%mn_IP/2,sf%x_IP(1:2,1:sf%mn_IP/2),DERIV_ZETA_ZETA,dofs))) refreal=0.0_wp IF(testdbg.OR.(.NOT.( ABS(checkreal-refreal).LT. realtol))) THEN nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,2(I4,A))') & '\n!! FBASE TEST ID',nTestCalled ,': TEST ',iTest,Fail nfailedMsg=nfailedMsg+1 ; WRITE(testUnit,'(A,I6," , ",I6,(A,I4),A,2(A,E11.3))') & ' mn_max= (',m_max,n_max, & ' ) nfp = ',nfp, & ' , sin/cos : '//TRIM( sin_cos_map(sin_cos)), & '\n => should be ', refreal,' : MAX(|g_IP(:)-evalDOF_x(dzeta_dzeta,x(:),dofs)|) ', checkreal END IF !TEST END IF !testlevel <=2 END ASSOCIATE !sf test_called=.FALSE. END SUBROUTINE fBase_test